Annotation of loncom/interface/loncommon.pm, revision 1.1198
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1198 ! musolffc 4: # $Id: loncommon.pm,v 1.1197 2014/07/27 11:39:36 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.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.112 bowersj2 3764: $getattempt, $regexp, $gradesub)
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.112 bowersj2 3786: =back
1.14 harris41 3787:
1.112 bowersj2 3788: The output string is a table containing all desired attempts, if any.
1.16 harris41 3789:
1.112 bowersj2 3790: =cut
1.1 albertel 3791:
3792: sub get_previous_attempt {
1.43 ng 3793: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3794: my $prevattempts='';
1.43 ng 3795: no strict 'refs';
1.1 albertel 3796: if ($symb) {
1.3 albertel 3797: my (%returnhash)=
3798: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3799: if ($returnhash{'version'}) {
3800: my %lasthash=();
3801: my $version;
3802: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3803: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3804: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3805: }
1.1 albertel 3806: }
1.596 albertel 3807: $prevattempts=&start_data_table().&start_data_table_header_row();
3808: $prevattempts.='<th>'.&mt('History').'</th>';
1.978 raeburn 3809: my (%typeparts,%lasthidden);
1.945 raeburn 3810: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3811: foreach my $key (sort(keys(%lasthash))) {
3812: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3813: if ($#parts > 0) {
1.31 albertel 3814: my $data=$parts[-1];
1.989 raeburn 3815: next if ($data eq 'foilorder');
1.31 albertel 3816: pop(@parts);
1.1010 www 3817: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3818: if ($data eq 'type') {
3819: unless ($showsurv) {
3820: my $id = join(',',@parts);
3821: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3822: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3823: $lasthidden{$ign.'.'.$id} = 1;
3824: }
1.945 raeburn 3825: }
1.1010 www 3826: }
1.31 albertel 3827: } else {
1.41 ng 3828: if ($#parts == 0) {
3829: $prevattempts.='<th>'.$parts[0].'</th>';
3830: } else {
3831: $prevattempts.='<th>'.$ign.'</th>';
3832: }
1.31 albertel 3833: }
1.16 harris41 3834: }
1.596 albertel 3835: $prevattempts.=&end_data_table_header_row();
1.40 ng 3836: if ($getattempt eq '') {
3837: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945 raeburn 3838: my @hidden;
3839: if (%typeparts) {
3840: foreach my $id (keys(%typeparts)) {
3841: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
3842: push(@hidden,$id);
3843: }
3844: }
3845: }
3846: $prevattempts.=&start_data_table_row().
3847: '<td>'.&mt('Transaction [_1]',$version).'</td>';
3848: if (@hidden) {
3849: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3850: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3851: my $hide;
3852: foreach my $id (@hidden) {
3853: if ($key =~ /^\Q$id\E/) {
3854: $hide = 1;
3855: last;
3856: }
3857: }
3858: if ($hide) {
3859: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3860: if (($data eq 'award') || ($data eq 'awarddetail')) {
3861: my $value = &format_previous_attempt_value($key,
3862: $returnhash{$version.':'.$key});
1.1173 kruse 3863: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3864: } else {
3865: $prevattempts.='<td> </td>';
3866: }
3867: } else {
3868: if ($key =~ /\./) {
3869: my $value = &format_previous_attempt_value($key,
3870: $returnhash{$version.':'.$key});
1.1173 kruse 3871: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3872: } else {
3873: $prevattempts.='<td> </td>';
3874: }
3875: }
3876: }
3877: } else {
3878: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3879: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3880: my $value = &format_previous_attempt_value($key,
3881: $returnhash{$version.':'.$key});
1.1173 kruse 3882: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3883: }
3884: }
3885: $prevattempts.=&end_data_table_row();
1.40 ng 3886: }
1.1 albertel 3887: }
1.945 raeburn 3888: my @currhidden = keys(%lasthidden);
1.596 albertel 3889: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3890: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3891: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3892: if (%typeparts) {
3893: my $hidden;
3894: foreach my $id (@currhidden) {
3895: if ($key =~ /^\Q$id\E/) {
3896: $hidden = 1;
3897: last;
3898: }
3899: }
3900: if ($hidden) {
3901: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3902: if (($data eq 'award') || ($data eq 'awarddetail')) {
3903: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3904: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3905: $value = &$gradesub($value);
3906: }
1.1173 kruse 3907: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 3908: } else {
3909: $prevattempts.='<td> </td>';
3910: }
3911: } else {
3912: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3913: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3914: $value = &$gradesub($value);
3915: }
1.1173 kruse 3916: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3917: }
3918: } else {
3919: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3920: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3921: $value = &$gradesub($value);
3922: }
1.1173 kruse 3923: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3924: }
1.16 harris41 3925: }
1.596 albertel 3926: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3927: } else {
1.596 albertel 3928: $prevattempts=
3929: &start_data_table().&start_data_table_row().
3930: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3931: &end_data_table_row().&end_data_table();
1.1 albertel 3932: }
3933: } else {
1.596 albertel 3934: $prevattempts=
3935: &start_data_table().&start_data_table_row().
3936: '<td>'.&mt('No data.').'</td>'.
3937: &end_data_table_row().&end_data_table();
1.1 albertel 3938: }
1.10 albertel 3939: }
3940:
1.581 albertel 3941: sub format_previous_attempt_value {
3942: my ($key,$value) = @_;
1.1011 www 3943: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 3944: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 3945: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 3946: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 3947: } elsif ($key =~ /answerstring$/) {
3948: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 3949: my @answer = %answers;
3950: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 3951: my @anskeys = sort(keys(%answers));
3952: if (@anskeys == 1) {
3953: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3954: if ($answer =~ m{\0}) {
3955: $answer =~ s{\0}{,}g;
1.988 raeburn 3956: }
3957: my $tag_internal_answer_name = 'INTERNAL';
3958: if ($anskeys[0] eq $tag_internal_answer_name) {
3959: $value = $answer;
3960: } else {
3961: $value = $anskeys[0].'='.$answer;
3962: }
3963: } else {
3964: foreach my $ans (@anskeys) {
3965: my $answer = $answers{$ans};
1.1001 raeburn 3966: if ($answer =~ m{\0}) {
3967: $answer =~ s{\0}{,}g;
1.988 raeburn 3968: }
3969: $value .= $ans.'='.$answer.'<br />';;
3970: }
3971: }
1.581 albertel 3972: } else {
1.1173 kruse 3973: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 3974: }
3975: return $value;
3976: }
3977:
3978:
1.107 albertel 3979: sub relative_to_absolute {
3980: my ($url,$output)=@_;
3981: my $parser=HTML::TokeParser->new(\$output);
3982: my $token;
3983: my $thisdir=$url;
3984: my @rlinks=();
3985: while ($token=$parser->get_token) {
3986: if ($token->[0] eq 'S') {
3987: if ($token->[1] eq 'a') {
3988: if ($token->[2]->{'href'}) {
3989: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3990: }
3991: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3992: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3993: } elsif ($token->[1] eq 'base') {
3994: $thisdir=$token->[2]->{'href'};
3995: }
3996: }
3997: }
3998: $thisdir=~s-/[^/]*$--;
1.356 albertel 3999: foreach my $link (@rlinks) {
1.726 raeburn 4000: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4001: ($link=~/^\//) ||
4002: ($link=~/^javascript:/i) ||
4003: ($link=~/^mailto:/i) ||
4004: ($link=~/^\#/)) {
4005: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4006: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4007: }
4008: }
4009: # -------------------------------------------------- Deal with Applet codebases
4010: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4011: return $output;
4012: }
4013:
1.112 bowersj2 4014: =pod
4015:
1.648 raeburn 4016: =item * &get_student_view()
1.112 bowersj2 4017:
4018: show a snapshot of what student was looking at
4019:
4020: =cut
4021:
1.10 albertel 4022: sub get_student_view {
1.186 albertel 4023: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4024: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4025: my (%form);
1.10 albertel 4026: my @elements=('symb','courseid','domain','username');
4027: foreach my $element (@elements) {
1.186 albertel 4028: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4029: }
1.186 albertel 4030: if (defined($moreenv)) {
4031: %form=(%form,%{$moreenv});
4032: }
1.236 albertel 4033: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4034: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4035: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4036: $userview=~s/\<body[^\>]*\>//gi;
4037: $userview=~s/\<\/body\>//gi;
4038: $userview=~s/\<html\>//gi;
4039: $userview=~s/\<\/html\>//gi;
4040: $userview=~s/\<head\>//gi;
4041: $userview=~s/\<\/head\>//gi;
4042: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4043: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4044: if (wantarray) {
4045: return ($userview,$response);
4046: } else {
4047: return $userview;
4048: }
4049: }
4050:
4051: sub get_student_view_with_retries {
4052: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4053:
4054: my $ok = 0; # True if we got a good response.
4055: my $content;
4056: my $response;
4057:
4058: # Try to get the student_view done. within the retries count:
4059:
4060: do {
4061: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4062: $ok = $response->is_success;
4063: if (!$ok) {
4064: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4065: }
4066: $retries--;
4067: } while (!$ok && ($retries > 0));
4068:
4069: if (!$ok) {
4070: $content = ''; # On error return an empty content.
4071: }
1.651 www 4072: if (wantarray) {
4073: return ($content, $response);
4074: } else {
4075: return $content;
4076: }
1.11 albertel 4077: }
4078:
1.112 bowersj2 4079: =pod
4080:
1.648 raeburn 4081: =item * &get_student_answers()
1.112 bowersj2 4082:
4083: show a snapshot of how student was answering problem
4084:
4085: =cut
4086:
1.11 albertel 4087: sub get_student_answers {
1.100 sakharuk 4088: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4089: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4090: my (%moreenv);
1.11 albertel 4091: my @elements=('symb','courseid','domain','username');
4092: foreach my $element (@elements) {
1.186 albertel 4093: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4094: }
1.186 albertel 4095: $moreenv{'grade_target'}='answer';
4096: %moreenv=(%form,%moreenv);
1.497 raeburn 4097: $feedurl = &Apache::lonnet::clutter($feedurl);
4098: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4099: return $userview;
1.1 albertel 4100: }
1.116 albertel 4101:
4102: =pod
4103:
4104: =item * &submlink()
4105:
1.242 albertel 4106: Inputs: $text $uname $udom $symb $target
1.116 albertel 4107:
4108: Returns: A link to grades.pm such as to see the SUBM view of a student
4109:
4110: =cut
4111:
4112: ###############################################
4113: sub submlink {
1.242 albertel 4114: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4115: if (!($uname && $udom)) {
4116: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4117: &Apache::lonnet::whichuser($symb);
1.116 albertel 4118: if (!$symb) { $symb=$cursymb; }
4119: }
1.254 matthew 4120: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4121: $symb=&escape($symb);
1.960 bisitz 4122: if ($target) { $target=" target=\"$target\""; }
4123: return
4124: '<a href="/adm/grades?command=submission'.
4125: '&symb='.$symb.
4126: '&student='.$uname.
4127: '&userdom='.$udom.'"'.
4128: $target.'>'.$text.'</a>';
1.242 albertel 4129: }
4130: ##############################################
4131:
4132: =pod
4133:
4134: =item * &pgrdlink()
4135:
4136: Inputs: $text $uname $udom $symb $target
4137:
4138: Returns: A link to grades.pm such as to see the PGRD view of a student
4139:
4140: =cut
4141:
4142: ###############################################
4143: sub pgrdlink {
4144: my $link=&submlink(@_);
4145: $link=~s/(&command=submission)/$1&showgrading=yes/;
4146: return $link;
4147: }
4148: ##############################################
4149:
4150: =pod
4151:
4152: =item * &pprmlink()
4153:
4154: Inputs: $text $uname $udom $symb $target
4155:
4156: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4157: student and a specific resource
1.242 albertel 4158:
4159: =cut
4160:
4161: ###############################################
4162: sub pprmlink {
4163: my ($text,$uname,$udom,$symb,$target)=@_;
4164: if (!($uname && $udom)) {
4165: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4166: &Apache::lonnet::whichuser($symb);
1.242 albertel 4167: if (!$symb) { $symb=$cursymb; }
4168: }
1.254 matthew 4169: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4170: $symb=&escape($symb);
1.242 albertel 4171: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4172: return '<a href="/adm/parmset?command=set&'.
4173: 'symb='.$symb.'&uname='.$uname.
4174: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4175: }
4176: ##############################################
1.37 matthew 4177:
1.112 bowersj2 4178: =pod
4179:
4180: =back
4181:
4182: =cut
4183:
1.37 matthew 4184: ###############################################
1.51 www 4185:
4186:
4187: sub timehash {
1.687 raeburn 4188: my ($thistime) = @_;
4189: my $timezone = &Apache::lonlocal::gettimezone();
4190: my $dt = DateTime->from_epoch(epoch => $thistime)
4191: ->set_time_zone($timezone);
4192: my $wday = $dt->day_of_week();
4193: if ($wday == 7) { $wday = 0; }
4194: return ( 'second' => $dt->second(),
4195: 'minute' => $dt->minute(),
4196: 'hour' => $dt->hour(),
4197: 'day' => $dt->day_of_month(),
4198: 'month' => $dt->month(),
4199: 'year' => $dt->year(),
4200: 'weekday' => $wday,
4201: 'dayyear' => $dt->day_of_year(),
4202: 'dlsav' => $dt->is_dst() );
1.51 www 4203: }
4204:
1.370 www 4205: sub utc_string {
4206: my ($date)=@_;
1.371 www 4207: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4208: }
4209:
1.51 www 4210: sub maketime {
4211: my %th=@_;
1.687 raeburn 4212: my ($epoch_time,$timezone,$dt);
4213: $timezone = &Apache::lonlocal::gettimezone();
4214: eval {
4215: $dt = DateTime->new( year => $th{'year'},
4216: month => $th{'month'},
4217: day => $th{'day'},
4218: hour => $th{'hour'},
4219: minute => $th{'minute'},
4220: second => $th{'second'},
4221: time_zone => $timezone,
4222: );
4223: };
4224: if (!$@) {
4225: $epoch_time = $dt->epoch;
4226: if ($epoch_time) {
4227: return $epoch_time;
4228: }
4229: }
1.51 www 4230: return POSIX::mktime(
4231: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4232: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4233: }
4234:
4235: #########################################
1.51 www 4236:
4237: sub findallcourses {
1.482 raeburn 4238: my ($roles,$uname,$udom) = @_;
1.355 albertel 4239: my %roles;
4240: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4241: my %courses;
1.51 www 4242: my $now=time;
1.482 raeburn 4243: if (!defined($uname)) {
4244: $uname = $env{'user.name'};
4245: }
4246: if (!defined($udom)) {
4247: $udom = $env{'user.domain'};
4248: }
4249: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4250: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4251: if (!%roles) {
4252: %roles = (
4253: cc => 1,
1.907 raeburn 4254: co => 1,
1.482 raeburn 4255: in => 1,
4256: ep => 1,
4257: ta => 1,
4258: cr => 1,
4259: st => 1,
4260: );
4261: }
4262: foreach my $entry (keys(%roleshash)) {
4263: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4264: if ($trole =~ /^cr/) {
4265: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4266: } else {
4267: next if (!exists($roles{$trole}));
4268: }
4269: if ($tend) {
4270: next if ($tend < $now);
4271: }
4272: if ($tstart) {
4273: next if ($tstart > $now);
4274: }
1.1058 raeburn 4275: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4276: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4277: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4278: if ($secpart eq '') {
4279: ($cnum,$role) = split(/_/,$cnumpart);
4280: $sec = 'none';
1.1058 raeburn 4281: $value .= $cnum.'/';
1.482 raeburn 4282: } else {
4283: $cnum = $cnumpart;
4284: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4285: $value .= $cnum.'/'.$sec;
4286: }
4287: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4288: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4289: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4290: }
4291: } else {
4292: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4293: }
1.482 raeburn 4294: }
4295: } else {
4296: foreach my $key (keys(%env)) {
1.483 albertel 4297: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4298: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4299: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4300: next if ($role eq 'ca' || $role eq 'aa');
4301: next if (%roles && !exists($roles{$role}));
4302: my ($starttime,$endtime)=split(/\./,$env{$key});
4303: my $active=1;
4304: if ($starttime) {
4305: if ($now<$starttime) { $active=0; }
4306: }
4307: if ($endtime) {
4308: if ($now>$endtime) { $active=0; }
4309: }
4310: if ($active) {
1.1058 raeburn 4311: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4312: if ($sec eq '') {
4313: $sec = 'none';
1.1058 raeburn 4314: } else {
4315: $value .= $sec;
4316: }
4317: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4318: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4319: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4320: }
4321: } else {
4322: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4323: }
1.474 raeburn 4324: }
4325: }
1.51 www 4326: }
4327: }
1.474 raeburn 4328: return %courses;
1.51 www 4329: }
1.37 matthew 4330:
1.54 www 4331: ###############################################
1.474 raeburn 4332:
4333: sub blockcheck {
1.1189 raeburn 4334: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4335:
1.1189 raeburn 4336: if (defined($udom) && defined($uname)) {
4337: # If uname and udom are for a course, check for blocks in the course.
4338: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4339: my ($startblock,$endblock,$triggerblock) =
4340: &get_blocks($setters,$activity,$udom,$uname,$url);
4341: return ($startblock,$endblock,$triggerblock);
4342: }
4343: } else {
1.490 raeburn 4344: $udom = $env{'user.domain'};
4345: $uname = $env{'user.name'};
4346: }
4347:
1.502 raeburn 4348: my $startblock = 0;
4349: my $endblock = 0;
1.1062 raeburn 4350: my $triggerblock = '';
1.482 raeburn 4351: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4352:
1.490 raeburn 4353: # If uname is for a user, and activity is course-specific, i.e.,
4354: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4355:
1.490 raeburn 4356: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4357: $activity eq 'groups' || $activity eq 'printout') &&
4358: ($env{'request.course.id'})) {
1.490 raeburn 4359: foreach my $key (keys(%live_courses)) {
4360: if ($key ne $env{'request.course.id'}) {
4361: delete($live_courses{$key});
4362: }
4363: }
4364: }
4365:
4366: my $otheruser = 0;
4367: my %own_courses;
4368: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4369: # Resource belongs to user other than current user.
4370: $otheruser = 1;
4371: # Gather courses for current user
4372: %own_courses =
4373: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4374: }
4375:
4376: # Gather active course roles - course coordinator, instructor,
4377: # exam proctor, ta, student, or custom role.
1.474 raeburn 4378:
4379: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4380: my ($cdom,$cnum);
4381: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4382: $cdom = $env{'course.'.$course.'.domain'};
4383: $cnum = $env{'course.'.$course.'.num'};
4384: } else {
1.490 raeburn 4385: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4386: }
4387: my $no_ownblock = 0;
4388: my $no_userblock = 0;
1.533 raeburn 4389: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4390: # Check if current user has 'evb' priv for this
4391: if (defined($own_courses{$course})) {
4392: foreach my $sec (keys(%{$own_courses{$course}})) {
4393: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4394: if ($sec ne 'none') {
4395: $checkrole .= '/'.$sec;
4396: }
4397: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4398: $no_ownblock = 1;
4399: last;
4400: }
4401: }
4402: }
4403: # if they have 'evb' priv and are currently not playing student
4404: next if (($no_ownblock) &&
4405: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4406: }
1.474 raeburn 4407: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4408: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4409: if ($sec ne 'none') {
1.482 raeburn 4410: $checkrole .= '/'.$sec;
1.474 raeburn 4411: }
1.490 raeburn 4412: if ($otheruser) {
4413: # Resource belongs to user other than current user.
4414: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4415: my (%allroles,%userroles);
4416: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4417: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4418: my ($trole,$tdom,$tnum,$tsec);
4419: if ($entry =~ /^cr/) {
4420: ($trole,$tdom,$tnum,$tsec) =
4421: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4422: } else {
4423: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4424: }
4425: my ($spec,$area,$trest);
4426: $area = '/'.$tdom.'/'.$tnum;
4427: $trest = $tnum;
4428: if ($tsec ne '') {
4429: $area .= '/'.$tsec;
4430: $trest .= '/'.$tsec;
4431: }
4432: $spec = $trole.'.'.$area;
4433: if ($trole =~ /^cr/) {
4434: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4435: $tdom,$spec,$trest,$area);
4436: } else {
4437: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4438: $tdom,$spec,$trest,$area);
4439: }
4440: }
4441: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4442: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4443: if ($1) {
4444: $no_userblock = 1;
4445: last;
4446: }
1.486 raeburn 4447: }
4448: }
1.490 raeburn 4449: } else {
4450: # Resource belongs to current user
4451: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4452: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4453: $no_ownblock = 1;
4454: last;
4455: }
1.474 raeburn 4456: }
4457: }
4458: # if they have the evb priv and are currently not playing student
1.482 raeburn 4459: next if (($no_ownblock) &&
1.491 albertel 4460: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4461: next if ($no_userblock);
1.474 raeburn 4462:
1.866 kalberla 4463: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4464: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4465:
1.1062 raeburn 4466: my ($start,$end,$trigger) =
4467: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4468: if (($start != 0) &&
4469: (($startblock == 0) || ($startblock > $start))) {
4470: $startblock = $start;
1.1062 raeburn 4471: if ($trigger ne '') {
4472: $triggerblock = $trigger;
4473: }
1.502 raeburn 4474: }
4475: if (($end != 0) &&
4476: (($endblock == 0) || ($endblock < $end))) {
4477: $endblock = $end;
1.1062 raeburn 4478: if ($trigger ne '') {
4479: $triggerblock = $trigger;
4480: }
1.502 raeburn 4481: }
1.490 raeburn 4482: }
1.1062 raeburn 4483: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4484: }
4485:
4486: sub get_blocks {
1.1062 raeburn 4487: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4488: my $startblock = 0;
4489: my $endblock = 0;
1.1062 raeburn 4490: my $triggerblock = '';
1.490 raeburn 4491: my $course = $cdom.'_'.$cnum;
4492: $setters->{$course} = {};
4493: $setters->{$course}{'staff'} = [];
4494: $setters->{$course}{'times'} = [];
1.1062 raeburn 4495: $setters->{$course}{'triggers'} = [];
4496: my (@blockers,%triggered);
4497: my $now = time;
4498: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4499: if ($activity eq 'docs') {
4500: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4501: foreach my $block (@blockers) {
4502: if ($block =~ /^firstaccess____(.+)$/) {
4503: my $item = $1;
4504: my $type = 'map';
4505: my $timersymb = $item;
4506: if ($item eq 'course') {
4507: $type = 'course';
4508: } elsif ($item =~ /___\d+___/) {
4509: $type = 'resource';
4510: } else {
4511: $timersymb = &Apache::lonnet::symbread($item);
4512: }
4513: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4514: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4515: $triggered{$block} = {
4516: start => $start,
4517: end => $end,
4518: type => $type,
4519: };
4520: }
4521: }
4522: } else {
4523: foreach my $block (keys(%commblocks)) {
4524: if ($block =~ m/^(\d+)____(\d+)$/) {
4525: my ($start,$end) = ($1,$2);
4526: if ($start <= time && $end >= time) {
4527: if (ref($commblocks{$block}) eq 'HASH') {
4528: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4529: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4530: unless(grep(/^\Q$block\E$/,@blockers)) {
4531: push(@blockers,$block);
4532: }
4533: }
4534: }
4535: }
4536: }
4537: } elsif ($block =~ /^firstaccess____(.+)$/) {
4538: my $item = $1;
4539: my $timersymb = $item;
4540: my $type = 'map';
4541: if ($item eq 'course') {
4542: $type = 'course';
4543: } elsif ($item =~ /___\d+___/) {
4544: $type = 'resource';
4545: } else {
4546: $timersymb = &Apache::lonnet::symbread($item);
4547: }
4548: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4549: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4550: if ($start && $end) {
4551: if (($start <= time) && ($end >= time)) {
4552: unless (grep(/^\Q$block\E$/,@blockers)) {
4553: push(@blockers,$block);
4554: $triggered{$block} = {
4555: start => $start,
4556: end => $end,
4557: type => $type,
4558: };
4559: }
4560: }
1.490 raeburn 4561: }
1.1062 raeburn 4562: }
4563: }
4564: }
4565: foreach my $blocker (@blockers) {
4566: my ($staff_name,$staff_dom,$title,$blocks) =
4567: &parse_block_record($commblocks{$blocker});
4568: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4569: my ($start,$end,$triggertype);
4570: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4571: ($start,$end) = ($1,$2);
4572: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4573: $start = $triggered{$blocker}{'start'};
4574: $end = $triggered{$blocker}{'end'};
4575: $triggertype = $triggered{$blocker}{'type'};
4576: }
4577: if ($start) {
4578: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4579: if ($triggertype) {
4580: push(@{$$setters{$course}{'triggers'}},$triggertype);
4581: } else {
4582: push(@{$$setters{$course}{'triggers'}},0);
4583: }
4584: if ( ($startblock == 0) || ($startblock > $start) ) {
4585: $startblock = $start;
4586: if ($triggertype) {
4587: $triggerblock = $blocker;
1.474 raeburn 4588: }
4589: }
1.1062 raeburn 4590: if ( ($endblock == 0) || ($endblock < $end) ) {
4591: $endblock = $end;
4592: if ($triggertype) {
4593: $triggerblock = $blocker;
4594: }
4595: }
1.474 raeburn 4596: }
4597: }
1.1062 raeburn 4598: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4599: }
4600:
4601: sub parse_block_record {
4602: my ($record) = @_;
4603: my ($setuname,$setudom,$title,$blocks);
4604: if (ref($record) eq 'HASH') {
4605: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4606: $title = &unescape($record->{'event'});
4607: $blocks = $record->{'blocks'};
4608: } else {
4609: my @data = split(/:/,$record,3);
4610: if (scalar(@data) eq 2) {
4611: $title = $data[1];
4612: ($setuname,$setudom) = split(/@/,$data[0]);
4613: } else {
4614: ($setuname,$setudom,$title) = @data;
4615: }
4616: $blocks = { 'com' => 'on' };
4617: }
4618: return ($setuname,$setudom,$title,$blocks);
4619: }
4620:
1.854 kalberla 4621: sub blocking_status {
1.1189 raeburn 4622: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4623: my %setters;
1.890 droeschl 4624:
1.1061 raeburn 4625: # check for active blocking
1.1062 raeburn 4626: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4627: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4628: my $blocked = 0;
4629: if ($startblock && $endblock) {
4630: $blocked = 1;
4631: }
1.890 droeschl 4632:
1.1061 raeburn 4633: # caller just wants to know whether a block is active
4634: if (!wantarray) { return $blocked; }
4635:
4636: # build a link to a popup window containing the details
4637: my $querystring = "?activity=$activity";
4638: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4639: if ($activity eq 'port') {
4640: $querystring .= "&udom=$udom" if $udom;
4641: $querystring .= "&uname=$uname" if $uname;
4642: } elsif ($activity eq 'docs') {
4643: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4644: }
1.1061 raeburn 4645:
4646: my $output .= <<'END_MYBLOCK';
4647: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4648: var options = "width=" + w + ",height=" + h + ",";
4649: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4650: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4651: var newWin = window.open(url, wdwName, options);
4652: newWin.focus();
4653: }
1.890 droeschl 4654: END_MYBLOCK
1.854 kalberla 4655:
1.1061 raeburn 4656: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4657:
1.1061 raeburn 4658: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4659: my $text = &mt('Communication Blocked');
4660: if ($activity eq 'docs') {
4661: $text = &mt('Content Access Blocked');
1.1063 raeburn 4662: } elsif ($activity eq 'printout') {
4663: $text = &mt('Printing Blocked');
1.1062 raeburn 4664: }
1.1061 raeburn 4665: $output .= <<"END_BLOCK";
1.867 kalberla 4666: <div class='LC_comblock'>
1.869 kalberla 4667: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4668: title='$text'>
4669: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4670: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4671: title='$text'>$text</a>
1.867 kalberla 4672: </div>
4673:
4674: END_BLOCK
1.474 raeburn 4675:
1.1061 raeburn 4676: return ($blocked, $output);
1.854 kalberla 4677: }
1.490 raeburn 4678:
1.60 matthew 4679: ###############################################
4680:
1.682 raeburn 4681: sub check_ip_acc {
4682: my ($acc)=@_;
4683: &Apache::lonxml::debug("acc is $acc");
4684: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4685: return 1;
4686: }
4687: my $allowed=0;
4688: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4689:
4690: my $name;
4691: foreach my $pattern (split(',',$acc)) {
4692: $pattern =~ s/^\s*//;
4693: $pattern =~ s/\s*$//;
4694: if ($pattern =~ /\*$/) {
4695: #35.8.*
4696: $pattern=~s/\*//;
4697: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4698: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4699: #35.8.3.[34-56]
4700: my $low=$2;
4701: my $high=$3;
4702: $pattern=$1;
4703: if ($ip =~ /^\Q$pattern\E/) {
4704: my $last=(split(/\./,$ip))[3];
4705: if ($last <=$high && $last >=$low) { $allowed=1; }
4706: }
4707: } elsif ($pattern =~ /^\*/) {
4708: #*.msu.edu
4709: $pattern=~s/\*//;
4710: if (!defined($name)) {
4711: use Socket;
4712: my $netaddr=inet_aton($ip);
4713: ($name)=gethostbyaddr($netaddr,AF_INET);
4714: }
4715: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4716: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4717: #127.0.0.1
4718: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4719: } else {
4720: #some.name.com
4721: if (!defined($name)) {
4722: use Socket;
4723: my $netaddr=inet_aton($ip);
4724: ($name)=gethostbyaddr($netaddr,AF_INET);
4725: }
4726: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4727: }
4728: if ($allowed) { last; }
4729: }
4730: return $allowed;
4731: }
4732:
4733: ###############################################
4734:
1.60 matthew 4735: =pod
4736:
1.112 bowersj2 4737: =head1 Domain Template Functions
4738:
4739: =over 4
4740:
4741: =item * &determinedomain()
1.60 matthew 4742:
4743: Inputs: $domain (usually will be undef)
4744:
1.63 www 4745: Returns: Determines which domain should be used for designs
1.60 matthew 4746:
4747: =cut
1.54 www 4748:
1.60 matthew 4749: ###############################################
1.63 www 4750: sub determinedomain {
4751: my $domain=shift;
1.531 albertel 4752: if (! $domain) {
1.60 matthew 4753: # Determine domain if we have not been given one
1.893 raeburn 4754: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4755: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4756: if ($env{'request.role.domain'}) {
4757: $domain=$env{'request.role.domain'};
1.60 matthew 4758: }
4759: }
1.63 www 4760: return $domain;
4761: }
4762: ###############################################
1.517 raeburn 4763:
1.518 albertel 4764: sub devalidate_domconfig_cache {
4765: my ($udom)=@_;
4766: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4767: }
4768:
4769: # ---------------------- Get domain configuration for a domain
4770: sub get_domainconf {
4771: my ($udom) = @_;
4772: my $cachetime=1800;
4773: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4774: if (defined($cached)) { return %{$result}; }
4775:
4776: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4777: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4778: my (%designhash,%legacy);
1.518 albertel 4779: if (keys(%domconfig) > 0) {
4780: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4781: if (keys(%{$domconfig{'login'}})) {
4782: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4783: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4784: if ($key eq 'loginvia') {
4785: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4786: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4787: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4788: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4789: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4790: $designhash{$udom.'.login.loginvia'} = $server;
4791: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4792:
4793: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4794: } else {
1.1013 raeburn 4795: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4796: }
4797: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4798: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4799: }
1.946 raeburn 4800: }
4801: }
4802: }
4803: }
4804: } else {
4805: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4806: $designhash{$udom.'.login.'.$key.'_'.$img} =
4807: $domconfig{'login'}{$key}{$img};
4808: }
1.699 raeburn 4809: }
4810: } else {
4811: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4812: }
1.632 raeburn 4813: }
4814: } else {
4815: $legacy{'login'} = 1;
1.518 albertel 4816: }
1.632 raeburn 4817: } else {
4818: $legacy{'login'} = 1;
1.518 albertel 4819: }
4820: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4821: if (keys(%{$domconfig{'rolecolors'}})) {
4822: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4823: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4824: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4825: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4826: }
1.518 albertel 4827: }
4828: }
1.632 raeburn 4829: } else {
4830: $legacy{'rolecolors'} = 1;
1.518 albertel 4831: }
1.632 raeburn 4832: } else {
4833: $legacy{'rolecolors'} = 1;
1.518 albertel 4834: }
1.948 raeburn 4835: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4836: if ($domconfig{'autoenroll'}{'co-owners'}) {
4837: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4838: }
4839: }
1.632 raeburn 4840: if (keys(%legacy) > 0) {
4841: my %legacyhash = &get_legacy_domconf($udom);
4842: foreach my $item (keys(%legacyhash)) {
4843: if ($item =~ /^\Q$udom\E\.login/) {
4844: if ($legacy{'login'}) {
4845: $designhash{$item} = $legacyhash{$item};
4846: }
4847: } else {
4848: if ($legacy{'rolecolors'}) {
4849: $designhash{$item} = $legacyhash{$item};
4850: }
1.518 albertel 4851: }
4852: }
4853: }
1.632 raeburn 4854: } else {
4855: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4856: }
4857: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4858: $cachetime);
4859: return %designhash;
4860: }
4861:
1.632 raeburn 4862: sub get_legacy_domconf {
4863: my ($udom) = @_;
4864: my %legacyhash;
4865: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4866: my $designfile = $designdir.'/'.$udom.'.tab';
4867: if (-e $designfile) {
4868: if ( open (my $fh,"<$designfile") ) {
4869: while (my $line = <$fh>) {
4870: next if ($line =~ /^\#/);
4871: chomp($line);
4872: my ($key,$val)=(split(/\=/,$line));
4873: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4874: }
4875: close($fh);
4876: }
4877: }
1.1026 raeburn 4878: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4879: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4880: }
4881: return %legacyhash;
4882: }
4883:
1.63 www 4884: =pod
4885:
1.112 bowersj2 4886: =item * &domainlogo()
1.63 www 4887:
4888: Inputs: $domain (usually will be undef)
4889:
4890: Returns: A link to a domain logo, if the domain logo exists.
4891: If the domain logo does not exist, a description of the domain.
4892:
4893: =cut
1.112 bowersj2 4894:
1.63 www 4895: ###############################################
4896: sub domainlogo {
1.517 raeburn 4897: my $domain = &determinedomain(shift);
1.518 albertel 4898: my %designhash = &get_domainconf($domain);
1.517 raeburn 4899: # See if there is a logo
4900: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4901: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4902: if ($imgsrc =~ m{^/(adm|res)/}) {
4903: if ($imgsrc =~ m{^/res/}) {
4904: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4905: &Apache::lonnet::repcopy($local_name);
4906: }
4907: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4908: }
4909: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4910: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4911: return &Apache::lonnet::domain($domain,'description');
1.59 www 4912: } else {
1.60 matthew 4913: return '';
1.59 www 4914: }
4915: }
1.63 www 4916: ##############################################
4917:
4918: =pod
4919:
1.112 bowersj2 4920: =item * &designparm()
1.63 www 4921:
4922: Inputs: $which parameter; $domain (usually will be undef)
4923:
4924: Returns: value of designparamter $which
4925:
4926: =cut
1.112 bowersj2 4927:
1.397 albertel 4928:
1.400 albertel 4929: ##############################################
1.397 albertel 4930: sub designparm {
4931: my ($which,$domain)=@_;
4932: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4933: return $env{'environment.color.'.$which};
1.96 www 4934: }
1.63 www 4935: $domain=&determinedomain($domain);
1.1016 raeburn 4936: my %domdesign;
4937: unless ($domain eq 'public') {
4938: %domdesign = &get_domainconf($domain);
4939: }
1.520 raeburn 4940: my $output;
1.517 raeburn 4941: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4942: $output = $domdesign{$domain.'.'.$which};
1.63 www 4943: } else {
1.520 raeburn 4944: $output = $defaultdesign{$which};
4945: }
4946: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4947: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4948: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4949: if ($output =~ m{^/res/}) {
4950: my $local_name = &Apache::lonnet::filelocation('',$output);
4951: &Apache::lonnet::repcopy($local_name);
4952: }
1.520 raeburn 4953: $output = &lonhttpdurl($output);
4954: }
1.63 www 4955: }
1.520 raeburn 4956: return $output;
1.63 www 4957: }
1.59 www 4958:
1.822 bisitz 4959: ##############################################
4960: =pod
4961:
1.832 bisitz 4962: =item * &authorspace()
4963:
1.1028 raeburn 4964: Inputs: $url (usually will be undef).
1.832 bisitz 4965:
1.1132 raeburn 4966: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4967: directory being viewed (or for which action is being taken).
4968: If $url is provided, and begins /priv/<domain>/<uname>
4969: the path will be that portion of the $context argument.
4970: Otherwise the path will be for the author space of the current
4971: user when the current role is author, or for that of the
4972: co-author/assistant co-author space when the current role
4973: is co-author or assistant co-author.
1.832 bisitz 4974:
4975: =cut
4976:
4977: sub authorspace {
1.1028 raeburn 4978: my ($url) = @_;
4979: if ($url ne '') {
4980: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4981: return $1;
4982: }
4983: }
1.832 bisitz 4984: my $caname = '';
1.1024 www 4985: my $cadom = '';
1.1028 raeburn 4986: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4987: ($cadom,$caname) =
1.832 bisitz 4988: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4989: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4990: $caname = $env{'user.name'};
1.1024 www 4991: $cadom = $env{'user.domain'};
1.832 bisitz 4992: }
1.1028 raeburn 4993: if (($caname ne '') && ($cadom ne '')) {
4994: return "/priv/$cadom/$caname/";
4995: }
4996: return;
1.832 bisitz 4997: }
4998:
4999: ##############################################
5000: =pod
5001:
1.822 bisitz 5002: =item * &head_subbox()
5003:
5004: Inputs: $content (contains HTML code with page functions, etc.)
5005:
5006: Returns: HTML div with $content
5007: To be included in page header
5008:
5009: =cut
5010:
5011: sub head_subbox {
5012: my ($content)=@_;
5013: my $output =
1.993 raeburn 5014: '<div class="LC_head_subbox">'
1.822 bisitz 5015: .$content
5016: .'</div>'
5017: }
5018:
5019: ##############################################
5020: =pod
5021:
5022: =item * &CSTR_pageheader()
5023:
1.1026 raeburn 5024: Input: (optional) filename from which breadcrumb trail is built.
5025: In most cases no input as needed, as $env{'request.filename'}
5026: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5027:
5028: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5029: To be included on Authoring Space pages
1.822 bisitz 5030:
5031: =cut
5032:
5033: sub CSTR_pageheader {
1.1026 raeburn 5034: my ($trailfile) = @_;
5035: if ($trailfile eq '') {
5036: $trailfile = $env{'request.filename'};
5037: }
5038:
5039: # this is for resources; directories have customtitle, and crumbs
5040: # and select recent are created in lonpubdir.pm
5041:
5042: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5043: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5044: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5045: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5046: $formaction =~ s{/+}{/}g;
1.822 bisitz 5047:
5048: my $parentpath = '';
5049: my $lastitem = '';
5050: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5051: $parentpath = $1;
5052: $lastitem = $2;
5053: } else {
5054: $lastitem = $thisdisfn;
5055: }
1.921 bisitz 5056:
5057: my $output =
1.822 bisitz 5058: '<div>'
5059: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5060: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5061: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5062: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5063: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5064:
5065: if ($lastitem) {
5066: $output .=
5067: '<span class="LC_filename">'
5068: .$lastitem
5069: .'</span>';
5070: }
5071: $output .=
5072: '<br />'
1.822 bisitz 5073: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5074: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5075: .'</form>'
5076: .&Apache::lonmenu::constspaceform()
5077: .'</div>';
1.921 bisitz 5078:
5079: return $output;
1.822 bisitz 5080: }
5081:
1.60 matthew 5082: ###############################################
5083: ###############################################
5084:
5085: =pod
5086:
1.112 bowersj2 5087: =back
5088:
1.549 albertel 5089: =head1 HTML Helpers
1.112 bowersj2 5090:
5091: =over 4
5092:
5093: =item * &bodytag()
1.60 matthew 5094:
5095: Returns a uniform header for LON-CAPA web pages.
5096:
5097: Inputs:
5098:
1.112 bowersj2 5099: =over 4
5100:
5101: =item * $title, A title to be displayed on the page.
5102:
5103: =item * $function, the current role (can be undef).
5104:
5105: =item * $addentries, extra parameters for the <body> tag.
5106:
5107: =item * $bodyonly, if defined, only return the <body> tag.
5108:
5109: =item * $domain, if defined, force a given domain.
5110:
5111: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5112: text interface only)
1.60 matthew 5113:
1.814 bisitz 5114: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5115: navigational links
1.317 albertel 5116:
1.338 albertel 5117: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5118:
1.460 albertel 5119: =item * $args, optional argument valid values are
5120: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5121: inherit_jsmath -> when creating popup window in a page,
5122: should it have jsmath forced on by the
5123: current page
1.460 albertel 5124:
1.1096 raeburn 5125: =item * $advtoolsref, optional argument, ref to an array containing
5126: inlineremote items to be added in "Functions" menu below
5127: breadcrumbs.
5128:
1.112 bowersj2 5129: =back
5130:
1.60 matthew 5131: Returns: A uniform header for LON-CAPA web pages.
5132: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5133: If $bodyonly is undef or zero, an html string containing a <body> tag and
5134: other decorations will be returned.
5135:
5136: =cut
5137:
1.54 www 5138: sub bodytag {
1.831 bisitz 5139: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5140: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5141:
1.954 raeburn 5142: my $public;
5143: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5144: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5145: $public = 1;
5146: }
1.460 albertel 5147: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5148: my $httphost = $args->{'use_absolute'};
1.339 albertel 5149:
1.183 matthew 5150: $function = &get_users_function() if (!$function);
1.339 albertel 5151: my $img = &designparm($function.'.img',$domain);
5152: my $font = &designparm($function.'.font',$domain);
5153: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5154:
1.803 bisitz 5155: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5156: 'bgcolor' => $pgbg,
1.339 albertel 5157: 'text' => $font,
5158: 'alink' => &designparm($function.'.alink',$domain),
5159: 'vlink' => &designparm($function.'.vlink',$domain),
5160: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5161: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5162:
1.63 www 5163: # role and realm
1.1178 raeburn 5164: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5165: if ($realm) {
5166: $realm = '/'.$realm;
5167: }
1.378 raeburn 5168: if ($role eq 'ca') {
1.479 albertel 5169: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5170: $realm = &plainname($rname,$rdom);
1.378 raeburn 5171: }
1.55 www 5172: # realm
1.258 albertel 5173: if ($env{'request.course.id'}) {
1.378 raeburn 5174: if ($env{'request.role'} !~ /^cr/) {
5175: $role = &Apache::lonnet::plaintext($role,&course_type());
5176: }
1.898 raeburn 5177: if ($env{'request.course.sec'}) {
5178: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5179: }
1.359 albertel 5180: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5181: } else {
5182: $role = &Apache::lonnet::plaintext($role);
1.54 www 5183: }
1.433 albertel 5184:
1.359 albertel 5185: if (!$realm) { $realm=' '; }
1.330 albertel 5186:
1.438 albertel 5187: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5188:
1.101 www 5189: # construct main body tag
1.359 albertel 5190: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5191: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5192:
1.1131 raeburn 5193: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5194:
1.1130 raeburn 5195: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5196: return $bodytag;
1.1130 raeburn 5197: }
1.359 albertel 5198:
1.954 raeburn 5199: if ($public) {
1.433 albertel 5200: undef($role);
5201: }
1.359 albertel 5202:
1.762 bisitz 5203: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5204: #
5205: # Extra info if you are the DC
5206: my $dc_info = '';
5207: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5208: $env{'course.'.$env{'request.course.id'}.
5209: '.domain'}.'/'})) {
5210: my $cid = $env{'request.course.id'};
1.917 raeburn 5211: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5212: $dc_info =~ s/\s+$//;
1.359 albertel 5213: }
5214:
1.898 raeburn 5215: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5216:
1.903 droeschl 5217: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5218:
5219: # if ($env{'request.state'} eq 'construct') {
5220: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5221: # }
5222:
1.1130 raeburn 5223: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5224: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5225:
1.1130 raeburn 5226: my ($left,$right) = Apache::lonmenu::primary_menu();
1.359 albertel 5227:
1.916 droeschl 5228: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5229: if ($dc_info) {
5230: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5231: }
1.1130 raeburn 5232: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5233: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5234: return $bodytag;
5235: }
1.894 droeschl 5236:
1.927 raeburn 5237: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5238: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5239: }
1.916 droeschl 5240:
1.1130 raeburn 5241: $bodytag .= $right;
1.852 droeschl 5242:
1.917 raeburn 5243: if ($dc_info) {
5244: $dc_info = &dc_courseid_toggle($dc_info);
5245: }
5246: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5247:
1.1169 raeburn 5248: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5249: if ($args->{'no_secondary_menu'}) {
5250: return $bodytag;
5251: }
1.1169 raeburn 5252: #don't show menus for public users
1.954 raeburn 5253: if (!$public){
1.1154 raeburn 5254: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5255: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5256: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5257: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5258: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5259: $args->{'bread_crumbs'});
1.1096 raeburn 5260: } elsif ($forcereg) {
5261: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5262: $args->{'group'});
5263: } else {
5264: $bodytag .=
5265: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5266: $forcereg,$args->{'group'},
5267: $args->{'bread_crumbs'},
5268: $advtoolsref);
1.920 raeburn 5269: }
1.903 droeschl 5270: }else{
5271: # this is to seperate menu from content when there's no secondary
5272: # menu. Especially needed for public accessible ressources.
5273: $bodytag .= '<hr style="clear:both" />';
5274: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5275: }
1.903 droeschl 5276:
1.235 raeburn 5277: return $bodytag;
1.182 matthew 5278: }
5279:
1.917 raeburn 5280: sub dc_courseid_toggle {
5281: my ($dc_info) = @_;
1.980 raeburn 5282: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5283: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5284: &mt('(More ...)').'</a></span>'.
5285: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5286: }
5287:
1.330 albertel 5288: sub make_attr_string {
5289: my ($register,$attr_ref) = @_;
5290:
5291: if ($attr_ref && !ref($attr_ref)) {
5292: die("addentries Must be a hash ref ".
5293: join(':',caller(1))." ".
5294: join(':',caller(0))." ");
5295: }
5296:
5297: if ($register) {
1.339 albertel 5298: my ($on_load,$on_unload);
5299: foreach my $key (keys(%{$attr_ref})) {
5300: if (lc($key) eq 'onload') {
5301: $on_load.=$attr_ref->{$key}.';';
5302: delete($attr_ref->{$key});
5303:
5304: } elsif (lc($key) eq 'onunload') {
5305: $on_unload.=$attr_ref->{$key}.';';
5306: delete($attr_ref->{$key});
5307: }
5308: }
1.953 droeschl 5309: $attr_ref->{'onload'} = $on_load;
5310: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5311: }
1.339 albertel 5312:
1.330 albertel 5313: my $attr_string;
1.1159 raeburn 5314: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5315: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5316: }
5317: return $attr_string;
5318: }
5319:
5320:
1.182 matthew 5321: ###############################################
1.251 albertel 5322: ###############################################
5323:
5324: =pod
5325:
5326: =item * &endbodytag()
5327:
5328: Returns a uniform footer for LON-CAPA web pages.
5329:
1.635 raeburn 5330: Inputs: 1 - optional reference to an args hash
5331: If in the hash, key for noredirectlink has a value which evaluates to true,
5332: a 'Continue' link is not displayed if the page contains an
5333: internal redirect in the <head></head> section,
5334: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5335:
5336: =cut
5337:
5338: sub endbodytag {
1.635 raeburn 5339: my ($args) = @_;
1.1080 raeburn 5340: my $endbodytag;
5341: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5342: $endbodytag='</body>';
5343: }
1.269 albertel 5344: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5345: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5346: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5347: $endbodytag=
5348: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5349: &mt('Continue').'</a>'.
5350: $endbodytag;
5351: }
1.315 albertel 5352: }
1.251 albertel 5353: return $endbodytag;
5354: }
5355:
1.352 albertel 5356: =pod
5357:
5358: =item * &standard_css()
5359:
5360: Returns a style sheet
5361:
5362: Inputs: (all optional)
5363: domain -> force to color decorate a page for a specific
5364: domain
5365: function -> force usage of a specific rolish color scheme
5366: bgcolor -> override the default page bgcolor
5367:
5368: =cut
5369:
1.343 albertel 5370: sub standard_css {
1.345 albertel 5371: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5372: $function = &get_users_function() if (!$function);
5373: my $img = &designparm($function.'.img', $domain);
5374: my $tabbg = &designparm($function.'.tabbg', $domain);
5375: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5376: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5377: #second colour for later usage
1.345 albertel 5378: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5379: my $pgbg_or_bgcolor =
5380: $bgcolor ||
1.352 albertel 5381: &designparm($function.'.pgbg', $domain);
1.382 albertel 5382: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5383: my $alink = &designparm($function.'.alink', $domain);
5384: my $vlink = &designparm($function.'.vlink', $domain);
5385: my $link = &designparm($function.'.link', $domain);
5386:
1.602 albertel 5387: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5388: my $mono = 'monospace';
1.850 bisitz 5389: my $data_table_head = $sidebg;
5390: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5391: my $data_table_dark = '#E0E0E0';
1.470 banghart 5392: my $data_table_darker = '#CCCCCC';
1.349 albertel 5393: my $data_table_highlight = '#FFFF00';
1.352 albertel 5394: my $mail_new = '#FFBB77';
5395: my $mail_new_hover = '#DD9955';
5396: my $mail_read = '#BBBB77';
5397: my $mail_read_hover = '#999944';
5398: my $mail_replied = '#AAAA88';
5399: my $mail_replied_hover = '#888855';
5400: my $mail_other = '#99BBBB';
5401: my $mail_other_hover = '#669999';
1.391 albertel 5402: my $table_header = '#DDDDDD';
1.489 raeburn 5403: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5404: my $lg_border_color = '#C8C8C8';
1.952 onken 5405: my $button_hover = '#BF2317';
1.392 albertel 5406:
1.608 albertel 5407: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5408: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5409: : '0 3px 0 4px';
1.448 albertel 5410:
1.523 albertel 5411:
1.343 albertel 5412: return <<END;
1.947 droeschl 5413:
5414: /* needed for iframe to allow 100% height in FF */
5415: body, html {
5416: margin: 0;
5417: padding: 0 0.5%;
5418: height: 99%; /* to avoid scrollbars */
5419: }
5420:
1.795 www 5421: body {
1.911 bisitz 5422: font-family: $sans;
5423: line-height:130%;
5424: font-size:0.83em;
5425: color:$font;
1.795 www 5426: }
5427:
1.959 onken 5428: a:focus,
5429: a:focus img {
1.795 www 5430: color: red;
5431: }
1.698 harmsja 5432:
1.911 bisitz 5433: form, .inline {
5434: display: inline;
1.795 www 5435: }
1.721 harmsja 5436:
1.795 www 5437: .LC_right {
1.911 bisitz 5438: text-align:right;
1.795 www 5439: }
5440:
5441: .LC_middle {
1.911 bisitz 5442: vertical-align:middle;
1.795 www 5443: }
1.721 harmsja 5444:
1.1130 raeburn 5445: .LC_floatleft {
5446: float: left;
5447: }
5448:
5449: .LC_floatright {
5450: float: right;
5451: }
5452:
1.911 bisitz 5453: .LC_400Box {
5454: width:400px;
5455: }
1.721 harmsja 5456:
1.947 droeschl 5457: .LC_iframecontainer {
5458: width: 98%;
5459: margin: 0;
5460: position: fixed;
5461: top: 8.5em;
5462: bottom: 0;
5463: }
5464:
5465: .LC_iframecontainer iframe{
5466: border: none;
5467: width: 100%;
5468: height: 100%;
5469: }
5470:
1.778 bisitz 5471: .LC_filename {
5472: font-family: $mono;
5473: white-space:pre;
1.921 bisitz 5474: font-size: 120%;
1.778 bisitz 5475: }
5476:
5477: .LC_fileicon {
5478: border: none;
5479: height: 1.3em;
5480: vertical-align: text-bottom;
5481: margin-right: 0.3em;
5482: text-decoration:none;
5483: }
5484:
1.1008 www 5485: .LC_setting {
5486: text-decoration:underline;
5487: }
5488:
1.350 albertel 5489: .LC_error {
5490: color: red;
5491: }
1.795 www 5492:
1.1097 bisitz 5493: .LC_warning {
5494: color: darkorange;
5495: }
5496:
1.457 albertel 5497: .LC_diff_removed {
1.733 bisitz 5498: color: red;
1.394 albertel 5499: }
1.532 albertel 5500:
5501: .LC_info,
1.457 albertel 5502: .LC_success,
5503: .LC_diff_added {
1.350 albertel 5504: color: green;
5505: }
1.795 www 5506:
1.802 bisitz 5507: div.LC_confirm_box {
5508: background-color: #FAFAFA;
5509: border: 1px solid $lg_border_color;
5510: margin-right: 0;
5511: padding: 5px;
5512: }
5513:
5514: div.LC_confirm_box .LC_error img,
5515: div.LC_confirm_box .LC_success img {
5516: vertical-align: middle;
5517: }
5518:
1.440 albertel 5519: .LC_icon {
1.771 droeschl 5520: border: none;
1.790 droeschl 5521: vertical-align: middle;
1.771 droeschl 5522: }
5523:
1.543 albertel 5524: .LC_docs_spacer {
5525: width: 25px;
5526: height: 1px;
1.771 droeschl 5527: border: none;
1.543 albertel 5528: }
1.346 albertel 5529:
1.532 albertel 5530: .LC_internal_info {
1.735 bisitz 5531: color: #999999;
1.532 albertel 5532: }
5533:
1.794 www 5534: .LC_discussion {
1.1050 www 5535: background: $data_table_dark;
1.911 bisitz 5536: border: 1px solid black;
5537: margin: 2px;
1.794 www 5538: }
5539:
5540: .LC_disc_action_left {
1.1050 www 5541: background: $sidebg;
1.911 bisitz 5542: text-align: left;
1.1050 www 5543: padding: 4px;
5544: margin: 2px;
1.794 www 5545: }
5546:
5547: .LC_disc_action_right {
1.1050 www 5548: background: $sidebg;
1.911 bisitz 5549: text-align: right;
1.1050 www 5550: padding: 4px;
5551: margin: 2px;
1.794 www 5552: }
5553:
5554: .LC_disc_new_item {
1.911 bisitz 5555: background: white;
5556: border: 2px solid red;
1.1050 www 5557: margin: 4px;
5558: padding: 4px;
1.794 www 5559: }
5560:
5561: .LC_disc_old_item {
1.911 bisitz 5562: background: white;
1.1050 www 5563: margin: 4px;
5564: padding: 4px;
1.794 www 5565: }
5566:
1.458 albertel 5567: table.LC_pastsubmission {
5568: border: 1px solid black;
5569: margin: 2px;
5570: }
5571:
1.924 bisitz 5572: table#LC_menubuttons {
1.345 albertel 5573: width: 100%;
5574: background: $pgbg;
1.392 albertel 5575: border: 2px;
1.402 albertel 5576: border-collapse: separate;
1.803 bisitz 5577: padding: 0;
1.345 albertel 5578: }
1.392 albertel 5579:
1.801 tempelho 5580: table#LC_title_bar a {
5581: color: $fontmenu;
5582: }
1.836 bisitz 5583:
1.807 droeschl 5584: table#LC_title_bar {
1.819 tempelho 5585: clear: both;
1.836 bisitz 5586: display: none;
1.807 droeschl 5587: }
5588:
1.795 www 5589: table#LC_title_bar,
1.933 droeschl 5590: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5591: table#LC_title_bar.LC_with_remote {
1.359 albertel 5592: width: 100%;
1.392 albertel 5593: border-color: $pgbg;
5594: border-style: solid;
5595: border-width: $border;
1.379 albertel 5596: background: $pgbg;
1.801 tempelho 5597: color: $fontmenu;
1.392 albertel 5598: border-collapse: collapse;
1.803 bisitz 5599: padding: 0;
1.819 tempelho 5600: margin: 0;
1.359 albertel 5601: }
1.795 www 5602:
1.933 droeschl 5603: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5604: margin: 0;
5605: padding: 0;
1.933 droeschl 5606: position: relative;
5607: list-style: none;
1.913 droeschl 5608: }
1.933 droeschl 5609: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5610: display: inline;
5611: }
1.933 droeschl 5612:
5613: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5614: padding: 0;
1.933 droeschl 5615: margin: 0;
5616: float: left;
1.913 droeschl 5617: }
1.933 droeschl 5618: .LC_breadcrumb_tools_tools {
5619: padding: 0;
5620: margin: 0;
1.913 droeschl 5621: float: right;
5622: }
5623:
1.359 albertel 5624: table#LC_title_bar td {
5625: background: $tabbg;
5626: }
1.795 www 5627:
1.911 bisitz 5628: table#LC_menubuttons img {
1.803 bisitz 5629: border: none;
1.346 albertel 5630: }
1.795 www 5631:
1.842 droeschl 5632: .LC_breadcrumbs_component {
1.911 bisitz 5633: float: right;
5634: margin: 0 1em;
1.357 albertel 5635: }
1.842 droeschl 5636: .LC_breadcrumbs_component img {
1.911 bisitz 5637: vertical-align: middle;
1.777 tempelho 5638: }
1.795 www 5639:
1.383 albertel 5640: td.LC_table_cell_checkbox {
5641: text-align: center;
5642: }
1.795 www 5643:
5644: .LC_fontsize_small {
1.911 bisitz 5645: font-size: 70%;
1.705 tempelho 5646: }
5647:
1.844 bisitz 5648: #LC_breadcrumbs {
1.911 bisitz 5649: clear:both;
5650: background: $sidebg;
5651: border-bottom: 1px solid $lg_border_color;
5652: line-height: 2.5em;
1.933 droeschl 5653: overflow: hidden;
1.911 bisitz 5654: margin: 0;
5655: padding: 0;
1.995 raeburn 5656: text-align: left;
1.819 tempelho 5657: }
1.862 bisitz 5658:
1.1098 bisitz 5659: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5660: clear:both;
5661: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5662: border: 1px solid $sidebg;
1.1098 bisitz 5663: margin: 0 0 10px 0;
1.966 bisitz 5664: padding: 3px;
1.995 raeburn 5665: text-align: left;
1.822 bisitz 5666: }
5667:
1.795 www 5668: .LC_fontsize_medium {
1.911 bisitz 5669: font-size: 85%;
1.705 tempelho 5670: }
5671:
1.795 www 5672: .LC_fontsize_large {
1.911 bisitz 5673: font-size: 120%;
1.705 tempelho 5674: }
5675:
1.346 albertel 5676: .LC_menubuttons_inline_text {
5677: color: $font;
1.698 harmsja 5678: font-size: 90%;
1.701 harmsja 5679: padding-left:3px;
1.346 albertel 5680: }
5681:
1.934 droeschl 5682: .LC_menubuttons_inline_text img{
5683: vertical-align: middle;
5684: }
5685:
1.1051 www 5686: li.LC_menubuttons_inline_text img {
1.951 onken 5687: cursor:pointer;
1.1002 droeschl 5688: text-decoration: none;
1.951 onken 5689: }
5690:
1.526 www 5691: .LC_menubuttons_link {
5692: text-decoration: none;
5693: }
1.795 www 5694:
1.522 albertel 5695: .LC_menubuttons_category {
1.521 www 5696: color: $font;
1.526 www 5697: background: $pgbg;
1.521 www 5698: font-size: larger;
5699: font-weight: bold;
5700: }
5701:
1.346 albertel 5702: td.LC_menubuttons_text {
1.911 bisitz 5703: color: $font;
1.346 albertel 5704: }
1.706 harmsja 5705:
1.346 albertel 5706: .LC_current_location {
5707: background: $tabbg;
5708: }
1.795 www 5709:
1.938 bisitz 5710: table.LC_data_table {
1.347 albertel 5711: border: 1px solid #000000;
1.402 albertel 5712: border-collapse: separate;
1.426 albertel 5713: border-spacing: 1px;
1.610 albertel 5714: background: $pgbg;
1.347 albertel 5715: }
1.795 www 5716:
1.422 albertel 5717: .LC_data_table_dense {
5718: font-size: small;
5719: }
1.795 www 5720:
1.507 raeburn 5721: table.LC_nested_outer {
5722: border: 1px solid #000000;
1.589 raeburn 5723: border-collapse: collapse;
1.803 bisitz 5724: border-spacing: 0;
1.507 raeburn 5725: width: 100%;
5726: }
1.795 www 5727:
1.879 raeburn 5728: table.LC_innerpickbox,
1.507 raeburn 5729: table.LC_nested {
1.803 bisitz 5730: border: none;
1.589 raeburn 5731: border-collapse: collapse;
1.803 bisitz 5732: border-spacing: 0;
1.507 raeburn 5733: width: 100%;
5734: }
1.795 www 5735:
1.911 bisitz 5736: table.LC_data_table tr th,
5737: table.LC_calendar tr th,
1.879 raeburn 5738: table.LC_prior_tries tr th,
5739: table.LC_innerpickbox tr th {
1.349 albertel 5740: font-weight: bold;
5741: background-color: $data_table_head;
1.801 tempelho 5742: color:$fontmenu;
1.701 harmsja 5743: font-size:90%;
1.347 albertel 5744: }
1.795 www 5745:
1.879 raeburn 5746: table.LC_innerpickbox tr th,
5747: table.LC_innerpickbox tr td {
5748: vertical-align: top;
5749: }
5750:
1.711 raeburn 5751: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5752: background-color: #CCCCCC;
1.711 raeburn 5753: font-weight: bold;
5754: text-align: left;
5755: }
1.795 www 5756:
1.912 bisitz 5757: table.LC_data_table tr.LC_odd_row > td {
5758: background-color: $data_table_light;
5759: padding: 2px;
5760: vertical-align: top;
5761: }
5762:
1.809 bisitz 5763: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5764: background-color: $data_table_light;
1.912 bisitz 5765: vertical-align: top;
5766: }
5767:
5768: table.LC_data_table tr.LC_even_row > td {
5769: background-color: $data_table_dark;
1.425 albertel 5770: padding: 2px;
1.900 bisitz 5771: vertical-align: top;
1.347 albertel 5772: }
1.795 www 5773:
1.809 bisitz 5774: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5775: background-color: $data_table_dark;
1.900 bisitz 5776: vertical-align: top;
1.347 albertel 5777: }
1.795 www 5778:
1.425 albertel 5779: table.LC_data_table tr.LC_data_table_highlight td {
5780: background-color: $data_table_darker;
5781: }
1.795 www 5782:
1.639 raeburn 5783: table.LC_data_table tr td.LC_leftcol_header {
5784: background-color: $data_table_head;
5785: font-weight: bold;
5786: }
1.795 www 5787:
1.451 albertel 5788: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5789: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5790: font-weight: bold;
5791: font-style: italic;
5792: text-align: center;
5793: padding: 8px;
1.347 albertel 5794: }
1.795 www 5795:
1.1114 raeburn 5796: table.LC_data_table tr.LC_empty_row td,
5797: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5798: background-color: $sidebg;
5799: }
5800:
5801: table.LC_nested tr.LC_empty_row td {
5802: background-color: #FFFFFF;
5803: }
5804:
1.890 droeschl 5805: table.LC_caption {
5806: }
5807:
1.507 raeburn 5808: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5809: padding: 4ex
5810: }
1.795 www 5811:
1.507 raeburn 5812: table.LC_nested_outer tr th {
5813: font-weight: bold;
1.801 tempelho 5814: color:$fontmenu;
1.507 raeburn 5815: background-color: $data_table_head;
1.701 harmsja 5816: font-size: small;
1.507 raeburn 5817: border-bottom: 1px solid #000000;
5818: }
1.795 www 5819:
1.507 raeburn 5820: table.LC_nested_outer tr td.LC_subheader {
5821: background-color: $data_table_head;
5822: font-weight: bold;
5823: font-size: small;
5824: border-bottom: 1px solid #000000;
5825: text-align: right;
1.451 albertel 5826: }
1.795 www 5827:
1.507 raeburn 5828: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5829: background-color: #CCCCCC;
1.451 albertel 5830: font-weight: bold;
5831: font-size: small;
1.507 raeburn 5832: text-align: center;
5833: }
1.795 www 5834:
1.589 raeburn 5835: table.LC_nested tr.LC_info_row td.LC_left_item,
5836: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5837: text-align: left;
1.451 albertel 5838: }
1.795 www 5839:
1.507 raeburn 5840: table.LC_nested td {
1.735 bisitz 5841: background-color: #FFFFFF;
1.451 albertel 5842: font-size: small;
1.507 raeburn 5843: }
1.795 www 5844:
1.507 raeburn 5845: table.LC_nested_outer tr th.LC_right_item,
5846: table.LC_nested tr.LC_info_row td.LC_right_item,
5847: table.LC_nested tr.LC_odd_row td.LC_right_item,
5848: table.LC_nested tr td.LC_right_item {
1.451 albertel 5849: text-align: right;
5850: }
5851:
1.507 raeburn 5852: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5853: background-color: #EEEEEE;
1.451 albertel 5854: }
5855:
1.473 raeburn 5856: table.LC_createuser {
5857: }
5858:
5859: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5860: font-size: small;
1.473 raeburn 5861: }
5862:
5863: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5864: background-color: #CCCCCC;
1.473 raeburn 5865: font-weight: bold;
5866: text-align: center;
5867: }
5868:
1.349 albertel 5869: table.LC_calendar {
5870: border: 1px solid #000000;
5871: border-collapse: collapse;
1.917 raeburn 5872: width: 98%;
1.349 albertel 5873: }
1.795 www 5874:
1.349 albertel 5875: table.LC_calendar_pickdate {
5876: font-size: xx-small;
5877: }
1.795 www 5878:
1.349 albertel 5879: table.LC_calendar tr td {
5880: border: 1px solid #000000;
5881: vertical-align: top;
1.917 raeburn 5882: width: 14%;
1.349 albertel 5883: }
1.795 www 5884:
1.349 albertel 5885: table.LC_calendar tr td.LC_calendar_day_empty {
5886: background-color: $data_table_dark;
5887: }
1.795 www 5888:
1.779 bisitz 5889: table.LC_calendar tr td.LC_calendar_day_current {
5890: background-color: $data_table_highlight;
1.777 tempelho 5891: }
1.795 www 5892:
1.938 bisitz 5893: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5894: background-color: $mail_new;
5895: }
1.795 www 5896:
1.938 bisitz 5897: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5898: background-color: $mail_new_hover;
5899: }
1.795 www 5900:
1.938 bisitz 5901: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5902: background-color: $mail_read;
5903: }
1.795 www 5904:
1.938 bisitz 5905: /*
5906: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5907: background-color: $mail_read_hover;
5908: }
1.938 bisitz 5909: */
1.795 www 5910:
1.938 bisitz 5911: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5912: background-color: $mail_replied;
5913: }
1.795 www 5914:
1.938 bisitz 5915: /*
5916: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5917: background-color: $mail_replied_hover;
5918: }
1.938 bisitz 5919: */
1.795 www 5920:
1.938 bisitz 5921: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5922: background-color: $mail_other;
5923: }
1.795 www 5924:
1.938 bisitz 5925: /*
5926: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5927: background-color: $mail_other_hover;
5928: }
1.938 bisitz 5929: */
1.494 raeburn 5930:
1.777 tempelho 5931: table.LC_data_table tr > td.LC_browser_file,
5932: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5933: background: #AAEE77;
1.389 albertel 5934: }
1.795 www 5935:
1.777 tempelho 5936: table.LC_data_table tr > td.LC_browser_file_locked,
5937: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5938: background: #FFAA99;
1.387 albertel 5939: }
1.795 www 5940:
1.777 tempelho 5941: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5942: background: #888888;
1.779 bisitz 5943: }
1.795 www 5944:
1.777 tempelho 5945: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5946: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5947: background: #F8F866;
1.777 tempelho 5948: }
1.795 www 5949:
1.696 bisitz 5950: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5951: background: #E0E8FF;
1.387 albertel 5952: }
1.696 bisitz 5953:
1.707 bisitz 5954: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5955: /* background: #77FF77; */
1.707 bisitz 5956: }
1.795 www 5957:
1.707 bisitz 5958: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 5959: border-right: 8px solid #FFFF77;
1.707 bisitz 5960: }
1.795 www 5961:
1.707 bisitz 5962: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 5963: border-right: 8px solid #FFAA77;
1.707 bisitz 5964: }
1.795 www 5965:
1.707 bisitz 5966: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 5967: border-right: 8px solid #FF7777;
1.707 bisitz 5968: }
1.795 www 5969:
1.707 bisitz 5970: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 5971: border-right: 8px solid #AAFF77;
1.707 bisitz 5972: }
1.795 www 5973:
1.707 bisitz 5974: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 5975: border-right: 8px solid #11CC55;
1.707 bisitz 5976: }
5977:
1.388 albertel 5978: span.LC_current_location {
1.701 harmsja 5979: font-size:larger;
1.388 albertel 5980: background: $pgbg;
5981: }
1.387 albertel 5982:
1.1029 www 5983: span.LC_current_nav_location {
5984: font-weight:bold;
5985: background: $sidebg;
5986: }
5987:
1.395 albertel 5988: span.LC_parm_menu_item {
5989: font-size: larger;
5990: }
1.795 www 5991:
1.395 albertel 5992: span.LC_parm_scope_all {
5993: color: red;
5994: }
1.795 www 5995:
1.395 albertel 5996: span.LC_parm_scope_folder {
5997: color: green;
5998: }
1.795 www 5999:
1.395 albertel 6000: span.LC_parm_scope_resource {
6001: color: orange;
6002: }
1.795 www 6003:
1.395 albertel 6004: span.LC_parm_part {
6005: color: blue;
6006: }
1.795 www 6007:
1.911 bisitz 6008: span.LC_parm_folder,
6009: span.LC_parm_symb {
1.395 albertel 6010: font-size: x-small;
6011: font-family: $mono;
6012: color: #AAAAAA;
6013: }
6014:
1.977 bisitz 6015: ul.LC_parm_parmlist li {
6016: display: inline-block;
6017: padding: 0.3em 0.8em;
6018: vertical-align: top;
6019: width: 150px;
6020: border-top:1px solid $lg_border_color;
6021: }
6022:
1.795 www 6023: td.LC_parm_overview_level_menu,
6024: td.LC_parm_overview_map_menu,
6025: td.LC_parm_overview_parm_selectors,
6026: td.LC_parm_overview_restrictions {
1.396 albertel 6027: border: 1px solid black;
6028: border-collapse: collapse;
6029: }
1.795 www 6030:
1.396 albertel 6031: table.LC_parm_overview_restrictions td {
6032: border-width: 1px 4px 1px 4px;
6033: border-style: solid;
6034: border-color: $pgbg;
6035: text-align: center;
6036: }
1.795 www 6037:
1.396 albertel 6038: table.LC_parm_overview_restrictions th {
6039: background: $tabbg;
6040: border-width: 1px 4px 1px 4px;
6041: border-style: solid;
6042: border-color: $pgbg;
6043: }
1.795 www 6044:
1.398 albertel 6045: table#LC_helpmenu {
1.803 bisitz 6046: border: none;
1.398 albertel 6047: height: 55px;
1.803 bisitz 6048: border-spacing: 0;
1.398 albertel 6049: }
6050:
6051: table#LC_helpmenu fieldset legend {
6052: font-size: larger;
6053: }
1.795 www 6054:
1.397 albertel 6055: table#LC_helpmenu_links {
6056: width: 100%;
6057: border: 1px solid black;
6058: background: $pgbg;
1.803 bisitz 6059: padding: 0;
1.397 albertel 6060: border-spacing: 1px;
6061: }
1.795 www 6062:
1.397 albertel 6063: table#LC_helpmenu_links tr td {
6064: padding: 1px;
6065: background: $tabbg;
1.399 albertel 6066: text-align: center;
6067: font-weight: bold;
1.397 albertel 6068: }
1.396 albertel 6069:
1.795 www 6070: table#LC_helpmenu_links a:link,
6071: table#LC_helpmenu_links a:visited,
1.397 albertel 6072: table#LC_helpmenu_links a:active {
6073: text-decoration: none;
6074: color: $font;
6075: }
1.795 www 6076:
1.397 albertel 6077: table#LC_helpmenu_links a:hover {
6078: text-decoration: underline;
6079: color: $vlink;
6080: }
1.396 albertel 6081:
1.417 albertel 6082: .LC_chrt_popup_exists {
6083: border: 1px solid #339933;
6084: margin: -1px;
6085: }
1.795 www 6086:
1.417 albertel 6087: .LC_chrt_popup_up {
6088: border: 1px solid yellow;
6089: margin: -1px;
6090: }
1.795 www 6091:
1.417 albertel 6092: .LC_chrt_popup {
6093: border: 1px solid #8888FF;
6094: background: #CCCCFF;
6095: }
1.795 www 6096:
1.421 albertel 6097: table.LC_pick_box {
6098: border-collapse: separate;
6099: background: white;
6100: border: 1px solid black;
6101: border-spacing: 1px;
6102: }
1.795 www 6103:
1.421 albertel 6104: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6105: background: $sidebg;
1.421 albertel 6106: font-weight: bold;
1.900 bisitz 6107: text-align: left;
1.740 bisitz 6108: vertical-align: top;
1.421 albertel 6109: width: 184px;
6110: padding: 8px;
6111: }
1.795 www 6112:
1.579 raeburn 6113: table.LC_pick_box td.LC_pick_box_value {
6114: text-align: left;
6115: padding: 8px;
6116: }
1.795 www 6117:
1.579 raeburn 6118: table.LC_pick_box td.LC_pick_box_select {
6119: text-align: left;
6120: padding: 8px;
6121: }
1.795 www 6122:
1.424 albertel 6123: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6124: padding: 0;
1.421 albertel 6125: height: 1px;
6126: background: black;
6127: }
1.795 www 6128:
1.421 albertel 6129: table.LC_pick_box td.LC_pick_box_submit {
6130: text-align: right;
6131: }
1.795 www 6132:
1.579 raeburn 6133: table.LC_pick_box td.LC_evenrow_value {
6134: text-align: left;
6135: padding: 8px;
6136: background-color: $data_table_light;
6137: }
1.795 www 6138:
1.579 raeburn 6139: table.LC_pick_box td.LC_oddrow_value {
6140: text-align: left;
6141: padding: 8px;
6142: background-color: $data_table_light;
6143: }
1.795 www 6144:
1.579 raeburn 6145: span.LC_helpform_receipt_cat {
6146: font-weight: bold;
6147: }
1.795 www 6148:
1.424 albertel 6149: table.LC_group_priv_box {
6150: background: white;
6151: border: 1px solid black;
6152: border-spacing: 1px;
6153: }
1.795 www 6154:
1.424 albertel 6155: table.LC_group_priv_box td.LC_pick_box_title {
6156: background: $tabbg;
6157: font-weight: bold;
6158: text-align: right;
6159: width: 184px;
6160: }
1.795 www 6161:
1.424 albertel 6162: table.LC_group_priv_box td.LC_groups_fixed {
6163: background: $data_table_light;
6164: text-align: center;
6165: }
1.795 www 6166:
1.424 albertel 6167: table.LC_group_priv_box td.LC_groups_optional {
6168: background: $data_table_dark;
6169: text-align: center;
6170: }
1.795 www 6171:
1.424 albertel 6172: table.LC_group_priv_box td.LC_groups_functionality {
6173: background: $data_table_darker;
6174: text-align: center;
6175: font-weight: bold;
6176: }
1.795 www 6177:
1.424 albertel 6178: table.LC_group_priv td {
6179: text-align: left;
1.803 bisitz 6180: padding: 0;
1.424 albertel 6181: }
6182:
6183: .LC_navbuttons {
6184: margin: 2ex 0ex 2ex 0ex;
6185: }
1.795 www 6186:
1.423 albertel 6187: .LC_topic_bar {
6188: font-weight: bold;
6189: background: $tabbg;
1.918 wenzelju 6190: margin: 1em 0em 1em 2em;
1.805 bisitz 6191: padding: 3px;
1.918 wenzelju 6192: font-size: 1.2em;
1.423 albertel 6193: }
1.795 www 6194:
1.423 albertel 6195: .LC_topic_bar span {
1.918 wenzelju 6196: left: 0.5em;
6197: position: absolute;
1.423 albertel 6198: vertical-align: middle;
1.918 wenzelju 6199: font-size: 1.2em;
1.423 albertel 6200: }
1.795 www 6201:
1.423 albertel 6202: table.LC_course_group_status {
6203: margin: 20px;
6204: }
1.795 www 6205:
1.423 albertel 6206: table.LC_status_selector td {
6207: vertical-align: top;
6208: text-align: center;
1.424 albertel 6209: padding: 4px;
6210: }
1.795 www 6211:
1.599 albertel 6212: div.LC_feedback_link {
1.616 albertel 6213: clear: both;
1.829 kalberla 6214: background: $sidebg;
1.779 bisitz 6215: width: 100%;
1.829 kalberla 6216: padding-bottom: 10px;
6217: border: 1px $tabbg solid;
1.833 kalberla 6218: height: 22px;
6219: line-height: 22px;
6220: padding-top: 5px;
6221: }
6222:
6223: div.LC_feedback_link img {
6224: height: 22px;
1.867 kalberla 6225: vertical-align:middle;
1.829 kalberla 6226: }
6227:
1.911 bisitz 6228: div.LC_feedback_link a {
1.829 kalberla 6229: text-decoration: none;
1.489 raeburn 6230: }
1.795 www 6231:
1.867 kalberla 6232: div.LC_comblock {
1.911 bisitz 6233: display:inline;
1.867 kalberla 6234: color:$font;
6235: font-size:90%;
6236: }
6237:
6238: div.LC_feedback_link div.LC_comblock {
6239: padding-left:5px;
6240: }
6241:
6242: div.LC_feedback_link div.LC_comblock a {
6243: color:$font;
6244: }
6245:
1.489 raeburn 6246: span.LC_feedback_link {
1.858 bisitz 6247: /* background: $feedback_link_bg; */
1.599 albertel 6248: font-size: larger;
6249: }
1.795 www 6250:
1.599 albertel 6251: span.LC_message_link {
1.858 bisitz 6252: /* background: $feedback_link_bg; */
1.599 albertel 6253: font-size: larger;
6254: position: absolute;
6255: right: 1em;
1.489 raeburn 6256: }
1.421 albertel 6257:
1.515 albertel 6258: table.LC_prior_tries {
1.524 albertel 6259: border: 1px solid #000000;
6260: border-collapse: separate;
6261: border-spacing: 1px;
1.515 albertel 6262: }
1.523 albertel 6263:
1.515 albertel 6264: table.LC_prior_tries td {
1.524 albertel 6265: padding: 2px;
1.515 albertel 6266: }
1.523 albertel 6267:
6268: .LC_answer_correct {
1.795 www 6269: background: lightgreen;
6270: color: darkgreen;
6271: padding: 6px;
1.523 albertel 6272: }
1.795 www 6273:
1.523 albertel 6274: .LC_answer_charged_try {
1.797 www 6275: background: #FFAAAA;
1.795 www 6276: color: darkred;
6277: padding: 6px;
1.523 albertel 6278: }
1.795 www 6279:
1.779 bisitz 6280: .LC_answer_not_charged_try,
1.523 albertel 6281: .LC_answer_no_grade,
6282: .LC_answer_late {
1.795 www 6283: background: lightyellow;
1.523 albertel 6284: color: black;
1.795 www 6285: padding: 6px;
1.523 albertel 6286: }
1.795 www 6287:
1.523 albertel 6288: .LC_answer_previous {
1.795 www 6289: background: lightblue;
6290: color: darkblue;
6291: padding: 6px;
1.523 albertel 6292: }
1.795 www 6293:
1.779 bisitz 6294: .LC_answer_no_message {
1.777 tempelho 6295: background: #FFFFFF;
6296: color: black;
1.795 www 6297: padding: 6px;
1.779 bisitz 6298: }
1.795 www 6299:
1.779 bisitz 6300: .LC_answer_unknown {
6301: background: orange;
6302: color: black;
1.795 www 6303: padding: 6px;
1.777 tempelho 6304: }
1.795 www 6305:
1.529 albertel 6306: span.LC_prior_numerical,
6307: span.LC_prior_string,
6308: span.LC_prior_custom,
6309: span.LC_prior_reaction,
6310: span.LC_prior_math {
1.925 bisitz 6311: font-family: $mono;
1.523 albertel 6312: white-space: pre;
6313: }
6314:
1.525 albertel 6315: span.LC_prior_string {
1.925 bisitz 6316: font-family: $mono;
1.525 albertel 6317: white-space: pre;
6318: }
6319:
1.523 albertel 6320: table.LC_prior_option {
6321: width: 100%;
6322: border-collapse: collapse;
6323: }
1.795 www 6324:
1.911 bisitz 6325: table.LC_prior_rank,
1.795 www 6326: table.LC_prior_match {
1.528 albertel 6327: border-collapse: collapse;
6328: }
1.795 www 6329:
1.528 albertel 6330: table.LC_prior_option tr td,
6331: table.LC_prior_rank tr td,
6332: table.LC_prior_match tr td {
1.524 albertel 6333: border: 1px solid #000000;
1.515 albertel 6334: }
6335:
1.855 bisitz 6336: .LC_nobreak {
1.544 albertel 6337: white-space: nowrap;
1.519 raeburn 6338: }
6339:
1.576 raeburn 6340: span.LC_cusr_emph {
6341: font-style: italic;
6342: }
6343:
1.633 raeburn 6344: span.LC_cusr_subheading {
6345: font-weight: normal;
6346: font-size: 85%;
6347: }
6348:
1.861 bisitz 6349: div.LC_docs_entry_move {
1.859 bisitz 6350: border: 1px solid #BBBBBB;
1.545 albertel 6351: background: #DDDDDD;
1.861 bisitz 6352: width: 22px;
1.859 bisitz 6353: padding: 1px;
6354: margin: 0;
1.545 albertel 6355: }
6356:
1.861 bisitz 6357: table.LC_data_table tr > td.LC_docs_entry_commands,
6358: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6359: font-size: x-small;
6360: }
1.795 www 6361:
1.861 bisitz 6362: .LC_docs_entry_parameter {
6363: white-space: nowrap;
6364: }
6365:
1.544 albertel 6366: .LC_docs_copy {
1.545 albertel 6367: color: #000099;
1.544 albertel 6368: }
1.795 www 6369:
1.544 albertel 6370: .LC_docs_cut {
1.545 albertel 6371: color: #550044;
1.544 albertel 6372: }
1.795 www 6373:
1.544 albertel 6374: .LC_docs_rename {
1.545 albertel 6375: color: #009900;
1.544 albertel 6376: }
1.795 www 6377:
1.544 albertel 6378: .LC_docs_remove {
1.545 albertel 6379: color: #990000;
6380: }
6381:
1.547 albertel 6382: .LC_docs_reinit_warn,
6383: .LC_docs_ext_edit {
6384: font-size: x-small;
6385: }
6386:
1.545 albertel 6387: table.LC_docs_adddocs td,
6388: table.LC_docs_adddocs th {
6389: border: 1px solid #BBBBBB;
6390: padding: 4px;
6391: background: #DDDDDD;
1.543 albertel 6392: }
6393:
1.584 albertel 6394: table.LC_sty_begin {
6395: background: #BBFFBB;
6396: }
1.795 www 6397:
1.584 albertel 6398: table.LC_sty_end {
6399: background: #FFBBBB;
6400: }
6401:
1.589 raeburn 6402: table.LC_double_column {
1.803 bisitz 6403: border-width: 0;
1.589 raeburn 6404: border-collapse: collapse;
6405: width: 100%;
6406: padding: 2px;
6407: }
6408:
6409: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6410: top: 2px;
1.589 raeburn 6411: left: 2px;
6412: width: 47%;
6413: vertical-align: top;
6414: }
6415:
6416: table.LC_double_column tr td.LC_right_col {
6417: top: 2px;
1.779 bisitz 6418: right: 2px;
1.589 raeburn 6419: width: 47%;
6420: vertical-align: top;
6421: }
6422:
1.591 raeburn 6423: div.LC_left_float {
6424: float: left;
6425: padding-right: 5%;
1.597 albertel 6426: padding-bottom: 4px;
1.591 raeburn 6427: }
6428:
6429: div.LC_clear_float_header {
1.597 albertel 6430: padding-bottom: 2px;
1.591 raeburn 6431: }
6432:
6433: div.LC_clear_float_footer {
1.597 albertel 6434: padding-top: 10px;
1.591 raeburn 6435: clear: both;
6436: }
6437:
1.597 albertel 6438: div.LC_grade_show_user {
1.941 bisitz 6439: /* border-left: 5px solid $sidebg; */
6440: border-top: 5px solid #000000;
6441: margin: 50px 0 0 0;
1.936 bisitz 6442: padding: 15px 0 5px 10px;
1.597 albertel 6443: }
1.795 www 6444:
1.936 bisitz 6445: div.LC_grade_show_user_odd_row {
1.941 bisitz 6446: /* border-left: 5px solid #000000; */
6447: }
6448:
6449: div.LC_grade_show_user div.LC_Box {
6450: margin-right: 50px;
1.597 albertel 6451: }
6452:
6453: div.LC_grade_submissions,
6454: div.LC_grade_message_center,
1.936 bisitz 6455: div.LC_grade_info_links {
1.597 albertel 6456: margin: 5px;
6457: width: 99%;
6458: background: #FFFFFF;
6459: }
1.795 www 6460:
1.597 albertel 6461: div.LC_grade_submissions_header,
1.936 bisitz 6462: div.LC_grade_message_center_header {
1.705 tempelho 6463: font-weight: bold;
6464: font-size: large;
1.597 albertel 6465: }
1.795 www 6466:
1.597 albertel 6467: div.LC_grade_submissions_body,
1.936 bisitz 6468: div.LC_grade_message_center_body {
1.597 albertel 6469: border: 1px solid black;
6470: width: 99%;
6471: background: #FFFFFF;
6472: }
1.795 www 6473:
1.613 albertel 6474: table.LC_scantron_action {
6475: width: 100%;
6476: }
1.795 www 6477:
1.613 albertel 6478: table.LC_scantron_action tr th {
1.698 harmsja 6479: font-weight:bold;
6480: font-style:normal;
1.613 albertel 6481: }
1.795 www 6482:
1.779 bisitz 6483: .LC_edit_problem_header,
1.614 albertel 6484: div.LC_edit_problem_footer {
1.705 tempelho 6485: font-weight: normal;
6486: font-size: medium;
1.602 albertel 6487: margin: 2px;
1.1060 bisitz 6488: background-color: $sidebg;
1.600 albertel 6489: }
1.795 www 6490:
1.600 albertel 6491: div.LC_edit_problem_header,
1.602 albertel 6492: div.LC_edit_problem_header div,
1.614 albertel 6493: div.LC_edit_problem_footer,
6494: div.LC_edit_problem_footer div,
1.602 albertel 6495: div.LC_edit_problem_editxml_header,
6496: div.LC_edit_problem_editxml_header div {
1.600 albertel 6497: margin-top: 5px;
6498: }
1.795 www 6499:
1.600 albertel 6500: div.LC_edit_problem_header_title {
1.705 tempelho 6501: font-weight: bold;
6502: font-size: larger;
1.602 albertel 6503: background: $tabbg;
6504: padding: 3px;
1.1060 bisitz 6505: margin: 0 0 5px 0;
1.602 albertel 6506: }
1.795 www 6507:
1.602 albertel 6508: table.LC_edit_problem_header_title {
6509: width: 100%;
1.600 albertel 6510: background: $tabbg;
1.602 albertel 6511: }
6512:
6513: div.LC_edit_problem_discards {
6514: float: left;
6515: padding-bottom: 5px;
6516: }
1.795 www 6517:
1.602 albertel 6518: div.LC_edit_problem_saves {
6519: float: right;
6520: padding-bottom: 5px;
1.600 albertel 6521: }
1.795 www 6522:
1.1124 bisitz 6523: .LC_edit_opt {
6524: padding-left: 1em;
6525: white-space: nowrap;
6526: }
6527:
1.1152 golterma 6528: .LC_edit_problem_latexhelper{
6529: text-align: right;
6530: }
6531:
6532: #LC_edit_problem_colorful div{
6533: margin-left: 40px;
6534: }
6535:
1.911 bisitz 6536: img.stift {
1.803 bisitz 6537: border-width: 0;
6538: vertical-align: middle;
1.677 riegler 6539: }
1.680 riegler 6540:
1.923 bisitz 6541: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6542: vertical-align: top;
1.777 tempelho 6543: }
1.795 www 6544:
1.716 raeburn 6545: div.LC_createcourse {
1.911 bisitz 6546: margin: 10px 10px 10px 10px;
1.716 raeburn 6547: }
6548:
1.917 raeburn 6549: .LC_dccid {
1.1130 raeburn 6550: float: right;
1.917 raeburn 6551: margin: 0.2em 0 0 0;
6552: padding: 0;
6553: font-size: 90%;
6554: display:none;
6555: }
6556:
1.897 wenzelju 6557: ol.LC_primary_menu a:hover,
1.721 harmsja 6558: ol#LC_MenuBreadcrumbs a:hover,
6559: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6560: ul#LC_secondary_menu a:hover,
1.721 harmsja 6561: .LC_FormSectionClearButton input:hover
1.795 www 6562: ul.LC_TabContent li:hover a {
1.952 onken 6563: color:$button_hover;
1.911 bisitz 6564: text-decoration:none;
1.693 droeschl 6565: }
6566:
1.779 bisitz 6567: h1 {
1.911 bisitz 6568: padding: 0;
6569: line-height:130%;
1.693 droeschl 6570: }
1.698 harmsja 6571:
1.911 bisitz 6572: h2,
6573: h3,
6574: h4,
6575: h5,
6576: h6 {
6577: margin: 5px 0 5px 0;
6578: padding: 0;
6579: line-height:130%;
1.693 droeschl 6580: }
1.795 www 6581:
6582: .LC_hcell {
1.911 bisitz 6583: padding:3px 15px 3px 15px;
6584: margin: 0;
6585: background-color:$tabbg;
6586: color:$fontmenu;
6587: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6588: }
1.795 www 6589:
1.840 bisitz 6590: .LC_Box > .LC_hcell {
1.911 bisitz 6591: margin: 0 -10px 10px -10px;
1.835 bisitz 6592: }
6593:
1.721 harmsja 6594: .LC_noBorder {
1.911 bisitz 6595: border: 0;
1.698 harmsja 6596: }
1.693 droeschl 6597:
1.721 harmsja 6598: .LC_FormSectionClearButton input {
1.911 bisitz 6599: background-color:transparent;
6600: border: none;
6601: cursor:pointer;
6602: text-decoration:underline;
1.693 droeschl 6603: }
1.763 bisitz 6604:
6605: .LC_help_open_topic {
1.911 bisitz 6606: color: #FFFFFF;
6607: background-color: #EEEEFF;
6608: margin: 1px;
6609: padding: 4px;
6610: border: 1px solid #000033;
6611: white-space: nowrap;
6612: /* vertical-align: middle; */
1.759 neumanie 6613: }
1.693 droeschl 6614:
1.911 bisitz 6615: dl,
6616: ul,
6617: div,
6618: fieldset {
6619: margin: 10px 10px 10px 0;
6620: /* overflow: hidden; */
1.693 droeschl 6621: }
1.795 www 6622:
1.838 bisitz 6623: fieldset > legend {
1.911 bisitz 6624: font-weight: bold;
6625: padding: 0 5px 0 5px;
1.838 bisitz 6626: }
6627:
1.813 bisitz 6628: #LC_nav_bar {
1.911 bisitz 6629: float: left;
1.995 raeburn 6630: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6631: margin: 0 0 2px 0;
1.807 droeschl 6632: }
6633:
1.916 droeschl 6634: #LC_realm {
6635: margin: 0.2em 0 0 0;
6636: padding: 0;
6637: font-weight: bold;
6638: text-align: center;
1.995 raeburn 6639: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6640: }
6641:
1.911 bisitz 6642: #LC_nav_bar em {
6643: font-weight: bold;
6644: font-style: normal;
1.807 droeschl 6645: }
6646:
1.897 wenzelju 6647: ol.LC_primary_menu {
1.934 droeschl 6648: margin: 0;
1.1076 raeburn 6649: padding: 0;
1.995 raeburn 6650: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6651: }
6652:
1.852 droeschl 6653: ol#LC_PathBreadcrumbs {
1.911 bisitz 6654: margin: 0;
1.693 droeschl 6655: }
6656:
1.897 wenzelju 6657: ol.LC_primary_menu li {
1.1076 raeburn 6658: color: RGB(80, 80, 80);
6659: vertical-align: middle;
6660: text-align: left;
6661: list-style: none;
6662: float: left;
6663: }
6664:
6665: ol.LC_primary_menu li a {
6666: display: block;
6667: margin: 0;
6668: padding: 0 5px 0 10px;
6669: text-decoration: none;
6670: }
6671:
6672: ol.LC_primary_menu li ul {
6673: display: none;
6674: width: 10em;
6675: background-color: $data_table_light;
6676: }
6677:
6678: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6679: display: block;
6680: position: absolute;
6681: margin: 0;
6682: padding: 0;
1.1078 raeburn 6683: z-index: 2;
1.1076 raeburn 6684: }
6685:
6686: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6687: font-size: 90%;
1.911 bisitz 6688: vertical-align: top;
1.1076 raeburn 6689: float: none;
1.1079 raeburn 6690: border-left: 1px solid black;
6691: border-right: 1px solid black;
1.1076 raeburn 6692: }
6693:
6694: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078 raeburn 6695: background-color:$data_table_light;
1.1076 raeburn 6696: }
6697:
6698: ol.LC_primary_menu li li a:hover {
6699: color:$button_hover;
6700: background-color:$data_table_dark;
1.693 droeschl 6701: }
6702:
1.897 wenzelju 6703: ol.LC_primary_menu li img {
1.911 bisitz 6704: vertical-align: bottom;
1.934 droeschl 6705: height: 1.1em;
1.1077 raeburn 6706: margin: 0.2em 0 0 0;
1.693 droeschl 6707: }
6708:
1.897 wenzelju 6709: ol.LC_primary_menu a {
1.911 bisitz 6710: color: RGB(80, 80, 80);
6711: text-decoration: none;
1.693 droeschl 6712: }
1.795 www 6713:
1.949 droeschl 6714: ol.LC_primary_menu a.LC_new_message {
6715: font-weight:bold;
6716: color: darkred;
6717: }
6718:
1.975 raeburn 6719: ol.LC_docs_parameters {
6720: margin-left: 0;
6721: padding: 0;
6722: list-style: none;
6723: }
6724:
6725: ol.LC_docs_parameters li {
6726: margin: 0;
6727: padding-right: 20px;
6728: display: inline;
6729: }
6730:
1.976 raeburn 6731: ol.LC_docs_parameters li:before {
6732: content: "\\002022 \\0020";
6733: }
6734:
6735: li.LC_docs_parameters_title {
6736: font-weight: bold;
6737: }
6738:
6739: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6740: content: "";
6741: }
6742:
1.897 wenzelju 6743: ul#LC_secondary_menu {
1.1107 raeburn 6744: clear: right;
1.911 bisitz 6745: color: $fontmenu;
6746: background: $tabbg;
6747: list-style: none;
6748: padding: 0;
6749: margin: 0;
6750: width: 100%;
1.995 raeburn 6751: text-align: left;
1.1107 raeburn 6752: float: left;
1.808 droeschl 6753: }
6754:
1.897 wenzelju 6755: ul#LC_secondary_menu li {
1.911 bisitz 6756: font-weight: bold;
6757: line-height: 1.8em;
1.1107 raeburn 6758: border-right: 1px solid black;
6759: float: left;
6760: }
6761:
6762: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6763: background-color: $data_table_light;
6764: }
6765:
6766: ul#LC_secondary_menu li a {
1.911 bisitz 6767: padding: 0 0.8em;
1.1107 raeburn 6768: }
6769:
6770: ul#LC_secondary_menu li ul {
6771: display: none;
6772: }
6773:
6774: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6775: display: block;
6776: position: absolute;
6777: margin: 0;
6778: padding: 0;
6779: list-style:none;
6780: float: none;
6781: background-color: $data_table_light;
6782: z-index: 2;
6783: margin-left: -1px;
6784: }
6785:
6786: ul#LC_secondary_menu li ul li {
6787: font-size: 90%;
6788: vertical-align: top;
6789: border-left: 1px solid black;
1.911 bisitz 6790: border-right: 1px solid black;
1.1119 raeburn 6791: background-color: $data_table_light;
1.1107 raeburn 6792: list-style:none;
6793: float: none;
6794: }
6795:
6796: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6797: background-color: $data_table_dark;
1.807 droeschl 6798: }
6799:
1.847 tempelho 6800: ul.LC_TabContent {
1.911 bisitz 6801: display:block;
6802: background: $sidebg;
6803: border-bottom: solid 1px $lg_border_color;
6804: list-style:none;
1.1020 raeburn 6805: margin: -1px -10px 0 -10px;
1.911 bisitz 6806: padding: 0;
1.693 droeschl 6807: }
6808:
1.795 www 6809: ul.LC_TabContent li,
6810: ul.LC_TabContentBigger li {
1.911 bisitz 6811: float:left;
1.741 harmsja 6812: }
1.795 www 6813:
1.897 wenzelju 6814: ul#LC_secondary_menu li a {
1.911 bisitz 6815: color: $fontmenu;
6816: text-decoration: none;
1.693 droeschl 6817: }
1.795 www 6818:
1.721 harmsja 6819: ul.LC_TabContent {
1.952 onken 6820: min-height:20px;
1.721 harmsja 6821: }
1.795 www 6822:
6823: ul.LC_TabContent li {
1.911 bisitz 6824: vertical-align:middle;
1.959 onken 6825: padding: 0 16px 0 10px;
1.911 bisitz 6826: background-color:$tabbg;
6827: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6828: border-left: solid 1px $font;
1.721 harmsja 6829: }
1.795 www 6830:
1.847 tempelho 6831: ul.LC_TabContent .right {
1.911 bisitz 6832: float:right;
1.847 tempelho 6833: }
6834:
1.911 bisitz 6835: ul.LC_TabContent li a,
6836: ul.LC_TabContent li {
6837: color:rgb(47,47,47);
6838: text-decoration:none;
6839: font-size:95%;
6840: font-weight:bold;
1.952 onken 6841: min-height:20px;
6842: }
6843:
1.959 onken 6844: ul.LC_TabContent li a:hover,
6845: ul.LC_TabContent li a:focus {
1.952 onken 6846: color: $button_hover;
1.959 onken 6847: background:none;
6848: outline:none;
1.952 onken 6849: }
6850:
6851: ul.LC_TabContent li:hover {
6852: color: $button_hover;
6853: cursor:pointer;
1.721 harmsja 6854: }
1.795 www 6855:
1.911 bisitz 6856: ul.LC_TabContent li.active {
1.952 onken 6857: color: $font;
1.911 bisitz 6858: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6859: border-bottom:solid 1px #FFFFFF;
6860: cursor: default;
1.744 ehlerst 6861: }
1.795 www 6862:
1.959 onken 6863: ul.LC_TabContent li.active a {
6864: color:$font;
6865: background:#FFFFFF;
6866: outline: none;
6867: }
1.1047 raeburn 6868:
6869: ul.LC_TabContent li.goback {
6870: float: left;
6871: border-left: none;
6872: }
6873:
1.870 tempelho 6874: #maincoursedoc {
1.911 bisitz 6875: clear:both;
1.870 tempelho 6876: }
6877:
6878: ul.LC_TabContentBigger {
1.911 bisitz 6879: display:block;
6880: list-style:none;
6881: padding: 0;
1.870 tempelho 6882: }
6883:
1.795 www 6884: ul.LC_TabContentBigger li {
1.911 bisitz 6885: vertical-align:bottom;
6886: height: 30px;
6887: font-size:110%;
6888: font-weight:bold;
6889: color: #737373;
1.841 tempelho 6890: }
6891:
1.957 onken 6892: ul.LC_TabContentBigger li.active {
6893: position: relative;
6894: top: 1px;
6895: }
6896:
1.870 tempelho 6897: ul.LC_TabContentBigger li a {
1.911 bisitz 6898: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6899: height: 30px;
6900: line-height: 30px;
6901: text-align: center;
6902: display: block;
6903: text-decoration: none;
1.958 onken 6904: outline: none;
1.741 harmsja 6905: }
1.795 www 6906:
1.870 tempelho 6907: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6908: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6909: color:$font;
1.744 ehlerst 6910: }
1.795 www 6911:
1.870 tempelho 6912: ul.LC_TabContentBigger li b {
1.911 bisitz 6913: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6914: display: block;
6915: float: left;
6916: padding: 0 30px;
1.957 onken 6917: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6918: }
6919:
1.956 onken 6920: ul.LC_TabContentBigger li:hover b {
6921: color:$button_hover;
6922: }
6923:
1.870 tempelho 6924: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6925: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6926: color:$font;
1.957 onken 6927: border: 0;
1.741 harmsja 6928: }
1.693 droeschl 6929:
1.870 tempelho 6930:
1.862 bisitz 6931: ul.LC_CourseBreadcrumbs {
6932: background: $sidebg;
1.1020 raeburn 6933: height: 2em;
1.862 bisitz 6934: padding-left: 10px;
1.1020 raeburn 6935: margin: 0;
1.862 bisitz 6936: list-style-position: inside;
6937: }
6938:
1.911 bisitz 6939: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6940: ol#LC_PathBreadcrumbs {
1.911 bisitz 6941: padding-left: 10px;
6942: margin: 0;
1.933 droeschl 6943: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6944: }
6945:
1.911 bisitz 6946: ol#LC_MenuBreadcrumbs li,
6947: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6948: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6949: display: inline;
1.933 droeschl 6950: white-space: normal;
1.693 droeschl 6951: }
6952:
1.823 bisitz 6953: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6954: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6955: text-decoration: none;
6956: font-size:90%;
1.693 droeschl 6957: }
1.795 www 6958:
1.969 droeschl 6959: ol#LC_MenuBreadcrumbs h1 {
6960: display: inline;
6961: font-size: 90%;
6962: line-height: 2.5em;
6963: margin: 0;
6964: padding: 0;
6965: }
6966:
1.795 www 6967: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6968: text-decoration:none;
6969: font-size:100%;
6970: font-weight:bold;
1.693 droeschl 6971: }
1.795 www 6972:
1.840 bisitz 6973: .LC_Box {
1.911 bisitz 6974: border: solid 1px $lg_border_color;
6975: padding: 0 10px 10px 10px;
1.746 neumanie 6976: }
1.795 www 6977:
1.1020 raeburn 6978: .LC_DocsBox {
6979: border: solid 1px $lg_border_color;
6980: padding: 0 0 10px 10px;
6981: }
6982:
1.795 www 6983: .LC_AboutMe_Image {
1.911 bisitz 6984: float:left;
6985: margin-right:10px;
1.747 neumanie 6986: }
1.795 www 6987:
6988: .LC_Clear_AboutMe_Image {
1.911 bisitz 6989: clear:left;
1.747 neumanie 6990: }
1.795 www 6991:
1.721 harmsja 6992: dl.LC_ListStyleClean dt {
1.911 bisitz 6993: padding-right: 5px;
6994: display: table-header-group;
1.693 droeschl 6995: }
6996:
1.721 harmsja 6997: dl.LC_ListStyleClean dd {
1.911 bisitz 6998: display: table-row;
1.693 droeschl 6999: }
7000:
1.721 harmsja 7001: .LC_ListStyleClean,
7002: .LC_ListStyleSimple,
7003: .LC_ListStyleNormal,
1.795 www 7004: .LC_ListStyleSpecial {
1.911 bisitz 7005: /* display:block; */
7006: list-style-position: inside;
7007: list-style-type: none;
7008: overflow: hidden;
7009: padding: 0;
1.693 droeschl 7010: }
7011:
1.721 harmsja 7012: .LC_ListStyleSimple li,
7013: .LC_ListStyleSimple dd,
7014: .LC_ListStyleNormal li,
7015: .LC_ListStyleNormal dd,
7016: .LC_ListStyleSpecial li,
1.795 www 7017: .LC_ListStyleSpecial dd {
1.911 bisitz 7018: margin: 0;
7019: padding: 5px 5px 5px 10px;
7020: clear: both;
1.693 droeschl 7021: }
7022:
1.721 harmsja 7023: .LC_ListStyleClean li,
7024: .LC_ListStyleClean dd {
1.911 bisitz 7025: padding-top: 0;
7026: padding-bottom: 0;
1.693 droeschl 7027: }
7028:
1.721 harmsja 7029: .LC_ListStyleSimple dd,
1.795 www 7030: .LC_ListStyleSimple li {
1.911 bisitz 7031: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7032: }
7033:
1.721 harmsja 7034: .LC_ListStyleSpecial li,
7035: .LC_ListStyleSpecial dd {
1.911 bisitz 7036: list-style-type: none;
7037: background-color: RGB(220, 220, 220);
7038: margin-bottom: 4px;
1.693 droeschl 7039: }
7040:
1.721 harmsja 7041: table.LC_SimpleTable {
1.911 bisitz 7042: margin:5px;
7043: border:solid 1px $lg_border_color;
1.795 www 7044: }
1.693 droeschl 7045:
1.721 harmsja 7046: table.LC_SimpleTable tr {
1.911 bisitz 7047: padding: 0;
7048: border:solid 1px $lg_border_color;
1.693 droeschl 7049: }
1.795 www 7050:
7051: table.LC_SimpleTable thead {
1.911 bisitz 7052: background:rgb(220,220,220);
1.693 droeschl 7053: }
7054:
1.721 harmsja 7055: div.LC_columnSection {
1.911 bisitz 7056: display: block;
7057: clear: both;
7058: overflow: hidden;
7059: margin: 0;
1.693 droeschl 7060: }
7061:
1.721 harmsja 7062: div.LC_columnSection>* {
1.911 bisitz 7063: float: left;
7064: margin: 10px 20px 10px 0;
7065: overflow:hidden;
1.693 droeschl 7066: }
1.721 harmsja 7067:
1.795 www 7068: table em {
1.911 bisitz 7069: font-weight: bold;
7070: font-style: normal;
1.748 schulted 7071: }
1.795 www 7072:
1.779 bisitz 7073: table.LC_tableBrowseRes,
1.795 www 7074: table.LC_tableOfContent {
1.911 bisitz 7075: border:none;
7076: border-spacing: 1px;
7077: padding: 3px;
7078: background-color: #FFFFFF;
7079: font-size: 90%;
1.753 droeschl 7080: }
1.789 droeschl 7081:
1.911 bisitz 7082: table.LC_tableOfContent {
7083: border-collapse: collapse;
1.789 droeschl 7084: }
7085:
1.771 droeschl 7086: table.LC_tableBrowseRes a,
1.768 schulted 7087: table.LC_tableOfContent a {
1.911 bisitz 7088: background-color: transparent;
7089: text-decoration: none;
1.753 droeschl 7090: }
7091:
1.795 www 7092: table.LC_tableOfContent img {
1.911 bisitz 7093: border: none;
7094: height: 1.3em;
7095: vertical-align: text-bottom;
7096: margin-right: 0.3em;
1.753 droeschl 7097: }
1.757 schulted 7098:
1.795 www 7099: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7100: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7101: }
7102:
1.795 www 7103: a#LC_content_toolbar_everything {
1.911 bisitz 7104: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7105: }
7106:
1.795 www 7107: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7108: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7109: }
7110:
1.795 www 7111: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7112: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7113: }
7114:
1.795 www 7115: a#LC_content_toolbar_changefolder {
1.911 bisitz 7116: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7117: }
7118:
1.795 www 7119: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7120: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7121: }
7122:
1.1043 raeburn 7123: a#LC_content_toolbar_edittoplevel {
7124: background-image:url(/res/adm/pages/edittoplevel.gif);
7125: }
7126:
1.795 www 7127: ul#LC_toolbar li a:hover {
1.911 bisitz 7128: background-position: bottom center;
1.757 schulted 7129: }
7130:
1.795 www 7131: ul#LC_toolbar {
1.911 bisitz 7132: padding: 0;
7133: margin: 2px;
7134: list-style:none;
7135: position:relative;
7136: background-color:white;
1.1082 raeburn 7137: overflow: auto;
1.757 schulted 7138: }
7139:
1.795 www 7140: ul#LC_toolbar li {
1.911 bisitz 7141: border:1px solid white;
7142: padding: 0;
7143: margin: 0;
7144: float: left;
7145: display:inline;
7146: vertical-align:middle;
1.1082 raeburn 7147: white-space: nowrap;
1.911 bisitz 7148: }
1.757 schulted 7149:
1.783 amueller 7150:
1.795 www 7151: a.LC_toolbarItem {
1.911 bisitz 7152: display:block;
7153: padding: 0;
7154: margin: 0;
7155: height: 32px;
7156: width: 32px;
7157: color:white;
7158: border: none;
7159: background-repeat:no-repeat;
7160: background-color:transparent;
1.757 schulted 7161: }
7162:
1.915 droeschl 7163: ul.LC_funclist {
7164: margin: 0;
7165: padding: 0.5em 1em 0.5em 0;
7166: }
7167:
1.933 droeschl 7168: ul.LC_funclist > li:first-child {
7169: font-weight:bold;
7170: margin-left:0.8em;
7171: }
7172:
1.915 droeschl 7173: ul.LC_funclist + ul.LC_funclist {
7174: /*
7175: left border as a seperator if we have more than
7176: one list
7177: */
7178: border-left: 1px solid $sidebg;
7179: /*
7180: this hides the left border behind the border of the
7181: outer box if element is wrapped to the next 'line'
7182: */
7183: margin-left: -1px;
7184: }
7185:
1.843 bisitz 7186: ul.LC_funclist li {
1.915 droeschl 7187: display: inline;
1.782 bisitz 7188: white-space: nowrap;
1.915 droeschl 7189: margin: 0 0 0 25px;
7190: line-height: 150%;
1.782 bisitz 7191: }
7192:
1.974 wenzelju 7193: .LC_hidden {
7194: display: none;
7195: }
7196:
1.1030 www 7197: .LCmodal-overlay {
7198: position:fixed;
7199: top:0;
7200: right:0;
7201: bottom:0;
7202: left:0;
7203: height:100%;
7204: width:100%;
7205: margin:0;
7206: padding:0;
7207: background:#999;
7208: opacity:.75;
7209: filter: alpha(opacity=75);
7210: -moz-opacity: 0.75;
7211: z-index:101;
7212: }
7213:
7214: * html .LCmodal-overlay {
7215: position: absolute;
7216: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7217: }
7218:
7219: .LCmodal-window {
7220: position:fixed;
7221: top:50%;
7222: left:50%;
7223: margin:0;
7224: padding:0;
7225: z-index:102;
7226: }
7227:
7228: * html .LCmodal-window {
7229: position:absolute;
7230: }
7231:
7232: .LCclose-window {
7233: position:absolute;
7234: width:32px;
7235: height:32px;
7236: right:8px;
7237: top:8px;
7238: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7239: text-indent:-99999px;
7240: overflow:hidden;
7241: cursor:pointer;
7242: }
7243:
1.1100 raeburn 7244: /*
7245: styles used by TTH when "Default set of options to pass to tth/m
7246: when converting TeX" in course settings has been set
7247:
7248: option passed: -t
7249:
7250: */
7251:
7252: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7253: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7254: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7255: td div.norm {line-height:normal;}
7256:
7257: /*
7258: option passed -y3
7259: */
7260:
7261: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7262: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7263: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7264:
1.343 albertel 7265: END
7266: }
7267:
1.306 albertel 7268: =pod
7269:
7270: =item * &headtag()
7271:
7272: Returns a uniform footer for LON-CAPA web pages.
7273:
1.307 albertel 7274: Inputs: $title - optional title for the head
7275: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7276: $args - optional arguments
1.319 albertel 7277: force_register - if is true call registerurl so the remote is
7278: informed
1.415 albertel 7279: redirect -> array ref of
7280: 1- seconds before redirect occurs
7281: 2- url to redirect to
7282: 3- whether the side effect should occur
1.315 albertel 7283: (side effect of setting
7284: $env{'internal.head.redirect'} to the url
7285: redirected too)
1.352 albertel 7286: domain -> force to color decorate a page for a specific
7287: domain
7288: function -> force usage of a specific rolish color scheme
7289: bgcolor -> override the default page bgcolor
1.460 albertel 7290: no_auto_mt_title
7291: -> prevent &mt()ing the title arg
1.464 albertel 7292:
1.306 albertel 7293: =cut
7294:
7295: sub headtag {
1.313 albertel 7296: my ($title,$head_extra,$args) = @_;
1.306 albertel 7297:
1.363 albertel 7298: my $function = $args->{'function'} || &get_users_function();
7299: my $domain = $args->{'domain'} || &determinedomain();
7300: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7301: my $httphost = $args->{'use_absolute'};
1.418 albertel 7302: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7303: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7304: #time(),
1.418 albertel 7305: $env{'environment.color.timestamp'},
1.363 albertel 7306: $function,$domain,$bgcolor);
7307:
1.369 www 7308: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7309:
1.308 albertel 7310: my $result =
7311: '<head>'.
1.1160 raeburn 7312: &font_settings($args);
1.319 albertel 7313:
1.1188 raeburn 7314: my $inhibitprint;
7315: if ($args->{'print_suppress'}) {
7316: $inhibitprint = &print_suppression();
7317: }
1.1064 raeburn 7318:
1.461 albertel 7319: if (!$args->{'frameset'}) {
7320: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7321: }
1.962 droeschl 7322: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7323: $result .= Apache::lonxml::display_title();
1.319 albertel 7324: }
1.436 albertel 7325: if (!$args->{'no_nav_bar'}
7326: && !$args->{'only_body'}
7327: && !$args->{'frameset'}) {
1.1154 raeburn 7328: $result .= &help_menu_js($httphost);
1.1032 www 7329: $result.=&modal_window();
1.1038 www 7330: $result.=&togglebox_script();
1.1034 www 7331: $result.=&wishlist_window();
1.1041 www 7332: $result.=&LCprogressbarUpdate_script();
1.1034 www 7333: } else {
7334: if ($args->{'add_modal'}) {
7335: $result.=&modal_window();
7336: }
7337: if ($args->{'add_wishlist'}) {
7338: $result.=&wishlist_window();
7339: }
1.1038 www 7340: if ($args->{'add_togglebox'}) {
7341: $result.=&togglebox_script();
7342: }
1.1041 www 7343: if ($args->{'add_progressbar'}) {
7344: $result.=&LCprogressbarUpdate_script();
7345: }
1.436 albertel 7346: }
1.314 albertel 7347: if (ref($args->{'redirect'})) {
1.414 albertel 7348: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7349: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7350: if (!$inhibit_continue) {
7351: $env{'internal.head.redirect'} = $url;
7352: }
1.313 albertel 7353: $result.=<<ADDMETA
7354: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7355: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7356: ADDMETA
7357: }
1.306 albertel 7358: if (!defined($title)) {
7359: $title = 'The LearningOnline Network with CAPA';
7360: }
1.460 albertel 7361: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7362: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7363: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7364: if (!$args->{'frameset'}) {
7365: $result .= ' /';
7366: }
7367: $result .= '>'
1.1064 raeburn 7368: .$inhibitprint
1.414 albertel 7369: .$head_extra;
1.1137 raeburn 7370: if ($env{'browser.mobile'}) {
7371: $result .= '
7372: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7373: <meta name="apple-mobile-web-app-capable" content="yes" />';
7374: }
1.962 droeschl 7375: return $result.'</head>';
1.306 albertel 7376: }
7377:
7378: =pod
7379:
1.340 albertel 7380: =item * &font_settings()
7381:
7382: Returns neccessary <meta> to set the proper encoding
7383:
1.1160 raeburn 7384: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7385:
7386: =cut
7387:
7388: sub font_settings {
1.1160 raeburn 7389: my ($args) = @_;
1.340 albertel 7390: my $headerstring='';
1.1160 raeburn 7391: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7392: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7393: $headerstring.=
7394: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7395: if (!$args->{'frameset'}) {
7396: $headerstring.= ' /';
7397: }
7398: $headerstring .= '>'."\n";
1.340 albertel 7399: }
7400: return $headerstring;
7401: }
7402:
1.341 albertel 7403: =pod
7404:
1.1064 raeburn 7405: =item * &print_suppression()
7406:
7407: In course context returns css which causes the body to be blank when media="print",
7408: if printout generation is unavailable for the current resource.
7409:
7410: This could be because:
7411:
7412: (a) printstartdate is in the future
7413:
7414: (b) printenddate is in the past
7415:
7416: (c) there is an active exam block with "printout"
7417: functionality blocked
7418:
7419: Users with pav, pfo or evb privileges are exempt.
7420:
7421: Inputs: none
7422:
7423: =cut
7424:
7425:
7426: sub print_suppression {
7427: my $noprint;
7428: if ($env{'request.course.id'}) {
7429: my $scope = $env{'request.course.id'};
7430: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7431: (&Apache::lonnet::allowed('pfo',$scope))) {
7432: return;
7433: }
7434: if ($env{'request.course.sec'} ne '') {
7435: $scope .= "/$env{'request.course.sec'}";
7436: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7437: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7438: return;
1.1064 raeburn 7439: }
7440: }
7441: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7442: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 7443: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7444: if ($blocked) {
7445: my $checkrole = "cm./$cdom/$cnum";
7446: if ($env{'request.course.sec'} ne '') {
7447: $checkrole .= "/$env{'request.course.sec'}";
7448: }
7449: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7450: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7451: $noprint = 1;
7452: }
7453: }
7454: unless ($noprint) {
7455: my $symb = &Apache::lonnet::symbread();
7456: if ($symb ne '') {
7457: my $navmap = Apache::lonnavmaps::navmap->new();
7458: if (ref($navmap)) {
7459: my $res = $navmap->getBySymb($symb);
7460: if (ref($res)) {
7461: if (!$res->resprintable()) {
7462: $noprint = 1;
7463: }
7464: }
7465: }
7466: }
7467: }
7468: if ($noprint) {
7469: return <<"ENDSTYLE";
7470: <style type="text/css" media="print">
7471: body { display:none }
7472: </style>
7473: ENDSTYLE
7474: }
7475: }
7476: return;
7477: }
7478:
7479: =pod
7480:
1.341 albertel 7481: =item * &xml_begin()
7482:
7483: Returns the needed doctype and <html>
7484:
7485: Inputs: none
7486:
7487: =cut
7488:
7489: sub xml_begin {
1.1168 raeburn 7490: my ($is_frameset) = @_;
1.341 albertel 7491: my $output='';
7492:
7493: if ($env{'browser.mathml'}) {
7494: $output='<?xml version="1.0"?>'
7495: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7496: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7497:
7498: # .'<!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">] >'
7499: .'<!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">'
7500: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7501: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 7502: } elsif ($is_frameset) {
7503: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7504: '<html>'."\n";
1.341 albertel 7505: } else {
1.1168 raeburn 7506: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7507: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7508: }
7509: return $output;
7510: }
1.340 albertel 7511:
7512: =pod
7513:
1.306 albertel 7514: =item * &start_page()
7515:
7516: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7517:
1.648 raeburn 7518: Inputs:
7519:
7520: =over 4
7521:
7522: $title - optional title for the page
7523:
7524: $head_extra - optional extra HTML to incude inside the <head>
7525:
7526: $args - additional optional args supported are:
7527:
7528: =over 8
7529:
7530: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7531: arg on
1.814 bisitz 7532: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7533: add_entries -> additional attributes to add to the <body>
7534: domain -> force to color decorate a page for a
1.317 albertel 7535: specific domain
1.648 raeburn 7536: function -> force usage of a specific rolish color
1.317 albertel 7537: scheme
1.648 raeburn 7538: redirect -> see &headtag()
7539: bgcolor -> override the default page bg color
7540: js_ready -> return a string ready for being used in
1.317 albertel 7541: a javascript writeln
1.648 raeburn 7542: html_encode -> return a string ready for being used in
1.320 albertel 7543: a html attribute
1.648 raeburn 7544: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7545: $forcereg arg
1.648 raeburn 7546: frameset -> if true will start with a <frameset>
1.330 albertel 7547: rather than <body>
1.648 raeburn 7548: skip_phases -> hash ref of
1.338 albertel 7549: head -> skip the <html><head> generation
7550: body -> skip all <body> generation
1.648 raeburn 7551: no_auto_mt_title -> prevent &mt()ing the title arg
7552: inherit_jsmath -> when creating popup window in a page,
7553: should it have jsmath forced on by the
7554: current page
1.867 kalberla 7555: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7556: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 7557: group -> includes the current group, if page is for a
7558: specific group
1.361 albertel 7559:
1.648 raeburn 7560: =back
1.460 albertel 7561:
1.648 raeburn 7562: =back
1.562 albertel 7563:
1.306 albertel 7564: =cut
7565:
7566: sub start_page {
1.309 albertel 7567: my ($title,$head_extra,$args) = @_;
1.318 albertel 7568: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7569:
1.315 albertel 7570: $env{'internal.start_page'}++;
1.1096 raeburn 7571: my ($result,@advtools);
1.964 droeschl 7572:
1.338 albertel 7573: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 7574: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7575: }
7576:
7577: if (! exists($args->{'skip_phases'}{'body'}) ) {
7578: if ($args->{'frameset'}) {
7579: my $attr_string = &make_attr_string($args->{'force_register'},
7580: $args->{'add_entries'});
7581: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7582: } else {
7583: $result .=
7584: &bodytag($title,
7585: $args->{'function'}, $args->{'add_entries'},
7586: $args->{'only_body'}, $args->{'domain'},
7587: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 7588: $args->{'bgcolor'}, $args,
7589: \@advtools);
1.831 bisitz 7590: }
1.330 albertel 7591: }
1.338 albertel 7592:
1.315 albertel 7593: if ($args->{'js_ready'}) {
1.713 kaisler 7594: $result = &js_ready($result);
1.315 albertel 7595: }
1.320 albertel 7596: if ($args->{'html_encode'}) {
1.713 kaisler 7597: $result = &html_encode($result);
7598: }
7599:
1.813 bisitz 7600: # Preparation for new and consistent functionlist at top of screen
7601: # if ($args->{'functionlist'}) {
7602: # $result .= &build_functionlist();
7603: #}
7604:
1.964 droeschl 7605: # Don't add anything more if only_body wanted or in const space
7606: return $result if $args->{'only_body'}
7607: || $env{'request.state'} eq 'construct';
1.813 bisitz 7608:
7609: #Breadcrumbs
1.758 kaisler 7610: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7611: &Apache::lonhtmlcommon::clear_breadcrumbs();
7612: #if any br links exists, add them to the breadcrumbs
7613: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7614: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7615: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7616: }
7617: }
1.1096 raeburn 7618: # if @advtools array contains items add then to the breadcrumbs
7619: if (@advtools > 0) {
7620: &Apache::lonmenu::advtools_crumbs(@advtools);
7621: }
1.758 kaisler 7622:
7623: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7624: if(exists($args->{'bread_crumbs_component'})){
7625: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7626: }else{
7627: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7628: }
1.320 albertel 7629: }
1.315 albertel 7630: return $result;
1.306 albertel 7631: }
7632:
7633: sub end_page {
1.315 albertel 7634: my ($args) = @_;
7635: $env{'internal.end_page'}++;
1.330 albertel 7636: my $result;
1.335 albertel 7637: if ($args->{'discussion'}) {
7638: my ($target,$parser);
7639: if (ref($args->{'discussion'})) {
7640: ($target,$parser) =($args->{'discussion'}{'target'},
7641: $args->{'discussion'}{'parser'});
7642: }
7643: $result .= &Apache::lonxml::xmlend($target,$parser);
7644: }
1.330 albertel 7645: if ($args->{'frameset'}) {
7646: $result .= '</frameset>';
7647: } else {
1.635 raeburn 7648: $result .= &endbodytag($args);
1.330 albertel 7649: }
1.1080 raeburn 7650: unless ($args->{'notbody'}) {
7651: $result .= "\n</html>";
7652: }
1.330 albertel 7653:
1.315 albertel 7654: if ($args->{'js_ready'}) {
1.317 albertel 7655: $result = &js_ready($result);
1.315 albertel 7656: }
1.335 albertel 7657:
1.320 albertel 7658: if ($args->{'html_encode'}) {
7659: $result = &html_encode($result);
7660: }
1.335 albertel 7661:
1.315 albertel 7662: return $result;
7663: }
7664:
1.1034 www 7665: sub wishlist_window {
7666: return(<<'ENDWISHLIST');
1.1046 raeburn 7667: <script type="text/javascript">
1.1034 www 7668: // <![CDATA[
7669: // <!-- BEGIN LON-CAPA Internal
7670: function set_wishlistlink(title, path) {
7671: if (!title) {
7672: title = document.title;
7673: title = title.replace(/^LON-CAPA /,'');
7674: }
1.1175 raeburn 7675: title = encodeURIComponent(title);
1.1034 www 7676: if (!path) {
7677: path = location.pathname;
7678: }
1.1175 raeburn 7679: path = encodeURIComponent(path);
1.1034 www 7680: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7681: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7682: }
7683: // END LON-CAPA Internal -->
7684: // ]]>
7685: </script>
7686: ENDWISHLIST
7687: }
7688:
1.1030 www 7689: sub modal_window {
7690: return(<<'ENDMODAL');
1.1046 raeburn 7691: <script type="text/javascript">
1.1030 www 7692: // <![CDATA[
7693: // <!-- BEGIN LON-CAPA Internal
7694: var modalWindow = {
7695: parent:"body",
7696: windowId:null,
7697: content:null,
7698: width:null,
7699: height:null,
7700: close:function()
7701: {
7702: $(".LCmodal-window").remove();
7703: $(".LCmodal-overlay").remove();
7704: },
7705: open:function()
7706: {
7707: var modal = "";
7708: modal += "<div class=\"LCmodal-overlay\"></div>";
7709: 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;\">";
7710: modal += this.content;
7711: modal += "</div>";
7712:
7713: $(this.parent).append(modal);
7714:
7715: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7716: $(".LCclose-window").click(function(){modalWindow.close();});
7717: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7718: }
7719: };
1.1140 raeburn 7720: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7721: {
7722: modalWindow.windowId = "myModal";
7723: modalWindow.width = width;
7724: modalWindow.height = height;
1.1196 raeburn 7725: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7726: modalWindow.open();
7727: };
7728: // END LON-CAPA Internal -->
7729: // ]]>
7730: </script>
7731: ENDMODAL
7732: }
7733:
7734: sub modal_link {
1.1140 raeburn 7735: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7736: unless ($width) { $width=480; }
7737: unless ($height) { $height=400; }
1.1031 www 7738: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 7739: unless ($transparency) { $transparency='true'; }
7740:
1.1074 raeburn 7741: my $target_attr;
7742: if (defined($target)) {
7743: $target_attr = 'target="'.$target.'"';
7744: }
7745: return <<"ENDLINK";
1.1140 raeburn 7746: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7747: $linktext</a>
7748: ENDLINK
1.1030 www 7749: }
7750:
1.1032 www 7751: sub modal_adhoc_script {
7752: my ($funcname,$width,$height,$content)=@_;
7753: return (<<ENDADHOC);
1.1046 raeburn 7754: <script type="text/javascript">
1.1032 www 7755: // <![CDATA[
7756: var $funcname = function()
7757: {
7758: modalWindow.windowId = "myModal";
7759: modalWindow.width = $width;
7760: modalWindow.height = $height;
7761: modalWindow.content = '$content';
7762: modalWindow.open();
7763: };
7764: // ]]>
7765: </script>
7766: ENDADHOC
7767: }
7768:
1.1041 www 7769: sub modal_adhoc_inner {
7770: my ($funcname,$width,$height,$content)=@_;
7771: my $innerwidth=$width-20;
7772: $content=&js_ready(
1.1140 raeburn 7773: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
7774: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7775: $content.
1.1041 www 7776: &end_scrollbox().
1.1140 raeburn 7777: &end_page()
1.1041 www 7778: );
7779: return &modal_adhoc_script($funcname,$width,$height,$content);
7780: }
7781:
7782: sub modal_adhoc_window {
7783: my ($funcname,$width,$height,$content,$linktext)=@_;
7784: return &modal_adhoc_inner($funcname,$width,$height,$content).
7785: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7786: }
7787:
7788: sub modal_adhoc_launch {
7789: my ($funcname,$width,$height,$content)=@_;
7790: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7791: <script type="text/javascript">
7792: // <![CDATA[
7793: $funcname();
7794: // ]]>
7795: </script>
7796: ENDLAUNCH
7797: }
7798:
7799: sub modal_adhoc_close {
7800: return (<<ENDCLOSE);
7801: <script type="text/javascript">
7802: // <![CDATA[
7803: modalWindow.close();
7804: // ]]>
7805: </script>
7806: ENDCLOSE
7807: }
7808:
1.1038 www 7809: sub togglebox_script {
7810: return(<<ENDTOGGLE);
7811: <script type="text/javascript">
7812: // <![CDATA[
7813: function LCtoggleDisplay(id,hidetext,showtext) {
7814: link = document.getElementById(id + "link").childNodes[0];
7815: with (document.getElementById(id).style) {
7816: if (display == "none" ) {
7817: display = "inline";
7818: link.nodeValue = hidetext;
7819: } else {
7820: display = "none";
7821: link.nodeValue = showtext;
7822: }
7823: }
7824: }
7825: // ]]>
7826: </script>
7827: ENDTOGGLE
7828: }
7829:
1.1039 www 7830: sub start_togglebox {
7831: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7832: unless ($heading) { $heading=''; } else { $heading.=' '; }
7833: unless ($showtext) { $showtext=&mt('show'); }
7834: unless ($hidetext) { $hidetext=&mt('hide'); }
7835: unless ($headerbg) { $headerbg='#FFFFFF'; }
7836: return &start_data_table().
7837: &start_data_table_header_row().
7838: '<td bgcolor="'.$headerbg.'">'.$heading.
7839: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7840: $showtext.'\')">'.$showtext.'</a>]</td>'.
7841: &end_data_table_header_row().
7842: '<tr id="'.$id.'" style="display:none""><td>';
7843: }
7844:
7845: sub end_togglebox {
7846: return '</td></tr>'.&end_data_table();
7847: }
7848:
1.1041 www 7849: sub LCprogressbar_script {
1.1045 www 7850: my ($id)=@_;
1.1041 www 7851: return(<<ENDPROGRESS);
7852: <script type="text/javascript">
7853: // <![CDATA[
1.1045 www 7854: \$('#progressbar$id').progressbar({
1.1041 www 7855: value: 0,
7856: change: function(event, ui) {
7857: var newVal = \$(this).progressbar('option', 'value');
7858: \$('.pblabel', this).text(LCprogressTxt);
7859: }
7860: });
7861: // ]]>
7862: </script>
7863: ENDPROGRESS
7864: }
7865:
7866: sub LCprogressbarUpdate_script {
7867: return(<<ENDPROGRESSUPDATE);
7868: <style type="text/css">
7869: .ui-progressbar { position:relative; }
7870: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7871: </style>
7872: <script type="text/javascript">
7873: // <![CDATA[
1.1045 www 7874: var LCprogressTxt='---';
7875:
7876: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7877: LCprogressTxt=progresstext;
1.1045 www 7878: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7879: }
7880: // ]]>
7881: </script>
7882: ENDPROGRESSUPDATE
7883: }
7884:
1.1042 www 7885: my $LClastpercent;
1.1045 www 7886: my $LCidcnt;
7887: my $LCcurrentid;
1.1042 www 7888:
1.1041 www 7889: sub LCprogressbar {
1.1042 www 7890: my ($r)=(@_);
7891: $LClastpercent=0;
1.1045 www 7892: $LCidcnt++;
7893: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7894: my $starting=&mt('Starting');
7895: my $content=(<<ENDPROGBAR);
1.1045 www 7896: <div id="progressbar$LCcurrentid">
1.1041 www 7897: <span class="pblabel">$starting</span>
7898: </div>
7899: ENDPROGBAR
1.1045 www 7900: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7901: }
7902:
7903: sub LCprogressbarUpdate {
1.1042 www 7904: my ($r,$val,$text)=@_;
7905: unless ($val) {
7906: if ($LClastpercent) {
7907: $val=$LClastpercent;
7908: } else {
7909: $val=0;
7910: }
7911: }
1.1041 www 7912: if ($val<0) { $val=0; }
7913: if ($val>100) { $val=0; }
1.1042 www 7914: $LClastpercent=$val;
1.1041 www 7915: unless ($text) { $text=$val.'%'; }
7916: $text=&js_ready($text);
1.1044 www 7917: &r_print($r,<<ENDUPDATE);
1.1041 www 7918: <script type="text/javascript">
7919: // <![CDATA[
1.1045 www 7920: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7921: // ]]>
7922: </script>
7923: ENDUPDATE
1.1035 www 7924: }
7925:
1.1042 www 7926: sub LCprogressbarClose {
7927: my ($r)=@_;
7928: $LClastpercent=0;
1.1044 www 7929: &r_print($r,<<ENDCLOSE);
1.1042 www 7930: <script type="text/javascript">
7931: // <![CDATA[
1.1045 www 7932: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7933: // ]]>
7934: </script>
7935: ENDCLOSE
1.1044 www 7936: }
7937:
7938: sub r_print {
7939: my ($r,$to_print)=@_;
7940: if ($r) {
7941: $r->print($to_print);
7942: $r->rflush();
7943: } else {
7944: print($to_print);
7945: }
1.1042 www 7946: }
7947:
1.320 albertel 7948: sub html_encode {
7949: my ($result) = @_;
7950:
1.322 albertel 7951: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7952:
7953: return $result;
7954: }
1.1044 www 7955:
1.317 albertel 7956: sub js_ready {
7957: my ($result) = @_;
7958:
1.323 albertel 7959: $result =~ s/[\n\r]/ /xmsg;
7960: $result =~ s/\\/\\\\/xmsg;
7961: $result =~ s/'/\\'/xmsg;
1.372 albertel 7962: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7963:
7964: return $result;
7965: }
7966:
1.315 albertel 7967: sub validate_page {
7968: if ( exists($env{'internal.start_page'})
1.316 albertel 7969: && $env{'internal.start_page'} > 1) {
7970: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7971: $env{'internal.start_page'}.' '.
1.316 albertel 7972: $ENV{'request.filename'});
1.315 albertel 7973: }
7974: if ( exists($env{'internal.end_page'})
1.316 albertel 7975: && $env{'internal.end_page'} > 1) {
7976: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7977: $env{'internal.end_page'}.' '.
1.316 albertel 7978: $env{'request.filename'});
1.315 albertel 7979: }
7980: if ( exists($env{'internal.start_page'})
7981: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7982: &Apache::lonnet::logthis('start_page called without end_page '.
7983: $env{'request.filename'});
1.315 albertel 7984: }
7985: if ( ! exists($env{'internal.start_page'})
7986: && exists($env{'internal.end_page'})) {
1.316 albertel 7987: &Apache::lonnet::logthis('end_page called without start_page'.
7988: $env{'request.filename'});
1.315 albertel 7989: }
1.306 albertel 7990: }
1.315 albertel 7991:
1.996 www 7992:
7993: sub start_scrollbox {
1.1140 raeburn 7994: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 7995: unless ($outerwidth) { $outerwidth='520px'; }
7996: unless ($width) { $width='500px'; }
7997: unless ($height) { $height='200px'; }
1.1075 raeburn 7998: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 7999: if ($id ne '') {
1.1140 raeburn 8000: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8001: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8002: }
1.1075 raeburn 8003: if ($bgcolor ne '') {
8004: $tdcol = "background-color: $bgcolor;";
8005: }
1.1137 raeburn 8006: my $nicescroll_js;
8007: if ($env{'browser.mobile'}) {
1.1140 raeburn 8008: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8009: }
8010: return <<"END";
8011: $nicescroll_js
8012:
8013: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8014: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8015: END
8016: }
8017:
8018: sub end_scrollbox {
8019: return '</div></td></tr></table>';
8020: }
8021:
8022: sub nicescroll_javascript {
8023: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8024: my %options;
8025: if (ref($cursor) eq 'HASH') {
8026: %options = %{$cursor};
8027: }
8028: unless ($options{'railalign'} =~ /^left|right$/) {
8029: $options{'railalign'} = 'left';
8030: }
8031: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8032: my $function = &get_users_function();
8033: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8034: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8035: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8036: }
1.1140 raeburn 8037: }
8038: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8039: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8040: $options{'cursoropacity'}='1.0';
8041: }
1.1140 raeburn 8042: } else {
8043: $options{'cursoropacity'}='1.0';
8044: }
8045: if ($options{'cursorfixedheight'} eq 'none') {
8046: delete($options{'cursorfixedheight'});
8047: } else {
8048: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8049: }
8050: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8051: delete($options{'railoffset'});
8052: }
8053: my @niceoptions;
8054: while (my($key,$value) = each(%options)) {
8055: if ($value =~ /^\{.+\}$/) {
8056: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8057: } else {
1.1140 raeburn 8058: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8059: }
1.1140 raeburn 8060: }
8061: my $nicescroll_js = '
1.1137 raeburn 8062: $(document).ready(
1.1140 raeburn 8063: function() {
8064: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8065: }
1.1137 raeburn 8066: );
8067: ';
1.1140 raeburn 8068: if ($framecheck) {
8069: $nicescroll_js .= '
8070: function expand_div(caller) {
8071: if (top === self) {
8072: document.getElementById("'.$id.'").style.width = "auto";
8073: document.getElementById("'.$id.'").style.height = "auto";
8074: } else {
8075: try {
8076: if (parent.frames) {
8077: if (parent.frames.length > 1) {
8078: var framesrc = parent.frames[1].location.href;
8079: var currsrc = framesrc.replace(/\#.*$/,"");
8080: if ((caller == "search") || (currsrc == "'.$location.'")) {
8081: document.getElementById("'.$id.'").style.width = "auto";
8082: document.getElementById("'.$id.'").style.height = "auto";
8083: }
8084: }
8085: }
8086: } catch (e) {
8087: return;
8088: }
1.1137 raeburn 8089: }
1.1140 raeburn 8090: return;
1.996 www 8091: }
1.1140 raeburn 8092: ';
8093: }
8094: if ($needjsready) {
8095: $nicescroll_js = '
8096: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8097: } else {
8098: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8099: }
8100: return $nicescroll_js;
1.996 www 8101: }
8102:
1.318 albertel 8103: sub simple_error_page {
1.1150 bisitz 8104: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8105: if (ref($args) eq 'HASH') {
8106: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8107: } else {
8108: $msg = &mt($msg);
8109: }
1.1150 bisitz 8110:
1.318 albertel 8111: my $page =
8112: &Apache::loncommon::start_page($title).
1.1150 bisitz 8113: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8114: &Apache::loncommon::end_page();
8115: if (ref($r)) {
8116: $r->print($page);
1.327 albertel 8117: return;
1.318 albertel 8118: }
8119: return $page;
8120: }
1.347 albertel 8121:
8122: {
1.610 albertel 8123: my @row_count;
1.961 onken 8124:
8125: sub start_data_table_count {
8126: unshift(@row_count, 0);
8127: return;
8128: }
8129:
8130: sub end_data_table_count {
8131: shift(@row_count);
8132: return;
8133: }
8134:
1.347 albertel 8135: sub start_data_table {
1.1018 raeburn 8136: my ($add_class,$id) = @_;
1.422 albertel 8137: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8138: my $table_id;
8139: if (defined($id)) {
8140: $table_id = ' id="'.$id.'"';
8141: }
1.961 onken 8142: &start_data_table_count();
1.1018 raeburn 8143: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8144: }
8145:
8146: sub end_data_table {
1.961 onken 8147: &end_data_table_count();
1.389 albertel 8148: return '</table>'."\n";;
1.347 albertel 8149: }
8150:
8151: sub start_data_table_row {
1.974 wenzelju 8152: my ($add_class, $id) = @_;
1.610 albertel 8153: $row_count[0]++;
8154: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8155: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8156: $id = (' id="'.$id.'"') unless ($id eq '');
8157: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8158: }
1.471 banghart 8159:
8160: sub continue_data_table_row {
1.974 wenzelju 8161: my ($add_class, $id) = @_;
1.610 albertel 8162: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8163: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8164: $id = (' id="'.$id.'"') unless ($id eq '');
8165: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8166: }
1.347 albertel 8167:
8168: sub end_data_table_row {
1.389 albertel 8169: return '</tr>'."\n";;
1.347 albertel 8170: }
1.367 www 8171:
1.421 albertel 8172: sub start_data_table_empty_row {
1.707 bisitz 8173: # $row_count[0]++;
1.421 albertel 8174: return '<tr class="LC_empty_row" >'."\n";;
8175: }
8176:
8177: sub end_data_table_empty_row {
8178: return '</tr>'."\n";;
8179: }
8180:
1.367 www 8181: sub start_data_table_header_row {
1.389 albertel 8182: return '<tr class="LC_header_row">'."\n";;
1.367 www 8183: }
8184:
8185: sub end_data_table_header_row {
1.389 albertel 8186: return '</tr>'."\n";;
1.367 www 8187: }
1.890 droeschl 8188:
8189: sub data_table_caption {
8190: my $caption = shift;
8191: return "<caption class=\"LC_caption\">$caption</caption>";
8192: }
1.347 albertel 8193: }
8194:
1.548 albertel 8195: =pod
8196:
8197: =item * &inhibit_menu_check($arg)
8198:
8199: Checks for a inhibitmenu state and generates output to preserve it
8200:
8201: Inputs: $arg - can be any of
8202: - undef - in which case the return value is a string
8203: to add into arguments list of a uri
8204: - 'input' - in which case the return value is a HTML
8205: <form> <input> field of type hidden to
8206: preserve the value
8207: - a url - in which case the return value is the url with
8208: the neccesary cgi args added to preserve the
8209: inhibitmenu state
8210: - a ref to a url - no return value, but the string is
8211: updated to include the neccessary cgi
8212: args to preserve the inhibitmenu state
8213:
8214: =cut
8215:
8216: sub inhibit_menu_check {
8217: my ($arg) = @_;
8218: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8219: if ($arg eq 'input') {
8220: if ($env{'form.inhibitmenu'}) {
8221: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8222: } else {
8223: return
8224: }
8225: }
8226: if ($env{'form.inhibitmenu'}) {
8227: if (ref($arg)) {
8228: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8229: } elsif ($arg eq '') {
8230: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8231: } else {
8232: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8233: }
8234: }
8235: if (!ref($arg)) {
8236: return $arg;
8237: }
8238: }
8239:
1.251 albertel 8240: ###############################################
1.182 matthew 8241:
8242: =pod
8243:
1.549 albertel 8244: =back
8245:
8246: =head1 User Information Routines
8247:
8248: =over 4
8249:
1.405 albertel 8250: =item * &get_users_function()
1.182 matthew 8251:
8252: Used by &bodytag to determine the current users primary role.
8253: Returns either 'student','coordinator','admin', or 'author'.
8254:
8255: =cut
8256:
8257: ###############################################
8258: sub get_users_function {
1.815 tempelho 8259: my $function = 'norole';
1.818 tempelho 8260: if ($env{'request.role'}=~/^(st)/) {
8261: $function='student';
8262: }
1.907 raeburn 8263: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8264: $function='coordinator';
8265: }
1.258 albertel 8266: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8267: $function='admin';
8268: }
1.826 bisitz 8269: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8270: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8271: $function='author';
8272: }
8273: return $function;
1.54 www 8274: }
1.99 www 8275:
8276: ###############################################
8277:
1.233 raeburn 8278: =pod
8279:
1.821 raeburn 8280: =item * &show_course()
8281:
8282: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8283: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8284:
8285: Inputs:
8286: None
8287:
8288: Outputs:
8289: Scalar: 1 if 'Course' to be used, 0 otherwise.
8290:
8291: =cut
8292:
8293: ###############################################
8294: sub show_course {
8295: my $course = !$env{'user.adv'};
8296: if (!$env{'user.adv'}) {
8297: foreach my $env (keys(%env)) {
8298: next if ($env !~ m/^user\.priv\./);
8299: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8300: $course = 0;
8301: last;
8302: }
8303: }
8304: }
8305: return $course;
8306: }
8307:
8308: ###############################################
8309:
8310: =pod
8311:
1.542 raeburn 8312: =item * &check_user_status()
1.274 raeburn 8313:
8314: Determines current status of supplied role for a
8315: specific user. Roles can be active, previous or future.
8316:
8317: Inputs:
8318: user's domain, user's username, course's domain,
1.375 raeburn 8319: course's number, optional section ID.
1.274 raeburn 8320:
8321: Outputs:
8322: role status: active, previous or future.
8323:
8324: =cut
8325:
8326: sub check_user_status {
1.412 raeburn 8327: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8328: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8329: my @uroles = keys %userinfo;
8330: my $srchstr;
8331: my $active_chk = 'none';
1.412 raeburn 8332: my $now = time;
1.274 raeburn 8333: if (@uroles > 0) {
1.908 raeburn 8334: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8335: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8336: } else {
1.412 raeburn 8337: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8338: }
8339: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8340: my $role_end = 0;
8341: my $role_start = 0;
8342: $active_chk = 'active';
1.412 raeburn 8343: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8344: $role_end = $1;
8345: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8346: $role_start = $1;
1.274 raeburn 8347: }
8348: }
8349: if ($role_start > 0) {
1.412 raeburn 8350: if ($now < $role_start) {
1.274 raeburn 8351: $active_chk = 'future';
8352: }
8353: }
8354: if ($role_end > 0) {
1.412 raeburn 8355: if ($now > $role_end) {
1.274 raeburn 8356: $active_chk = 'previous';
8357: }
8358: }
8359: }
8360: }
8361: return $active_chk;
8362: }
8363:
8364: ###############################################
8365:
8366: =pod
8367:
1.405 albertel 8368: =item * &get_sections()
1.233 raeburn 8369:
8370: Determines all the sections for a course including
8371: sections with students and sections containing other roles.
1.419 raeburn 8372: Incoming parameters:
8373:
8374: 1. domain
8375: 2. course number
8376: 3. reference to array containing roles for which sections should
8377: be gathered (optional).
8378: 4. reference to array containing status types for which sections
8379: should be gathered (optional).
8380:
8381: If the third argument is undefined, sections are gathered for any role.
8382: If the fourth argument is undefined, sections are gathered for any status.
8383: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8384:
1.374 raeburn 8385: Returns section hash (keys are section IDs, values are
8386: number of users in each section), subject to the
1.419 raeburn 8387: optional roles filter, optional status filter
1.233 raeburn 8388:
8389: =cut
8390:
8391: ###############################################
8392: sub get_sections {
1.419 raeburn 8393: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8394: if (!defined($cdom) || !defined($cnum)) {
8395: my $cid = $env{'request.course.id'};
8396:
8397: return if (!defined($cid));
8398:
8399: $cdom = $env{'course.'.$cid.'.domain'};
8400: $cnum = $env{'course.'.$cid.'.num'};
8401: }
8402:
8403: my %sectioncount;
1.419 raeburn 8404: my $now = time;
1.240 albertel 8405:
1.1118 raeburn 8406: my $check_students = 1;
8407: my $only_students = 0;
8408: if (ref($possible_roles) eq 'ARRAY') {
8409: if (grep(/^st$/,@{$possible_roles})) {
8410: if (@{$possible_roles} == 1) {
8411: $only_students = 1;
8412: }
8413: } else {
8414: $check_students = 0;
8415: }
8416: }
8417:
8418: if ($check_students) {
1.276 albertel 8419: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8420: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8421: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8422: my $start_index = &Apache::loncoursedata::CL_START();
8423: my $end_index = &Apache::loncoursedata::CL_END();
8424: my $status;
1.366 albertel 8425: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8426: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8427: $data->[$status_index],
8428: $data->[$start_index],
8429: $data->[$end_index]);
8430: if ($stu_status eq 'Active') {
8431: $status = 'active';
8432: } elsif ($end < $now) {
8433: $status = 'previous';
8434: } elsif ($start > $now) {
8435: $status = 'future';
8436: }
8437: if ($section ne '-1' && $section !~ /^\s*$/) {
8438: if ((!defined($possible_status)) || (($status ne '') &&
8439: (grep/^\Q$status\E$/,@{$possible_status}))) {
8440: $sectioncount{$section}++;
8441: }
1.240 albertel 8442: }
8443: }
8444: }
1.1118 raeburn 8445: if ($only_students) {
8446: return %sectioncount;
8447: }
1.240 albertel 8448: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8449: foreach my $user (sort(keys(%courseroles))) {
8450: if ($user !~ /^(\w{2})/) { next; }
8451: my ($role) = ($user =~ /^(\w{2})/);
8452: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8453: my ($section,$status);
1.240 albertel 8454: if ($role eq 'cr' &&
8455: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8456: $section=$1;
8457: }
8458: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8459: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8460: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8461: if ($end == -1 && $start == -1) {
8462: next; #deleted role
8463: }
8464: if (!defined($possible_status)) {
8465: $sectioncount{$section}++;
8466: } else {
8467: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8468: $status = 'active';
8469: } elsif ($end < $now) {
8470: $status = 'future';
8471: } elsif ($start > $now) {
8472: $status = 'previous';
8473: }
8474: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8475: $sectioncount{$section}++;
8476: }
8477: }
1.233 raeburn 8478: }
1.366 albertel 8479: return %sectioncount;
1.233 raeburn 8480: }
8481:
1.274 raeburn 8482: ###############################################
1.294 raeburn 8483:
8484: =pod
1.405 albertel 8485:
8486: =item * &get_course_users()
8487:
1.275 raeburn 8488: Retrieves usernames:domains for users in the specified course
8489: with specific role(s), and access status.
8490:
8491: Incoming parameters:
1.277 albertel 8492: 1. course domain
8493: 2. course number
8494: 3. access status: users must have - either active,
1.275 raeburn 8495: previous, future, or all.
1.277 albertel 8496: 4. reference to array of permissible roles
1.288 raeburn 8497: 5. reference to array of section restrictions (optional)
8498: 6. reference to results object (hash of hashes).
8499: 7. reference to optional userdata hash
1.609 raeburn 8500: 8. reference to optional statushash
1.630 raeburn 8501: 9. flag if privileged users (except those set to unhide in
8502: course settings) should be excluded
1.609 raeburn 8503: Keys of top level results hash are roles.
1.275 raeburn 8504: Keys of inner hashes are username:domain, with
8505: values set to access type.
1.288 raeburn 8506: Optional userdata hash returns an array with arguments in the
8507: same order as loncoursedata::get_classlist() for student data.
8508:
1.609 raeburn 8509: Optional statushash returns
8510:
1.288 raeburn 8511: Entries for end, start, section and status are blank because
8512: of the possibility of multiple values for non-student roles.
8513:
1.275 raeburn 8514: =cut
1.405 albertel 8515:
1.275 raeburn 8516: ###############################################
1.405 albertel 8517:
1.275 raeburn 8518: sub get_course_users {
1.630 raeburn 8519: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8520: my %idx = ();
1.419 raeburn 8521: my %seclists;
1.288 raeburn 8522:
8523: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8524: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8525: $idx{end} = &Apache::loncoursedata::CL_END();
8526: $idx{start} = &Apache::loncoursedata::CL_START();
8527: $idx{id} = &Apache::loncoursedata::CL_ID();
8528: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8529: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8530: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8531:
1.290 albertel 8532: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8533: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8534: my $now = time;
1.277 albertel 8535: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8536: my $match = 0;
1.412 raeburn 8537: my $secmatch = 0;
1.419 raeburn 8538: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8539: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8540: if ($section eq '') {
8541: $section = 'none';
8542: }
1.291 albertel 8543: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8544: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8545: $secmatch = 1;
8546: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8547: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8548: $secmatch = 1;
8549: }
8550: } else {
1.419 raeburn 8551: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8552: $secmatch = 1;
8553: }
1.290 albertel 8554: }
1.412 raeburn 8555: if (!$secmatch) {
8556: next;
8557: }
1.419 raeburn 8558: }
1.275 raeburn 8559: if (defined($$types{'active'})) {
1.288 raeburn 8560: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8561: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8562: $match = 1;
1.275 raeburn 8563: }
8564: }
8565: if (defined($$types{'previous'})) {
1.609 raeburn 8566: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8567: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8568: $match = 1;
1.275 raeburn 8569: }
8570: }
8571: if (defined($$types{'future'})) {
1.609 raeburn 8572: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8573: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8574: $match = 1;
1.275 raeburn 8575: }
8576: }
1.609 raeburn 8577: if ($match) {
8578: push(@{$seclists{$student}},$section);
8579: if (ref($userdata) eq 'HASH') {
8580: $$userdata{$student} = $$classlist{$student};
8581: }
8582: if (ref($statushash) eq 'HASH') {
8583: $statushash->{$student}{'st'}{$section} = $status;
8584: }
1.288 raeburn 8585: }
1.275 raeburn 8586: }
8587: }
1.412 raeburn 8588: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8589: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8590: my $now = time;
1.609 raeburn 8591: my %displaystatus = ( previous => 'Expired',
8592: active => 'Active',
8593: future => 'Future',
8594: );
1.1121 raeburn 8595: my (%nothide,@possdoms);
1.630 raeburn 8596: if ($hidepriv) {
8597: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8598: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8599: if ($user !~ /:/) {
8600: $nothide{join(':',split(/[\@]/,$user))}=1;
8601: } else {
8602: $nothide{$user} = 1;
8603: }
8604: }
1.1121 raeburn 8605: my @possdoms = ($cdom);
8606: if ($coursehash{'checkforpriv'}) {
8607: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8608: }
1.630 raeburn 8609: }
1.439 raeburn 8610: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8611: my $match = 0;
1.412 raeburn 8612: my $secmatch = 0;
1.439 raeburn 8613: my $status;
1.412 raeburn 8614: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8615: $user =~ s/:$//;
1.439 raeburn 8616: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8617: if ($end == -1 || $start == -1) {
8618: next;
8619: }
8620: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8621: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8622: my ($uname,$udom) = split(/:/,$user);
8623: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8624: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8625: $secmatch = 1;
8626: } elsif ($usec eq '') {
1.420 albertel 8627: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8628: $secmatch = 1;
8629: }
8630: } else {
8631: if (grep(/^\Q$usec\E$/,@{$sections})) {
8632: $secmatch = 1;
8633: }
8634: }
8635: if (!$secmatch) {
8636: next;
8637: }
1.288 raeburn 8638: }
1.419 raeburn 8639: if ($usec eq '') {
8640: $usec = 'none';
8641: }
1.275 raeburn 8642: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8643: if ($hidepriv) {
1.1121 raeburn 8644: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8645: (!$nothide{$uname.':'.$udom})) {
8646: next;
8647: }
8648: }
1.503 raeburn 8649: if ($end > 0 && $end < $now) {
1.439 raeburn 8650: $status = 'previous';
8651: } elsif ($start > $now) {
8652: $status = 'future';
8653: } else {
8654: $status = 'active';
8655: }
1.277 albertel 8656: foreach my $type (keys(%{$types})) {
1.275 raeburn 8657: if ($status eq $type) {
1.420 albertel 8658: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8659: push(@{$$users{$role}{$user}},$type);
8660: }
1.288 raeburn 8661: $match = 1;
8662: }
8663: }
1.419 raeburn 8664: if (($match) && (ref($userdata) eq 'HASH')) {
8665: if (!exists($$userdata{$uname.':'.$udom})) {
8666: &get_user_info($udom,$uname,\%idx,$userdata);
8667: }
1.420 albertel 8668: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8669: push(@{$seclists{$uname.':'.$udom}},$usec);
8670: }
1.609 raeburn 8671: if (ref($statushash) eq 'HASH') {
8672: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8673: }
1.275 raeburn 8674: }
8675: }
8676: }
8677: }
1.290 albertel 8678: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8679: if ((defined($cdom)) && (defined($cnum))) {
8680: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8681: if ( defined($csettings{'internal.courseowner'}) ) {
8682: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8683: next if ($owner eq '');
8684: my ($ownername,$ownerdom);
8685: if ($owner =~ /^([^:]+):([^:]+)$/) {
8686: $ownername = $1;
8687: $ownerdom = $2;
8688: } else {
8689: $ownername = $owner;
8690: $ownerdom = $cdom;
8691: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8692: }
8693: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8694: if (defined($userdata) &&
1.609 raeburn 8695: !exists($$userdata{$owner})) {
8696: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8697: if (!grep(/^none$/,@{$seclists{$owner}})) {
8698: push(@{$seclists{$owner}},'none');
8699: }
8700: if (ref($statushash) eq 'HASH') {
8701: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8702: }
1.290 albertel 8703: }
1.279 raeburn 8704: }
8705: }
8706: }
1.419 raeburn 8707: foreach my $user (keys(%seclists)) {
8708: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8709: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8710: }
1.275 raeburn 8711: }
8712: return;
8713: }
8714:
1.288 raeburn 8715: sub get_user_info {
8716: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8717: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8718: &plainname($uname,$udom,'lastname');
1.291 albertel 8719: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8720: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8721: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8722: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8723: return;
8724: }
1.275 raeburn 8725:
1.472 raeburn 8726: ###############################################
8727:
8728: =pod
8729:
8730: =item * &get_user_quota()
8731:
1.1134 raeburn 8732: Retrieves quota assigned for storage of user files.
8733: Default is to report quota for portfolio files.
1.472 raeburn 8734:
8735: Incoming parameters:
8736: 1. user's username
8737: 2. user's domain
1.1134 raeburn 8738: 3. quota name - portfolio, author, or course
1.1136 raeburn 8739: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 8740: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 8741: course
1.472 raeburn 8742:
8743: Returns:
1.1163 raeburn 8744: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8745: 2. (Optional) Type of setting: custom or default
8746: (individually assigned or default for user's
8747: institutional status).
8748: 3. (Optional) - User's institutional status (e.g., faculty, staff
8749: or student - types as defined in localenroll::inst_usertypes
8750: for user's domain, which determines default quota for user.
8751: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8752:
8753: If a value has been stored in the user's environment,
1.536 raeburn 8754: it will return that, otherwise it returns the maximal default
1.1134 raeburn 8755: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8756:
8757: =cut
8758:
8759: ###############################################
8760:
8761:
8762: sub get_user_quota {
1.1136 raeburn 8763: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8764: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8765: if (!defined($udom)) {
8766: $udom = $env{'user.domain'};
8767: }
8768: if (!defined($uname)) {
8769: $uname = $env{'user.name'};
8770: }
8771: if (($udom eq '' || $uname eq '') ||
8772: ($udom eq 'public') && ($uname eq 'public')) {
8773: $quota = 0;
1.536 raeburn 8774: $quotatype = 'default';
8775: $defquota = 0;
1.472 raeburn 8776: } else {
1.536 raeburn 8777: my $inststatus;
1.1134 raeburn 8778: if ($quotaname eq 'course') {
8779: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8780: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8781: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8782: } else {
8783: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8784: $quota = $cenv{'internal.uploadquota'};
8785: }
1.536 raeburn 8786: } else {
1.1134 raeburn 8787: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8788: if ($quotaname eq 'author') {
8789: $quota = $env{'environment.authorquota'};
8790: } else {
8791: $quota = $env{'environment.portfolioquota'};
8792: }
8793: $inststatus = $env{'environment.inststatus'};
8794: } else {
8795: my %userenv =
8796: &Apache::lonnet::get('environment',['portfolioquota',
8797: 'authorquota','inststatus'],$udom,$uname);
8798: my ($tmp) = keys(%userenv);
8799: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8800: if ($quotaname eq 'author') {
8801: $quota = $userenv{'authorquota'};
8802: } else {
8803: $quota = $userenv{'portfolioquota'};
8804: }
8805: $inststatus = $userenv{'inststatus'};
8806: } else {
8807: undef(%userenv);
8808: }
8809: }
8810: }
8811: if ($quota eq '' || wantarray) {
8812: if ($quotaname eq 'course') {
8813: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 8814: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8815: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 8816: $defquota = $domdefs{$crstype.'quota'};
8817: }
8818: if ($defquota eq '') {
8819: $defquota = 500;
8820: }
1.1134 raeburn 8821: } else {
8822: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8823: }
8824: if ($quota eq '') {
8825: $quota = $defquota;
8826: $quotatype = 'default';
8827: } else {
8828: $quotatype = 'custom';
8829: }
1.472 raeburn 8830: }
8831: }
1.536 raeburn 8832: if (wantarray) {
8833: return ($quota,$quotatype,$settingstatus,$defquota);
8834: } else {
8835: return $quota;
8836: }
1.472 raeburn 8837: }
8838:
8839: ###############################################
8840:
8841: =pod
8842:
8843: =item * &default_quota()
8844:
1.536 raeburn 8845: Retrieves default quota assigned for storage of user portfolio files,
8846: given an (optional) user's institutional status.
1.472 raeburn 8847:
8848: Incoming parameters:
1.1142 raeburn 8849:
1.472 raeburn 8850: 1. domain
1.536 raeburn 8851: 2. (Optional) institutional status(es). This is a : separated list of
8852: status types (e.g., faculty, staff, student etc.)
8853: which apply to the user for whom the default is being retrieved.
8854: If the institutional status string in undefined, the domain
1.1134 raeburn 8855: default quota will be returned.
8856: 3. quota name - portfolio, author, or course
8857: (if no quota name provided, defaults to portfolio).
1.472 raeburn 8858:
8859: Returns:
1.1142 raeburn 8860:
1.1163 raeburn 8861: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 8862: 2. (Optional) institutional type which determined the value of the
8863: default quota.
1.472 raeburn 8864:
8865: If a value has been stored in the domain's configuration db,
8866: it will return that, otherwise it returns 20 (for backwards
8867: compatibility with domains which have not set up a configuration
1.1163 raeburn 8868: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 8869:
1.536 raeburn 8870: If the user's status includes multiple types (e.g., staff and student),
8871: the largest default quota which applies to the user determines the
8872: default quota returned.
8873:
1.472 raeburn 8874: =cut
8875:
8876: ###############################################
8877:
8878:
8879: sub default_quota {
1.1134 raeburn 8880: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 8881: my ($defquota,$settingstatus);
8882: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8883: ['quotas'],$udom);
1.1134 raeburn 8884: my $key = 'defaultquota';
8885: if ($quotaname eq 'author') {
8886: $key = 'authorquota';
8887: }
1.622 raeburn 8888: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8889: if ($inststatus ne '') {
1.765 raeburn 8890: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8891: foreach my $item (@statuses) {
1.1134 raeburn 8892: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8893: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 8894: if ($defquota eq '') {
1.1134 raeburn 8895: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8896: $settingstatus = $item;
1.1134 raeburn 8897: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
8898: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8899: $settingstatus = $item;
8900: }
8901: }
1.1134 raeburn 8902: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8903: if ($quotahash{'quotas'}{$item} ne '') {
8904: if ($defquota eq '') {
8905: $defquota = $quotahash{'quotas'}{$item};
8906: $settingstatus = $item;
8907: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8908: $defquota = $quotahash{'quotas'}{$item};
8909: $settingstatus = $item;
8910: }
1.536 raeburn 8911: }
8912: }
8913: }
8914: }
8915: if ($defquota eq '') {
1.1134 raeburn 8916: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8917: $defquota = $quotahash{'quotas'}{$key}{'default'};
8918: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8919: $defquota = $quotahash{'quotas'}{'default'};
8920: }
1.536 raeburn 8921: $settingstatus = 'default';
1.1139 raeburn 8922: if ($defquota eq '') {
8923: if ($quotaname eq 'author') {
8924: $defquota = 500;
8925: }
8926: }
1.536 raeburn 8927: }
8928: } else {
8929: $settingstatus = 'default';
1.1134 raeburn 8930: if ($quotaname eq 'author') {
8931: $defquota = 500;
8932: } else {
8933: $defquota = 20;
8934: }
1.536 raeburn 8935: }
8936: if (wantarray) {
8937: return ($defquota,$settingstatus);
1.472 raeburn 8938: } else {
1.536 raeburn 8939: return $defquota;
1.472 raeburn 8940: }
8941: }
8942:
1.1135 raeburn 8943: ###############################################
8944:
8945: =pod
8946:
1.1136 raeburn 8947: =item * &excess_filesize_warning()
1.1135 raeburn 8948:
8949: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 8950: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 8951: space to be exceeded.
1.1136 raeburn 8952:
8953: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 8954: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 8955:
1.1165 raeburn 8956: Inputs: 7
1.1136 raeburn 8957: 1. username or coursenum
1.1135 raeburn 8958: 2. domain
1.1136 raeburn 8959: 3. context ('author' or 'course')
1.1135 raeburn 8960: 4. filename of file for which action is being requested
8961: 5. filesize (kB) of file
8962: 6. action being taken: copy or upload.
1.1165 raeburn 8963: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 8964:
8965: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 8966: otherwise return null.
8967:
8968: =back
1.1135 raeburn 8969:
8970: =cut
8971:
1.1136 raeburn 8972: sub excess_filesize_warning {
1.1165 raeburn 8973: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 8974: my $current_disk_usage = 0;
1.1165 raeburn 8975: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 8976: if ($context eq 'author') {
8977: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
8978: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
8979: } else {
8980: foreach my $subdir ('docs','supplemental') {
8981: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
8982: }
8983: }
1.1135 raeburn 8984: $disk_quota = int($disk_quota * 1000);
8985: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 8986: return '<p class="LC_warning">'.
1.1135 raeburn 8987: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 8988: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
8989: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 8990: $disk_quota,$current_disk_usage).
8991: '</p>';
8992: }
8993: return;
8994: }
8995:
8996: ###############################################
8997:
8998:
1.1136 raeburn 8999:
9000:
1.384 raeburn 9001: sub get_secgrprole_info {
9002: my ($cdom,$cnum,$needroles,$type) = @_;
9003: my %sections_count = &get_sections($cdom,$cnum);
9004: my @sections = (sort {$a <=> $b} keys(%sections_count));
9005: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9006: my @groups = sort(keys(%curr_groups));
9007: my $allroles = [];
9008: my $rolehash;
9009: my $accesshash = {
9010: active => 'Currently has access',
9011: future => 'Will have future access',
9012: previous => 'Previously had access',
9013: };
9014: if ($needroles) {
9015: $rolehash = {'all' => 'all'};
1.385 albertel 9016: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9017: if (&Apache::lonnet::error(%user_roles)) {
9018: undef(%user_roles);
9019: }
9020: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9021: my ($role)=split(/\:/,$item,2);
9022: if ($role eq 'cr') { next; }
9023: if ($role =~ /^cr/) {
9024: $$rolehash{$role} = (split('/',$role))[3];
9025: } else {
9026: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9027: }
9028: }
9029: foreach my $key (sort(keys(%{$rolehash}))) {
9030: push(@{$allroles},$key);
9031: }
9032: push (@{$allroles},'st');
9033: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9034: }
9035: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9036: }
9037:
1.555 raeburn 9038: sub user_picker {
1.994 raeburn 9039: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9040: my $currdom = $dom;
9041: my %curr_selected = (
9042: srchin => 'dom',
1.580 raeburn 9043: srchby => 'lastname',
1.555 raeburn 9044: );
9045: my $srchterm;
1.625 raeburn 9046: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9047: if ($srch->{'srchby'} ne '') {
9048: $curr_selected{'srchby'} = $srch->{'srchby'};
9049: }
9050: if ($srch->{'srchin'} ne '') {
9051: $curr_selected{'srchin'} = $srch->{'srchin'};
9052: }
9053: if ($srch->{'srchtype'} ne '') {
9054: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9055: }
9056: if ($srch->{'srchdomain'} ne '') {
9057: $currdom = $srch->{'srchdomain'};
9058: }
9059: $srchterm = $srch->{'srchterm'};
9060: }
9061: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9062: 'usr' => 'Search criteria',
1.563 raeburn 9063: 'doma' => 'Domain/institution to search',
1.558 albertel 9064: 'uname' => 'username',
9065: 'lastname' => 'last name',
1.555 raeburn 9066: 'lastfirst' => 'last name, first name',
1.558 albertel 9067: 'crs' => 'in this course',
1.576 raeburn 9068: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9069: 'alc' => 'all LON-CAPA',
1.573 raeburn 9070: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9071: 'exact' => 'is',
9072: 'contains' => 'contains',
1.569 raeburn 9073: 'begins' => 'begins with',
1.571 raeburn 9074: 'youm' => "You must include some text to search for.",
9075: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9076: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9077: 'yomc' => "You must choose a domain when using an institutional directory search.",
9078: 'ymcd' => "You must choose a domain when using a domain search.",
9079: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9080: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9081: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9082: );
1.563 raeburn 9083: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9084: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9085:
9086: my @srchins = ('crs','dom','alc','instd');
9087:
9088: foreach my $option (@srchins) {
9089: # FIXME 'alc' option unavailable until
9090: # loncreateuser::print_user_query_page()
9091: # has been completed.
9092: next if ($option eq 'alc');
1.880 raeburn 9093: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9094: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9095: if ($curr_selected{'srchin'} eq $option) {
9096: $srchinsel .= '
9097: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9098: } else {
9099: $srchinsel .= '
9100: <option value="'.$option.'">'.$lt{$option}.'</option>';
9101: }
1.555 raeburn 9102: }
1.563 raeburn 9103: $srchinsel .= "\n </select>\n";
1.555 raeburn 9104:
9105: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9106: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9107: if ($curr_selected{'srchby'} eq $option) {
9108: $srchbysel .= '
9109: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9110: } else {
9111: $srchbysel .= '
9112: <option value="'.$option.'">'.$lt{$option}.'</option>';
9113: }
9114: }
9115: $srchbysel .= "\n </select>\n";
9116:
9117: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9118: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9119: if ($curr_selected{'srchtype'} eq $option) {
9120: $srchtypesel .= '
9121: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9122: } else {
9123: $srchtypesel .= '
9124: <option value="'.$option.'">'.$lt{$option}.'</option>';
9125: }
9126: }
9127: $srchtypesel .= "\n </select>\n";
9128:
1.558 albertel 9129: my ($newuserscript,$new_user_create);
1.994 raeburn 9130: my $context_dom = $env{'request.role.domain'};
9131: if ($context eq 'requestcrs') {
9132: if ($env{'form.coursedom'} ne '') {
9133: $context_dom = $env{'form.coursedom'};
9134: }
9135: }
1.556 raeburn 9136: if ($forcenewuser) {
1.576 raeburn 9137: if (ref($srch) eq 'HASH') {
1.994 raeburn 9138: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9139: if ($cancreate) {
9140: $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>';
9141: } else {
1.799 bisitz 9142: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9143: my %usertypetext = (
9144: official => 'institutional',
9145: unofficial => 'non-institutional',
9146: );
1.799 bisitz 9147: $new_user_create = '<p class="LC_warning">'
9148: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9149: .' '
9150: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9151: ,'<a href="'.$helplink.'">','</a>')
9152: .'</p><br />';
1.627 raeburn 9153: }
1.576 raeburn 9154: }
9155: }
9156:
1.556 raeburn 9157: $newuserscript = <<"ENDSCRIPT";
9158:
1.570 raeburn 9159: function setSearch(createnew,callingForm) {
1.556 raeburn 9160: if (createnew == 1) {
1.570 raeburn 9161: for (var i=0; i<callingForm.srchby.length; i++) {
9162: if (callingForm.srchby.options[i].value == 'uname') {
9163: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9164: }
9165: }
1.570 raeburn 9166: for (var i=0; i<callingForm.srchin.length; i++) {
9167: if ( callingForm.srchin.options[i].value == 'dom') {
9168: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9169: }
9170: }
1.570 raeburn 9171: for (var i=0; i<callingForm.srchtype.length; i++) {
9172: if (callingForm.srchtype.options[i].value == 'exact') {
9173: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9174: }
9175: }
1.570 raeburn 9176: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9177: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9178: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9179: }
9180: }
9181: }
9182: }
9183: ENDSCRIPT
1.558 albertel 9184:
1.556 raeburn 9185: }
9186:
1.555 raeburn 9187: my $output = <<"END_BLOCK";
1.556 raeburn 9188: <script type="text/javascript">
1.824 bisitz 9189: // <![CDATA[
1.570 raeburn 9190: function validateEntry(callingForm) {
1.558 albertel 9191:
1.556 raeburn 9192: var checkok = 1;
1.558 albertel 9193: var srchin;
1.570 raeburn 9194: for (var i=0; i<callingForm.srchin.length; i++) {
9195: if ( callingForm.srchin[i].checked ) {
9196: srchin = callingForm.srchin[i].value;
1.558 albertel 9197: }
9198: }
9199:
1.570 raeburn 9200: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9201: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9202: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9203: var srchterm = callingForm.srchterm.value;
9204: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9205: var msg = "";
9206:
9207: if (srchterm == "") {
9208: checkok = 0;
1.571 raeburn 9209: msg += "$lt{'youm'}\\n";
1.556 raeburn 9210: }
9211:
1.569 raeburn 9212: if (srchtype== 'begins') {
9213: if (srchterm.length < 2) {
9214: checkok = 0;
1.571 raeburn 9215: msg += "$lt{'thte'}\\n";
1.569 raeburn 9216: }
9217: }
9218:
1.556 raeburn 9219: if (srchtype== 'contains') {
9220: if (srchterm.length < 3) {
9221: checkok = 0;
1.571 raeburn 9222: msg += "$lt{'thet'}\\n";
1.556 raeburn 9223: }
9224: }
9225: if (srchin == 'instd') {
9226: if (srchdomain == '') {
9227: checkok = 0;
1.571 raeburn 9228: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9229: }
9230: }
9231: if (srchin == 'dom') {
9232: if (srchdomain == '') {
9233: checkok = 0;
1.571 raeburn 9234: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9235: }
9236: }
9237: if (srchby == 'lastfirst') {
9238: if (srchterm.indexOf(",") == -1) {
9239: checkok = 0;
1.571 raeburn 9240: msg += "$lt{'whus'}\\n";
1.556 raeburn 9241: }
9242: if (srchterm.indexOf(",") == srchterm.length -1) {
9243: checkok = 0;
1.571 raeburn 9244: msg += "$lt{'whse'}\\n";
1.556 raeburn 9245: }
9246: }
9247: if (checkok == 0) {
1.571 raeburn 9248: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9249: return;
9250: }
9251: if (checkok == 1) {
1.570 raeburn 9252: callingForm.submit();
1.556 raeburn 9253: }
9254: }
9255:
9256: $newuserscript
9257:
1.824 bisitz 9258: // ]]>
1.556 raeburn 9259: </script>
1.558 albertel 9260:
9261: $new_user_create
9262:
1.555 raeburn 9263: END_BLOCK
1.558 albertel 9264:
1.876 raeburn 9265: $output .= &Apache::lonhtmlcommon::start_pick_box().
9266: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9267: $domform.
9268: &Apache::lonhtmlcommon::row_closure().
9269: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9270: $srchbysel.
9271: $srchtypesel.
9272: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9273: $srchinsel.
9274: &Apache::lonhtmlcommon::row_closure(1).
9275: &Apache::lonhtmlcommon::end_pick_box().
9276: '<br />';
1.555 raeburn 9277: return $output;
9278: }
9279:
1.612 raeburn 9280: sub user_rule_check {
1.615 raeburn 9281: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9282: my $response;
9283: if (ref($usershash) eq 'HASH') {
9284: foreach my $user (keys(%{$usershash})) {
9285: my ($uname,$udom) = split(/:/,$user);
9286: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9287: my ($id,$newuser);
1.612 raeburn 9288: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9289: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9290: $id = $usershash->{$user}->{'id'};
9291: }
9292: my $inst_response;
9293: if (ref($checks) eq 'HASH') {
9294: if (defined($checks->{'username'})) {
1.615 raeburn 9295: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9296: &Apache::lonnet::get_instuser($udom,$uname);
9297: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9298: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9299: &Apache::lonnet::get_instuser($udom,undef,$id);
9300: }
1.615 raeburn 9301: } else {
9302: ($inst_response,%{$inst_results->{$user}}) =
9303: &Apache::lonnet::get_instuser($udom,$uname);
9304: return;
1.612 raeburn 9305: }
1.615 raeburn 9306: if (!$got_rules->{$udom}) {
1.612 raeburn 9307: my %domconfig = &Apache::lonnet::get_dom('configuration',
9308: ['usercreation'],$udom);
9309: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9310: foreach my $item ('username','id') {
1.612 raeburn 9311: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9312: $$curr_rules{$udom}{$item} =
9313: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9314: }
9315: }
9316: }
1.615 raeburn 9317: $got_rules->{$udom} = 1;
1.585 raeburn 9318: }
1.612 raeburn 9319: foreach my $item (keys(%{$checks})) {
9320: if (ref($$curr_rules{$udom}) eq 'HASH') {
9321: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9322: if (@{$$curr_rules{$udom}{$item}} > 0) {
9323: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9324: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9325: if ($rule_check{$rule}) {
9326: $$rulematch{$user}{$item} = $rule;
9327: if ($inst_response eq 'ok') {
1.615 raeburn 9328: if (ref($inst_results) eq 'HASH') {
9329: if (ref($inst_results->{$user}) eq 'HASH') {
9330: if (keys(%{$inst_results->{$user}}) == 0) {
9331: $$alerts{$item}{$udom}{$uname} = 1;
9332: }
1.612 raeburn 9333: }
9334: }
1.615 raeburn 9335: }
9336: last;
1.585 raeburn 9337: }
9338: }
9339: }
9340: }
9341: }
9342: }
9343: }
9344: }
1.612 raeburn 9345: return;
9346: }
9347:
9348: sub user_rule_formats {
9349: my ($domain,$domdesc,$curr_rules,$check) = @_;
9350: my %text = (
9351: 'username' => 'Usernames',
9352: 'id' => 'IDs',
9353: );
9354: my $output;
9355: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9356: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9357: if (@{$ruleorder} > 0) {
1.1102 raeburn 9358: $output = '<br />'.
9359: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9360: '<span class="LC_cusr_emph">','</span>',$domdesc).
9361: ' <ul>';
1.612 raeburn 9362: foreach my $rule (@{$ruleorder}) {
9363: if (ref($curr_rules) eq 'ARRAY') {
9364: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9365: if (ref($rules->{$rule}) eq 'HASH') {
9366: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9367: $rules->{$rule}{'desc'}.'</li>';
9368: }
9369: }
9370: }
9371: }
9372: $output .= '</ul>';
9373: }
9374: }
9375: return $output;
9376: }
9377:
9378: sub instrule_disallow_msg {
1.615 raeburn 9379: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9380: my $response;
9381: my %text = (
9382: item => 'username',
9383: items => 'usernames',
9384: match => 'matches',
9385: do => 'does',
9386: action => 'a username',
9387: one => 'one',
9388: );
9389: if ($count > 1) {
9390: $text{'item'} = 'usernames';
9391: $text{'match'} ='match';
9392: $text{'do'} = 'do';
9393: $text{'action'} = 'usernames',
9394: $text{'one'} = 'ones';
9395: }
9396: if ($checkitem eq 'id') {
9397: $text{'items'} = 'IDs';
9398: $text{'item'} = 'ID';
9399: $text{'action'} = 'an ID';
1.615 raeburn 9400: if ($count > 1) {
9401: $text{'item'} = 'IDs';
9402: $text{'action'} = 'IDs';
9403: }
1.612 raeburn 9404: }
1.674 bisitz 9405: $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 9406: if ($mode eq 'upload') {
9407: if ($checkitem eq 'username') {
9408: $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'}.");
9409: } elsif ($checkitem eq 'id') {
1.674 bisitz 9410: $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 9411: }
1.669 raeburn 9412: } elsif ($mode eq 'selfcreate') {
9413: if ($checkitem eq 'id') {
9414: $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.");
9415: }
1.615 raeburn 9416: } else {
9417: if ($checkitem eq 'username') {
9418: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9419: } elsif ($checkitem eq 'id') {
9420: $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.");
9421: }
1.612 raeburn 9422: }
9423: return $response;
1.585 raeburn 9424: }
9425:
1.624 raeburn 9426: sub personal_data_fieldtitles {
9427: my %fieldtitles = &Apache::lonlocal::texthash (
9428: id => 'Student/Employee ID',
9429: permanentemail => 'E-mail address',
9430: lastname => 'Last Name',
9431: firstname => 'First Name',
9432: middlename => 'Middle Name',
9433: generation => 'Generation',
9434: gen => 'Generation',
1.765 raeburn 9435: inststatus => 'Affiliation',
1.624 raeburn 9436: );
9437: return %fieldtitles;
9438: }
9439:
1.642 raeburn 9440: sub sorted_inst_types {
9441: my ($dom) = @_;
1.1185 raeburn 9442: my ($usertypes,$order);
9443: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9444: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9445: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9446: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9447: } else {
9448: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9449: }
1.642 raeburn 9450: my $othertitle = &mt('All users');
9451: if ($env{'request.course.id'}) {
1.668 raeburn 9452: $othertitle = &mt('Any users');
1.642 raeburn 9453: }
9454: my @types;
9455: if (ref($order) eq 'ARRAY') {
9456: @types = @{$order};
9457: }
9458: if (@types == 0) {
9459: if (ref($usertypes) eq 'HASH') {
9460: @types = sort(keys(%{$usertypes}));
9461: }
9462: }
9463: if (keys(%{$usertypes}) > 0) {
9464: $othertitle = &mt('Other users');
9465: }
9466: return ($othertitle,$usertypes,\@types);
9467: }
9468:
1.645 raeburn 9469: sub get_institutional_codes {
9470: my ($settings,$allcourses,$LC_code) = @_;
9471: # Get complete list of course sections to update
9472: my @currsections = ();
9473: my @currxlists = ();
9474: my $coursecode = $$settings{'internal.coursecode'};
9475:
9476: if ($$settings{'internal.sectionnums'} ne '') {
9477: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9478: }
9479:
9480: if ($$settings{'internal.crosslistings'} ne '') {
9481: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9482: }
9483:
9484: if (@currxlists > 0) {
9485: foreach (@currxlists) {
9486: if (m/^([^:]+):(\w*)$/) {
9487: unless (grep/^$1$/,@{$allcourses}) {
9488: push @{$allcourses},$1;
9489: $$LC_code{$1} = $2;
9490: }
9491: }
9492: }
9493: }
9494:
9495: if (@currsections > 0) {
9496: foreach (@currsections) {
9497: if (m/^(\w+):(\w*)$/) {
9498: my $sec = $coursecode.$1;
9499: my $lc_sec = $2;
9500: unless (grep/^$sec$/,@{$allcourses}) {
9501: push @{$allcourses},$sec;
9502: $$LC_code{$sec} = $lc_sec;
9503: }
9504: }
9505: }
9506: }
9507: return;
9508: }
9509:
1.971 raeburn 9510: sub get_standard_codeitems {
9511: return ('Year','Semester','Department','Number','Section');
9512: }
9513:
1.112 bowersj2 9514: =pod
9515:
1.780 raeburn 9516: =head1 Slot Helpers
9517:
9518: =over 4
9519:
9520: =item * sorted_slots()
9521:
1.1040 raeburn 9522: Sorts an array of slot names in order of an optional sort key,
9523: default sort is by slot start time (earliest first).
1.780 raeburn 9524:
9525: Inputs:
9526:
9527: =over 4
9528:
9529: slotsarr - Reference to array of unsorted slot names.
9530:
9531: slots - Reference to hash of hash, where outer hash keys are slot names.
9532:
1.1040 raeburn 9533: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9534:
1.549 albertel 9535: =back
9536:
1.780 raeburn 9537: Returns:
9538:
9539: =over 4
9540:
1.1040 raeburn 9541: sorted - An array of slot names sorted by a specified sort key
9542: (default sort key is start time of the slot).
1.780 raeburn 9543:
9544: =back
9545:
9546: =cut
9547:
9548:
9549: sub sorted_slots {
1.1040 raeburn 9550: my ($slotsarr,$slots,$sortkey) = @_;
9551: if ($sortkey eq '') {
9552: $sortkey = 'starttime';
9553: }
1.780 raeburn 9554: my @sorted;
9555: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9556: @sorted =
9557: sort {
9558: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9559: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9560: }
9561: if (ref($slots->{$a})) { return -1;}
9562: if (ref($slots->{$b})) { return 1;}
9563: return 0;
9564: } @{$slotsarr};
9565: }
9566: return @sorted;
9567: }
9568:
1.1040 raeburn 9569: =pod
9570:
9571: =item * get_future_slots()
9572:
9573: Inputs:
9574:
9575: =over 4
9576:
9577: cnum - course number
9578:
9579: cdom - course domain
9580:
9581: now - current UNIX time
9582:
9583: symb - optional symb
9584:
9585: =back
9586:
9587: Returns:
9588:
9589: =over 4
9590:
9591: sorted_reservable - ref to array of student_schedulable slots currently
9592: reservable, ordered by end date of reservation period.
9593:
9594: reservable_now - ref to hash of student_schedulable slots currently
9595: reservable.
9596:
9597: Keys in inner hash are:
9598: (a) symb: either blank or symb to which slot use is restricted.
9599: (b) endreserve: end date of reservation period.
9600:
9601: sorted_future - ref to array of student_schedulable slots reservable in
9602: the future, ordered by start date of reservation period.
9603:
9604: future_reservable - ref to hash of student_schedulable slots reservable
9605: in the future.
9606:
9607: Keys in inner hash are:
9608: (a) symb: either blank or symb to which slot use is restricted.
9609: (b) startreserve: start date of reservation period.
9610:
9611: =back
9612:
9613: =cut
9614:
9615: sub get_future_slots {
9616: my ($cnum,$cdom,$now,$symb) = @_;
9617: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9618: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9619: foreach my $slot (keys(%slots)) {
9620: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9621: if ($symb) {
9622: next if (($slots{$slot}->{'symb'} ne '') &&
9623: ($slots{$slot}->{'symb'} ne $symb));
9624: }
9625: if (($slots{$slot}->{'starttime'} > $now) &&
9626: ($slots{$slot}->{'endtime'} > $now)) {
9627: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9628: my $userallowed = 0;
9629: if ($slots{$slot}->{'allowedsections'}) {
9630: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9631: if (!defined($env{'request.role.sec'})
9632: && grep(/^No section assigned$/,@allowed_sec)) {
9633: $userallowed=1;
9634: } else {
9635: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9636: $userallowed=1;
9637: }
9638: }
9639: unless ($userallowed) {
9640: if (defined($env{'request.course.groups'})) {
9641: my @groups = split(/:/,$env{'request.course.groups'});
9642: foreach my $group (@groups) {
9643: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9644: $userallowed=1;
9645: last;
9646: }
9647: }
9648: }
9649: }
9650: }
9651: if ($slots{$slot}->{'allowedusers'}) {
9652: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9653: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9654: if (grep(/^\Q$user\E$/,@allowed_users)) {
9655: $userallowed = 1;
9656: }
9657: }
9658: next unless($userallowed);
9659: }
9660: my $startreserve = $slots{$slot}->{'startreserve'};
9661: my $endreserve = $slots{$slot}->{'endreserve'};
9662: my $symb = $slots{$slot}->{'symb'};
9663: if (($startreserve < $now) &&
9664: (!$endreserve || $endreserve > $now)) {
9665: my $lastres = $endreserve;
9666: if (!$lastres) {
9667: $lastres = $slots{$slot}->{'starttime'};
9668: }
9669: $reservable_now{$slot} = {
9670: symb => $symb,
9671: endreserve => $lastres
9672: };
9673: } elsif (($startreserve > $now) &&
9674: (!$endreserve || $endreserve > $startreserve)) {
9675: $future_reservable{$slot} = {
9676: symb => $symb,
9677: startreserve => $startreserve
9678: };
9679: }
9680: }
9681: }
9682: my @unsorted_reservable = keys(%reservable_now);
9683: if (@unsorted_reservable > 0) {
9684: @sorted_reservable =
9685: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9686: }
9687: my @unsorted_future = keys(%future_reservable);
9688: if (@unsorted_future > 0) {
9689: @sorted_future =
9690: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9691: }
9692: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9693: }
1.780 raeburn 9694:
9695: =pod
9696:
1.1057 foxr 9697: =back
9698:
1.549 albertel 9699: =head1 HTTP Helpers
9700:
9701: =over 4
9702:
1.648 raeburn 9703: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9704:
1.258 albertel 9705: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9706: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9707: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9708:
9709: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9710: $possible_names is an ref to an array of form element names. As an example:
9711: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9712: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9713:
9714: =cut
1.1 albertel 9715:
1.6 albertel 9716: sub get_unprocessed_cgi {
1.25 albertel 9717: my ($query,$possible_names)= @_;
1.26 matthew 9718: # $Apache::lonxml::debug=1;
1.356 albertel 9719: foreach my $pair (split(/&/,$query)) {
9720: my ($name, $value) = split(/=/,$pair);
1.369 www 9721: $name = &unescape($name);
1.25 albertel 9722: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9723: $value =~ tr/+/ /;
9724: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9725: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9726: }
1.16 harris41 9727: }
1.6 albertel 9728: }
9729:
1.112 bowersj2 9730: =pod
9731:
1.648 raeburn 9732: =item * &cacheheader()
1.112 bowersj2 9733:
9734: returns cache-controlling header code
9735:
9736: =cut
9737:
1.7 albertel 9738: sub cacheheader {
1.258 albertel 9739: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9740: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9741: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9742: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9743: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9744: return $output;
1.7 albertel 9745: }
9746:
1.112 bowersj2 9747: =pod
9748:
1.648 raeburn 9749: =item * &no_cache($r)
1.112 bowersj2 9750:
9751: specifies header code to not have cache
9752:
9753: =cut
9754:
1.9 albertel 9755: sub no_cache {
1.216 albertel 9756: my ($r) = @_;
9757: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9758: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9759: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9760: $r->no_cache(1);
9761: $r->header_out("Expires" => $date);
9762: $r->header_out("Pragma" => "no-cache");
1.123 www 9763: }
9764:
9765: sub content_type {
1.181 albertel 9766: my ($r,$type,$charset) = @_;
1.299 foxr 9767: if ($r) {
9768: # Note that printout.pl calls this with undef for $r.
9769: &no_cache($r);
9770: }
1.258 albertel 9771: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9772: unless ($charset) {
9773: $charset=&Apache::lonlocal::current_encoding;
9774: }
9775: if ($charset) { $type.='; charset='.$charset; }
9776: if ($r) {
9777: $r->content_type($type);
9778: } else {
9779: print("Content-type: $type\n\n");
9780: }
1.9 albertel 9781: }
1.25 albertel 9782:
1.112 bowersj2 9783: =pod
9784:
1.648 raeburn 9785: =item * &add_to_env($name,$value)
1.112 bowersj2 9786:
1.258 albertel 9787: adds $name to the %env hash with value
1.112 bowersj2 9788: $value, if $name already exists, the entry is converted to an array
9789: reference and $value is added to the array.
9790:
9791: =cut
9792:
1.25 albertel 9793: sub add_to_env {
9794: my ($name,$value)=@_;
1.258 albertel 9795: if (defined($env{$name})) {
9796: if (ref($env{$name})) {
1.25 albertel 9797: #already have multiple values
1.258 albertel 9798: push(@{ $env{$name} },$value);
1.25 albertel 9799: } else {
9800: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9801: my $first=$env{$name};
9802: undef($env{$name});
9803: push(@{ $env{$name} },$first,$value);
1.25 albertel 9804: }
9805: } else {
1.258 albertel 9806: $env{$name}=$value;
1.25 albertel 9807: }
1.31 albertel 9808: }
1.149 albertel 9809:
9810: =pod
9811:
1.648 raeburn 9812: =item * &get_env_multiple($name)
1.149 albertel 9813:
1.258 albertel 9814: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9815: values may be defined and end up as an array ref.
9816:
9817: returns an array of values
9818:
9819: =cut
9820:
9821: sub get_env_multiple {
9822: my ($name) = @_;
9823: my @values;
1.258 albertel 9824: if (defined($env{$name})) {
1.149 albertel 9825: # exists is it an array
1.258 albertel 9826: if (ref($env{$name})) {
9827: @values=@{ $env{$name} };
1.149 albertel 9828: } else {
1.258 albertel 9829: $values[0]=$env{$name};
1.149 albertel 9830: }
9831: }
9832: return(@values);
9833: }
9834:
1.660 raeburn 9835: sub ask_for_embedded_content {
9836: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9837: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9838: %currsubfile,%unused,$rem);
1.1071 raeburn 9839: my $counter = 0;
9840: my $numnew = 0;
1.987 raeburn 9841: my $numremref = 0;
9842: my $numinvalid = 0;
9843: my $numpathchg = 0;
9844: my $numexisting = 0;
1.1071 raeburn 9845: my $numunused = 0;
9846: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 9847: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9848: my $heading = &mt('Upload embedded files');
9849: my $buttontext = &mt('Upload');
9850:
1.1085 raeburn 9851: if ($env{'request.course.id'}) {
1.1123 raeburn 9852: if ($actionurl eq '/adm/dependencies') {
9853: $navmap = Apache::lonnavmaps::navmap->new();
9854: }
9855: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9856: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 9857: }
1.1123 raeburn 9858: if (($actionurl eq '/adm/portfolio') ||
9859: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 9860: my $current_path='/';
9861: if ($env{'form.currentpath'}) {
9862: $current_path = $env{'form.currentpath'};
9863: }
9864: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 9865: $udom = $cdom;
9866: $uname = $cnum;
1.984 raeburn 9867: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9868: } else {
9869: $udom = $env{'user.domain'};
9870: $uname = $env{'user.name'};
9871: $url = '/userfiles/portfolio';
9872: }
1.987 raeburn 9873: $toplevel = $url.'/';
1.984 raeburn 9874: $url .= $current_path;
9875: $getpropath = 1;
1.987 raeburn 9876: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9877: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9878: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9879: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9880: $toplevel = $url;
1.984 raeburn 9881: if ($rest ne '') {
1.987 raeburn 9882: $url .= $rest;
9883: }
9884: } elsif ($actionurl eq '/adm/coursedocs') {
9885: if (ref($args) eq 'HASH') {
1.1071 raeburn 9886: $url = $args->{'docs_url'};
9887: $toplevel = $url;
1.1084 raeburn 9888: if ($args->{'context'} eq 'paste') {
9889: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9890: ($path) =
9891: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9892: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9893: $fileloc =~ s{^/}{};
9894: }
1.1071 raeburn 9895: }
1.1084 raeburn 9896: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9897: if ($env{'request.course.id'} ne '') {
9898: if (ref($args) eq 'HASH') {
9899: $url = $args->{'docs_url'};
9900: $title = $args->{'docs_title'};
1.1126 raeburn 9901: $toplevel = $url;
9902: unless ($toplevel =~ m{^/}) {
9903: $toplevel = "/$url";
9904: }
1.1085 raeburn 9905: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 9906: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
9907: $path = $1;
9908: } else {
9909: ($path) =
9910: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9911: }
1.1195 raeburn 9912: if ($toplevel=~/^\/*(uploaded|editupload)/) {
9913: $fileloc = $toplevel;
9914: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
9915: my ($udom,$uname,$fname) =
9916: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
9917: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
9918: } else {
9919: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9920: }
1.1071 raeburn 9921: $fileloc =~ s{^/}{};
9922: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9923: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9924: }
1.987 raeburn 9925: }
1.1123 raeburn 9926: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9927: $udom = $cdom;
9928: $uname = $cnum;
9929: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
9930: $toplevel = $url;
9931: $path = $url;
9932: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
9933: $fileloc =~ s{^/}{};
1.987 raeburn 9934: }
1.1126 raeburn 9935: foreach my $file (keys(%{$allfiles})) {
9936: my $embed_file;
9937: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
9938: $embed_file = $1;
9939: } else {
9940: $embed_file = $file;
9941: }
1.1158 raeburn 9942: my ($absolutepath,$cleaned_file);
9943: if ($embed_file =~ m{^\w+://}) {
9944: $cleaned_file = $embed_file;
1.1147 raeburn 9945: $newfiles{$cleaned_file} = 1;
9946: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 9947: } else {
1.1158 raeburn 9948: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 9949: if ($embed_file =~ m{^/}) {
9950: $absolutepath = $embed_file;
9951: }
1.1147 raeburn 9952: if ($cleaned_file =~ m{/}) {
9953: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 9954: $path = &check_for_traversal($path,$url,$toplevel);
9955: my $item = $fname;
9956: if ($path ne '') {
9957: $item = $path.'/'.$fname;
9958: $subdependencies{$path}{$fname} = 1;
9959: } else {
9960: $dependencies{$item} = 1;
9961: }
9962: if ($absolutepath) {
9963: $mapping{$item} = $absolutepath;
9964: } else {
9965: $mapping{$item} = $embed_file;
9966: }
9967: } else {
9968: $dependencies{$embed_file} = 1;
9969: if ($absolutepath) {
1.1147 raeburn 9970: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 9971: } else {
1.1147 raeburn 9972: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 9973: }
9974: }
1.984 raeburn 9975: }
9976: }
1.1071 raeburn 9977: my $dirptr = 16384;
1.984 raeburn 9978: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 9979: $currsubfile{$path} = {};
1.1123 raeburn 9980: if (($actionurl eq '/adm/portfolio') ||
9981: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9982: my ($sublistref,$listerror) =
9983: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
9984: if (ref($sublistref) eq 'ARRAY') {
9985: foreach my $line (@{$sublistref}) {
9986: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 9987: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 9988: }
1.984 raeburn 9989: }
1.987 raeburn 9990: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9991: if (opendir(my $dir,$url.'/'.$path)) {
9992: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 9993: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
9994: }
1.1084 raeburn 9995: } elsif (($actionurl eq '/adm/dependencies') ||
9996: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 9997: ($args->{'context'} eq 'paste')) ||
9998: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 9999: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10000: my $dir;
10001: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10002: $dir = $fileloc;
10003: } else {
10004: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10005: }
1.1071 raeburn 10006: if ($dir ne '') {
10007: my ($sublistref,$listerror) =
10008: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10009: if (ref($sublistref) eq 'ARRAY') {
10010: foreach my $line (@{$sublistref}) {
10011: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10012: undef,$mtime)=split(/\&/,$line,12);
10013: unless (($testdir&$dirptr) ||
10014: ($file_name =~ /^\.\.?$/)) {
10015: $currsubfile{$path}{$file_name} = [$size,$mtime];
10016: }
10017: }
10018: }
10019: }
1.984 raeburn 10020: }
10021: }
10022: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10023: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10024: my $item = $path.'/'.$file;
10025: unless ($mapping{$item} eq $item) {
10026: $pathchanges{$item} = 1;
10027: }
10028: $existing{$item} = 1;
10029: $numexisting ++;
10030: } else {
10031: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10032: }
10033: }
1.1071 raeburn 10034: if ($actionurl eq '/adm/dependencies') {
10035: foreach my $path (keys(%currsubfile)) {
10036: if (ref($currsubfile{$path}) eq 'HASH') {
10037: foreach my $file (keys(%{$currsubfile{$path}})) {
10038: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10039: next if (($rem ne '') &&
10040: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10041: (ref($navmap) &&
10042: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10043: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10044: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10045: $unused{$path.'/'.$file} = 1;
10046: }
10047: }
10048: }
10049: }
10050: }
1.984 raeburn 10051: }
1.987 raeburn 10052: my %currfile;
1.1123 raeburn 10053: if (($actionurl eq '/adm/portfolio') ||
10054: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10055: my ($dirlistref,$listerror) =
10056: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10057: if (ref($dirlistref) eq 'ARRAY') {
10058: foreach my $line (@{$dirlistref}) {
10059: my ($file_name,$rest) = split(/\&/,$line,2);
10060: $currfile{$file_name} = 1;
10061: }
1.984 raeburn 10062: }
1.987 raeburn 10063: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10064: if (opendir(my $dir,$url)) {
1.987 raeburn 10065: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10066: map {$currfile{$_} = 1;} @dir_list;
10067: }
1.1084 raeburn 10068: } elsif (($actionurl eq '/adm/dependencies') ||
10069: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10070: ($args->{'context'} eq 'paste')) ||
10071: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10072: if ($env{'request.course.id'} ne '') {
10073: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10074: if ($dir ne '') {
10075: my ($dirlistref,$listerror) =
10076: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10077: if (ref($dirlistref) eq 'ARRAY') {
10078: foreach my $line (@{$dirlistref}) {
10079: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10080: $size,undef,$mtime)=split(/\&/,$line,12);
10081: unless (($testdir&$dirptr) ||
10082: ($file_name =~ /^\.\.?$/)) {
10083: $currfile{$file_name} = [$size,$mtime];
10084: }
10085: }
10086: }
10087: }
10088: }
1.984 raeburn 10089: }
10090: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10091: if (exists($currfile{$file})) {
1.987 raeburn 10092: unless ($mapping{$file} eq $file) {
10093: $pathchanges{$file} = 1;
10094: }
10095: $existing{$file} = 1;
10096: $numexisting ++;
10097: } else {
1.984 raeburn 10098: $newfiles{$file} = 1;
10099: }
10100: }
1.1071 raeburn 10101: foreach my $file (keys(%currfile)) {
10102: unless (($file eq $filename) ||
10103: ($file eq $filename.'.bak') ||
10104: ($dependencies{$file})) {
1.1085 raeburn 10105: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10106: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10107: next if (($rem ne '') &&
10108: (($env{"httpref.$rem".$file} ne '') ||
10109: (ref($navmap) &&
10110: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10111: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10112: ($navmap->getResourceByUrl($rem.$1)))))));
10113: }
1.1085 raeburn 10114: }
1.1071 raeburn 10115: $unused{$file} = 1;
10116: }
10117: }
1.1084 raeburn 10118: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10119: ($args->{'context'} eq 'paste')) {
10120: $counter = scalar(keys(%existing));
10121: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10122: return ($output,$counter,$numpathchg,\%existing);
10123: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10124: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10125: $counter = scalar(keys(%existing));
10126: $numpathchg = scalar(keys(%pathchanges));
10127: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10128: }
1.984 raeburn 10129: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10130: if ($actionurl eq '/adm/dependencies') {
10131: next if ($embed_file =~ m{^\w+://});
10132: }
1.660 raeburn 10133: $upload_output .= &start_data_table_row().
1.1123 raeburn 10134: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10135: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10136: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10137: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10138: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10139: }
1.1123 raeburn 10140: $upload_output .= '</td>';
1.1071 raeburn 10141: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10142: $upload_output.='<td align="right">'.
10143: '<span class="LC_info LC_fontsize_medium">'.
10144: &mt("URL points to web address").'</span>';
1.987 raeburn 10145: $numremref++;
1.660 raeburn 10146: } elsif ($args->{'error_on_invalid_names'}
10147: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10148: $upload_output.='<td align="right"><span class="LC_warning">'.
10149: &mt('Invalid characters').'</span>';
1.987 raeburn 10150: $numinvalid++;
1.660 raeburn 10151: } else {
1.1123 raeburn 10152: $upload_output .= '<td>'.
10153: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10154: $embed_file,\%mapping,
1.1071 raeburn 10155: $allfiles,$codebase,'upload');
10156: $counter ++;
10157: $numnew ++;
1.987 raeburn 10158: }
10159: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10160: }
10161: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10162: if ($actionurl eq '/adm/dependencies') {
10163: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10164: $modify_output .= &start_data_table_row().
10165: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10166: '<img src="'.&icon($embed_file).'" border="0" />'.
10167: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10168: '<td>'.$size.'</td>'.
10169: '<td>'.$mtime.'</td>'.
10170: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10171: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10172: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10173: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10174: &embedded_file_element('upload_embedded',$counter,
10175: $embed_file,\%mapping,
10176: $allfiles,$codebase,'modify').
10177: '</div></td>'.
10178: &end_data_table_row()."\n";
10179: $counter ++;
10180: } else {
10181: $upload_output .= &start_data_table_row().
1.1123 raeburn 10182: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10183: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10184: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10185: &Apache::loncommon::end_data_table_row()."\n";
10186: }
10187: }
10188: my $delidx = $counter;
10189: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10190: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10191: $delete_output .= &start_data_table_row().
10192: '<td><img src="'.&icon($oldfile).'" />'.
10193: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10194: '<td>'.$size.'</td>'.
10195: '<td>'.$mtime.'</td>'.
10196: '<td><label><input type="checkbox" name="del_upload_dep" '.
10197: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10198: &embedded_file_element('upload_embedded',$delidx,
10199: $oldfile,\%mapping,$allfiles,
10200: $codebase,'delete').'</td>'.
10201: &end_data_table_row()."\n";
10202: $numunused ++;
10203: $delidx ++;
1.987 raeburn 10204: }
10205: if ($upload_output) {
10206: $upload_output = &start_data_table().
10207: $upload_output.
10208: &end_data_table()."\n";
10209: }
1.1071 raeburn 10210: if ($modify_output) {
10211: $modify_output = &start_data_table().
10212: &start_data_table_header_row().
10213: '<th>'.&mt('File').'</th>'.
10214: '<th>'.&mt('Size (KB)').'</th>'.
10215: '<th>'.&mt('Modified').'</th>'.
10216: '<th>'.&mt('Upload replacement?').'</th>'.
10217: &end_data_table_header_row().
10218: $modify_output.
10219: &end_data_table()."\n";
10220: }
10221: if ($delete_output) {
10222: $delete_output = &start_data_table().
10223: &start_data_table_header_row().
10224: '<th>'.&mt('File').'</th>'.
10225: '<th>'.&mt('Size (KB)').'</th>'.
10226: '<th>'.&mt('Modified').'</th>'.
10227: '<th>'.&mt('Delete?').'</th>'.
10228: &end_data_table_header_row().
10229: $delete_output.
10230: &end_data_table()."\n";
10231: }
1.987 raeburn 10232: my $applies = 0;
10233: if ($numremref) {
10234: $applies ++;
10235: }
10236: if ($numinvalid) {
10237: $applies ++;
10238: }
10239: if ($numexisting) {
10240: $applies ++;
10241: }
1.1071 raeburn 10242: if ($counter || $numunused) {
1.987 raeburn 10243: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10244: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10245: $state.'<h3>'.$heading.'</h3>';
10246: if ($actionurl eq '/adm/dependencies') {
10247: if ($numnew) {
10248: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10249: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10250: $upload_output.'<br />'."\n";
10251: }
10252: if ($numexisting) {
10253: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10254: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10255: $modify_output.'<br />'."\n";
10256: $buttontext = &mt('Save changes');
10257: }
10258: if ($numunused) {
10259: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10260: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10261: $delete_output.'<br />'."\n";
10262: $buttontext = &mt('Save changes');
10263: }
10264: } else {
10265: $output .= $upload_output.'<br />'."\n";
10266: }
10267: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10268: $counter.'" />'."\n";
10269: if ($actionurl eq '/adm/dependencies') {
10270: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10271: $numnew.'" />'."\n";
10272: } elsif ($actionurl eq '') {
1.987 raeburn 10273: $output .= '<input type="hidden" name="phase" value="three" />';
10274: }
10275: } elsif ($applies) {
10276: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10277: if ($applies > 1) {
10278: $output .=
1.1123 raeburn 10279: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10280: if ($numremref) {
10281: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10282: }
10283: if ($numinvalid) {
10284: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10285: }
10286: if ($numexisting) {
10287: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10288: }
10289: $output .= '</ul><br />';
10290: } elsif ($numremref) {
10291: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10292: } elsif ($numinvalid) {
10293: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10294: } elsif ($numexisting) {
10295: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10296: }
10297: $output .= $upload_output.'<br />';
10298: }
10299: my ($pathchange_output,$chgcount);
1.1071 raeburn 10300: $chgcount = $counter;
1.987 raeburn 10301: if (keys(%pathchanges) > 0) {
10302: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10303: if ($counter) {
1.987 raeburn 10304: $output .= &embedded_file_element('pathchange',$chgcount,
10305: $embed_file,\%mapping,
1.1071 raeburn 10306: $allfiles,$codebase,'change');
1.987 raeburn 10307: } else {
10308: $pathchange_output .=
10309: &start_data_table_row().
10310: '<td><input type ="checkbox" name="namechange" value="'.
10311: $chgcount.'" checked="checked" /></td>'.
10312: '<td>'.$mapping{$embed_file}.'</td>'.
10313: '<td>'.$embed_file.
10314: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10315: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10316: '</td>'.&end_data_table_row();
1.660 raeburn 10317: }
1.987 raeburn 10318: $numpathchg ++;
10319: $chgcount ++;
1.660 raeburn 10320: }
10321: }
1.1127 raeburn 10322: if (($counter) || ($numunused)) {
1.987 raeburn 10323: if ($numpathchg) {
10324: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10325: $numpathchg.'" />'."\n";
10326: }
10327: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10328: ($actionurl eq '/adm/imsimport')) {
10329: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10330: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10331: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10332: } elsif ($actionurl eq '/adm/dependencies') {
10333: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10334: }
1.1123 raeburn 10335: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10336: } elsif ($numpathchg) {
10337: my %pathchange = ();
10338: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10339: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10340: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10341: }
1.987 raeburn 10342: }
1.1071 raeburn 10343: return ($output,$counter,$numpathchg);
1.987 raeburn 10344: }
10345:
1.1147 raeburn 10346: =pod
10347:
10348: =item * clean_path($name)
10349:
10350: Performs clean-up of directories, subdirectories and filename in an
10351: embedded object, referenced in an HTML file which is being uploaded
10352: to a course or portfolio, where
10353: "Upload embedded images/multimedia files if HTML file" checkbox was
10354: checked.
10355:
10356: Clean-up is similar to replacements in lonnet::clean_filename()
10357: except each / between sub-directory and next level is preserved.
10358:
10359: =cut
10360:
10361: sub clean_path {
10362: my ($embed_file) = @_;
10363: $embed_file =~s{^/+}{};
10364: my @contents;
10365: if ($embed_file =~ m{/}) {
10366: @contents = split(/\//,$embed_file);
10367: } else {
10368: @contents = ($embed_file);
10369: }
10370: my $lastidx = scalar(@contents)-1;
10371: for (my $i=0; $i<=$lastidx; $i++) {
10372: $contents[$i]=~s{\\}{/}g;
10373: $contents[$i]=~s/\s+/\_/g;
10374: $contents[$i]=~s{[^/\w\.\-]}{}g;
10375: if ($i == $lastidx) {
10376: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10377: }
10378: }
10379: if ($lastidx > 0) {
10380: return join('/',@contents);
10381: } else {
10382: return $contents[0];
10383: }
10384: }
10385:
1.987 raeburn 10386: sub embedded_file_element {
1.1071 raeburn 10387: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10388: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10389: (ref($codebase) eq 'HASH'));
10390: my $output;
1.1071 raeburn 10391: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10392: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10393: }
10394: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10395: &escape($embed_file).'" />';
10396: unless (($context eq 'upload_embedded') &&
10397: ($mapping->{$embed_file} eq $embed_file)) {
10398: $output .='
10399: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10400: }
10401: my $attrib;
10402: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10403: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10404: }
10405: $output .=
10406: "\n\t\t".
10407: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10408: $attrib.'" />';
10409: if (exists($codebase->{$mapping->{$embed_file}})) {
10410: $output .=
10411: "\n\t\t".
10412: '<input name="codebase_'.$num.'" type="hidden" value="'.
10413: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10414: }
1.987 raeburn 10415: return $output;
1.660 raeburn 10416: }
10417:
1.1071 raeburn 10418: sub get_dependency_details {
10419: my ($currfile,$currsubfile,$embed_file) = @_;
10420: my ($size,$mtime,$showsize,$showmtime);
10421: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10422: if ($embed_file =~ m{/}) {
10423: my ($path,$fname) = split(/\//,$embed_file);
10424: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10425: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10426: }
10427: } else {
10428: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10429: ($size,$mtime) = @{$currfile->{$embed_file}};
10430: }
10431: }
10432: $showsize = $size/1024.0;
10433: $showsize = sprintf("%.1f",$showsize);
10434: if ($mtime > 0) {
10435: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10436: }
10437: }
10438: return ($showsize,$showmtime);
10439: }
10440:
10441: sub ask_embedded_js {
10442: return <<"END";
10443: <script type="text/javascript"">
10444: // <![CDATA[
10445: function toggleBrowse(counter) {
10446: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10447: var fileid = document.getElementById('embedded_item_'+counter);
10448: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10449: if (chkboxid.checked == true) {
10450: uploaddivid.style.display='block';
10451: } else {
10452: uploaddivid.style.display='none';
10453: fileid.value = '';
10454: }
10455: }
10456: // ]]>
10457: </script>
10458:
10459: END
10460: }
10461:
1.661 raeburn 10462: sub upload_embedded {
10463: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10464: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10465: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10466: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10467: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10468: my $orig_uploaded_filename =
10469: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10470: foreach my $type ('orig','ref','attrib','codebase') {
10471: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10472: $env{'form.embedded_'.$type.'_'.$i} =
10473: &unescape($env{'form.embedded_'.$type.'_'.$i});
10474: }
10475: }
1.661 raeburn 10476: my ($path,$fname) =
10477: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10478: # no path, whole string is fname
10479: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10480: $fname = &Apache::lonnet::clean_filename($fname);
10481: # See if there is anything left
10482: next if ($fname eq '');
10483:
10484: # Check if file already exists as a file or directory.
10485: my ($state,$msg);
10486: if ($context eq 'portfolio') {
10487: my $port_path = $dirpath;
10488: if ($group ne '') {
10489: $port_path = "groups/$group/$port_path";
10490: }
1.987 raeburn 10491: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10492: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10493: $dir_root,$port_path,$disk_quota,
10494: $current_disk_usage,$uname,$udom);
10495: if ($state eq 'will_exceed_quota'
1.984 raeburn 10496: || $state eq 'file_locked') {
1.661 raeburn 10497: $output .= $msg;
10498: next;
10499: }
10500: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10501: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10502: if ($state eq 'exists') {
10503: $output .= $msg;
10504: next;
10505: }
10506: }
10507: # Check if extension is valid
10508: if (($fname =~ /\.(\w+)$/) &&
10509: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10510: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10511: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10512: next;
10513: } elsif (($fname =~ /\.(\w+)$/) &&
10514: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10515: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10516: next;
10517: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10518: $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 10519: next;
10520: }
10521: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10522: my $subdir = $path;
10523: $subdir =~ s{/+$}{};
1.661 raeburn 10524: if ($context eq 'portfolio') {
1.984 raeburn 10525: my $result;
10526: if ($state eq 'existingfile') {
10527: $result=
10528: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 10529: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10530: } else {
1.984 raeburn 10531: $result=
10532: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10533: $dirpath.
1.1123 raeburn 10534: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10535: if ($result !~ m|^/uploaded/|) {
10536: $output .= '<span class="LC_error">'
10537: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10538: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10539: .'</span><br />';
10540: next;
10541: } else {
1.987 raeburn 10542: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10543: $path.$fname.'</span>').'<br />';
1.984 raeburn 10544: }
1.661 raeburn 10545: }
1.1123 raeburn 10546: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 10547: my $extendedsubdir = $dirpath.'/'.$subdir;
10548: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10549: my $result =
1.1126 raeburn 10550: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10551: if ($result !~ m|^/uploaded/|) {
10552: $output .= '<span class="LC_error">'
10553: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10554: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10555: .'</span><br />';
10556: next;
10557: } else {
10558: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10559: $path.$fname.'</span>').'<br />';
1.1125 raeburn 10560: if ($context eq 'syllabus') {
10561: &Apache::lonnet::make_public_indefinitely($result);
10562: }
1.987 raeburn 10563: }
1.661 raeburn 10564: } else {
10565: # Save the file
10566: my $target = $env{'form.embedded_item_'.$i};
10567: my $fullpath = $dir_root.$dirpath.'/'.$path;
10568: my $dest = $fullpath.$fname;
10569: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10570: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10571: my $count;
10572: my $filepath = $dir_root;
1.1027 raeburn 10573: foreach my $subdir (@parts) {
10574: $filepath .= "/$subdir";
10575: if (!-e $filepath) {
1.661 raeburn 10576: mkdir($filepath,0770);
10577: }
10578: }
10579: my $fh;
10580: if (!open($fh,'>'.$dest)) {
10581: &Apache::lonnet::logthis('Failed to create '.$dest);
10582: $output .= '<span class="LC_error">'.
1.1071 raeburn 10583: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10584: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10585: '</span><br />';
10586: } else {
10587: if (!print $fh $env{'form.embedded_item_'.$i}) {
10588: &Apache::lonnet::logthis('Failed to write to '.$dest);
10589: $output .= '<span class="LC_error">'.
1.1071 raeburn 10590: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10591: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10592: '</span><br />';
10593: } else {
1.987 raeburn 10594: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10595: $url.'</span>').'<br />';
10596: unless ($context eq 'testbank') {
10597: $footer .= &mt('View embedded file: [_1]',
10598: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10599: }
10600: }
10601: close($fh);
10602: }
10603: }
10604: if ($env{'form.embedded_ref_'.$i}) {
10605: $pathchange{$i} = 1;
10606: }
10607: }
10608: if ($output) {
10609: $output = '<p>'.$output.'</p>';
10610: }
10611: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10612: $returnflag = 'ok';
1.1071 raeburn 10613: my $numpathchgs = scalar(keys(%pathchange));
10614: if ($numpathchgs > 0) {
1.987 raeburn 10615: if ($context eq 'portfolio') {
10616: $output .= '<p>'.&mt('or').'</p>';
10617: } elsif ($context eq 'testbank') {
1.1071 raeburn 10618: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10619: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10620: $returnflag = 'modify_orightml';
10621: }
10622: }
1.1071 raeburn 10623: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10624: }
10625:
10626: sub modify_html_form {
10627: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10628: my $end = 0;
10629: my $modifyform;
10630: if ($context eq 'upload_embedded') {
10631: return unless (ref($pathchange) eq 'HASH');
10632: if ($env{'form.number_embedded_items'}) {
10633: $end += $env{'form.number_embedded_items'};
10634: }
10635: if ($env{'form.number_pathchange_items'}) {
10636: $end += $env{'form.number_pathchange_items'};
10637: }
10638: if ($end) {
10639: for (my $i=0; $i<$end; $i++) {
10640: if ($i < $env{'form.number_embedded_items'}) {
10641: next unless($pathchange->{$i});
10642: }
10643: $modifyform .=
10644: &start_data_table_row().
10645: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10646: 'checked="checked" /></td>'.
10647: '<td>'.$env{'form.embedded_ref_'.$i}.
10648: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10649: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10650: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10651: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10652: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10653: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10654: '<td>'.$env{'form.embedded_orig_'.$i}.
10655: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10656: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10657: &end_data_table_row();
1.1071 raeburn 10658: }
1.987 raeburn 10659: }
10660: } else {
10661: $modifyform = $pathchgtable;
10662: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10663: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10664: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10665: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10666: }
10667: }
10668: if ($modifyform) {
1.1071 raeburn 10669: if ($actionurl eq '/adm/dependencies') {
10670: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10671: }
1.987 raeburn 10672: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10673: '<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".
10674: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10675: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10676: '</ol></p>'."\n".'<p>'.
10677: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10678: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10679: &start_data_table()."\n".
10680: &start_data_table_header_row().
10681: '<th>'.&mt('Change?').'</th>'.
10682: '<th>'.&mt('Current reference').'</th>'.
10683: '<th>'.&mt('Required reference').'</th>'.
10684: &end_data_table_header_row()."\n".
10685: $modifyform.
10686: &end_data_table().'<br />'."\n".$hiddenstate.
10687: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10688: '</form>'."\n";
10689: }
10690: return;
10691: }
10692:
10693: sub modify_html_refs {
1.1123 raeburn 10694: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10695: my $container;
10696: if ($context eq 'portfolio') {
10697: $container = $env{'form.container'};
10698: } elsif ($context eq 'coursedoc') {
10699: $container = $env{'form.primaryurl'};
1.1071 raeburn 10700: } elsif ($context eq 'manage_dependencies') {
10701: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10702: $container = "/$container";
1.1123 raeburn 10703: } elsif ($context eq 'syllabus') {
10704: $container = $url;
1.987 raeburn 10705: } else {
1.1027 raeburn 10706: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10707: }
10708: my (%allfiles,%codebase,$output,$content);
10709: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 10710: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10711: if (wantarray) {
10712: return ('',0,0);
10713: } else {
10714: return;
10715: }
10716: }
10717: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10718: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10719: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10720: if (wantarray) {
10721: return ('',0,0);
10722: } else {
10723: return;
10724: }
10725: }
1.987 raeburn 10726: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10727: if ($content eq '-1') {
10728: if (wantarray) {
10729: return ('',0,0);
10730: } else {
10731: return;
10732: }
10733: }
1.987 raeburn 10734: } else {
1.1071 raeburn 10735: unless ($container =~ /^\Q$dir_root\E/) {
10736: if (wantarray) {
10737: return ('',0,0);
10738: } else {
10739: return;
10740: }
10741: }
1.987 raeburn 10742: if (open(my $fh,"<$container")) {
10743: $content = join('', <$fh>);
10744: close($fh);
10745: } else {
1.1071 raeburn 10746: if (wantarray) {
10747: return ('',0,0);
10748: } else {
10749: return;
10750: }
1.987 raeburn 10751: }
10752: }
10753: my ($count,$codebasecount) = (0,0);
10754: my $mm = new File::MMagic;
10755: my $mime_type = $mm->checktype_contents($content);
10756: if ($mime_type eq 'text/html') {
10757: my $parse_result =
10758: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10759: \%codebase,\$content);
10760: if ($parse_result eq 'ok') {
10761: foreach my $i (@changes) {
10762: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10763: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10764: if ($allfiles{$ref}) {
10765: my $newname = $orig;
10766: my ($attrib_regexp,$codebase);
1.1006 raeburn 10767: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10768: if ($attrib_regexp =~ /:/) {
10769: $attrib_regexp =~ s/\:/|/g;
10770: }
10771: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10772: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10773: $count += $numchg;
1.1123 raeburn 10774: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 10775: delete($allfiles{$ref});
1.987 raeburn 10776: }
10777: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10778: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10779: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10780: $codebasecount ++;
10781: }
10782: }
10783: }
1.1123 raeburn 10784: my $skiprewrites;
1.987 raeburn 10785: if ($count || $codebasecount) {
10786: my $saveresult;
1.1071 raeburn 10787: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10788: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10789: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10790: if ($url eq $container) {
10791: my ($fname) = ($container =~ m{/([^/]+)$});
10792: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10793: $count,'<span class="LC_filename">'.
1.1071 raeburn 10794: $fname.'</span>').'</p>';
1.987 raeburn 10795: } else {
10796: $output = '<p class="LC_error">'.
10797: &mt('Error: update failed for: [_1].',
10798: '<span class="LC_filename">'.
10799: $container.'</span>').'</p>';
10800: }
1.1123 raeburn 10801: if ($context eq 'syllabus') {
10802: unless ($saveresult eq 'ok') {
10803: $skiprewrites = 1;
10804: }
10805: }
1.987 raeburn 10806: } else {
10807: if (open(my $fh,">$container")) {
10808: print $fh $content;
10809: close($fh);
10810: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10811: $count,'<span class="LC_filename">'.
10812: $container.'</span>').'</p>';
1.661 raeburn 10813: } else {
1.987 raeburn 10814: $output = '<p class="LC_error">'.
10815: &mt('Error: could not update [_1].',
10816: '<span class="LC_filename">'.
10817: $container.'</span>').'</p>';
1.661 raeburn 10818: }
10819: }
10820: }
1.1123 raeburn 10821: if (($context eq 'syllabus') && (!$skiprewrites)) {
10822: my ($actionurl,$state);
10823: $actionurl = "/public/$udom/$uname/syllabus";
10824: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10825: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10826: \%codebase,
10827: {'context' => 'rewrites',
10828: 'ignore_remote_references' => 1,});
10829: if (ref($mapping) eq 'HASH') {
10830: my $rewrites = 0;
10831: foreach my $key (keys(%{$mapping})) {
10832: next if ($key =~ m{^https?://});
10833: my $ref = $mapping->{$key};
10834: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10835: my $attrib;
10836: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10837: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10838: }
10839: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10840: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10841: $rewrites += $numchg;
10842: }
10843: }
10844: if ($rewrites) {
10845: my $saveresult;
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('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10850: $count,'<span class="LC_filename">'.
10851: $fname.'</span>').'</p>';
10852: } else {
10853: $output .= '<p class="LC_error">'.
10854: &mt('Error: could not update links in [_1].',
10855: '<span class="LC_filename">'.
10856: $container.'</span>').'</p>';
10857:
10858: }
10859: }
10860: }
10861: }
1.987 raeburn 10862: } else {
10863: &logthis('Failed to parse '.$container.
10864: ' to modify references: '.$parse_result);
1.661 raeburn 10865: }
10866: }
1.1071 raeburn 10867: if (wantarray) {
10868: return ($output,$count,$codebasecount);
10869: } else {
10870: return $output;
10871: }
1.661 raeburn 10872: }
10873:
10874: sub check_for_existing {
10875: my ($path,$fname,$element) = @_;
10876: my ($state,$msg);
10877: if (-d $path.'/'.$fname) {
10878: $state = 'exists';
10879: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10880: } elsif (-e $path.'/'.$fname) {
10881: $state = 'exists';
10882: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10883: }
10884: if ($state eq 'exists') {
10885: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10886: }
10887: return ($state,$msg);
10888: }
10889:
10890: sub check_for_upload {
10891: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10892: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10893: my $filesize = length($env{'form.'.$element});
10894: if (!$filesize) {
10895: my $msg = '<span class="LC_error">'.
10896: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10897: '<span class="LC_filename">'.$fname.'</span>',
10898: $filesize).'<br />'.
1.1007 raeburn 10899: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10900: '</span>';
10901: return ('zero_bytes',$msg);
10902: }
10903: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10904: my $getpropath = 1;
1.1021 raeburn 10905: my ($dirlistref,$listerror) =
10906: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10907: my $found_file = 0;
10908: my $locked_file = 0;
1.991 raeburn 10909: my @lockers;
10910: my $navmap;
10911: if ($env{'request.course.id'}) {
10912: $navmap = Apache::lonnavmaps::navmap->new();
10913: }
1.1021 raeburn 10914: if (ref($dirlistref) eq 'ARRAY') {
10915: foreach my $line (@{$dirlistref}) {
10916: my ($file_name,$rest)=split(/\&/,$line,2);
10917: if ($file_name eq $fname){
10918: $file_name = $path.$file_name;
10919: if ($group ne '') {
10920: $file_name = $group.$file_name;
10921: }
10922: $found_file = 1;
10923: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10924: foreach my $lock (@lockers) {
10925: if (ref($lock) eq 'ARRAY') {
10926: my ($symb,$crsid) = @{$lock};
10927: if ($crsid eq $env{'request.course.id'}) {
10928: if (ref($navmap)) {
10929: my $res = $navmap->getBySymb($symb);
10930: foreach my $part (@{$res->parts()}) {
10931: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10932: unless (($slot_status == $res->RESERVED) ||
10933: ($slot_status == $res->RESERVED_LOCATION)) {
10934: $locked_file = 1;
10935: }
1.991 raeburn 10936: }
1.1021 raeburn 10937: } else {
10938: $locked_file = 1;
1.991 raeburn 10939: }
10940: } else {
10941: $locked_file = 1;
10942: }
10943: }
1.1021 raeburn 10944: }
10945: } else {
10946: my @info = split(/\&/,$rest);
10947: my $currsize = $info[6]/1000;
10948: if ($currsize < $filesize) {
10949: my $extra = $filesize - $currsize;
10950: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 10951: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 10952: &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 10953: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
10954: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
10955: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 10956: return ('will_exceed_quota',$msg);
10957: }
1.984 raeburn 10958: }
10959: }
1.661 raeburn 10960: }
10961: }
10962: }
10963: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 10964: my $msg = '<p class="LC_warning">'.
10965: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 10966: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 10967: return ('will_exceed_quota',$msg);
10968: } elsif ($found_file) {
10969: if ($locked_file) {
1.1179 bisitz 10970: my $msg = '<p class="LC_warning">';
1.661 raeburn 10971: $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 10972: $msg .= '</p>';
1.661 raeburn 10973: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
10974: return ('file_locked',$msg);
10975: } else {
1.1179 bisitz 10976: my $msg = '<p class="LC_error">';
1.984 raeburn 10977: $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 10978: $msg .= '</p>';
1.984 raeburn 10979: return ('existingfile',$msg);
1.661 raeburn 10980: }
10981: }
10982: }
10983:
1.987 raeburn 10984: sub check_for_traversal {
10985: my ($path,$url,$toplevel) = @_;
10986: my @parts=split(/\//,$path);
10987: my $cleanpath;
10988: my $fullpath = $url;
10989: for (my $i=0;$i<@parts;$i++) {
10990: next if ($parts[$i] eq '.');
10991: if ($parts[$i] eq '..') {
10992: $fullpath =~ s{([^/]+/)$}{};
10993: } else {
10994: $fullpath .= $parts[$i].'/';
10995: }
10996: }
10997: if ($fullpath =~ /^\Q$url\E(.*)$/) {
10998: $cleanpath = $1;
10999: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11000: my $curr_toprel = $1;
11001: my @parts = split(/\//,$curr_toprel);
11002: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11003: my @urlparts = split(/\//,$url_toprel);
11004: my $doubledots;
11005: my $startdiff = -1;
11006: for (my $i=0; $i<@urlparts; $i++) {
11007: if ($startdiff == -1) {
11008: unless ($urlparts[$i] eq $parts[$i]) {
11009: $startdiff = $i;
11010: $doubledots .= '../';
11011: }
11012: } else {
11013: $doubledots .= '../';
11014: }
11015: }
11016: if ($startdiff > -1) {
11017: $cleanpath = $doubledots;
11018: for (my $i=$startdiff; $i<@parts; $i++) {
11019: $cleanpath .= $parts[$i].'/';
11020: }
11021: }
11022: }
11023: $cleanpath =~ s{(/)$}{};
11024: return $cleanpath;
11025: }
1.31 albertel 11026:
1.1053 raeburn 11027: sub is_archive_file {
11028: my ($mimetype) = @_;
11029: if (($mimetype eq 'application/octet-stream') ||
11030: ($mimetype eq 'application/x-stuffit') ||
11031: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11032: return 1;
11033: }
11034: return;
11035: }
11036:
11037: sub decompress_form {
1.1065 raeburn 11038: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11039: my %lt = &Apache::lonlocal::texthash (
11040: this => 'This file is an archive file.',
1.1067 raeburn 11041: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11042: itsc => 'Its contents are as follows:',
1.1053 raeburn 11043: youm => 'You may wish to extract its contents.',
11044: extr => 'Extract contents',
1.1067 raeburn 11045: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11046: proa => 'Process automatically?',
1.1053 raeburn 11047: yes => 'Yes',
11048: no => 'No',
1.1067 raeburn 11049: fold => 'Title for folder containing movie',
11050: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11051: );
1.1065 raeburn 11052: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11053: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11054: my $info = &list_archive_contents($fileloc,\@paths);
11055: if (@paths) {
11056: foreach my $path (@paths) {
11057: $path =~ s{^/}{};
1.1067 raeburn 11058: if ($path =~ m{^([^/]+)/$}) {
11059: $topdir = $1;
11060: }
1.1065 raeburn 11061: if ($path =~ m{^([^/]+)/}) {
11062: $toplevel{$1} = $path;
11063: } else {
11064: $toplevel{$path} = $path;
11065: }
11066: }
11067: }
1.1067 raeburn 11068: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11069: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11070: "$topdir/media/",
11071: "$topdir/media/$topdir.mp4",
11072: "$topdir/media/FirstFrame.png",
11073: "$topdir/media/player.swf",
11074: "$topdir/media/swfobject.js",
11075: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11076: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11077: "$topdir/$topdir.mp4",
11078: "$topdir/$topdir\_config.xml",
11079: "$topdir/$topdir\_controller.swf",
11080: "$topdir/$topdir\_embed.css",
11081: "$topdir/$topdir\_First_Frame.png",
11082: "$topdir/$topdir\_player.html",
11083: "$topdir/$topdir\_Thumbnails.png",
11084: "$topdir/playerProductInstall.swf",
11085: "$topdir/scripts/",
11086: "$topdir/scripts/config_xml.js",
11087: "$topdir/scripts/handlebars.js",
11088: "$topdir/scripts/jquery-1.7.1.min.js",
11089: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11090: "$topdir/scripts/modernizr.js",
11091: "$topdir/scripts/player-min.js",
11092: "$topdir/scripts/swfobject.js",
11093: "$topdir/skins/",
11094: "$topdir/skins/configuration_express.xml",
11095: "$topdir/skins/express_show/",
11096: "$topdir/skins/express_show/player-min.css",
11097: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11098: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11099: "$topdir/$topdir.mp4",
11100: "$topdir/$topdir\_config.xml",
11101: "$topdir/$topdir\_controller.swf",
11102: "$topdir/$topdir\_embed.css",
11103: "$topdir/$topdir\_First_Frame.png",
11104: "$topdir/$topdir\_player.html",
11105: "$topdir/$topdir\_Thumbnails.png",
11106: "$topdir/playerProductInstall.swf",
11107: "$topdir/scripts/",
11108: "$topdir/scripts/config_xml.js",
11109: "$topdir/scripts/techsmith-smart-player.min.js",
11110: "$topdir/skins/",
11111: "$topdir/skins/configuration_express.xml",
11112: "$topdir/skins/express_show/",
11113: "$topdir/skins/express_show/spritesheet.min.css",
11114: "$topdir/skins/express_show/spritesheet.png",
11115: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11116: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11117: if (@diffs == 0) {
1.1164 raeburn 11118: $is_camtasia = 6;
11119: } else {
1.1197 raeburn 11120: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11121: if (@diffs == 0) {
11122: $is_camtasia = 8;
1.1197 raeburn 11123: } else {
11124: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11125: if (@diffs == 0) {
11126: $is_camtasia = 8;
11127: }
1.1164 raeburn 11128: }
1.1067 raeburn 11129: }
11130: }
11131: my $output;
11132: if ($is_camtasia) {
11133: $output = <<"ENDCAM";
11134: <script type="text/javascript" language="Javascript">
11135: // <![CDATA[
11136:
11137: function camtasiaToggle() {
11138: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11139: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11140: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11141:
11142: document.getElementById('camtasia_titles').style.display='block';
11143: } else {
11144: document.getElementById('camtasia_titles').style.display='none';
11145: }
11146: }
11147: }
11148: return;
11149: }
11150:
11151: // ]]>
11152: </script>
11153: <p>$lt{'camt'}</p>
11154: ENDCAM
1.1065 raeburn 11155: } else {
1.1067 raeburn 11156: $output = '<p>'.$lt{'this'};
11157: if ($info eq '') {
11158: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11159: } else {
11160: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11161: '<div><pre>'.$info.'</pre></div>';
11162: }
1.1065 raeburn 11163: }
1.1067 raeburn 11164: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11165: my $duplicates;
11166: my $num = 0;
11167: if (ref($dirlist) eq 'ARRAY') {
11168: foreach my $item (@{$dirlist}) {
11169: if (ref($item) eq 'ARRAY') {
11170: if (exists($toplevel{$item->[0]})) {
11171: $duplicates .=
11172: &start_data_table_row().
11173: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11174: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11175: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11176: 'value="1" />'.&mt('Yes').'</label>'.
11177: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11178: '<td>'.$item->[0].'</td>';
11179: if ($item->[2]) {
11180: $duplicates .= '<td>'.&mt('Directory').'</td>';
11181: } else {
11182: $duplicates .= '<td>'.&mt('File').'</td>';
11183: }
11184: $duplicates .= '<td>'.$item->[3].'</td>'.
11185: '<td>'.
11186: &Apache::lonlocal::locallocaltime($item->[4]).
11187: '</td>'.
11188: &end_data_table_row();
11189: $num ++;
11190: }
11191: }
11192: }
11193: }
11194: my $itemcount;
11195: if (@paths > 0) {
11196: $itemcount = scalar(@paths);
11197: } else {
11198: $itemcount = 1;
11199: }
1.1067 raeburn 11200: if ($is_camtasia) {
11201: $output .= $lt{'auto'}.'<br />'.
11202: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11203: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11204: $lt{'yes'}.'</label> <label>'.
11205: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11206: $lt{'no'}.'</label></span><br />'.
11207: '<div id="camtasia_titles" style="display:block">'.
11208: &Apache::lonhtmlcommon::start_pick_box().
11209: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11210: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11211: &Apache::lonhtmlcommon::row_closure().
11212: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11213: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11214: &Apache::lonhtmlcommon::row_closure(1).
11215: &Apache::lonhtmlcommon::end_pick_box().
11216: '</div>';
11217: }
1.1065 raeburn 11218: $output .=
11219: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11220: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11221: "\n";
1.1065 raeburn 11222: if ($duplicates ne '') {
11223: $output .= '<p><span class="LC_warning">'.
11224: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11225: &start_data_table().
11226: &start_data_table_header_row().
11227: '<th>'.&mt('Overwrite?').'</th>'.
11228: '<th>'.&mt('Name').'</th>'.
11229: '<th>'.&mt('Type').'</th>'.
11230: '<th>'.&mt('Size').'</th>'.
11231: '<th>'.&mt('Last modified').'</th>'.
11232: &end_data_table_header_row().
11233: $duplicates.
11234: &end_data_table().
11235: '</p>';
11236: }
1.1067 raeburn 11237: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11238: if (ref($hiddenelements) eq 'HASH') {
11239: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11240: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11241: }
11242: }
11243: $output .= <<"END";
1.1067 raeburn 11244: <br />
1.1053 raeburn 11245: <input type="submit" name="decompress" value="$lt{'extr'}" />
11246: </form>
11247: $noextract
11248: END
11249: return $output;
11250: }
11251:
1.1065 raeburn 11252: sub decompression_utility {
11253: my ($program) = @_;
11254: my @utilities = ('tar','gunzip','bunzip2','unzip');
11255: my $location;
11256: if (grep(/^\Q$program\E$/,@utilities)) {
11257: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11258: '/usr/sbin/') {
11259: if (-x $dir.$program) {
11260: $location = $dir.$program;
11261: last;
11262: }
11263: }
11264: }
11265: return $location;
11266: }
11267:
11268: sub list_archive_contents {
11269: my ($file,$pathsref) = @_;
11270: my (@cmd,$output);
11271: my $needsregexp;
11272: if ($file =~ /\.zip$/) {
11273: @cmd = (&decompression_utility('unzip'),"-l");
11274: $needsregexp = 1;
11275: } elsif (($file =~ m/\.tar\.gz$/) ||
11276: ($file =~ /\.tgz$/)) {
11277: @cmd = (&decompression_utility('tar'),"-ztf");
11278: } elsif ($file =~ /\.tar\.bz2$/) {
11279: @cmd = (&decompression_utility('tar'),"-jtf");
11280: } elsif ($file =~ m|\.tar$|) {
11281: @cmd = (&decompression_utility('tar'),"-tf");
11282: }
11283: if (@cmd) {
11284: undef($!);
11285: undef($@);
11286: if (open(my $fh,"-|", @cmd, $file)) {
11287: while (my $line = <$fh>) {
11288: $output .= $line;
11289: chomp($line);
11290: my $item;
11291: if ($needsregexp) {
11292: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11293: } else {
11294: $item = $line;
11295: }
11296: if ($item ne '') {
11297: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11298: push(@{$pathsref},$item);
11299: }
11300: }
11301: }
11302: close($fh);
11303: }
11304: }
11305: return $output;
11306: }
11307:
1.1053 raeburn 11308: sub decompress_uploaded_file {
11309: my ($file,$dir) = @_;
11310: &Apache::lonnet::appenv({'cgi.file' => $file});
11311: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11312: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11313: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11314: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11315: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11316: my $decompressed = $env{'cgi.decompressed'};
11317: &Apache::lonnet::delenv('cgi.file');
11318: &Apache::lonnet::delenv('cgi.dir');
11319: &Apache::lonnet::delenv('cgi.decompressed');
11320: return ($decompressed,$result);
11321: }
11322:
1.1055 raeburn 11323: sub process_decompression {
11324: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11325: my ($dir,$error,$warning,$output);
1.1180 raeburn 11326: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11327: $error = &mt('Filename not a supported archive file type.').
11328: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11329: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11330: } else {
11331: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11332: if ($docuhome eq 'no_host') {
11333: $error = &mt('Could not determine home server for course.');
11334: } else {
11335: my @ids=&Apache::lonnet::current_machine_ids();
11336: my $currdir = "$dir_root/$destination";
11337: if (grep(/^\Q$docuhome\E$/,@ids)) {
11338: $dir = &LONCAPA::propath($docudom,$docuname).
11339: "$dir_root/$destination";
11340: } else {
11341: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11342: "$dir_root/$docudom/$docuname/$destination";
11343: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11344: $error = &mt('Archive file not found.');
11345: }
11346: }
1.1065 raeburn 11347: my (@to_overwrite,@to_skip);
11348: if ($env{'form.archive_overwrite_total'} > 0) {
11349: my $total = $env{'form.archive_overwrite_total'};
11350: for (my $i=0; $i<$total; $i++) {
11351: if ($env{'form.archive_overwrite_'.$i} == 1) {
11352: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11353: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11354: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11355: }
11356: }
11357: }
11358: my $numskip = scalar(@to_skip);
11359: if (($numskip > 0) &&
11360: ($numskip == $env{'form.archive_itemcount'})) {
11361: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11362: } elsif ($dir eq '') {
1.1055 raeburn 11363: $error = &mt('Directory containing archive file unavailable.');
11364: } elsif (!$error) {
1.1065 raeburn 11365: my ($decompressed,$display);
11366: if ($numskip > 0) {
11367: my $tempdir = time.'_'.$$.int(rand(10000));
11368: mkdir("$dir/$tempdir",0755);
11369: system("mv $dir/$file $dir/$tempdir/$file");
11370: ($decompressed,$display) =
11371: &decompress_uploaded_file($file,"$dir/$tempdir");
11372: foreach my $item (@to_skip) {
11373: if (($item ne '') && ($item !~ /\.\./)) {
11374: if (-f "$dir/$tempdir/$item") {
11375: unlink("$dir/$tempdir/$item");
11376: } elsif (-d "$dir/$tempdir/$item") {
11377: system("rm -rf $dir/$tempdir/$item");
11378: }
11379: }
11380: }
11381: system("mv $dir/$tempdir/* $dir");
11382: rmdir("$dir/$tempdir");
11383: } else {
11384: ($decompressed,$display) =
11385: &decompress_uploaded_file($file,$dir);
11386: }
1.1055 raeburn 11387: if ($decompressed eq 'ok') {
1.1065 raeburn 11388: $output = '<p class="LC_info">'.
11389: &mt('Files extracted successfully from archive.').
11390: '</p>'."\n";
1.1055 raeburn 11391: my ($warning,$result,@contents);
11392: my ($newdirlistref,$newlisterror) =
11393: &Apache::lonnet::dirlist($currdir,$docudom,
11394: $docuname,1);
11395: my (%is_dir,%changes,@newitems);
11396: my $dirptr = 16384;
1.1065 raeburn 11397: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11398: foreach my $dir_line (@{$newdirlistref}) {
11399: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11400: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11401: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11402: push(@newitems,$item);
11403: if ($dirptr&$testdir) {
11404: $is_dir{$item} = 1;
11405: }
11406: $changes{$item} = 1;
11407: }
11408: }
11409: }
11410: if (keys(%changes) > 0) {
11411: foreach my $item (sort(@newitems)) {
11412: if ($changes{$item}) {
11413: push(@contents,$item);
11414: }
11415: }
11416: }
11417: if (@contents > 0) {
1.1067 raeburn 11418: my $wantform;
11419: unless ($env{'form.autoextract_camtasia'}) {
11420: $wantform = 1;
11421: }
1.1056 raeburn 11422: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11423: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11424: $currdir,\%is_dir,
11425: \%children,\%parent,
1.1056 raeburn 11426: \@contents,\%dirorder,
11427: \%titles,$wantform);
1.1055 raeburn 11428: if ($datatable ne '') {
11429: $output .= &archive_options_form('decompressed',$datatable,
11430: $count,$hiddenelem);
1.1065 raeburn 11431: my $startcount = 6;
1.1055 raeburn 11432: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11433: \%titles,\%children);
1.1055 raeburn 11434: }
1.1067 raeburn 11435: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11436: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11437: my %displayed;
11438: my $total = 1;
11439: $env{'form.archive_directory'} = [];
11440: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11441: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11442: $path =~ s{/$}{};
11443: my $item;
11444: if ($path ne '') {
11445: $item = "$path/$titles{$i}";
11446: } else {
11447: $item = $titles{$i};
11448: }
11449: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11450: if ($item eq $contents[0]) {
11451: push(@{$env{'form.archive_directory'}},$i);
11452: $env{'form.archive_'.$i} = 'display';
11453: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11454: $displayed{'folder'} = $i;
1.1164 raeburn 11455: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11456: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11457: $env{'form.archive_'.$i} = 'display';
11458: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11459: $displayed{'web'} = $i;
11460: } else {
1.1164 raeburn 11461: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11462: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11463: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11464: push(@{$env{'form.archive_directory'}},$i);
11465: }
11466: $env{'form.archive_'.$i} = 'dependency';
11467: }
11468: $total ++;
11469: }
11470: for (my $i=1; $i<$total; $i++) {
11471: next if ($i == $displayed{'web'});
11472: next if ($i == $displayed{'folder'});
11473: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11474: }
11475: $env{'form.phase'} = 'decompress_cleanup';
11476: $env{'form.archivedelete'} = 1;
11477: $env{'form.archive_count'} = $total-1;
11478: $output .=
11479: &process_extracted_files('coursedocs',$docudom,
11480: $docuname,$destination,
11481: $dir_root,$hiddenelem);
11482: }
1.1055 raeburn 11483: } else {
11484: $warning = &mt('No new items extracted from archive file.');
11485: }
11486: } else {
11487: $output = $display;
11488: $error = &mt('An error occurred during extraction from the archive file.');
11489: }
11490: }
11491: }
11492: }
11493: if ($error) {
11494: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11495: $error.'</p>'."\n";
11496: }
11497: if ($warning) {
11498: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11499: }
11500: return $output;
11501: }
11502:
11503: sub get_extracted {
1.1056 raeburn 11504: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11505: $titles,$wantform) = @_;
1.1055 raeburn 11506: my $count = 0;
11507: my $depth = 0;
11508: my $datatable;
1.1056 raeburn 11509: my @hierarchy;
1.1055 raeburn 11510: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11511: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11512: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11513: foreach my $item (@{$contents}) {
11514: $count ++;
1.1056 raeburn 11515: @{$dirorder->{$count}} = @hierarchy;
11516: $titles->{$count} = $item;
1.1055 raeburn 11517: &archive_hierarchy($depth,$count,$parent,$children);
11518: if ($wantform) {
11519: $datatable .= &archive_row($is_dir->{$item},$item,
11520: $currdir,$depth,$count);
11521: }
11522: if ($is_dir->{$item}) {
11523: $depth ++;
1.1056 raeburn 11524: push(@hierarchy,$count);
11525: $parent->{$depth} = $count;
1.1055 raeburn 11526: $datatable .=
11527: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11528: \$depth,\$count,\@hierarchy,$dirorder,
11529: $children,$parent,$titles,$wantform);
1.1055 raeburn 11530: $depth --;
1.1056 raeburn 11531: pop(@hierarchy);
1.1055 raeburn 11532: }
11533: }
11534: return ($count,$datatable);
11535: }
11536:
11537: sub recurse_extracted_archive {
1.1056 raeburn 11538: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11539: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11540: my $result='';
1.1056 raeburn 11541: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11542: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11543: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11544: return $result;
11545: }
11546: my $dirptr = 16384;
11547: my ($newdirlistref,$newlisterror) =
11548: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11549: if (ref($newdirlistref) eq 'ARRAY') {
11550: foreach my $dir_line (@{$newdirlistref}) {
11551: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11552: unless ($item =~ /^\.+$/) {
11553: $$count ++;
1.1056 raeburn 11554: @{$dirorder->{$$count}} = @{$hierarchy};
11555: $titles->{$$count} = $item;
1.1055 raeburn 11556: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11557:
1.1055 raeburn 11558: my $is_dir;
11559: if ($dirptr&$testdir) {
11560: $is_dir = 1;
11561: }
11562: if ($wantform) {
11563: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11564: }
11565: if ($is_dir) {
11566: $$depth ++;
1.1056 raeburn 11567: push(@{$hierarchy},$$count);
11568: $parent->{$$depth} = $$count;
1.1055 raeburn 11569: $result .=
11570: &recurse_extracted_archive("$currdir/$item",$docudom,
11571: $docuname,$depth,$count,
1.1056 raeburn 11572: $hierarchy,$dirorder,$children,
11573: $parent,$titles,$wantform);
1.1055 raeburn 11574: $$depth --;
1.1056 raeburn 11575: pop(@{$hierarchy});
1.1055 raeburn 11576: }
11577: }
11578: }
11579: }
11580: return $result;
11581: }
11582:
11583: sub archive_hierarchy {
11584: my ($depth,$count,$parent,$children) =@_;
11585: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11586: if (exists($parent->{$depth})) {
11587: $children->{$parent->{$depth}} .= $count.':';
11588: }
11589: }
11590: return;
11591: }
11592:
11593: sub archive_row {
11594: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11595: my ($name) = ($item =~ m{([^/]+)$});
11596: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11597: 'display' => 'Add as file',
1.1055 raeburn 11598: 'dependency' => 'Include as dependency',
11599: 'discard' => 'Discard',
11600: );
11601: if ($is_dir) {
1.1059 raeburn 11602: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11603: }
1.1056 raeburn 11604: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11605: my $offset = 0;
1.1055 raeburn 11606: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11607: $offset ++;
1.1065 raeburn 11608: if ($action ne 'display') {
11609: $offset ++;
11610: }
1.1055 raeburn 11611: $output .= '<td><span class="LC_nobreak">'.
11612: '<label><input type="radio" name="archive_'.$count.
11613: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11614: my $text = $choices{$action};
11615: if ($is_dir) {
11616: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11617: if ($action eq 'display') {
1.1059 raeburn 11618: $text = &mt('Add as folder');
1.1055 raeburn 11619: }
1.1056 raeburn 11620: } else {
11621: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11622:
11623: }
11624: $output .= ' /> '.$choices{$action}.'</label></span>';
11625: if ($action eq 'dependency') {
11626: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11627: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11628: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11629: '<option value=""></option>'."\n".
11630: '</select>'."\n".
11631: '</div>';
1.1059 raeburn 11632: } elsif ($action eq 'display') {
11633: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11634: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11635: '</div>';
1.1055 raeburn 11636: }
1.1056 raeburn 11637: $output .= '</td>';
1.1055 raeburn 11638: }
11639: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11640: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11641: for (my $i=0; $i<$depth; $i++) {
11642: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11643: }
11644: if ($is_dir) {
11645: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11646: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11647: } else {
11648: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11649: }
11650: $output .= ' '.$name.'</td>'."\n".
11651: &end_data_table_row();
11652: return $output;
11653: }
11654:
11655: sub archive_options_form {
1.1065 raeburn 11656: my ($form,$display,$count,$hiddenelem) = @_;
11657: my %lt = &Apache::lonlocal::texthash(
11658: perm => 'Permanently remove archive file?',
11659: hows => 'How should each extracted item be incorporated in the course?',
11660: cont => 'Content actions for all',
11661: addf => 'Add as folder/file',
11662: incd => 'Include as dependency for a displayed file',
11663: disc => 'Discard',
11664: no => 'No',
11665: yes => 'Yes',
11666: save => 'Save',
11667: );
11668: my $output = <<"END";
11669: <form name="$form" method="post" action="">
11670: <p><span class="LC_nobreak">$lt{'perm'}
11671: <label>
11672: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11673: </label>
11674:
11675: <label>
11676: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11677: </span>
11678: </p>
11679: <input type="hidden" name="phase" value="decompress_cleanup" />
11680: <br />$lt{'hows'}
11681: <div class="LC_columnSection">
11682: <fieldset>
11683: <legend>$lt{'cont'}</legend>
11684: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11685: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11686: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11687: </fieldset>
11688: </div>
11689: END
11690: return $output.
1.1055 raeburn 11691: &start_data_table()."\n".
1.1065 raeburn 11692: $display."\n".
1.1055 raeburn 11693: &end_data_table()."\n".
11694: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11695: $hiddenelem.
1.1065 raeburn 11696: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11697: '</form>';
11698: }
11699:
11700: sub archive_javascript {
1.1056 raeburn 11701: my ($startcount,$numitems,$titles,$children) = @_;
11702: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11703: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11704: my $scripttag = <<START;
11705: <script type="text/javascript">
11706: // <![CDATA[
11707:
11708: function checkAll(form,prefix) {
11709: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11710: for (var i=0; i < form.elements.length; i++) {
11711: var id = form.elements[i].id;
11712: if ((id != '') && (id != undefined)) {
11713: if (idstr.test(id)) {
11714: if (form.elements[i].type == 'radio') {
11715: form.elements[i].checked = true;
1.1056 raeburn 11716: var nostart = i-$startcount;
1.1059 raeburn 11717: var offset = nostart%7;
11718: var count = (nostart-offset)/7;
1.1056 raeburn 11719: dependencyCheck(form,count,offset);
1.1055 raeburn 11720: }
11721: }
11722: }
11723: }
11724: }
11725:
11726: function propagateCheck(form,count) {
11727: if (count > 0) {
1.1059 raeburn 11728: var startelement = $startcount + ((count-1) * 7);
11729: for (var j=1; j<6; j++) {
11730: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11731: var item = startelement + j;
11732: if (form.elements[item].type == 'radio') {
11733: if (form.elements[item].checked) {
11734: containerCheck(form,count,j);
11735: break;
11736: }
1.1055 raeburn 11737: }
11738: }
11739: }
11740: }
11741: }
11742:
11743: numitems = $numitems
1.1056 raeburn 11744: var titles = new Array(numitems);
11745: var parents = new Array(numitems);
1.1055 raeburn 11746: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11747: parents[i] = new Array;
1.1055 raeburn 11748: }
1.1059 raeburn 11749: var maintitle = '$maintitle';
1.1055 raeburn 11750:
11751: START
11752:
1.1056 raeburn 11753: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11754: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11755: for (my $i=0; $i<@contents; $i ++) {
11756: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11757: }
11758: }
11759:
1.1056 raeburn 11760: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11761: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11762: }
11763:
1.1055 raeburn 11764: $scripttag .= <<END;
11765:
11766: function containerCheck(form,count,offset) {
11767: if (count > 0) {
1.1056 raeburn 11768: dependencyCheck(form,count,offset);
1.1059 raeburn 11769: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11770: form.elements[item].checked = true;
11771: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11772: if (parents[count].length > 0) {
11773: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11774: containerCheck(form,parents[count][j],offset);
11775: }
11776: }
11777: }
11778: }
11779: }
11780:
11781: function dependencyCheck(form,count,offset) {
11782: if (count > 0) {
1.1059 raeburn 11783: var chosen = (offset+$startcount)+7*(count-1);
11784: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11785: var currtype = form.elements[depitem].type;
11786: if (form.elements[chosen].value == 'dependency') {
11787: document.getElementById('arc_depon_'+count).style.display='block';
11788: form.elements[depitem].options.length = 0;
11789: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11790: for (var i=1; i<=numitems; i++) {
11791: if (i == count) {
11792: continue;
11793: }
1.1059 raeburn 11794: var startelement = $startcount + (i-1) * 7;
11795: for (var j=1; j<6; j++) {
11796: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11797: var item = startelement + j;
11798: if (form.elements[item].type == 'radio') {
11799: if (form.elements[item].checked) {
11800: if (form.elements[item].value == 'display') {
11801: var n = form.elements[depitem].options.length;
11802: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11803: }
11804: }
11805: }
11806: }
11807: }
11808: }
11809: } else {
11810: document.getElementById('arc_depon_'+count).style.display='none';
11811: form.elements[depitem].options.length = 0;
11812: form.elements[depitem].options[0] = new Option('Select','',true,true);
11813: }
1.1059 raeburn 11814: titleCheck(form,count,offset);
1.1056 raeburn 11815: }
11816: }
11817:
11818: function propagateSelect(form,count,offset) {
11819: if (count > 0) {
1.1065 raeburn 11820: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11821: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11822: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11823: if (parents[count].length > 0) {
11824: for (var j=0; j<parents[count].length; j++) {
11825: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11826: }
11827: }
11828: }
11829: }
11830: }
1.1056 raeburn 11831:
11832: function containerSelect(form,count,offset,picked) {
11833: if (count > 0) {
1.1065 raeburn 11834: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11835: if (form.elements[item].type == 'radio') {
11836: if (form.elements[item].value == 'dependency') {
11837: if (form.elements[item+1].type == 'select-one') {
11838: for (var i=0; i<form.elements[item+1].options.length; i++) {
11839: if (form.elements[item+1].options[i].value == picked) {
11840: form.elements[item+1].selectedIndex = i;
11841: break;
11842: }
11843: }
11844: }
11845: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11846: if (parents[count].length > 0) {
11847: for (var j=0; j<parents[count].length; j++) {
11848: containerSelect(form,parents[count][j],offset,picked);
11849: }
11850: }
11851: }
11852: }
11853: }
11854: }
11855: }
11856:
1.1059 raeburn 11857: function titleCheck(form,count,offset) {
11858: if (count > 0) {
11859: var chosen = (offset+$startcount)+7*(count-1);
11860: var depitem = $startcount + ((count-1) * 7) + 2;
11861: var currtype = form.elements[depitem].type;
11862: if (form.elements[chosen].value == 'display') {
11863: document.getElementById('arc_title_'+count).style.display='block';
11864: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11865: document.getElementById('archive_title_'+count).value=maintitle;
11866: }
11867: } else {
11868: document.getElementById('arc_title_'+count).style.display='none';
11869: if (currtype == 'text') {
11870: document.getElementById('archive_title_'+count).value='';
11871: }
11872: }
11873: }
11874: return;
11875: }
11876:
1.1055 raeburn 11877: // ]]>
11878: </script>
11879: END
11880: return $scripttag;
11881: }
11882:
11883: sub process_extracted_files {
1.1067 raeburn 11884: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11885: my $numitems = $env{'form.archive_count'};
11886: return unless ($numitems);
11887: my @ids=&Apache::lonnet::current_machine_ids();
11888: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11889: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11890: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11891: if (grep(/^\Q$docuhome\E$/,@ids)) {
11892: $prefix = &LONCAPA::propath($docudom,$docuname);
11893: $pathtocheck = "$dir_root/$destination";
11894: $dir = $dir_root;
11895: $ishome = 1;
11896: } else {
11897: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11898: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11899: $dir = "$dir_root/$docudom/$docuname";
11900: }
11901: my $currdir = "$dir_root/$destination";
11902: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11903: if ($env{'form.folderpath'}) {
11904: my @items = split('&',$env{'form.folderpath'});
11905: $folders{'0'} = $items[-2];
1.1099 raeburn 11906: if ($env{'form.folderpath'} =~ /\:1$/) {
11907: $containers{'0'}='page';
11908: } else {
11909: $containers{'0'}='sequence';
11910: }
1.1055 raeburn 11911: }
11912: my @archdirs = &get_env_multiple('form.archive_directory');
11913: if ($numitems) {
11914: for (my $i=1; $i<=$numitems; $i++) {
11915: my $path = $env{'form.archive_content_'.$i};
11916: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11917: my $item = $1;
11918: $toplevelitems{$item} = $i;
11919: if (grep(/^\Q$i\E$/,@archdirs)) {
11920: $is_dir{$item} = 1;
11921: }
11922: }
11923: }
11924: }
1.1067 raeburn 11925: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11926: if (keys(%toplevelitems) > 0) {
11927: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11928: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11929: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11930: }
1.1066 raeburn 11931: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11932: if ($numitems) {
11933: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11934: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11935: my $path = $env{'form.archive_content_'.$i};
11936: if ($path =~ /^\Q$pathtocheck\E/) {
11937: if ($env{'form.archive_'.$i} eq 'discard') {
11938: if ($prefix ne '' && $path ne '') {
11939: if (-e $prefix.$path) {
1.1066 raeburn 11940: if ((@archdirs > 0) &&
11941: (grep(/^\Q$i\E$/,@archdirs))) {
11942: $todeletedir{$prefix.$path} = 1;
11943: } else {
11944: $todelete{$prefix.$path} = 1;
11945: }
1.1055 raeburn 11946: }
11947: }
11948: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 11949: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 11950: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 11951: $docstitle = $env{'form.archive_title_'.$i};
11952: if ($docstitle eq '') {
11953: $docstitle = $title;
11954: }
1.1055 raeburn 11955: $outer = 0;
1.1056 raeburn 11956: if (ref($dirorder{$i}) eq 'ARRAY') {
11957: if (@{$dirorder{$i}} > 0) {
11958: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 11959: if ($env{'form.archive_'.$item} eq 'display') {
11960: $outer = $item;
11961: last;
11962: }
11963: }
11964: }
11965: }
11966: my ($errtext,$fatal) =
11967: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
11968: '/'.$folders{$outer}.'.'.
11969: $containers{$outer});
11970: next if ($fatal);
11971: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
11972: if ($context eq 'coursedocs') {
1.1056 raeburn 11973: $mapinner{$i} = time;
1.1055 raeburn 11974: $folders{$i} = 'default_'.$mapinner{$i};
11975: $containers{$i} = 'sequence';
11976: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11977: $folders{$i}.'.'.$containers{$i};
11978: my $newidx = &LONCAPA::map::getresidx();
11979: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11980: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11981: push(@LONCAPA::map::order,$newidx);
11982: my ($outtext,$errtext) =
11983: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11984: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 11985: '.'.$containers{$outer},1,1);
1.1056 raeburn 11986: $newseqid{$i} = $newidx;
1.1067 raeburn 11987: unless ($errtext) {
11988: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
11989: }
1.1055 raeburn 11990: }
11991: } else {
11992: if ($context eq 'coursedocs') {
11993: my $newidx=&LONCAPA::map::getresidx();
11994: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11995: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
11996: $title;
11997: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
11998: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
11999: }
12000: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12001: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12002: }
12003: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12004: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12005: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12006: unless ($ishome) {
12007: my $fetch = "$newdest{$i}/$title";
12008: $fetch =~ s/^\Q$prefix$dir\E//;
12009: $prompttofetch{$fetch} = 1;
12010: }
1.1055 raeburn 12011: }
12012: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12013: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12014: push(@LONCAPA::map::order, $newidx);
12015: my ($outtext,$errtext)=
12016: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12017: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12018: '.'.$containers{$outer},1,1);
1.1067 raeburn 12019: unless ($errtext) {
12020: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12021: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12022: }
12023: }
1.1055 raeburn 12024: }
12025: }
1.1086 raeburn 12026: }
12027: } else {
12028: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12029: }
12030: }
12031: for (my $i=1; $i<=$numitems; $i++) {
12032: next unless ($env{'form.archive_'.$i} eq 'dependency');
12033: my $path = $env{'form.archive_content_'.$i};
12034: if ($path =~ /^\Q$pathtocheck\E/) {
12035: my ($title) = ($path =~ m{/([^/]+)$});
12036: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12037: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12038: if (ref($dirorder{$i}) eq 'ARRAY') {
12039: my ($itemidx,$fullpath,$relpath);
12040: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12041: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12042: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12043: if ($dirorder{$i}->[$j] eq $container) {
12044: $itemidx = $j;
1.1056 raeburn 12045: }
12046: }
1.1086 raeburn 12047: }
12048: if ($itemidx eq '') {
12049: $itemidx = 0;
12050: }
12051: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12052: if ($mapinner{$referrer{$i}}) {
12053: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12054: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12055: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12056: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12057: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12058: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12059: if (!-e $fullpath) {
12060: mkdir($fullpath,0755);
1.1056 raeburn 12061: }
12062: }
1.1086 raeburn 12063: } else {
12064: last;
1.1056 raeburn 12065: }
1.1086 raeburn 12066: }
12067: }
12068: } elsif ($newdest{$referrer{$i}}) {
12069: $fullpath = $newdest{$referrer{$i}};
12070: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12071: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12072: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12073: last;
12074: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12075: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12076: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12077: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12078: if (!-e $fullpath) {
12079: mkdir($fullpath,0755);
1.1056 raeburn 12080: }
12081: }
1.1086 raeburn 12082: } else {
12083: last;
1.1056 raeburn 12084: }
1.1055 raeburn 12085: }
12086: }
1.1086 raeburn 12087: if ($fullpath ne '') {
12088: if (-e "$prefix$path") {
12089: system("mv $prefix$path $fullpath/$title");
12090: }
12091: if (-e "$fullpath/$title") {
12092: my $showpath;
12093: if ($relpath ne '') {
12094: $showpath = "$relpath/$title";
12095: } else {
12096: $showpath = "/$title";
12097: }
12098: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12099: }
12100: unless ($ishome) {
12101: my $fetch = "$fullpath/$title";
12102: $fetch =~ s/^\Q$prefix$dir\E//;
12103: $prompttofetch{$fetch} = 1;
12104: }
12105: }
1.1055 raeburn 12106: }
1.1086 raeburn 12107: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12108: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12109: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12110: }
12111: } else {
12112: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12113: }
12114: }
12115: if (keys(%todelete)) {
12116: foreach my $key (keys(%todelete)) {
12117: unlink($key);
1.1066 raeburn 12118: }
12119: }
12120: if (keys(%todeletedir)) {
12121: foreach my $key (keys(%todeletedir)) {
12122: rmdir($key);
12123: }
12124: }
12125: foreach my $dir (sort(keys(%is_dir))) {
12126: if (($pathtocheck ne '') && ($dir ne '')) {
12127: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12128: }
12129: }
1.1067 raeburn 12130: if ($result ne '') {
12131: $output .= '<ul>'."\n".
12132: $result."\n".
12133: '</ul>';
12134: }
12135: unless ($ishome) {
12136: my $replicationfail;
12137: foreach my $item (keys(%prompttofetch)) {
12138: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12139: unless ($fetchresult eq 'ok') {
12140: $replicationfail .= '<li>'.$item.'</li>'."\n";
12141: }
12142: }
12143: if ($replicationfail) {
12144: $output .= '<p class="LC_error">'.
12145: &mt('Course home server failed to retrieve:').'<ul>'.
12146: $replicationfail.
12147: '</ul></p>';
12148: }
12149: }
1.1055 raeburn 12150: } else {
12151: $warning = &mt('No items found in archive.');
12152: }
12153: if ($error) {
12154: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12155: $error.'</p>'."\n";
12156: }
12157: if ($warning) {
12158: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12159: }
12160: return $output;
12161: }
12162:
1.1066 raeburn 12163: sub cleanup_empty_dirs {
12164: my ($path) = @_;
12165: if (($path ne '') && (-d $path)) {
12166: if (opendir(my $dirh,$path)) {
12167: my @dircontents = grep(!/^\./,readdir($dirh));
12168: my $numitems = 0;
12169: foreach my $item (@dircontents) {
12170: if (-d "$path/$item") {
1.1111 raeburn 12171: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12172: if (-e "$path/$item") {
12173: $numitems ++;
12174: }
12175: } else {
12176: $numitems ++;
12177: }
12178: }
12179: if ($numitems == 0) {
12180: rmdir($path);
12181: }
12182: closedir($dirh);
12183: }
12184: }
12185: return;
12186: }
12187:
1.41 ng 12188: =pod
1.45 matthew 12189:
1.1162 raeburn 12190: =item * &get_folder_hierarchy()
1.1068 raeburn 12191:
12192: Provides hierarchy of names of folders/sub-folders containing the current
12193: item,
12194:
12195: Inputs: 3
12196: - $navmap - navmaps object
12197:
12198: - $map - url for map (either the trigger itself, or map containing
12199: the resource, which is the trigger).
12200:
12201: - $showitem - 1 => show title for map itself; 0 => do not show.
12202:
12203: Outputs: 1 @pathitems - array of folder/subfolder names.
12204:
12205: =cut
12206:
12207: sub get_folder_hierarchy {
12208: my ($navmap,$map,$showitem) = @_;
12209: my @pathitems;
12210: if (ref($navmap)) {
12211: my $mapres = $navmap->getResourceByUrl($map);
12212: if (ref($mapres)) {
12213: my $pcslist = $mapres->map_hierarchy();
12214: if ($pcslist ne '') {
12215: my @pcs = split(/,/,$pcslist);
12216: foreach my $pc (@pcs) {
12217: if ($pc == 1) {
1.1129 raeburn 12218: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12219: } else {
12220: my $res = $navmap->getByMapPc($pc);
12221: if (ref($res)) {
12222: my $title = $res->compTitle();
12223: $title =~ s/\W+/_/g;
12224: if ($title ne '') {
12225: push(@pathitems,$title);
12226: }
12227: }
12228: }
12229: }
12230: }
1.1071 raeburn 12231: if ($showitem) {
12232: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12233: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12234: } else {
12235: my $maptitle = $mapres->compTitle();
12236: $maptitle =~ s/\W+/_/g;
12237: if ($maptitle ne '') {
12238: push(@pathitems,$maptitle);
12239: }
1.1068 raeburn 12240: }
12241: }
12242: }
12243: }
12244: return @pathitems;
12245: }
12246:
12247: =pod
12248:
1.1015 raeburn 12249: =item * &get_turnedin_filepath()
12250:
12251: Determines path in a user's portfolio file for storage of files uploaded
12252: to a specific essayresponse or dropbox item.
12253:
12254: Inputs: 3 required + 1 optional.
12255: $symb is symb for resource, $uname and $udom are for current user (required).
12256: $caller is optional (can be "submission", if routine is called when storing
12257: an upoaded file when "Submit Answer" button was pressed).
12258:
12259: Returns array containing $path and $multiresp.
12260: $path is path in portfolio. $multiresp is 1 if this resource contains more
12261: than one file upload item. Callers of routine should append partid as a
12262: subdirectory to $path in cases where $multiresp is 1.
12263:
12264: Called by: homework/essayresponse.pm and homework/structuretags.pm
12265:
12266: =cut
12267:
12268: sub get_turnedin_filepath {
12269: my ($symb,$uname,$udom,$caller) = @_;
12270: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12271: my $turnindir;
12272: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12273: $turnindir = $userhash{'turnindir'};
12274: my ($path,$multiresp);
12275: if ($turnindir eq '') {
12276: if ($caller eq 'submission') {
12277: $turnindir = &mt('turned in');
12278: $turnindir =~ s/\W+/_/g;
12279: my %newhash = (
12280: 'turnindir' => $turnindir,
12281: );
12282: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12283: }
12284: }
12285: if ($turnindir ne '') {
12286: $path = '/'.$turnindir.'/';
12287: my ($multipart,$turnin,@pathitems);
12288: my $navmap = Apache::lonnavmaps::navmap->new();
12289: if (defined($navmap)) {
12290: my $mapres = $navmap->getResourceByUrl($map);
12291: if (ref($mapres)) {
12292: my $pcslist = $mapres->map_hierarchy();
12293: if ($pcslist ne '') {
12294: foreach my $pc (split(/,/,$pcslist)) {
12295: my $res = $navmap->getByMapPc($pc);
12296: if (ref($res)) {
12297: my $title = $res->compTitle();
12298: $title =~ s/\W+/_/g;
12299: if ($title ne '') {
1.1149 raeburn 12300: if (($pc > 1) && (length($title) > 12)) {
12301: $title = substr($title,0,12);
12302: }
1.1015 raeburn 12303: push(@pathitems,$title);
12304: }
12305: }
12306: }
12307: }
12308: my $maptitle = $mapres->compTitle();
12309: $maptitle =~ s/\W+/_/g;
12310: if ($maptitle ne '') {
1.1149 raeburn 12311: if (length($maptitle) > 12) {
12312: $maptitle = substr($maptitle,0,12);
12313: }
1.1015 raeburn 12314: push(@pathitems,$maptitle);
12315: }
12316: unless ($env{'request.state'} eq 'construct') {
12317: my $res = $navmap->getBySymb($symb);
12318: if (ref($res)) {
12319: my $partlist = $res->parts();
12320: my $totaluploads = 0;
12321: if (ref($partlist) eq 'ARRAY') {
12322: foreach my $part (@{$partlist}) {
12323: my @types = $res->responseType($part);
12324: my @ids = $res->responseIds($part);
12325: for (my $i=0; $i < scalar(@ids); $i++) {
12326: if ($types[$i] eq 'essay') {
12327: my $partid = $part.'_'.$ids[$i];
12328: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12329: $totaluploads ++;
12330: }
12331: }
12332: }
12333: }
12334: if ($totaluploads > 1) {
12335: $multiresp = 1;
12336: }
12337: }
12338: }
12339: }
12340: } else {
12341: return;
12342: }
12343: } else {
12344: return;
12345: }
12346: my $restitle=&Apache::lonnet::gettitle($symb);
12347: $restitle =~ s/\W+/_/g;
12348: if ($restitle eq '') {
12349: $restitle = ($resurl =~ m{/[^/]+$});
12350: if ($restitle eq '') {
12351: $restitle = time;
12352: }
12353: }
1.1149 raeburn 12354: if (length($restitle) > 12) {
12355: $restitle = substr($restitle,0,12);
12356: }
1.1015 raeburn 12357: push(@pathitems,$restitle);
12358: $path .= join('/',@pathitems);
12359: }
12360: return ($path,$multiresp);
12361: }
12362:
12363: =pod
12364:
1.464 albertel 12365: =back
1.41 ng 12366:
1.112 bowersj2 12367: =head1 CSV Upload/Handling functions
1.38 albertel 12368:
1.41 ng 12369: =over 4
12370:
1.648 raeburn 12371: =item * &upfile_store($r)
1.41 ng 12372:
12373: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12374: needs $env{'form.upfile'}
1.41 ng 12375: returns $datatoken to be put into hidden field
12376:
12377: =cut
1.31 albertel 12378:
12379: sub upfile_store {
12380: my $r=shift;
1.258 albertel 12381: $env{'form.upfile'}=~s/\r/\n/gs;
12382: $env{'form.upfile'}=~s/\f/\n/gs;
12383: $env{'form.upfile'}=~s/\n+/\n/gs;
12384: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12385:
1.258 albertel 12386: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12387: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12388: {
1.158 raeburn 12389: my $datafile = $r->dir_config('lonDaemons').
12390: '/tmp/'.$datatoken.'.tmp';
12391: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12392: print $fh $env{'form.upfile'};
1.158 raeburn 12393: close($fh);
12394: }
1.31 albertel 12395: }
12396: return $datatoken;
12397: }
12398:
1.56 matthew 12399: =pod
12400:
1.648 raeburn 12401: =item * &load_tmp_file($r)
1.41 ng 12402:
12403: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12404: needs $env{'form.datatoken'},
12405: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12406:
12407: =cut
1.31 albertel 12408:
12409: sub load_tmp_file {
12410: my $r=shift;
12411: my @studentdata=();
12412: {
1.158 raeburn 12413: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12414: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12415: if ( open(my $fh,"<$studentfile") ) {
12416: @studentdata=<$fh>;
12417: close($fh);
12418: }
1.31 albertel 12419: }
1.258 albertel 12420: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12421: }
12422:
1.56 matthew 12423: =pod
12424:
1.648 raeburn 12425: =item * &upfile_record_sep()
1.41 ng 12426:
12427: Separate uploaded file into records
12428: returns array of records,
1.258 albertel 12429: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12430:
12431: =cut
1.31 albertel 12432:
12433: sub upfile_record_sep {
1.258 albertel 12434: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12435: } else {
1.248 albertel 12436: my @records;
1.258 albertel 12437: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12438: if ($line=~/^\s*$/) { next; }
12439: push(@records,$line);
12440: }
12441: return @records;
1.31 albertel 12442: }
12443: }
12444:
1.56 matthew 12445: =pod
12446:
1.648 raeburn 12447: =item * &record_sep($record)
1.41 ng 12448:
1.258 albertel 12449: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12450:
12451: =cut
12452:
1.263 www 12453: sub takeleft {
12454: my $index=shift;
12455: return substr('0000'.$index,-4,4);
12456: }
12457:
1.31 albertel 12458: sub record_sep {
12459: my $record=shift;
12460: my %components=();
1.258 albertel 12461: if ($env{'form.upfiletype'} eq 'xml') {
12462: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12463: my $i=0;
1.356 albertel 12464: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12465: $field=~s/^(\"|\')//;
12466: $field=~s/(\"|\')$//;
1.263 www 12467: $components{&takeleft($i)}=$field;
1.31 albertel 12468: $i++;
12469: }
1.258 albertel 12470: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12471: my $i=0;
1.356 albertel 12472: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12473: $field=~s/^(\"|\')//;
12474: $field=~s/(\"|\')$//;
1.263 www 12475: $components{&takeleft($i)}=$field;
1.31 albertel 12476: $i++;
12477: }
12478: } else {
1.561 www 12479: my $separator=',';
1.480 banghart 12480: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12481: $separator=';';
1.480 banghart 12482: }
1.31 albertel 12483: my $i=0;
1.561 www 12484: # the character we are looking for to indicate the end of a quote or a record
12485: my $looking_for=$separator;
12486: # do not add the characters to the fields
12487: my $ignore=0;
12488: # we just encountered a separator (or the beginning of the record)
12489: my $just_found_separator=1;
12490: # store the field we are working on here
12491: my $field='';
12492: # work our way through all characters in record
12493: foreach my $character ($record=~/(.)/g) {
12494: if ($character eq $looking_for) {
12495: if ($character ne $separator) {
12496: # Found the end of a quote, again looking for separator
12497: $looking_for=$separator;
12498: $ignore=1;
12499: } else {
12500: # Found a separator, store away what we got
12501: $components{&takeleft($i)}=$field;
12502: $i++;
12503: $just_found_separator=1;
12504: $ignore=0;
12505: $field='';
12506: }
12507: next;
12508: }
12509: # single or double quotation marks after a separator indicate beginning of a quote
12510: # we are now looking for the end of the quote and need to ignore separators
12511: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12512: $looking_for=$character;
12513: next;
12514: }
12515: # ignore would be true after we reached the end of a quote
12516: if ($ignore) { next; }
12517: if (($just_found_separator) && ($character=~/\s/)) { next; }
12518: $field.=$character;
12519: $just_found_separator=0;
1.31 albertel 12520: }
1.561 www 12521: # catch the very last entry, since we never encountered the separator
12522: $components{&takeleft($i)}=$field;
1.31 albertel 12523: }
12524: return %components;
12525: }
12526:
1.144 matthew 12527: ######################################################
12528: ######################################################
12529:
1.56 matthew 12530: =pod
12531:
1.648 raeburn 12532: =item * &upfile_select_html()
1.41 ng 12533:
1.144 matthew 12534: Return HTML code to select a file from the users machine and specify
12535: the file type.
1.41 ng 12536:
12537: =cut
12538:
1.144 matthew 12539: ######################################################
12540: ######################################################
1.31 albertel 12541: sub upfile_select_html {
1.144 matthew 12542: my %Types = (
12543: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12544: semisv => &mt('Semicolon separated values'),
1.144 matthew 12545: space => &mt('Space separated'),
12546: tab => &mt('Tabulator separated'),
12547: # xml => &mt('HTML/XML'),
12548: );
12549: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12550: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12551: foreach my $type (sort(keys(%Types))) {
12552: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12553: }
12554: $Str .= "</select>\n";
12555: return $Str;
1.31 albertel 12556: }
12557:
1.301 albertel 12558: sub get_samples {
12559: my ($records,$toget) = @_;
12560: my @samples=({});
12561: my $got=0;
12562: foreach my $rec (@$records) {
12563: my %temp = &record_sep($rec);
12564: if (! grep(/\S/, values(%temp))) { next; }
12565: if (%temp) {
12566: $samples[$got]=\%temp;
12567: $got++;
12568: if ($got == $toget) { last; }
12569: }
12570: }
12571: return \@samples;
12572: }
12573:
1.144 matthew 12574: ######################################################
12575: ######################################################
12576:
1.56 matthew 12577: =pod
12578:
1.648 raeburn 12579: =item * &csv_print_samples($r,$records)
1.41 ng 12580:
12581: Prints a table of sample values from each column uploaded $r is an
12582: Apache Request ref, $records is an arrayref from
12583: &Apache::loncommon::upfile_record_sep
12584:
12585: =cut
12586:
1.144 matthew 12587: ######################################################
12588: ######################################################
1.31 albertel 12589: sub csv_print_samples {
12590: my ($r,$records) = @_;
1.662 bisitz 12591: my $samples = &get_samples($records,5);
1.301 albertel 12592:
1.594 raeburn 12593: $r->print(&mt('Samples').'<br />'.&start_data_table().
12594: &start_data_table_header_row());
1.356 albertel 12595: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12596: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12597: $r->print(&end_data_table_header_row());
1.301 albertel 12598: foreach my $hash (@$samples) {
1.594 raeburn 12599: $r->print(&start_data_table_row());
1.356 albertel 12600: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12601: $r->print('<td>');
1.356 albertel 12602: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12603: $r->print('</td>');
12604: }
1.594 raeburn 12605: $r->print(&end_data_table_row());
1.31 albertel 12606: }
1.594 raeburn 12607: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12608: }
12609:
1.144 matthew 12610: ######################################################
12611: ######################################################
12612:
1.56 matthew 12613: =pod
12614:
1.648 raeburn 12615: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12616:
12617: Prints a table to create associations between values and table columns.
1.144 matthew 12618:
1.41 ng 12619: $r is an Apache Request ref,
12620: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12621: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12622:
12623: =cut
12624:
1.144 matthew 12625: ######################################################
12626: ######################################################
1.31 albertel 12627: sub csv_print_select_table {
12628: my ($r,$records,$d) = @_;
1.301 albertel 12629: my $i=0;
12630: my $samples = &get_samples($records,1);
1.144 matthew 12631: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12632: &start_data_table().&start_data_table_header_row().
1.144 matthew 12633: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12634: '<th>'.&mt('Column').'</th>'.
12635: &end_data_table_header_row()."\n");
1.356 albertel 12636: foreach my $array_ref (@$d) {
12637: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12638: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12639:
1.875 bisitz 12640: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12641: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12642: $r->print('<option value="none"></option>');
1.356 albertel 12643: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12644: $r->print('<option value="'.$sample.'"'.
12645: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12646: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12647: }
1.594 raeburn 12648: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12649: $i++;
12650: }
1.594 raeburn 12651: $r->print(&end_data_table());
1.31 albertel 12652: $i--;
12653: return $i;
12654: }
1.56 matthew 12655:
1.144 matthew 12656: ######################################################
12657: ######################################################
12658:
1.56 matthew 12659: =pod
1.31 albertel 12660:
1.648 raeburn 12661: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12662:
12663: Prints a table of sample values from the upload and can make associate samples to internal names.
12664:
12665: $r is an Apache Request ref,
12666: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12667: $d is an array of 2 element arrays (internal name, displayed name)
12668:
12669: =cut
12670:
1.144 matthew 12671: ######################################################
12672: ######################################################
1.31 albertel 12673: sub csv_samples_select_table {
12674: my ($r,$records,$d) = @_;
12675: my $i=0;
1.144 matthew 12676: #
1.662 bisitz 12677: my $max_samples = 5;
12678: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12679: $r->print(&start_data_table().
12680: &start_data_table_header_row().'<th>'.
12681: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12682: &end_data_table_header_row());
1.301 albertel 12683:
12684: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12685: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12686: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12687: foreach my $option (@$d) {
12688: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12689: $r->print('<option value="'.$value.'"'.
1.253 albertel 12690: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12691: $display.'</option>');
1.31 albertel 12692: }
12693: $r->print('</select></td><td>');
1.662 bisitz 12694: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12695: if (defined($samples->[$line]{$key})) {
12696: $r->print($samples->[$line]{$key}."<br />\n");
12697: }
12698: }
1.594 raeburn 12699: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12700: $i++;
12701: }
1.594 raeburn 12702: $r->print(&end_data_table());
1.31 albertel 12703: $i--;
12704: return($i);
1.115 matthew 12705: }
12706:
1.144 matthew 12707: ######################################################
12708: ######################################################
12709:
1.115 matthew 12710: =pod
12711:
1.648 raeburn 12712: =item * &clean_excel_name($name)
1.115 matthew 12713:
12714: Returns a replacement for $name which does not contain any illegal characters.
12715:
12716: =cut
12717:
1.144 matthew 12718: ######################################################
12719: ######################################################
1.115 matthew 12720: sub clean_excel_name {
12721: my ($name) = @_;
12722: $name =~ s/[:\*\?\/\\]//g;
12723: if (length($name) > 31) {
12724: $name = substr($name,0,31);
12725: }
12726: return $name;
1.25 albertel 12727: }
1.84 albertel 12728:
1.85 albertel 12729: =pod
12730:
1.648 raeburn 12731: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12732:
12733: Returns either 1 or undef
12734:
12735: 1 if the part is to be hidden, undef if it is to be shown
12736:
12737: Arguments are:
12738:
12739: $id the id of the part to be checked
12740: $symb, optional the symb of the resource to check
12741: $udom, optional the domain of the user to check for
12742: $uname, optional the username of the user to check for
12743:
12744: =cut
1.84 albertel 12745:
12746: sub check_if_partid_hidden {
12747: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12748: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12749: $symb,$udom,$uname);
1.141 albertel 12750: my $truth=1;
12751: #if the string starts with !, then the list is the list to show not hide
12752: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12753: my @hiddenlist=split(/,/,$hiddenparts);
12754: foreach my $checkid (@hiddenlist) {
1.141 albertel 12755: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12756: }
1.141 albertel 12757: return !$truth;
1.84 albertel 12758: }
1.127 matthew 12759:
1.138 matthew 12760:
12761: ############################################################
12762: ############################################################
12763:
12764: =pod
12765:
1.157 matthew 12766: =back
12767:
1.138 matthew 12768: =head1 cgi-bin script and graphing routines
12769:
1.157 matthew 12770: =over 4
12771:
1.648 raeburn 12772: =item * &get_cgi_id()
1.138 matthew 12773:
12774: Inputs: none
12775:
12776: Returns an id which can be used to pass environment variables
12777: to various cgi-bin scripts. These environment variables will
12778: be removed from the users environment after a given time by
12779: the routine &Apache::lonnet::transfer_profile_to_env.
12780:
12781: =cut
12782:
12783: ############################################################
12784: ############################################################
1.152 albertel 12785: my $uniq=0;
1.136 matthew 12786: sub get_cgi_id {
1.154 albertel 12787: $uniq=($uniq+1)%100000;
1.280 albertel 12788: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12789: }
12790:
1.127 matthew 12791: ############################################################
12792: ############################################################
12793:
12794: =pod
12795:
1.648 raeburn 12796: =item * &DrawBarGraph()
1.127 matthew 12797:
1.138 matthew 12798: Facilitates the plotting of data in a (stacked) bar graph.
12799: Puts plot definition data into the users environment in order for
12800: graph.png to plot it. Returns an <img> tag for the plot.
12801: The bars on the plot are labeled '1','2',...,'n'.
12802:
12803: Inputs:
12804:
12805: =over 4
12806:
12807: =item $Title: string, the title of the plot
12808:
12809: =item $xlabel: string, text describing the X-axis of the plot
12810:
12811: =item $ylabel: string, text describing the Y-axis of the plot
12812:
12813: =item $Max: scalar, the maximum Y value to use in the plot
12814: If $Max is < any data point, the graph will not be rendered.
12815:
1.140 matthew 12816: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12817: they are plotted. If undefined, default values will be used.
12818:
1.178 matthew 12819: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12820:
1.138 matthew 12821: =item @Values: An array of array references. Each array reference holds data
12822: to be plotted in a stacked bar chart.
12823:
1.239 matthew 12824: =item If the final element of @Values is a hash reference the key/value
12825: pairs will be added to the graph definition.
12826:
1.138 matthew 12827: =back
12828:
12829: Returns:
12830:
12831: An <img> tag which references graph.png and the appropriate identifying
12832: information for the plot.
12833:
1.127 matthew 12834: =cut
12835:
12836: ############################################################
12837: ############################################################
1.134 matthew 12838: sub DrawBarGraph {
1.178 matthew 12839: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12840: #
12841: if (! defined($colors)) {
12842: $colors = ['#33ff00',
12843: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12844: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12845: ];
12846: }
1.228 matthew 12847: my $extra_settings = {};
12848: if (ref($Values[-1]) eq 'HASH') {
12849: $extra_settings = pop(@Values);
12850: }
1.127 matthew 12851: #
1.136 matthew 12852: my $identifier = &get_cgi_id();
12853: my $id = 'cgi.'.$identifier;
1.129 matthew 12854: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12855: return '';
12856: }
1.225 matthew 12857: #
12858: my @Labels;
12859: if (defined($labels)) {
12860: @Labels = @$labels;
12861: } else {
12862: for (my $i=0;$i<@{$Values[0]};$i++) {
12863: push (@Labels,$i+1);
12864: }
12865: }
12866: #
1.129 matthew 12867: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12868: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12869: my %ValuesHash;
12870: my $NumSets=1;
12871: foreach my $array (@Values) {
12872: next if (! ref($array));
1.136 matthew 12873: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12874: join(',',@$array);
1.129 matthew 12875: }
1.127 matthew 12876: #
1.136 matthew 12877: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12878: if ($NumBars < 3) {
12879: $width = 120+$NumBars*32;
1.220 matthew 12880: $xskip = 1;
1.225 matthew 12881: $bar_width = 30;
12882: } elsif ($NumBars < 5) {
12883: $width = 120+$NumBars*20;
12884: $xskip = 1;
12885: $bar_width = 20;
1.220 matthew 12886: } elsif ($NumBars < 10) {
1.136 matthew 12887: $width = 120+$NumBars*15;
12888: $xskip = 1;
12889: $bar_width = 15;
12890: } elsif ($NumBars <= 25) {
12891: $width = 120+$NumBars*11;
12892: $xskip = 5;
12893: $bar_width = 8;
12894: } elsif ($NumBars <= 50) {
12895: $width = 120+$NumBars*8;
12896: $xskip = 5;
12897: $bar_width = 4;
12898: } else {
12899: $width = 120+$NumBars*8;
12900: $xskip = 5;
12901: $bar_width = 4;
12902: }
12903: #
1.137 matthew 12904: $Max = 1 if ($Max < 1);
12905: if ( int($Max) < $Max ) {
12906: $Max++;
12907: $Max = int($Max);
12908: }
1.127 matthew 12909: $Title = '' if (! defined($Title));
12910: $xlabel = '' if (! defined($xlabel));
12911: $ylabel = '' if (! defined($ylabel));
1.369 www 12912: $ValuesHash{$id.'.title'} = &escape($Title);
12913: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12914: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12915: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12916: $ValuesHash{$id.'.NumBars'} = $NumBars;
12917: $ValuesHash{$id.'.NumSets'} = $NumSets;
12918: $ValuesHash{$id.'.PlotType'} = 'bar';
12919: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12920: $ValuesHash{$id.'.height'} = $height;
12921: $ValuesHash{$id.'.width'} = $width;
12922: $ValuesHash{$id.'.xskip'} = $xskip;
12923: $ValuesHash{$id.'.bar_width'} = $bar_width;
12924: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12925: #
1.228 matthew 12926: # Deal with other parameters
12927: while (my ($key,$value) = each(%$extra_settings)) {
12928: $ValuesHash{$id.'.'.$key} = $value;
12929: }
12930: #
1.646 raeburn 12931: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12932: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12933: }
12934:
12935: ############################################################
12936: ############################################################
12937:
12938: =pod
12939:
1.648 raeburn 12940: =item * &DrawXYGraph()
1.137 matthew 12941:
1.138 matthew 12942: Facilitates the plotting of data in an XY graph.
12943: Puts plot definition data into the users environment in order for
12944: graph.png to plot it. Returns an <img> tag for the plot.
12945:
12946: Inputs:
12947:
12948: =over 4
12949:
12950: =item $Title: string, the title of the plot
12951:
12952: =item $xlabel: string, text describing the X-axis of the plot
12953:
12954: =item $ylabel: string, text describing the Y-axis of the plot
12955:
12956: =item $Max: scalar, the maximum Y value to use in the plot
12957: If $Max is < any data point, the graph will not be rendered.
12958:
12959: =item $colors: Array ref containing the hex color codes for the data to be
12960: plotted in. If undefined, default values will be used.
12961:
12962: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12963:
12964: =item $Ydata: Array ref containing Array refs.
1.185 www 12965: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 12966:
12967: =item %Values: hash indicating or overriding any default values which are
12968: passed to graph.png.
12969: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12970:
12971: =back
12972:
12973: Returns:
12974:
12975: An <img> tag which references graph.png and the appropriate identifying
12976: information for the plot.
12977:
1.137 matthew 12978: =cut
12979:
12980: ############################################################
12981: ############################################################
12982: sub DrawXYGraph {
12983: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
12984: #
12985: # Create the identifier for the graph
12986: my $identifier = &get_cgi_id();
12987: my $id = 'cgi.'.$identifier;
12988: #
12989: $Title = '' if (! defined($Title));
12990: $xlabel = '' if (! defined($xlabel));
12991: $ylabel = '' if (! defined($ylabel));
12992: my %ValuesHash =
12993: (
1.369 www 12994: $id.'.title' => &escape($Title),
12995: $id.'.xlabel' => &escape($xlabel),
12996: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 12997: $id.'.y_max_value'=> $Max,
12998: $id.'.labels' => join(',',@$Xlabels),
12999: $id.'.PlotType' => 'XY',
13000: );
13001: #
13002: if (defined($colors) && ref($colors) eq 'ARRAY') {
13003: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13004: }
13005: #
13006: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13007: return '';
13008: }
13009: my $NumSets=1;
1.138 matthew 13010: foreach my $array (@{$Ydata}){
1.137 matthew 13011: next if (! ref($array));
13012: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13013: }
1.138 matthew 13014: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13015: #
13016: # Deal with other parameters
13017: while (my ($key,$value) = each(%Values)) {
13018: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13019: }
13020: #
1.646 raeburn 13021: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13022: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13023: }
13024:
13025: ############################################################
13026: ############################################################
13027:
13028: =pod
13029:
1.648 raeburn 13030: =item * &DrawXYYGraph()
1.138 matthew 13031:
13032: Facilitates the plotting of data in an XY graph with two Y axes.
13033: Puts plot definition data into the users environment in order for
13034: graph.png to plot it. Returns an <img> tag for the plot.
13035:
13036: Inputs:
13037:
13038: =over 4
13039:
13040: =item $Title: string, the title of the plot
13041:
13042: =item $xlabel: string, text describing the X-axis of the plot
13043:
13044: =item $ylabel: string, text describing the Y-axis of the plot
13045:
13046: =item $colors: Array ref containing the hex color codes for the data to be
13047: plotted in. If undefined, default values will be used.
13048:
13049: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13050:
13051: =item $Ydata1: The first data set
13052:
13053: =item $Min1: The minimum value of the left Y-axis
13054:
13055: =item $Max1: The maximum value of the left Y-axis
13056:
13057: =item $Ydata2: The second data set
13058:
13059: =item $Min2: The minimum value of the right Y-axis
13060:
13061: =item $Max2: The maximum value of the left Y-axis
13062:
13063: =item %Values: hash indicating or overriding any default values which are
13064: passed to graph.png.
13065: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13066:
13067: =back
13068:
13069: Returns:
13070:
13071: An <img> tag which references graph.png and the appropriate identifying
13072: information for the plot.
1.136 matthew 13073:
13074: =cut
13075:
13076: ############################################################
13077: ############################################################
1.137 matthew 13078: sub DrawXYYGraph {
13079: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13080: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13081: #
13082: # Create the identifier for the graph
13083: my $identifier = &get_cgi_id();
13084: my $id = 'cgi.'.$identifier;
13085: #
13086: $Title = '' if (! defined($Title));
13087: $xlabel = '' if (! defined($xlabel));
13088: $ylabel = '' if (! defined($ylabel));
13089: my %ValuesHash =
13090: (
1.369 www 13091: $id.'.title' => &escape($Title),
13092: $id.'.xlabel' => &escape($xlabel),
13093: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13094: $id.'.labels' => join(',',@$Xlabels),
13095: $id.'.PlotType' => 'XY',
13096: $id.'.NumSets' => 2,
1.137 matthew 13097: $id.'.two_axes' => 1,
13098: $id.'.y1_max_value' => $Max1,
13099: $id.'.y1_min_value' => $Min1,
13100: $id.'.y2_max_value' => $Max2,
13101: $id.'.y2_min_value' => $Min2,
1.136 matthew 13102: );
13103: #
1.137 matthew 13104: if (defined($colors) && ref($colors) eq 'ARRAY') {
13105: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13106: }
13107: #
13108: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13109: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13110: return '';
13111: }
13112: my $NumSets=1;
1.137 matthew 13113: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13114: next if (! ref($array));
13115: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13116: }
13117: #
13118: # Deal with other parameters
13119: while (my ($key,$value) = each(%Values)) {
13120: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13121: }
13122: #
1.646 raeburn 13123: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13124: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13125: }
13126:
13127: ############################################################
13128: ############################################################
13129:
13130: =pod
13131:
1.157 matthew 13132: =back
13133:
1.139 matthew 13134: =head1 Statistics helper routines?
13135:
13136: Bad place for them but what the hell.
13137:
1.157 matthew 13138: =over 4
13139:
1.648 raeburn 13140: =item * &chartlink()
1.139 matthew 13141:
13142: Returns a link to the chart for a specific student.
13143:
13144: Inputs:
13145:
13146: =over 4
13147:
13148: =item $linktext: The text of the link
13149:
13150: =item $sname: The students username
13151:
13152: =item $sdomain: The students domain
13153:
13154: =back
13155:
1.157 matthew 13156: =back
13157:
1.139 matthew 13158: =cut
13159:
13160: ############################################################
13161: ############################################################
13162: sub chartlink {
13163: my ($linktext, $sname, $sdomain) = @_;
13164: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13165: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13166: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13167: '">'.$linktext.'</a>';
1.153 matthew 13168: }
13169:
13170: #######################################################
13171: #######################################################
13172:
13173: =pod
13174:
13175: =head1 Course Environment Routines
1.157 matthew 13176:
13177: =over 4
1.153 matthew 13178:
1.648 raeburn 13179: =item * &restore_course_settings()
1.153 matthew 13180:
1.648 raeburn 13181: =item * &store_course_settings()
1.153 matthew 13182:
13183: Restores/Store indicated form parameters from the course environment.
13184: Will not overwrite existing values of the form parameters.
13185:
13186: Inputs:
13187: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13188:
13189: a hash ref describing the data to be stored. For example:
13190:
13191: %Save_Parameters = ('Status' => 'scalar',
13192: 'chartoutputmode' => 'scalar',
13193: 'chartoutputdata' => 'scalar',
13194: 'Section' => 'array',
1.373 raeburn 13195: 'Group' => 'array',
1.153 matthew 13196: 'StudentData' => 'array',
13197: 'Maps' => 'array');
13198:
13199: Returns: both routines return nothing
13200:
1.631 raeburn 13201: =back
13202:
1.153 matthew 13203: =cut
13204:
13205: #######################################################
13206: #######################################################
13207: sub store_course_settings {
1.496 albertel 13208: return &store_settings($env{'request.course.id'},@_);
13209: }
13210:
13211: sub store_settings {
1.153 matthew 13212: # save to the environment
13213: # appenv the same items, just to be safe
1.300 albertel 13214: my $udom = $env{'user.domain'};
13215: my $uname = $env{'user.name'};
1.496 albertel 13216: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13217: my %SaveHash;
13218: my %AppHash;
13219: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13220: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13221: my $envname = 'environment.'.$basename;
1.258 albertel 13222: if (exists($env{'form.'.$setting})) {
1.153 matthew 13223: # Save this value away
13224: if ($type eq 'scalar' &&
1.258 albertel 13225: (! exists($env{$envname}) ||
13226: $env{$envname} ne $env{'form.'.$setting})) {
13227: $SaveHash{$basename} = $env{'form.'.$setting};
13228: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13229: } elsif ($type eq 'array') {
13230: my $stored_form;
1.258 albertel 13231: if (ref($env{'form.'.$setting})) {
1.153 matthew 13232: $stored_form = join(',',
13233: map {
1.369 www 13234: &escape($_);
1.258 albertel 13235: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13236: } else {
13237: $stored_form =
1.369 www 13238: &escape($env{'form.'.$setting});
1.153 matthew 13239: }
13240: # Determine if the array contents are the same.
1.258 albertel 13241: if ($stored_form ne $env{$envname}) {
1.153 matthew 13242: $SaveHash{$basename} = $stored_form;
13243: $AppHash{$envname} = $stored_form;
13244: }
13245: }
13246: }
13247: }
13248: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13249: $udom,$uname);
1.153 matthew 13250: if ($put_result !~ /^(ok|delayed)/) {
13251: &Apache::lonnet::logthis('unable to save form parameters, '.
13252: 'got error:'.$put_result);
13253: }
13254: # Make sure these settings stick around in this session, too
1.646 raeburn 13255: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13256: return;
13257: }
13258:
13259: sub restore_course_settings {
1.499 albertel 13260: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13261: }
13262:
13263: sub restore_settings {
13264: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13265: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13266: next if (exists($env{'form.'.$setting}));
1.496 albertel 13267: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13268: '.'.$setting;
1.258 albertel 13269: if (exists($env{$envname})) {
1.153 matthew 13270: if ($type eq 'scalar') {
1.258 albertel 13271: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13272: } elsif ($type eq 'array') {
1.258 albertel 13273: $env{'form.'.$setting} = [
1.153 matthew 13274: map {
1.369 www 13275: &unescape($_);
1.258 albertel 13276: } split(',',$env{$envname})
1.153 matthew 13277: ];
13278: }
13279: }
13280: }
1.127 matthew 13281: }
13282:
1.618 raeburn 13283: #######################################################
13284: #######################################################
13285:
13286: =pod
13287:
13288: =head1 Domain E-mail Routines
13289:
13290: =over 4
13291:
1.648 raeburn 13292: =item * &build_recipient_list()
1.618 raeburn 13293:
1.1144 raeburn 13294: Build recipient lists for following types of e-mail:
1.766 raeburn 13295: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13296: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13297: module change checking, student/employee ID conflict checks, as
13298: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13299: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13300:
13301: Inputs:
1.619 raeburn 13302: defmail (scalar - email address of default recipient),
1.1144 raeburn 13303: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13304: requestsmail, updatesmail, or idconflictsmail).
13305:
1.619 raeburn 13306: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13307:
1.619 raeburn 13308: origmail (scalar - email address of recipient from loncapa.conf,
13309: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13310:
1.655 raeburn 13311: Returns: comma separated list of addresses to which to send e-mail.
13312:
13313: =back
1.618 raeburn 13314:
13315: =cut
13316:
13317: ############################################################
13318: ############################################################
13319: sub build_recipient_list {
1.619 raeburn 13320: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13321: my @recipients;
13322: my $otheremails;
13323: my %domconfig =
13324: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13325: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13326: if (exists($domconfig{'contacts'}{$mailing})) {
13327: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13328: my @contacts = ('adminemail','supportemail');
13329: foreach my $item (@contacts) {
13330: if ($domconfig{'contacts'}{$mailing}{$item}) {
13331: my $addr = $domconfig{'contacts'}{$item};
13332: if (!grep(/^\Q$addr\E$/,@recipients)) {
13333: push(@recipients,$addr);
13334: }
1.619 raeburn 13335: }
1.766 raeburn 13336: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13337: }
13338: }
1.766 raeburn 13339: } elsif ($origmail ne '') {
13340: push(@recipients,$origmail);
1.618 raeburn 13341: }
1.619 raeburn 13342: } elsif ($origmail ne '') {
13343: push(@recipients,$origmail);
1.618 raeburn 13344: }
1.688 raeburn 13345: if (defined($defmail)) {
13346: if ($defmail ne '') {
13347: push(@recipients,$defmail);
13348: }
1.618 raeburn 13349: }
13350: if ($otheremails) {
1.619 raeburn 13351: my @others;
13352: if ($otheremails =~ /,/) {
13353: @others = split(/,/,$otheremails);
1.618 raeburn 13354: } else {
1.619 raeburn 13355: push(@others,$otheremails);
13356: }
13357: foreach my $addr (@others) {
13358: if (!grep(/^\Q$addr\E$/,@recipients)) {
13359: push(@recipients,$addr);
13360: }
1.618 raeburn 13361: }
13362: }
1.619 raeburn 13363: my $recipientlist = join(',',@recipients);
1.618 raeburn 13364: return $recipientlist;
13365: }
13366:
1.127 matthew 13367: ############################################################
13368: ############################################################
1.154 albertel 13369:
1.655 raeburn 13370: =pod
13371:
13372: =head1 Course Catalog Routines
13373:
13374: =over 4
13375:
13376: =item * &gather_categories()
13377:
13378: Converts category definitions - keys of categories hash stored in
13379: coursecategories in configuration.db on the primary library server in a
13380: domain - to an array. Also generates javascript and idx hash used to
13381: generate Domain Coordinator interface for editing Course Categories.
13382:
13383: Inputs:
1.663 raeburn 13384:
1.655 raeburn 13385: categories (reference to hash of category definitions).
1.663 raeburn 13386:
1.655 raeburn 13387: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13388: categories and subcategories).
1.663 raeburn 13389:
1.655 raeburn 13390: idx (reference to hash of counters used in Domain Coordinator interface for
13391: editing Course Categories).
1.663 raeburn 13392:
1.655 raeburn 13393: jsarray (reference to array of categories used to create Javascript arrays for
13394: Domain Coordinator interface for editing Course Categories).
13395:
13396: Returns: nothing
13397:
13398: Side effects: populates cats, idx and jsarray.
13399:
13400: =cut
13401:
13402: sub gather_categories {
13403: my ($categories,$cats,$idx,$jsarray) = @_;
13404: my %counters;
13405: my $num = 0;
13406: foreach my $item (keys(%{$categories})) {
13407: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13408: if ($container eq '' && $depth == 0) {
13409: $cats->[$depth][$categories->{$item}] = $cat;
13410: } else {
13411: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13412: }
13413: my ($escitem,$tail) = split(/:/,$item,2);
13414: if ($counters{$tail} eq '') {
13415: $counters{$tail} = $num;
13416: $num ++;
13417: }
13418: if (ref($idx) eq 'HASH') {
13419: $idx->{$item} = $counters{$tail};
13420: }
13421: if (ref($jsarray) eq 'ARRAY') {
13422: push(@{$jsarray->[$counters{$tail}]},$item);
13423: }
13424: }
13425: return;
13426: }
13427:
13428: =pod
13429:
13430: =item * &extract_categories()
13431:
13432: Used to generate breadcrumb trails for course categories.
13433:
13434: Inputs:
1.663 raeburn 13435:
1.655 raeburn 13436: categories (reference to hash of category definitions).
1.663 raeburn 13437:
1.655 raeburn 13438: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13439: categories and subcategories).
1.663 raeburn 13440:
1.655 raeburn 13441: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13442:
1.655 raeburn 13443: allitems (reference to hash - key is category key
13444: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13445:
1.655 raeburn 13446: idx (reference to hash of counters used in Domain Coordinator interface for
13447: editing Course Categories).
1.663 raeburn 13448:
1.655 raeburn 13449: jsarray (reference to array of categories used to create Javascript arrays for
13450: Domain Coordinator interface for editing Course Categories).
13451:
1.665 raeburn 13452: subcats (reference to hash of arrays containing all subcategories within each
13453: category, -recursive)
13454:
1.655 raeburn 13455: Returns: nothing
13456:
13457: Side effects: populates trails and allitems hash references.
13458:
13459: =cut
13460:
13461: sub extract_categories {
1.665 raeburn 13462: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13463: if (ref($categories) eq 'HASH') {
13464: &gather_categories($categories,$cats,$idx,$jsarray);
13465: if (ref($cats->[0]) eq 'ARRAY') {
13466: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13467: my $name = $cats->[0][$i];
13468: my $item = &escape($name).'::0';
13469: my $trailstr;
13470: if ($name eq 'instcode') {
13471: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13472: } elsif ($name eq 'communities') {
13473: $trailstr = &mt('Communities');
1.655 raeburn 13474: } else {
13475: $trailstr = $name;
13476: }
13477: if ($allitems->{$item} eq '') {
13478: push(@{$trails},$trailstr);
13479: $allitems->{$item} = scalar(@{$trails})-1;
13480: }
13481: my @parents = ($name);
13482: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13483: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13484: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13485: if (ref($subcats) eq 'HASH') {
13486: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13487: }
13488: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13489: }
13490: } else {
13491: if (ref($subcats) eq 'HASH') {
13492: $subcats->{$item} = [];
1.655 raeburn 13493: }
13494: }
13495: }
13496: }
13497: }
13498: return;
13499: }
13500:
13501: =pod
13502:
1.1162 raeburn 13503: =item * &recurse_categories()
1.655 raeburn 13504:
13505: Recursively used to generate breadcrumb trails for course categories.
13506:
13507: Inputs:
1.663 raeburn 13508:
1.655 raeburn 13509: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13510: categories and subcategories).
1.663 raeburn 13511:
1.655 raeburn 13512: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13513:
13514: category (current course category, for which breadcrumb trail is being generated).
13515:
13516: trails (reference to array of breadcrumb trails for each category).
13517:
1.655 raeburn 13518: allitems (reference to hash - key is category key
13519: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13520:
1.655 raeburn 13521: parents (array containing containers directories for current category,
13522: back to top level).
13523:
13524: Returns: nothing
13525:
13526: Side effects: populates trails and allitems hash references
13527:
13528: =cut
13529:
13530: sub recurse_categories {
1.665 raeburn 13531: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13532: my $shallower = $depth - 1;
13533: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13534: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13535: my $name = $cats->[$depth]{$category}[$k];
13536: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13537: my $trailstr = join(' -> ',(@{$parents},$category));
13538: if ($allitems->{$item} eq '') {
13539: push(@{$trails},$trailstr);
13540: $allitems->{$item} = scalar(@{$trails})-1;
13541: }
13542: my $deeper = $depth+1;
13543: push(@{$parents},$category);
1.665 raeburn 13544: if (ref($subcats) eq 'HASH') {
13545: my $subcat = &escape($name).':'.$category.':'.$depth;
13546: for (my $j=@{$parents}; $j>=0; $j--) {
13547: my $higher;
13548: if ($j > 0) {
13549: $higher = &escape($parents->[$j]).':'.
13550: &escape($parents->[$j-1]).':'.$j;
13551: } else {
13552: $higher = &escape($parents->[$j]).'::'.$j;
13553: }
13554: push(@{$subcats->{$higher}},$subcat);
13555: }
13556: }
13557: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13558: $subcats);
1.655 raeburn 13559: pop(@{$parents});
13560: }
13561: } else {
13562: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13563: my $trailstr = join(' -> ',(@{$parents},$category));
13564: if ($allitems->{$item} eq '') {
13565: push(@{$trails},$trailstr);
13566: $allitems->{$item} = scalar(@{$trails})-1;
13567: }
13568: }
13569: return;
13570: }
13571:
1.663 raeburn 13572: =pod
13573:
1.1162 raeburn 13574: =item * &assign_categories_table()
1.663 raeburn 13575:
13576: Create a datatable for display of hierarchical categories in a domain,
13577: with checkboxes to allow a course to be categorized.
13578:
13579: Inputs:
13580:
13581: cathash - reference to hash of categories defined for the domain (from
13582: configuration.db)
13583:
13584: currcat - scalar with an & separated list of categories assigned to a course.
13585:
1.919 raeburn 13586: type - scalar contains course type (Course or Community).
13587:
1.663 raeburn 13588: Returns: $output (markup to be displayed)
13589:
13590: =cut
13591:
13592: sub assign_categories_table {
1.919 raeburn 13593: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13594: my $output;
13595: if (ref($cathash) eq 'HASH') {
13596: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13597: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13598: $maxdepth = scalar(@cats);
13599: if (@cats > 0) {
13600: my $itemcount = 0;
13601: if (ref($cats[0]) eq 'ARRAY') {
13602: my @currcategories;
13603: if ($currcat ne '') {
13604: @currcategories = split('&',$currcat);
13605: }
1.919 raeburn 13606: my $table;
1.663 raeburn 13607: for (my $i=0; $i<@{$cats[0]}; $i++) {
13608: my $parent = $cats[0][$i];
1.919 raeburn 13609: next if ($parent eq 'instcode');
13610: if ($type eq 'Community') {
13611: next unless ($parent eq 'communities');
13612: } else {
13613: next if ($parent eq 'communities');
13614: }
1.663 raeburn 13615: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13616: my $item = &escape($parent).'::0';
13617: my $checked = '';
13618: if (@currcategories > 0) {
13619: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13620: $checked = ' checked="checked"';
1.663 raeburn 13621: }
13622: }
1.919 raeburn 13623: my $parent_title = $parent;
13624: if ($parent eq 'communities') {
13625: $parent_title = &mt('Communities');
13626: }
13627: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13628: '<input type="checkbox" name="usecategory" value="'.
13629: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13630: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13631: my $depth = 1;
13632: push(@path,$parent);
1.919 raeburn 13633: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13634: pop(@path);
1.919 raeburn 13635: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13636: $itemcount ++;
13637: }
1.919 raeburn 13638: if ($itemcount) {
13639: $output = &Apache::loncommon::start_data_table().
13640: $table.
13641: &Apache::loncommon::end_data_table();
13642: }
1.663 raeburn 13643: }
13644: }
13645: }
13646: return $output;
13647: }
13648:
13649: =pod
13650:
1.1162 raeburn 13651: =item * &assign_category_rows()
1.663 raeburn 13652:
13653: Create a datatable row for display of nested categories in a domain,
13654: with checkboxes to allow a course to be categorized,called recursively.
13655:
13656: Inputs:
13657:
13658: itemcount - track row number for alternating colors
13659:
13660: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13661: categories and subcategories.
13662:
13663: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13664:
13665: parent - parent of current category item
13666:
13667: path - Array containing all categories back up through the hierarchy from the
13668: current category to the top level.
13669:
13670: currcategories - reference to array of current categories assigned to the course
13671:
13672: Returns: $output (markup to be displayed).
13673:
13674: =cut
13675:
13676: sub assign_category_rows {
13677: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13678: my ($text,$name,$item,$chgstr);
13679: if (ref($cats) eq 'ARRAY') {
13680: my $maxdepth = scalar(@{$cats});
13681: if (ref($cats->[$depth]) eq 'HASH') {
13682: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13683: my $numchildren = @{$cats->[$depth]{$parent}};
13684: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 13685: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13686: for (my $j=0; $j<$numchildren; $j++) {
13687: $name = $cats->[$depth]{$parent}[$j];
13688: $item = &escape($name).':'.&escape($parent).':'.$depth;
13689: my $deeper = $depth+1;
13690: my $checked = '';
13691: if (ref($currcategories) eq 'ARRAY') {
13692: if (@{$currcategories} > 0) {
13693: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13694: $checked = ' checked="checked"';
1.663 raeburn 13695: }
13696: }
13697: }
1.664 raeburn 13698: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13699: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13700: $item.'"'.$checked.' />'.$name.'</label></span>'.
13701: '<input type="hidden" name="catname" value="'.$name.'" />'.
13702: '</td><td>';
1.663 raeburn 13703: if (ref($path) eq 'ARRAY') {
13704: push(@{$path},$name);
13705: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13706: pop(@{$path});
13707: }
13708: $text .= '</td></tr>';
13709: }
13710: $text .= '</table></td>';
13711: }
13712: }
13713: }
13714: return $text;
13715: }
13716:
1.1181 raeburn 13717: =pod
13718:
13719: =back
13720:
13721: =cut
13722:
1.655 raeburn 13723: ############################################################
13724: ############################################################
13725:
13726:
1.443 albertel 13727: sub commit_customrole {
1.664 raeburn 13728: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13729: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13730: ($start?', '.&mt('starting').' '.localtime($start):'').
13731: ($end?', ending '.localtime($end):'').': <b>'.
13732: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13733: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13734: '</b><br />';
13735: return $output;
13736: }
13737:
13738: sub commit_standardrole {
1.1116 raeburn 13739: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13740: my ($output,$logmsg,$linefeed);
13741: if ($context eq 'auto') {
13742: $linefeed = "\n";
13743: } else {
13744: $linefeed = "<br />\n";
13745: }
1.443 albertel 13746: if ($three eq 'st') {
1.541 raeburn 13747: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 13748: $one,$two,$sec,$context,$credits);
1.541 raeburn 13749: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13750: ($result eq 'unknown_course') || ($result eq 'refused')) {
13751: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13752: } else {
1.541 raeburn 13753: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13754: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13755: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13756: if ($context eq 'auto') {
13757: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13758: } else {
13759: $output .= '<b>'.$result.'</b>'.$linefeed.
13760: &mt('Add to classlist').': <b>ok</b>';
13761: }
13762: $output .= $linefeed;
1.443 albertel 13763: }
13764: } else {
13765: $output = &mt('Assigning').' '.$three.' in '.$url.
13766: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13767: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13768: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13769: if ($context eq 'auto') {
13770: $output .= $result.$linefeed;
13771: } else {
13772: $output .= '<b>'.$result.'</b>'.$linefeed;
13773: }
1.443 albertel 13774: }
13775: return $output;
13776: }
13777:
13778: sub commit_studentrole {
1.1116 raeburn 13779: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13780: $credits) = @_;
1.626 raeburn 13781: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13782: if ($context eq 'auto') {
13783: $linefeed = "\n";
13784: } else {
13785: $linefeed = '<br />'."\n";
13786: }
1.443 albertel 13787: if (defined($one) && defined($two)) {
13788: my $cid=$one.'_'.$two;
13789: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13790: my $secchange = 0;
13791: my $expire_role_result;
13792: my $modify_section_result;
1.628 raeburn 13793: if ($oldsec ne '-1') {
13794: if ($oldsec ne $sec) {
1.443 albertel 13795: $secchange = 1;
1.628 raeburn 13796: my $now = time;
1.443 albertel 13797: my $uurl='/'.$cid;
13798: $uurl=~s/\_/\//g;
13799: if ($oldsec) {
13800: $uurl.='/'.$oldsec;
13801: }
1.626 raeburn 13802: $oldsecurl = $uurl;
1.628 raeburn 13803: $expire_role_result =
1.652 raeburn 13804: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13805: if ($env{'request.course.sec'} ne '') {
13806: if ($expire_role_result eq 'refused') {
13807: my @roles = ('st');
13808: my @statuses = ('previous');
13809: my @roledoms = ($one);
13810: my $withsec = 1;
13811: my %roleshash =
13812: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13813: \@statuses,\@roles,\@roledoms,$withsec);
13814: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13815: my ($oldstart,$oldend) =
13816: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13817: if ($oldend > 0 && $oldend <= $now) {
13818: $expire_role_result = 'ok';
13819: }
13820: }
13821: }
13822: }
1.443 albertel 13823: $result = $expire_role_result;
13824: }
13825: }
13826: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 13827: $modify_section_result =
13828: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13829: undef,undef,undef,$sec,
13830: $end,$start,'','',$cid,
13831: '',$context,$credits);
1.443 albertel 13832: if ($modify_section_result =~ /^ok/) {
13833: if ($secchange == 1) {
1.628 raeburn 13834: if ($sec eq '') {
13835: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13836: } else {
13837: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13838: }
1.443 albertel 13839: } elsif ($oldsec eq '-1') {
1.628 raeburn 13840: if ($sec eq '') {
13841: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13842: } else {
13843: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13844: }
1.443 albertel 13845: } else {
1.628 raeburn 13846: if ($sec eq '') {
13847: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13848: } else {
13849: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13850: }
1.443 albertel 13851: }
13852: } else {
1.1115 raeburn 13853: if ($secchange) {
1.628 raeburn 13854: $$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;
13855: } else {
13856: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13857: }
1.443 albertel 13858: }
13859: $result = $modify_section_result;
13860: } elsif ($secchange == 1) {
1.628 raeburn 13861: if ($oldsec eq '') {
1.1103 raeburn 13862: $$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 13863: } else {
13864: $$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;
13865: }
1.626 raeburn 13866: if ($expire_role_result eq 'refused') {
13867: my $newsecurl = '/'.$cid;
13868: $newsecurl =~ s/\_/\//g;
13869: if ($sec ne '') {
13870: $newsecurl.='/'.$sec;
13871: }
13872: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13873: if ($sec eq '') {
13874: $$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;
13875: } else {
13876: $$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;
13877: }
13878: }
13879: }
1.443 albertel 13880: }
13881: } else {
1.626 raeburn 13882: $$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 13883: $result = "error: incomplete course id\n";
13884: }
13885: return $result;
13886: }
13887:
1.1108 raeburn 13888: sub show_role_extent {
13889: my ($scope,$context,$role) = @_;
13890: $scope =~ s{^/}{};
13891: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13892: push(@courseroles,'co');
13893: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13894: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13895: $scope =~ s{/}{_};
13896: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13897: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13898: my ($audom,$auname) = split(/\//,$scope);
13899: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13900: &Apache::loncommon::plainname($auname,$audom).'</span>');
13901: } else {
13902: $scope =~ s{/$}{};
13903: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13904: &Apache::lonnet::domain($scope,'description').'</span>');
13905: }
13906: }
13907:
1.443 albertel 13908: ############################################################
13909: ############################################################
13910:
1.566 albertel 13911: sub check_clone {
1.578 raeburn 13912: my ($args,$linefeed) = @_;
1.566 albertel 13913: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13914: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13915: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13916: my $clonemsg;
13917: my $can_clone = 0;
1.944 raeburn 13918: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13919: if ($lctype ne 'community') {
13920: $lctype = 'course';
13921: }
1.566 albertel 13922: if ($clonehome eq 'no_host') {
1.944 raeburn 13923: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13924: $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'});
13925: } else {
13926: $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'});
13927: }
1.566 albertel 13928: } else {
13929: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13930: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13931: if ($clonedesc{'type'} ne 'Community') {
13932: $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'});
13933: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13934: }
13935: }
1.882 raeburn 13936: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13937: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13938: $can_clone = 1;
13939: } else {
13940: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13941: $args->{'clonedomain'},$args->{'clonecourse'});
13942: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 13943: if (grep(/^\*$/,@cloners)) {
13944: $can_clone = 1;
13945: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
13946: $can_clone = 1;
13947: } else {
1.908 raeburn 13948: my $ccrole = 'cc';
1.944 raeburn 13949: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13950: $ccrole = 'co';
13951: }
1.578 raeburn 13952: my %roleshash =
13953: &Apache::lonnet::get_my_roles($args->{'ccuname'},
13954: $args->{'ccdomain'},
1.908 raeburn 13955: 'userroles',['active'],[$ccrole],
1.578 raeburn 13956: [$args->{'clonedomain'}]);
1.908 raeburn 13957: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 13958: $can_clone = 1;
13959: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
13960: $can_clone = 1;
13961: } else {
1.944 raeburn 13962: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13963: $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'});
13964: } else {
13965: $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'});
13966: }
1.578 raeburn 13967: }
1.566 albertel 13968: }
1.578 raeburn 13969: }
1.566 albertel 13970: }
13971: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13972: }
13973:
1.444 albertel 13974: sub construct_course {
1.1166 raeburn 13975: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 13976: my $outcome;
1.541 raeburn 13977: my $linefeed = '<br />'."\n";
13978: if ($context eq 'auto') {
13979: $linefeed = "\n";
13980: }
1.566 albertel 13981:
13982: #
13983: # Are we cloning?
13984: #
13985: my ($can_clone, $clonemsg, $cloneid, $clonehome);
13986: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 13987: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 13988: if ($context ne 'auto') {
1.578 raeburn 13989: if ($clonemsg ne '') {
13990: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
13991: }
1.566 albertel 13992: }
13993: $outcome .= $clonemsg.$linefeed;
13994:
13995: if (!$can_clone) {
13996: return (0,$outcome);
13997: }
13998: }
13999:
1.444 albertel 14000: #
14001: # Open course
14002: #
14003: my $crstype = lc($args->{'crstype'});
14004: my %cenv=();
14005: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14006: $args->{'cdescr'},
14007: $args->{'curl'},
14008: $args->{'course_home'},
14009: $args->{'nonstandard'},
14010: $args->{'crscode'},
14011: $args->{'ccuname'}.':'.
14012: $args->{'ccdomain'},
1.882 raeburn 14013: $args->{'crstype'},
1.885 raeburn 14014: $cnum,$context,$category);
1.444 albertel 14015:
14016: # Note: The testing routines depend on this being output; see
14017: # Utils::Course. This needs to at least be output as a comment
14018: # if anyone ever decides to not show this, and Utils::Course::new
14019: # will need to be suitably modified.
1.541 raeburn 14020: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14021: if ($$courseid =~ /^error:/) {
14022: return (0,$outcome);
14023: }
14024:
1.444 albertel 14025: #
14026: # Check if created correctly
14027: #
1.479 albertel 14028: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14029: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14030: if ($crsuhome eq 'no_host') {
14031: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14032: return (0,$outcome);
14033: }
1.541 raeburn 14034: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14035:
1.444 albertel 14036: #
1.566 albertel 14037: # Do the cloning
14038: #
14039: if ($can_clone && $cloneid) {
14040: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14041: if ($context ne 'auto') {
14042: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14043: }
14044: $outcome .= $clonemsg.$linefeed;
14045: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14046: # Copy all files
1.637 www 14047: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14048: # Restore URL
1.566 albertel 14049: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14050: # Restore title
1.566 albertel 14051: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14052: # Restore creation date, creator and creation context.
14053: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14054: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14055: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14056: # Mark as cloned
1.566 albertel 14057: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14058: # Need to clone grading mode
14059: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14060: $cenv{'grading'}=$newenv{'grading'};
14061: # Do not clone these environment entries
14062: &Apache::lonnet::del('environment',
14063: ['default_enrollment_start_date',
14064: 'default_enrollment_end_date',
14065: 'question.email',
14066: 'policy.email',
14067: 'comment.email',
14068: 'pch.users.denied',
1.725 raeburn 14069: 'plc.users.denied',
14070: 'hidefromcat',
1.1121 raeburn 14071: 'checkforpriv',
1.1166 raeburn 14072: 'categories',
14073: 'internal.uniquecode'],
1.638 www 14074: $$crsudom,$$crsunum);
1.1170 raeburn 14075: if ($args->{'textbook'}) {
14076: $cenv{'internal.textbook'} = $args->{'textbook'};
14077: }
1.444 albertel 14078: }
1.566 albertel 14079:
1.444 albertel 14080: #
14081: # Set environment (will override cloned, if existing)
14082: #
14083: my @sections = ();
14084: my @xlists = ();
14085: if ($args->{'crstype'}) {
14086: $cenv{'type'}=$args->{'crstype'};
14087: }
14088: if ($args->{'crsid'}) {
14089: $cenv{'courseid'}=$args->{'crsid'};
14090: }
14091: if ($args->{'crscode'}) {
14092: $cenv{'internal.coursecode'}=$args->{'crscode'};
14093: }
14094: if ($args->{'crsquota'} ne '') {
14095: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14096: } else {
14097: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14098: }
14099: if ($args->{'ccuname'}) {
14100: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14101: ':'.$args->{'ccdomain'};
14102: } else {
14103: $cenv{'internal.courseowner'} = $args->{'curruser'};
14104: }
1.1116 raeburn 14105: if ($args->{'defaultcredits'}) {
14106: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14107: }
1.444 albertel 14108: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14109: if ($args->{'crssections'}) {
14110: $cenv{'internal.sectionnums'} = '';
14111: if ($args->{'crssections'} =~ m/,/) {
14112: @sections = split/,/,$args->{'crssections'};
14113: } else {
14114: $sections[0] = $args->{'crssections'};
14115: }
14116: if (@sections > 0) {
14117: foreach my $item (@sections) {
14118: my ($sec,$gp) = split/:/,$item;
14119: my $class = $args->{'crscode'}.$sec;
14120: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14121: $cenv{'internal.sectionnums'} .= $item.',';
14122: unless ($addcheck eq 'ok') {
14123: push @badclasses, $class;
14124: }
14125: }
14126: $cenv{'internal.sectionnums'} =~ s/,$//;
14127: }
14128: }
14129: # do not hide course coordinator from staff listing,
14130: # even if privileged
14131: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14132: # add course coordinator's domain to domains to check for privileged users
14133: # if different to course domain
14134: if ($$crsudom ne $args->{'ccdomain'}) {
14135: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14136: }
1.444 albertel 14137: # add crosslistings
14138: if ($args->{'crsxlist'}) {
14139: $cenv{'internal.crosslistings'}='';
14140: if ($args->{'crsxlist'} =~ m/,/) {
14141: @xlists = split/,/,$args->{'crsxlist'};
14142: } else {
14143: $xlists[0] = $args->{'crsxlist'};
14144: }
14145: if (@xlists > 0) {
14146: foreach my $item (@xlists) {
14147: my ($xl,$gp) = split/:/,$item;
14148: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14149: $cenv{'internal.crosslistings'} .= $item.',';
14150: unless ($addcheck eq 'ok') {
14151: push @badclasses, $xl;
14152: }
14153: }
14154: $cenv{'internal.crosslistings'} =~ s/,$//;
14155: }
14156: }
14157: if ($args->{'autoadds'}) {
14158: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14159: }
14160: if ($args->{'autodrops'}) {
14161: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14162: }
14163: # check for notification of enrollment changes
14164: my @notified = ();
14165: if ($args->{'notify_owner'}) {
14166: if ($args->{'ccuname'} ne '') {
14167: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14168: }
14169: }
14170: if ($args->{'notify_dc'}) {
14171: if ($uname ne '') {
1.630 raeburn 14172: push(@notified,$uname.':'.$udom);
1.444 albertel 14173: }
14174: }
14175: if (@notified > 0) {
14176: my $notifylist;
14177: if (@notified > 1) {
14178: $notifylist = join(',',@notified);
14179: } else {
14180: $notifylist = $notified[0];
14181: }
14182: $cenv{'internal.notifylist'} = $notifylist;
14183: }
14184: if (@badclasses > 0) {
14185: my %lt=&Apache::lonlocal::texthash(
14186: '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',
14187: 'dnhr' => 'does not have rights to access enrollment in these classes',
14188: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14189: );
1.541 raeburn 14190: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14191: ' ('.$lt{'adby'}.')';
14192: if ($context eq 'auto') {
14193: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14194: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14195: foreach my $item (@badclasses) {
14196: if ($context eq 'auto') {
14197: $outcome .= " - $item\n";
14198: } else {
14199: $outcome .= "<li>$item</li>\n";
14200: }
14201: }
14202: if ($context eq 'auto') {
14203: $outcome .= $linefeed;
14204: } else {
1.566 albertel 14205: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14206: }
14207: }
1.444 albertel 14208: }
14209: if ($args->{'no_end_date'}) {
14210: $args->{'endaccess'} = 0;
14211: }
14212: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14213: $cenv{'internal.autoend'}=$args->{'enrollend'};
14214: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14215: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14216: if ($args->{'showphotos'}) {
14217: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14218: }
14219: $cenv{'internal.authtype'} = $args->{'authtype'};
14220: $cenv{'internal.autharg'} = $args->{'autharg'};
14221: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14222: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14223: 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');
14224: if ($context eq 'auto') {
14225: $outcome .= $krb_msg;
14226: } else {
1.566 albertel 14227: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14228: }
14229: $outcome .= $linefeed;
1.444 albertel 14230: }
14231: }
14232: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14233: if ($args->{'setpolicy'}) {
14234: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14235: }
14236: if ($args->{'setcontent'}) {
14237: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14238: }
14239: }
14240: if ($args->{'reshome'}) {
14241: $cenv{'reshome'}=$args->{'reshome'}.'/';
14242: $cenv{'reshome'}=~s/\/+$/\//;
14243: }
14244: #
14245: # course has keyed access
14246: #
14247: if ($args->{'setkeys'}) {
14248: $cenv{'keyaccess'}='yes';
14249: }
14250: # if specified, key authority is not course, but user
14251: # only active if keyaccess is yes
14252: if ($args->{'keyauth'}) {
1.487 albertel 14253: my ($user,$domain) = split(':',$args->{'keyauth'});
14254: $user = &LONCAPA::clean_username($user);
14255: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14256: if ($user ne '' && $domain ne '') {
1.487 albertel 14257: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14258: }
14259: }
14260:
1.1166 raeburn 14261: #
1.1167 raeburn 14262: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14263: #
14264: if ($args->{'uniquecode'}) {
14265: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14266: if ($code) {
14267: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14268: my %crsinfo =
14269: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14270: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14271: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14272: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14273: }
1.1166 raeburn 14274: if (ref($coderef)) {
14275: $$coderef = $code;
14276: }
14277: }
14278: }
14279:
1.444 albertel 14280: if ($args->{'disresdis'}) {
14281: $cenv{'pch.roles.denied'}='st';
14282: }
14283: if ($args->{'disablechat'}) {
14284: $cenv{'plc.roles.denied'}='st';
14285: }
14286:
14287: # Record we've not yet viewed the Course Initialization Helper for this
14288: # course
14289: $cenv{'course.helper.not.run'} = 1;
14290: #
14291: # Use new Randomseed
14292: #
14293: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14294: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14295: #
14296: # The encryption code and receipt prefix for this course
14297: #
14298: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14299: $cenv{'internal.encpref'}=100+int(9*rand(99));
14300: #
14301: # By default, use standard grading
14302: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14303:
1.541 raeburn 14304: $outcome .= $linefeed.&mt('Setting environment').': '.
14305: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14306: #
14307: # Open all assignments
14308: #
14309: if ($args->{'openall'}) {
14310: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14311: my %storecontent = ($storeunder => time,
14312: $storeunder.'.type' => 'date_start');
14313:
14314: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14315: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14316: }
14317: #
14318: # Set first page
14319: #
14320: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14321: || ($cloneid)) {
1.445 albertel 14322: use LONCAPA::map;
1.444 albertel 14323: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14324:
14325: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14326: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14327:
1.444 albertel 14328: $outcome .= ($fatal?$errtext:'read ok').' - ';
14329: my $title; my $url;
14330: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14331: $title=&mt('Syllabus');
1.444 albertel 14332: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14333: } else {
1.963 raeburn 14334: $title=&mt('Table of Contents');
1.444 albertel 14335: $url='/adm/navmaps';
14336: }
1.445 albertel 14337:
14338: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14339: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14340:
14341: if ($errtext) { $fatal=2; }
1.541 raeburn 14342: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14343: }
1.566 albertel 14344:
14345: return (1,$outcome);
1.444 albertel 14346: }
14347:
1.1166 raeburn 14348: sub make_unique_code {
14349: my ($cdom,$cnum) = @_;
14350: # get lock on uniquecodes db
14351: my $lockhash = {
14352: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14353: ':'.$env{'user.domain'},
14354: };
14355: my $tries = 0;
14356: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14357: my ($code,$error);
14358:
14359: while (($gotlock ne 'ok') && ($tries<3)) {
14360: $tries ++;
14361: sleep 1;
14362: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14363: }
14364: if ($gotlock eq 'ok') {
14365: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14366: my $gotcode;
14367: my $attempts = 0;
14368: while ((!$gotcode) && ($attempts < 100)) {
14369: $code = &generate_code();
14370: if (!exists($currcodes{$code})) {
14371: $gotcode = 1;
14372: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14373: $error = 'nostore';
14374: }
14375: }
14376: $attempts ++;
14377: }
14378: my @del_lock = ($cnum."\0".'uniquecodes');
14379: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14380: } else {
14381: $error = 'nolock';
14382: }
14383: return ($code,$error);
14384: }
14385:
14386: sub generate_code {
14387: my $code;
14388: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14389: for (my $i=0; $i<6; $i++) {
14390: my $lettnum = int (rand 2);
14391: my $item = '';
14392: if ($lettnum) {
14393: $item = $letts[int( rand(18) )];
14394: } else {
14395: $item = 1+int( rand(8) );
14396: }
14397: $code .= $item;
14398: }
14399: return $code;
14400: }
14401:
1.444 albertel 14402: ############################################################
14403: ############################################################
14404:
1.953 droeschl 14405: #SD
14406: # only Community and Course, or anything else?
1.378 raeburn 14407: sub course_type {
14408: my ($cid) = @_;
14409: if (!defined($cid)) {
14410: $cid = $env{'request.course.id'};
14411: }
1.404 albertel 14412: if (defined($env{'course.'.$cid.'.type'})) {
14413: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14414: } else {
14415: return 'Course';
1.377 raeburn 14416: }
14417: }
1.156 albertel 14418:
1.406 raeburn 14419: sub group_term {
14420: my $crstype = &course_type();
14421: my %names = (
14422: 'Course' => 'group',
1.865 raeburn 14423: 'Community' => 'group',
1.406 raeburn 14424: );
14425: return $names{$crstype};
14426: }
14427:
1.902 raeburn 14428: sub course_types {
1.1165 raeburn 14429: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14430: my %typename = (
14431: official => 'Official course',
14432: unofficial => 'Unofficial course',
14433: community => 'Community',
1.1165 raeburn 14434: textbook => 'Textbook course',
1.902 raeburn 14435: );
14436: return (\@types,\%typename);
14437: }
14438:
1.156 albertel 14439: sub icon {
14440: my ($file)=@_;
1.505 albertel 14441: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14442: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14443: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14444: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14445: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14446: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14447: $curfext.".gif") {
14448: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14449: $curfext.".gif";
14450: }
14451: }
1.249 albertel 14452: return &lonhttpdurl($iconname);
1.154 albertel 14453: }
1.84 albertel 14454:
1.575 albertel 14455: sub lonhttpdurl {
1.692 www 14456: #
14457: # Had been used for "small fry" static images on separate port 8080.
14458: # Modify here if lightweight http functionality desired again.
14459: # Currently eliminated due to increasing firewall issues.
14460: #
1.575 albertel 14461: my ($url)=@_;
1.692 www 14462: return $url;
1.215 albertel 14463: }
14464:
1.213 albertel 14465: sub connection_aborted {
14466: my ($r)=@_;
14467: $r->print(" ");$r->rflush();
14468: my $c = $r->connection;
14469: return $c->aborted();
14470: }
14471:
1.221 foxr 14472: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14473: # strings as 'strings'.
14474: sub escape_single {
1.221 foxr 14475: my ($input) = @_;
1.223 albertel 14476: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14477: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14478: return $input;
14479: }
1.223 albertel 14480:
1.222 foxr 14481: # Same as escape_single, but escape's "'s This
14482: # can be used for "strings"
14483: sub escape_double {
14484: my ($input) = @_;
14485: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14486: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14487: return $input;
14488: }
1.223 albertel 14489:
1.222 foxr 14490: # Escapes the last element of a full URL.
14491: sub escape_url {
14492: my ($url) = @_;
1.238 raeburn 14493: my @urlslices = split(/\//, $url,-1);
1.369 www 14494: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 14495: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 14496: }
1.462 albertel 14497:
1.820 raeburn 14498: sub compare_arrays {
14499: my ($arrayref1,$arrayref2) = @_;
14500: my (@difference,%count);
14501: @difference = ();
14502: %count = ();
14503: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14504: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14505: foreach my $element (keys(%count)) {
14506: if ($count{$element} == 1) {
14507: push(@difference,$element);
14508: }
14509: }
14510: }
14511: return @difference;
14512: }
14513:
1.817 bisitz 14514: # -------------------------------------------------------- Initialize user login
1.462 albertel 14515: sub init_user_environment {
1.463 albertel 14516: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14517: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14518:
14519: my $public=($username eq 'public' && $domain eq 'public');
14520:
14521: # See if old ID present, if so, remove
14522:
1.1062 raeburn 14523: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14524: my $now=time;
14525:
14526: if ($public) {
14527: my $max_public=100;
14528: my $oldest;
14529: my $oldest_time=0;
14530: for(my $next=1;$next<=$max_public;$next++) {
14531: if (-e $lonids."/publicuser_$next.id") {
14532: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14533: if ($mtime<$oldest_time || !$oldest_time) {
14534: $oldest_time=$mtime;
14535: $oldest=$next;
14536: }
14537: } else {
14538: $cookie="publicuser_$next";
14539: last;
14540: }
14541: }
14542: if (!$cookie) { $cookie="publicuser_$oldest"; }
14543: } else {
1.463 albertel 14544: # if this isn't a robot, kill any existing non-robot sessions
14545: if (!$args->{'robot'}) {
14546: opendir(DIR,$lonids);
14547: while ($filename=readdir(DIR)) {
14548: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14549: unlink($lonids.'/'.$filename);
14550: }
1.462 albertel 14551: }
1.463 albertel 14552: closedir(DIR);
1.462 albertel 14553: }
14554: # Give them a new cookie
1.463 albertel 14555: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14556: : $now.$$.int(rand(10000)));
1.463 albertel 14557: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14558:
14559: # Initialize roles
14560:
1.1062 raeburn 14561: ($userroles,$firstaccenv,$timerintenv) =
14562: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14563: }
14564: # ------------------------------------ Check browser type and MathML capability
14565:
1.1194 raeburn 14566: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14567: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14568:
14569: # ------------------------------------------------------------- Get environment
14570:
14571: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14572: my ($tmp) = keys(%userenv);
14573: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14574: } else {
14575: undef(%userenv);
14576: }
14577: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14578: $form->{'interface'}=$userenv{'interface'};
14579: }
14580: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14581:
14582: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14583: foreach my $option ('interface','localpath','localres') {
14584: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14585: }
14586: # --------------------------------------------------------- Write first profile
14587:
14588: {
14589: my %initial_env =
14590: ("user.name" => $username,
14591: "user.domain" => $domain,
14592: "user.home" => $authhost,
14593: "browser.type" => $clientbrowser,
14594: "browser.version" => $clientversion,
14595: "browser.mathml" => $clientmathml,
14596: "browser.unicode" => $clientunicode,
14597: "browser.os" => $clientos,
1.1137 raeburn 14598: "browser.mobile" => $clientmobile,
1.1141 raeburn 14599: "browser.info" => $clientinfo,
1.1194 raeburn 14600: "browser.osversion" => $clientosversion,
1.462 albertel 14601: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14602: "request.course.fn" => '',
14603: "request.course.uri" => '',
14604: "request.course.sec" => '',
14605: "request.role" => 'cm',
14606: "request.role.adv" => $env{'user.adv'},
14607: "request.host" => $ENV{'REMOTE_ADDR'},);
14608:
14609: if ($form->{'localpath'}) {
14610: $initial_env{"browser.localpath"} = $form->{'localpath'};
14611: $initial_env{"browser.localres"} = $form->{'localres'};
14612: }
14613:
14614: if ($form->{'interface'}) {
14615: $form->{'interface'}=~s/\W//gs;
14616: $initial_env{"browser.interface"} = $form->{'interface'};
14617: $env{'browser.interface'}=$form->{'interface'};
14618: }
14619:
1.1157 raeburn 14620: if ($form->{'iptoken'}) {
14621: my $lonhost = $r->dir_config('lonHostID');
14622: $initial_env{"user.noloadbalance"} = $lonhost;
14623: $env{'user.noloadbalance'} = $lonhost;
14624: }
14625:
1.981 raeburn 14626: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14627: my %domdef;
14628: unless ($domain eq 'public') {
14629: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14630: }
1.980 raeburn 14631:
1.1081 raeburn 14632: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14633: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14634: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14635: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14636: }
14637:
1.1165 raeburn 14638: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14639: $userenv{'canrequest.'.$crstype} =
14640: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14641: 'reload','requestcourses',
14642: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14643: }
14644:
1.1092 raeburn 14645: $userenv{'canrequest.author'} =
14646: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14647: 'reload','requestauthor',
14648: \%userenv,\%domdef,\%is_adv);
14649: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14650: $domain,$username);
14651: my $reqstatus = $reqauthor{'author_status'};
14652: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14653: if (ref($reqauthor{'author'}) eq 'HASH') {
14654: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14655: $reqauthor{'author'}{'timestamp'};
14656: }
14657: }
14658:
1.462 albertel 14659: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14660:
1.462 albertel 14661: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14662: &GDBM_WRCREAT(),0640)) {
14663: &_add_to_env(\%disk_env,\%initial_env);
14664: &_add_to_env(\%disk_env,\%userenv,'environment.');
14665: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14666: if (ref($firstaccenv) eq 'HASH') {
14667: &_add_to_env(\%disk_env,$firstaccenv);
14668: }
14669: if (ref($timerintenv) eq 'HASH') {
14670: &_add_to_env(\%disk_env,$timerintenv);
14671: }
1.463 albertel 14672: if (ref($args->{'extra_env'})) {
14673: &_add_to_env(\%disk_env,$args->{'extra_env'});
14674: }
1.462 albertel 14675: untie(%disk_env);
14676: } else {
1.705 tempelho 14677: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14678: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14679: return 'error: '.$!;
14680: }
14681: }
14682: $env{'request.role'}='cm';
14683: $env{'request.role.adv'}=$env{'user.adv'};
14684: $env{'browser.type'}=$clientbrowser;
14685:
14686: return $cookie;
14687:
14688: }
14689:
14690: sub _add_to_env {
14691: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14692: if (ref($env_data) eq 'HASH') {
14693: while (my ($key,$value) = each(%$env_data)) {
14694: $idf->{$prefix.$key} = $value;
14695: $env{$prefix.$key} = $value;
14696: }
1.462 albertel 14697: }
14698: }
14699:
1.685 tempelho 14700: # --- Get the symbolic name of a problem and the url
14701: sub get_symb {
14702: my ($request,$silent) = @_;
1.726 raeburn 14703: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14704: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14705: if ($symb eq '') {
14706: if (!$silent) {
1.1071 raeburn 14707: if (ref($request)) {
14708: $request->print("Unable to handle ambiguous references:$url:.");
14709: }
1.685 tempelho 14710: return ();
14711: }
14712: }
14713: &Apache::lonenc::check_decrypt(\$symb);
14714: return ($symb);
14715: }
14716:
14717: # --------------------------------------------------------------Get annotation
14718:
14719: sub get_annotation {
14720: my ($symb,$enc) = @_;
14721:
14722: my $key = $symb;
14723: if (!$enc) {
14724: $key =
14725: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14726: }
14727: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14728: return $annotation{$key};
14729: }
14730:
14731: sub clean_symb {
1.731 raeburn 14732: my ($symb,$delete_enc) = @_;
1.685 tempelho 14733:
14734: &Apache::lonenc::check_decrypt(\$symb);
14735: my $enc = $env{'request.enc'};
1.731 raeburn 14736: if ($delete_enc) {
1.730 raeburn 14737: delete($env{'request.enc'});
14738: }
1.685 tempelho 14739:
14740: return ($symb,$enc);
14741: }
1.462 albertel 14742:
1.1181 raeburn 14743: ############################################################
14744: ############################################################
14745:
14746: =pod
14747:
14748: =head1 Routines for building display used to search for courses
14749:
14750:
14751: =over 4
14752:
14753: =item * &build_filters()
14754:
14755: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 14756: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14757: and quotacheck.pl
14758:
1.1181 raeburn 14759:
14760: Inputs:
14761:
14762: filterlist - anonymous array of fields to include as potential filters
14763:
14764: crstype - course type
14765:
14766: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14767: to pop-open a course selector (will contain "extra element").
14768:
14769: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14770:
14771: filter - anonymous hash of criteria and their values
14772:
14773: action - form action
14774:
14775: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14776:
1.1182 raeburn 14777: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 14778:
14779: cloneruname - username of owner of new course who wants to clone
14780:
14781: clonerudom - domain of owner of new course who wants to clone
14782:
14783: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14784:
14785: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14786:
14787: codedom - domain
14788:
14789: formname - value of form element named "form".
14790:
14791: fixeddom - domain, if fixed.
14792:
14793: prevphase - value to assign to form element named "phase" when going back to the previous screen
14794:
14795: cnameelement - name of form element in form on opener page which will receive title of selected course
14796:
14797: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14798:
14799: cdomelement - name of form element in form on opener page which will receive domain of selected course
14800:
14801: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14802:
14803: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14804:
14805: clonewarning - warning message about missing information for intended course owner when DC creates a course
14806:
1.1182 raeburn 14807:
1.1181 raeburn 14808: Returns: $output - HTML for display of search criteria, and hidden form elements.
14809:
1.1182 raeburn 14810:
1.1181 raeburn 14811: Side Effects: None
14812:
14813: =cut
14814:
14815: # ---------------------------------------------- search for courses based on last activity etc.
14816:
14817: sub build_filters {
14818: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14819: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14820: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14821: $cnameelement,$cnumelement,$cdomelement,$setroles,
14822: $clonetext,$clonewarning) = @_;
1.1182 raeburn 14823: my ($list,$jscript);
1.1181 raeburn 14824: my $onchange = 'javascript:updateFilters(this)';
14825: my ($domainselectform,$sincefilterform,$createdfilterform,
14826: $ownerdomselectform,$persondomselectform,$instcodeform,
14827: $typeselectform,$instcodetitle);
14828: if ($formname eq '') {
14829: $formname = $caller;
14830: }
14831: foreach my $item (@{$filterlist}) {
14832: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
14833: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
14834: if ($item eq 'domainfilter') {
14835: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
14836: } elsif ($item eq 'coursefilter') {
14837: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
14838: } elsif ($item eq 'ownerfilter') {
14839: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14840: } elsif ($item eq 'ownerdomfilter') {
14841: $filter->{'ownerdomfilter'} =
14842: &LONCAPA::clean_domain($filter->{$item});
14843: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
14844: 'ownerdomfilter',1);
14845: } elsif ($item eq 'personfilter') {
14846: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14847: } elsif ($item eq 'persondomfilter') {
14848: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
14849: 'persondomfilter',1);
14850: } else {
14851: $filter->{$item} =~ s/\W//g;
14852: }
14853: if (!$filter->{$item}) {
14854: $filter->{$item} = '';
14855: }
14856: }
14857: if ($item eq 'domainfilter') {
14858: my $allow_blank = 1;
14859: if ($formname eq 'portform') {
14860: $allow_blank=0;
14861: } elsif ($formname eq 'studentform') {
14862: $allow_blank=0;
14863: }
14864: if ($fixeddom) {
14865: $domainselectform = '<input type="hidden" name="domainfilter"'.
14866: ' value="'.$codedom.'" />'.
14867: &Apache::lonnet::domain($codedom,'description');
14868: } else {
14869: $domainselectform = &select_dom_form($filter->{$item},
14870: 'domainfilter',
14871: $allow_blank,'',$onchange);
14872: }
14873: } else {
14874: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
14875: }
14876: }
14877:
14878: # last course activity filter and selection
14879: $sincefilterform = &timebased_select_form('sincefilter',$filter);
14880:
14881: # course created filter and selection
14882: if (exists($filter->{'createdfilter'})) {
14883: $createdfilterform = &timebased_select_form('createdfilter',$filter);
14884: }
14885:
14886: my %lt = &Apache::lonlocal::texthash(
14887: 'cac' => "$crstype Activity",
14888: 'ccr' => "$crstype Created",
14889: 'cde' => "$crstype Title",
14890: 'cdo' => "$crstype Domain",
14891: 'ins' => 'Institutional Code',
14892: 'inc' => 'Institutional Categorization',
14893: 'cow' => "$crstype Owner/Co-owner",
14894: 'cop' => "$crstype Personnel Includes",
14895: 'cog' => 'Type',
14896: );
14897:
14898: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
14899: my $typeval = 'Course';
14900: if ($crstype eq 'Community') {
14901: $typeval = 'Community';
14902: }
14903: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
14904: } else {
14905: $typeselectform = '<select name="type" size="1"';
14906: if ($onchange) {
14907: $typeselectform .= ' onchange="'.$onchange.'"';
14908: }
14909: $typeselectform .= '>'."\n";
14910: foreach my $posstype ('Course','Community') {
14911: $typeselectform.='<option value="'.$posstype.'"'.
14912: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
14913: }
14914: $typeselectform.="</select>";
14915: }
14916:
14917: my ($cloneableonlyform,$cloneabletitle);
14918: if (exists($filter->{'cloneableonly'})) {
14919: my $cloneableon = '';
14920: my $cloneableoff = ' checked="checked"';
14921: if ($filter->{'cloneableonly'}) {
14922: $cloneableon = $cloneableoff;
14923: $cloneableoff = '';
14924: }
14925: $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>';
14926: if ($formname eq 'ccrs') {
1.1187 bisitz 14927: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 14928: } else {
14929: $cloneabletitle = &mt('Cloneable by you');
14930: }
14931: }
14932: my $officialjs;
14933: if ($crstype eq 'Course') {
14934: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 14935: # if (($fixeddom) || ($formname eq 'requestcrs') ||
14936: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
14937: if ($codedom) {
1.1181 raeburn 14938: $officialjs = 1;
14939: ($instcodeform,$jscript,$$numtitlesref) =
14940: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
14941: $officialjs,$codetitlesref);
14942: if ($jscript) {
1.1182 raeburn 14943: $jscript = '<script type="text/javascript">'."\n".
14944: '// <![CDATA['."\n".
14945: $jscript."\n".
14946: '// ]]>'."\n".
14947: '</script>'."\n";
1.1181 raeburn 14948: }
14949: }
14950: if ($instcodeform eq '') {
14951: $instcodeform =
14952: '<input type="text" name="instcodefilter" size="10" value="'.
14953: $list->{'instcodefilter'}.'" />';
14954: $instcodetitle = $lt{'ins'};
14955: } else {
14956: $instcodetitle = $lt{'inc'};
14957: }
14958: if ($fixeddom) {
14959: $instcodetitle .= '<br />('.$codedom.')';
14960: }
14961: }
14962: }
14963: my $output = qq|
14964: <form method="post" name="filterpicker" action="$action">
14965: <input type="hidden" name="form" value="$formname" />
14966: |;
14967: if ($formname eq 'modifycourse') {
14968: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
14969: '<input type="hidden" name="prevphase" value="'.
14970: $prevphase.'" />'."\n";
1.1198 ! musolffc 14971: } elsif ($formname eq 'quotacheck') {
! 14972: $output .= qq|
! 14973: <input type="hidden" name="sortby" value="" />
! 14974: <input type="hidden" name="sortorder" value="" />
! 14975: |;
! 14976: } else {
1.1181 raeburn 14977: my $name_input;
14978: if ($cnameelement ne '') {
14979: $name_input = '<input type="hidden" name="cnameelement" value="'.
14980: $cnameelement.'" />';
14981: }
14982: $output .= qq|
1.1182 raeburn 14983: <input type="hidden" name="cnumelement" value="$cnumelement" />
14984: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 14985: $name_input
14986: $roleelement
14987: $multelement
14988: $typeelement
14989: |;
14990: if ($formname eq 'portform') {
14991: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
14992: }
14993: }
14994: if ($fixeddom) {
14995: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
14996: }
14997: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
14998: if ($sincefilterform) {
14999: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15000: .$sincefilterform
15001: .&Apache::lonhtmlcommon::row_closure();
15002: }
15003: if ($createdfilterform) {
15004: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15005: .$createdfilterform
15006: .&Apache::lonhtmlcommon::row_closure();
15007: }
15008: if ($domainselectform) {
15009: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15010: .$domainselectform
15011: .&Apache::lonhtmlcommon::row_closure();
15012: }
15013: if ($typeselectform) {
15014: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15015: $output .= $typeselectform;
15016: } else {
15017: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15018: .$typeselectform
15019: .&Apache::lonhtmlcommon::row_closure();
15020: }
15021: }
15022: if ($instcodeform) {
15023: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15024: .$instcodeform
15025: .&Apache::lonhtmlcommon::row_closure();
15026: }
15027: if (exists($filter->{'ownerfilter'})) {
15028: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15029: '<table><tr><td>'.&mt('Username').'<br />'.
15030: '<input type="text" name="ownerfilter" size="20" value="'.
15031: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15032: $ownerdomselectform.'</td></tr></table>'.
15033: &Apache::lonhtmlcommon::row_closure();
15034: }
15035: if (exists($filter->{'personfilter'})) {
15036: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15037: '<table><tr><td>'.&mt('Username').'<br />'.
15038: '<input type="text" name="personfilter" size="20" value="'.
15039: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15040: $persondomselectform.'</td></tr></table>'.
15041: &Apache::lonhtmlcommon::row_closure();
15042: }
15043: if (exists($filter->{'coursefilter'})) {
15044: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15045: .'<input type="text" name="coursefilter" size="25" value="'
15046: .$list->{'coursefilter'}.'" />'
15047: .&Apache::lonhtmlcommon::row_closure();
15048: }
15049: if ($cloneableonlyform) {
15050: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15051: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15052: }
15053: if (exists($filter->{'descriptfilter'})) {
15054: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15055: .'<input type="text" name="descriptfilter" size="40" value="'
15056: .$list->{'descriptfilter'}.'" />'
15057: .&Apache::lonhtmlcommon::row_closure(1);
15058: }
15059: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15060: '<input type="hidden" name="updater" value="" />'."\n".
15061: '<input type="submit" name="gosearch" value="'.
15062: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15063: return $jscript.$clonewarning.$output;
15064: }
15065:
15066: =pod
15067:
15068: =item * &timebased_select_form()
15069:
1.1182 raeburn 15070: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15071: filter e.g., Course Activity, Course Created, when searching for courses
15072: or communities
15073:
15074: Inputs:
15075:
15076: item - name of form element (sincefilter or createdfilter)
15077:
15078: filter - anonymous hash of criteria and their values
15079:
15080: Returns: HTML for a select box contained a blank, then six time selections,
15081: with value set in incoming form variables currently selected.
15082:
15083: Side Effects: None
15084:
15085: =cut
15086:
15087: sub timebased_select_form {
15088: my ($item,$filter) = @_;
15089: if (ref($filter) eq 'HASH') {
15090: $filter->{$item} =~ s/[^\d-]//g;
15091: if (!$filter->{$item}) { $filter->{$item}=-1; }
15092: return &select_form(
15093: $filter->{$item},
15094: $item,
15095: { '-1' => '',
15096: '86400' => &mt('today'),
15097: '604800' => &mt('last week'),
15098: '2592000' => &mt('last month'),
15099: '7776000' => &mt('last three months'),
15100: '15552000' => &mt('last six months'),
15101: '31104000' => &mt('last year'),
15102: 'select_form_order' =>
15103: ['-1','86400','604800','2592000','7776000',
15104: '15552000','31104000']});
15105: }
15106: }
15107:
15108: =pod
15109:
15110: =item * &js_changer()
15111:
15112: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15113: when course type or domain is changed, and also to hide 'Searching ...' on
15114: page load completion for page showing search result.
1.1181 raeburn 15115:
15116: Inputs: None
15117:
1.1183 raeburn 15118: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15119:
15120: Side Effects: None
15121:
15122: =cut
15123:
15124: sub js_changer {
15125: return <<ENDJS;
15126: <script type="text/javascript">
15127: // <![CDATA[
15128: function updateFilters(caller) {
15129: if (typeof(caller) != "undefined") {
15130: document.filterpicker.updater.value = caller.name;
15131: }
15132: document.filterpicker.submit();
15133: }
1.1183 raeburn 15134:
15135: function hideSearching() {
15136: if (document.getElementById('searching')) {
15137: document.getElementById('searching').style.display = 'none';
15138: }
15139: return;
15140: }
15141:
1.1181 raeburn 15142: // ]]>
15143: </script>
15144:
15145: ENDJS
15146: }
15147:
15148: =pod
15149:
1.1182 raeburn 15150: =item * &search_courses()
15151:
15152: Process selected filters form course search form and pass to lonnet::courseiddump
15153: to retrieve a hash for which keys are courseIDs which match the selected filters.
15154:
15155: Inputs:
15156:
15157: dom - domain being searched
15158:
15159: type - course type ('Course' or 'Community' or '.' if any).
15160:
15161: filter - anonymous hash of criteria and their values
15162:
15163: numtitles - for institutional codes - number of categories
15164:
15165: cloneruname - optional username of new course owner
15166:
15167: clonerudom - optional domain of new course owner
15168:
15169: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15170: (used when DC is using course creation form)
15171:
15172: codetitles - reference to array of titles of components in institutional codes (official courses).
15173:
15174:
15175: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15176:
15177:
15178: Side Effects: None
15179:
15180: =cut
15181:
15182:
15183: sub search_courses {
15184: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15185: my (%courses,%showcourses,$cloner);
15186: if (($filter->{'ownerfilter'} ne '') ||
15187: ($filter->{'ownerdomfilter'} ne '')) {
15188: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15189: $filter->{'ownerdomfilter'};
15190: }
15191: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15192: if (!$filter->{$item}) {
15193: $filter->{$item}='.';
15194: }
15195: }
15196: my $now = time;
15197: my $timefilter =
15198: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15199: my ($createdbefore,$createdafter);
15200: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15201: $createdbefore = $now;
15202: $createdafter = $now-$filter->{'createdfilter'};
15203: }
15204: my ($instcodefilter,$regexpok);
15205: if ($numtitles) {
15206: if ($env{'form.official'} eq 'on') {
15207: $instcodefilter =
15208: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15209: $regexpok = 1;
15210: } elsif ($env{'form.official'} eq 'off') {
15211: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15212: unless ($instcodefilter eq '') {
15213: $regexpok = -1;
15214: }
15215: }
15216: } else {
15217: $instcodefilter = $filter->{'instcodefilter'};
15218: }
15219: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15220: if ($type eq '') { $type = '.'; }
15221:
15222: if (($clonerudom ne '') && ($cloneruname ne '')) {
15223: $cloner = $cloneruname.':'.$clonerudom;
15224: }
15225: %courses = &Apache::lonnet::courseiddump($dom,
15226: $filter->{'descriptfilter'},
15227: $timefilter,
15228: $instcodefilter,
15229: $filter->{'combownerfilter'},
15230: $filter->{'coursefilter'},
15231: undef,undef,$type,$regexpok,undef,undef,
15232: undef,undef,$cloner,$env{'form.cc_clone'},
15233: $filter->{'cloneableonly'},
15234: $createdbefore,$createdafter,undef,
15235: $domcloner);
15236: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15237: my $ccrole;
15238: if ($type eq 'Community') {
15239: $ccrole = 'co';
15240: } else {
15241: $ccrole = 'cc';
15242: }
15243: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15244: $filter->{'persondomfilter'},
15245: 'userroles',undef,
15246: [$ccrole,'in','ad','ep','ta','cr'],
15247: $dom);
15248: foreach my $role (keys(%rolehash)) {
15249: my ($cnum,$cdom,$courserole) = split(':',$role);
15250: my $cid = $cdom.'_'.$cnum;
15251: if (exists($courses{$cid})) {
15252: if (ref($courses{$cid}) eq 'HASH') {
15253: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15254: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15255: push (@{$courses{$cid}{roles}},$courserole);
15256: }
15257: } else {
15258: $courses{$cid}{roles} = [$courserole];
15259: }
15260: $showcourses{$cid} = $courses{$cid};
15261: }
15262: }
15263: }
15264: %courses = %showcourses;
15265: }
15266: return %courses;
15267: }
15268:
15269:
15270: =pod
15271:
1.1181 raeburn 15272: =back
15273:
15274: =cut
15275:
15276:
1.1083 raeburn 15277: sub update_content_constraints {
15278: my ($cdom,$cnum,$chome,$cid) = @_;
15279: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15280: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15281: my %checkresponsetypes;
15282: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15283: my ($item,$name,$value) = split(/:/,$key);
15284: if ($item eq 'resourcetag') {
15285: if ($name eq 'responsetype') {
15286: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15287: }
15288: }
15289: }
15290: my $navmap = Apache::lonnavmaps::navmap->new();
15291: if (defined($navmap)) {
15292: my %allresponses;
15293: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15294: my %responses = $res->responseTypes();
15295: foreach my $key (keys(%responses)) {
15296: next unless(exists($checkresponsetypes{$key}));
15297: $allresponses{$key} += $responses{$key};
15298: }
15299: }
15300: foreach my $key (keys(%allresponses)) {
15301: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15302: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15303: ($reqdmajor,$reqdminor) = ($major,$minor);
15304: }
15305: }
15306: undef($navmap);
15307: }
15308: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15309: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15310: }
15311: return;
15312: }
15313:
1.1110 raeburn 15314: sub allmaps_incourse {
15315: my ($cdom,$cnum,$chome,$cid) = @_;
15316: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15317: $cid = $env{'request.course.id'};
15318: $cdom = $env{'course.'.$cid.'.domain'};
15319: $cnum = $env{'course.'.$cid.'.num'};
15320: $chome = $env{'course.'.$cid.'.home'};
15321: }
15322: my %allmaps = ();
15323: my $lastchange =
15324: &Apache::lonnet::get_coursechange($cdom,$cnum);
15325: if ($lastchange > $env{'request.course.tied'}) {
15326: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15327: unless ($ferr) {
15328: &update_content_constraints($cdom,$cnum,$chome,$cid);
15329: }
15330: }
15331: my $navmap = Apache::lonnavmaps::navmap->new();
15332: if (defined($navmap)) {
15333: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15334: $allmaps{$res->src()} = 1;
15335: }
15336: }
15337: return \%allmaps;
15338: }
15339:
1.1083 raeburn 15340: sub parse_supplemental_title {
15341: my ($title) = @_;
15342:
15343: my ($foldertitle,$renametitle);
15344: if ($title =~ /&&&/) {
15345: $title = &HTML::Entites::decode($title);
15346: }
15347: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15348: $renametitle=$4;
15349: my ($time,$uname,$udom) = ($1,$2,$3);
15350: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15351: my $name = &plainname($uname,$udom);
15352: $name = &HTML::Entities::encode($name,'"<>&\'');
15353: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15354: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15355: $name.': <br />'.$foldertitle;
15356: }
15357: if (wantarray) {
15358: return ($title,$foldertitle,$renametitle);
15359: }
15360: return $title;
15361: }
15362:
1.1143 raeburn 15363: sub recurse_supplemental {
15364: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15365: if ($suppmap) {
15366: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15367: if ($fatal) {
15368: $errors ++;
15369: } else {
15370: if ($#LONCAPA::map::resources > 0) {
15371: foreach my $res (@LONCAPA::map::resources) {
15372: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15373: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 15374: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15375: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 15376: } else {
15377: $numfiles ++;
15378: }
15379: }
15380: }
15381: }
15382: }
15383: }
15384: return ($numfiles,$errors);
15385: }
15386:
1.1101 raeburn 15387: sub symb_to_docspath {
15388: my ($symb) = @_;
15389: return unless ($symb);
15390: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15391: if ($resurl=~/\.(sequence|page)$/) {
15392: $mapurl=$resurl;
15393: } elsif ($resurl eq 'adm/navmaps') {
15394: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15395: }
15396: my $mapresobj;
15397: my $navmap = Apache::lonnavmaps::navmap->new();
15398: if (ref($navmap)) {
15399: $mapresobj = $navmap->getResourceByUrl($mapurl);
15400: }
15401: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15402: my $type=$2;
15403: my $path;
15404: if (ref($mapresobj)) {
15405: my $pcslist = $mapresobj->map_hierarchy();
15406: if ($pcslist ne '') {
15407: foreach my $pc (split(/,/,$pcslist)) {
15408: next if ($pc <= 1);
15409: my $res = $navmap->getByMapPc($pc);
15410: if (ref($res)) {
15411: my $thisurl = $res->src();
15412: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15413: my $thistitle = $res->title();
15414: $path .= '&'.
15415: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 15416: &escape($thistitle).
1.1101 raeburn 15417: ':'.$res->randompick().
15418: ':'.$res->randomout().
15419: ':'.$res->encrypted().
15420: ':'.$res->randomorder().
15421: ':'.$res->is_page();
15422: }
15423: }
15424: }
15425: $path =~ s/^\&//;
15426: my $maptitle = $mapresobj->title();
15427: if ($mapurl eq 'default') {
1.1129 raeburn 15428: $maptitle = 'Main Content';
1.1101 raeburn 15429: }
15430: $path .= (($path ne '')? '&' : '').
15431: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15432: &escape($maptitle).
1.1101 raeburn 15433: ':'.$mapresobj->randompick().
15434: ':'.$mapresobj->randomout().
15435: ':'.$mapresobj->encrypted().
15436: ':'.$mapresobj->randomorder().
15437: ':'.$mapresobj->is_page();
15438: } else {
15439: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15440: my $ispage = (($type eq 'page')? 1 : '');
15441: if ($mapurl eq 'default') {
1.1129 raeburn 15442: $maptitle = 'Main Content';
1.1101 raeburn 15443: }
15444: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15445: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 15446: }
15447: unless ($mapurl eq 'default') {
15448: $path = 'default&'.
1.1146 raeburn 15449: &escape('Main Content').
1.1101 raeburn 15450: ':::::&'.$path;
15451: }
15452: return $path;
15453: }
15454:
1.1094 raeburn 15455: sub captcha_display {
15456: my ($context,$lonhost) = @_;
15457: my ($output,$error);
15458: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15459: if ($captcha eq 'original') {
1.1094 raeburn 15460: $output = &create_captcha();
15461: unless ($output) {
1.1172 raeburn 15462: $error = 'captcha';
1.1094 raeburn 15463: }
15464: } elsif ($captcha eq 'recaptcha') {
15465: $output = &create_recaptcha($pubkey);
15466: unless ($output) {
1.1172 raeburn 15467: $error = 'recaptcha';
1.1094 raeburn 15468: }
15469: }
1.1176 raeburn 15470: return ($output,$error,$captcha);
1.1094 raeburn 15471: }
15472:
15473: sub captcha_response {
15474: my ($context,$lonhost) = @_;
15475: my ($captcha_chk,$captcha_error);
15476: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15477: if ($captcha eq 'original') {
1.1094 raeburn 15478: ($captcha_chk,$captcha_error) = &check_captcha();
15479: } elsif ($captcha eq 'recaptcha') {
15480: $captcha_chk = &check_recaptcha($privkey);
15481: } else {
15482: $captcha_chk = 1;
15483: }
15484: return ($captcha_chk,$captcha_error);
15485: }
15486:
15487: sub get_captcha_config {
15488: my ($context,$lonhost) = @_;
1.1095 raeburn 15489: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 15490: my $hostname = &Apache::lonnet::hostname($lonhost);
15491: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15492: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 15493: if ($context eq 'usercreation') {
15494: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15495: if (ref($domconfig{$context}) eq 'HASH') {
15496: $hashtocheck = $domconfig{$context}{'cancreate'};
15497: if (ref($hashtocheck) eq 'HASH') {
15498: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15499: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15500: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15501: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15502: }
15503: if ($privkey && $pubkey) {
15504: $captcha = 'recaptcha';
15505: } else {
15506: $captcha = 'original';
15507: }
15508: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15509: $captcha = 'original';
15510: }
1.1094 raeburn 15511: }
1.1095 raeburn 15512: } else {
15513: $captcha = 'captcha';
15514: }
15515: } elsif ($context eq 'login') {
15516: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15517: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15518: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15519: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 15520: if ($privkey && $pubkey) {
15521: $captcha = 'recaptcha';
1.1095 raeburn 15522: } else {
15523: $captcha = 'original';
1.1094 raeburn 15524: }
1.1095 raeburn 15525: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15526: $captcha = 'original';
1.1094 raeburn 15527: }
15528: }
15529: return ($captcha,$pubkey,$privkey);
15530: }
15531:
15532: sub create_captcha {
15533: my %captcha_params = &captcha_settings();
15534: my ($output,$maxtries,$tries) = ('',10,0);
15535: while ($tries < $maxtries) {
15536: $tries ++;
15537: my $captcha = Authen::Captcha->new (
15538: output_folder => $captcha_params{'output_dir'},
15539: data_folder => $captcha_params{'db_dir'},
15540: );
15541: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15542:
15543: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15544: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15545: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 15546: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15547: '<br />'.
15548: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 15549: last;
15550: }
15551: }
15552: return $output;
15553: }
15554:
15555: sub captcha_settings {
15556: my %captcha_params = (
15557: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15558: www_output_dir => "/captchaspool",
15559: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15560: numchars => '5',
15561: );
15562: return %captcha_params;
15563: }
15564:
15565: sub check_captcha {
15566: my ($captcha_chk,$captcha_error);
15567: my $code = $env{'form.code'};
15568: my $md5sum = $env{'form.crypt'};
15569: my %captcha_params = &captcha_settings();
15570: my $captcha = Authen::Captcha->new(
15571: output_folder => $captcha_params{'output_dir'},
15572: data_folder => $captcha_params{'db_dir'},
15573: );
1.1109 raeburn 15574: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 15575: my %captcha_hash = (
15576: 0 => 'Code not checked (file error)',
15577: -1 => 'Failed: code expired',
15578: -2 => 'Failed: invalid code (not in database)',
15579: -3 => 'Failed: invalid code (code does not match crypt)',
15580: );
15581: if ($captcha_chk != 1) {
15582: $captcha_error = $captcha_hash{$captcha_chk}
15583: }
15584: return ($captcha_chk,$captcha_error);
15585: }
15586:
15587: sub create_recaptcha {
15588: my ($pubkey) = @_;
1.1153 raeburn 15589: my $use_ssl;
15590: if ($ENV{'SERVER_PORT'} == 443) {
15591: $use_ssl = 1;
15592: }
1.1094 raeburn 15593: my $captcha = Captcha::reCAPTCHA->new;
15594: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 15595: $captcha->get_html($pubkey,undef,$use_ssl).
1.1094 raeburn 15596: &mt('If either word is hard to read, [_1] will replace them.',
1.1133 raeburn 15597: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 15598: '<br /><br />';
15599: }
15600:
15601: sub check_recaptcha {
15602: my ($privkey) = @_;
15603: my $captcha_chk;
15604: my $captcha = Captcha::reCAPTCHA->new;
15605: my $captcha_result =
15606: $captcha->check_answer(
15607: $privkey,
15608: $ENV{'REMOTE_ADDR'},
15609: $env{'form.recaptcha_challenge_field'},
15610: $env{'form.recaptcha_response_field'},
15611: );
15612: if ($captcha_result->{is_valid}) {
15613: $captcha_chk = 1;
15614: }
15615: return $captcha_chk;
15616: }
15617:
1.1174 raeburn 15618: sub emailusername_info {
1.1177 raeburn 15619: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 15620: my %titles = &Apache::lonlocal::texthash (
15621: lastname => 'Last Name',
15622: firstname => 'First Name',
15623: institution => 'School/college/university',
15624: location => "School's city, state/province, country",
15625: web => "School's web address",
15626: officialemail => 'E-mail address at institution (if different)',
15627: );
15628: return (\@fields,\%titles);
15629: }
15630:
1.1161 raeburn 15631: sub cleanup_html {
15632: my ($incoming) = @_;
15633: my $outgoing;
15634: if ($incoming ne '') {
15635: $outgoing = $incoming;
15636: $outgoing =~ s/;/;/g;
15637: $outgoing =~ s/\#/#/g;
15638: $outgoing =~ s/\&/&/g;
15639: $outgoing =~ s/</</g;
15640: $outgoing =~ s/>/>/g;
15641: $outgoing =~ s/\(/(/g;
15642: $outgoing =~ s/\)/)/g;
15643: $outgoing =~ s/"/"/g;
15644: $outgoing =~ s/'/'/g;
15645: $outgoing =~ s/\$/$/g;
15646: $outgoing =~ s{/}{/}g;
15647: $outgoing =~ s/=/=/g;
15648: $outgoing =~ s/\\/\/g
15649: }
15650: return $outgoing;
15651: }
15652:
1.1190 musolffc 15653: # Checks for critical messages and returns a redirect url if one exists.
15654: # $interval indicates how often to check for messages.
15655: sub critical_redirect {
15656: my ($interval) = @_;
15657: if ((time-$env{'user.criticalcheck.time'})>$interval) {
15658: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
15659: $env{'user.name'});
15660: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 15661: my $redirecturl;
1.1190 musolffc 15662: if ($what[0]) {
15663: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
15664: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 15665: my $url=&Apache::lonnet::absolute_url().$redirecturl;
15666: return (1, $url);
1.1190 musolffc 15667: }
1.1191 raeburn 15668: }
15669: }
15670: return ();
1.1190 musolffc 15671: }
15672:
1.1174 raeburn 15673: # Use:
15674: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
15675: #
15676: ##################################################
15677: # password associated functions #
15678: ##################################################
15679: sub des_keys {
15680: # Make a new key for DES encryption.
15681: # Each key has two parts which are returned separately.
15682: # Please note: Each key must be passed through the &hex function
15683: # before it is output to the web browser. The hex versions cannot
15684: # be used to decrypt.
15685: my @hexstr=('0','1','2','3','4','5','6','7',
15686: '8','9','a','b','c','d','e','f');
15687: my $lkey='';
15688: for (0..7) {
15689: $lkey.=$hexstr[rand(15)];
15690: }
15691: my $ukey='';
15692: for (0..7) {
15693: $ukey.=$hexstr[rand(15)];
15694: }
15695: return ($lkey,$ukey);
15696: }
15697:
15698: sub des_decrypt {
15699: my ($key,$cyphertext) = @_;
15700: my $keybin=pack("H16",$key);
15701: my $cypher;
15702: if ($Crypt::DES::VERSION>=2.03) {
15703: $cypher=new Crypt::DES $keybin;
15704: } else {
15705: $cypher=new DES $keybin;
15706: }
15707: my $plaintext=
15708: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
15709: $plaintext.=
15710: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
15711: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
15712: return $plaintext;
15713: }
15714:
1.112 bowersj2 15715: 1;
15716: __END__;
1.41 ng 15717:
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