Annotation of loncom/interface/loncommon.pm, revision 1.1200
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1200 ! raeburn 4: # $Id: loncommon.pm,v 1.1199 2014/11/08 18:26:06 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.1199 raeburn 3764: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3765:
3766: Return string with previous attempt on problem. Arguments:
3767:
3768: =over 4
3769:
3770: =item * $symb: Problem, including path
3771:
3772: =item * $username: username of the desired student
3773:
3774: =item * $domain: domain of the desired student
1.14 harris41 3775:
1.112 bowersj2 3776: =item * $course: Course ID
1.14 harris41 3777:
1.112 bowersj2 3778: =item * $getattempt: Leave blank for all attempts, otherwise put
3779: something
1.14 harris41 3780:
1.112 bowersj2 3781: =item * $regexp: if string matches this regexp, the string will be
3782: sent to $gradesub
1.14 harris41 3783:
1.112 bowersj2 3784: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3785:
1.1199 raeburn 3786: =item * $usec: section of the desired student
3787:
3788: =item * $identifier: counter for student (multiple students one problem) or
3789: problem (one student; whole sequence).
3790:
1.112 bowersj2 3791: =back
1.14 harris41 3792:
1.112 bowersj2 3793: The output string is a table containing all desired attempts, if any.
1.16 harris41 3794:
1.112 bowersj2 3795: =cut
1.1 albertel 3796:
3797: sub get_previous_attempt {
1.1199 raeburn 3798: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3799: my $prevattempts='';
1.43 ng 3800: no strict 'refs';
1.1 albertel 3801: if ($symb) {
1.3 albertel 3802: my (%returnhash)=
3803: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3804: if ($returnhash{'version'}) {
3805: my %lasthash=();
3806: my $version;
3807: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3808: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3809: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3810: }
1.1 albertel 3811: }
1.596 albertel 3812: $prevattempts=&start_data_table().&start_data_table_header_row();
3813: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 3814: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3815: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3816: foreach my $key (sort(keys(%lasthash))) {
3817: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3818: if ($#parts > 0) {
1.31 albertel 3819: my $data=$parts[-1];
1.989 raeburn 3820: next if ($data eq 'foilorder');
1.31 albertel 3821: pop(@parts);
1.1010 www 3822: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3823: if ($data eq 'type') {
3824: unless ($showsurv) {
3825: my $id = join(',',@parts);
3826: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3827: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3828: $lasthidden{$ign.'.'.$id} = 1;
3829: }
1.945 raeburn 3830: }
1.1199 raeburn 3831: if ($identifier ne '') {
3832: my $id = join(',',@parts);
3833: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
3834: $domain,$username,$usec,undef,$course) =~ /^no/) {
3835: $hidestatus{$ign.'.'.$id} = 1;
3836: }
3837: }
3838: } elsif ($data eq 'regrader') {
3839: if (($identifier ne '') && (@parts)) {
1.1200 ! raeburn 3840: my $id = join(',',@parts);
! 3841: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 3842: }
1.1010 www 3843: }
1.31 albertel 3844: } else {
1.41 ng 3845: if ($#parts == 0) {
3846: $prevattempts.='<th>'.$parts[0].'</th>';
3847: } else {
3848: $prevattempts.='<th>'.$ign.'</th>';
3849: }
1.31 albertel 3850: }
1.16 harris41 3851: }
1.596 albertel 3852: $prevattempts.=&end_data_table_header_row();
1.40 ng 3853: if ($getattempt eq '') {
1.1199 raeburn 3854: my (%solved,%resets,%probstatus);
1.1200 ! raeburn 3855: if (($identifier ne '') && (keys(%regraded) > 0)) {
! 3856: for ($version=1;$version<=$returnhash{'version'};$version++) {
! 3857: foreach my $id (keys(%regraded)) {
! 3858: if (($returnhash{$version.':'.$id.'.regrader'}) &&
! 3859: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
! 3860: ($returnhash{$version.':'.$id.'.award'} eq '')) {
! 3861: push(@{$resets{$id}},$version);
1.1199 raeburn 3862: }
3863: }
3864: }
1.1200 ! raeburn 3865: }
! 3866: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 3867: my (@hidden,@unsolved);
1.945 raeburn 3868: if (%typeparts) {
3869: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 3870: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
3871: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3872: push(@hidden,$id);
1.1199 raeburn 3873: } elsif ($identifier ne '') {
3874: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
3875: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
3876: ($hidestatus{$id})) {
1.1200 ! raeburn 3877: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 3878: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
3879: push(@{$solved{$id}},$version);
3880: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
3881: (ref($solved{$id}) eq 'ARRAY')) {
3882: my $skip;
3883: if (ref($resets{$id}) eq 'ARRAY') {
3884: foreach my $reset (@{$resets{$id}}) {
3885: if ($reset > $solved{$id}[-1]) {
3886: $skip=1;
3887: last;
3888: }
3889: }
3890: }
3891: unless ($skip) {
3892: my ($ign,$partslist) = split(/\./,$id,2);
3893: push(@unsolved,$partslist);
3894: }
3895: }
3896: }
1.945 raeburn 3897: }
3898: }
3899: }
3900: $prevattempts.=&start_data_table_row().
1.1199 raeburn 3901: '<td>'.&mt('Transaction [_1]',$version);
3902: if (@unsolved) {
3903: $prevattempts .= '<span class="LC_nobreak"><label>'.
3904: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
3905: &mt('Hide').'</label></span>';
3906: }
3907: $prevattempts .= '</td>';
1.945 raeburn 3908: if (@hidden) {
3909: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3910: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3911: my $hide;
3912: foreach my $id (@hidden) {
3913: if ($key =~ /^\Q$id\E/) {
3914: $hide = 1;
3915: last;
3916: }
3917: }
3918: if ($hide) {
3919: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3920: if (($data eq 'award') || ($data eq 'awarddetail')) {
3921: my $value = &format_previous_attempt_value($key,
3922: $returnhash{$version.':'.$key});
1.1173 kruse 3923: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3924: } else {
3925: $prevattempts.='<td> </td>';
3926: }
3927: } else {
3928: if ($key =~ /\./) {
3929: my $value = &format_previous_attempt_value($key,
3930: $returnhash{$version.':'.$key});
1.1173 kruse 3931: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3932: } else {
3933: $prevattempts.='<td> </td>';
3934: }
3935: }
3936: }
3937: } else {
3938: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3939: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3940: my $value = &format_previous_attempt_value($key,
3941: $returnhash{$version.':'.$key});
1.1173 kruse 3942: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3943: }
3944: }
3945: $prevattempts.=&end_data_table_row();
1.40 ng 3946: }
1.1 albertel 3947: }
1.945 raeburn 3948: my @currhidden = keys(%lasthidden);
1.596 albertel 3949: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3950: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3951: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3952: if (%typeparts) {
3953: my $hidden;
3954: foreach my $id (@currhidden) {
3955: if ($key =~ /^\Q$id\E/) {
3956: $hidden = 1;
3957: last;
3958: }
3959: }
3960: if ($hidden) {
3961: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3962: if (($data eq 'award') || ($data eq 'awarddetail')) {
3963: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3964: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3965: $value = &$gradesub($value);
3966: }
1.1173 kruse 3967: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 3968: } else {
3969: $prevattempts.='<td> </td>';
3970: }
3971: } else {
3972: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3973: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3974: $value = &$gradesub($value);
3975: }
1.1173 kruse 3976: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3977: }
3978: } else {
3979: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3980: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3981: $value = &$gradesub($value);
3982: }
1.1173 kruse 3983: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3984: }
1.16 harris41 3985: }
1.596 albertel 3986: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3987: } else {
1.596 albertel 3988: $prevattempts=
3989: &start_data_table().&start_data_table_row().
3990: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3991: &end_data_table_row().&end_data_table();
1.1 albertel 3992: }
3993: } else {
1.596 albertel 3994: $prevattempts=
3995: &start_data_table().&start_data_table_row().
3996: '<td>'.&mt('No data.').'</td>'.
3997: &end_data_table_row().&end_data_table();
1.1 albertel 3998: }
1.10 albertel 3999: }
4000:
1.581 albertel 4001: sub format_previous_attempt_value {
4002: my ($key,$value) = @_;
1.1011 www 4003: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4004: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4005: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4006: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4007: } elsif ($key =~ /answerstring$/) {
4008: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4009: my @answer = %answers;
4010: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4011: my @anskeys = sort(keys(%answers));
4012: if (@anskeys == 1) {
4013: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4014: if ($answer =~ m{\0}) {
4015: $answer =~ s{\0}{,}g;
1.988 raeburn 4016: }
4017: my $tag_internal_answer_name = 'INTERNAL';
4018: if ($anskeys[0] eq $tag_internal_answer_name) {
4019: $value = $answer;
4020: } else {
4021: $value = $anskeys[0].'='.$answer;
4022: }
4023: } else {
4024: foreach my $ans (@anskeys) {
4025: my $answer = $answers{$ans};
1.1001 raeburn 4026: if ($answer =~ m{\0}) {
4027: $answer =~ s{\0}{,}g;
1.988 raeburn 4028: }
4029: $value .= $ans.'='.$answer.'<br />';;
4030: }
4031: }
1.581 albertel 4032: } else {
1.1173 kruse 4033: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4034: }
4035: return $value;
4036: }
4037:
4038:
1.107 albertel 4039: sub relative_to_absolute {
4040: my ($url,$output)=@_;
4041: my $parser=HTML::TokeParser->new(\$output);
4042: my $token;
4043: my $thisdir=$url;
4044: my @rlinks=();
4045: while ($token=$parser->get_token) {
4046: if ($token->[0] eq 'S') {
4047: if ($token->[1] eq 'a') {
4048: if ($token->[2]->{'href'}) {
4049: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4050: }
4051: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4052: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4053: } elsif ($token->[1] eq 'base') {
4054: $thisdir=$token->[2]->{'href'};
4055: }
4056: }
4057: }
4058: $thisdir=~s-/[^/]*$--;
1.356 albertel 4059: foreach my $link (@rlinks) {
1.726 raeburn 4060: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4061: ($link=~/^\//) ||
4062: ($link=~/^javascript:/i) ||
4063: ($link=~/^mailto:/i) ||
4064: ($link=~/^\#/)) {
4065: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4066: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4067: }
4068: }
4069: # -------------------------------------------------- Deal with Applet codebases
4070: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4071: return $output;
4072: }
4073:
1.112 bowersj2 4074: =pod
4075:
1.648 raeburn 4076: =item * &get_student_view()
1.112 bowersj2 4077:
4078: show a snapshot of what student was looking at
4079:
4080: =cut
4081:
1.10 albertel 4082: sub get_student_view {
1.186 albertel 4083: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4084: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4085: my (%form);
1.10 albertel 4086: my @elements=('symb','courseid','domain','username');
4087: foreach my $element (@elements) {
1.186 albertel 4088: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4089: }
1.186 albertel 4090: if (defined($moreenv)) {
4091: %form=(%form,%{$moreenv});
4092: }
1.236 albertel 4093: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4094: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4095: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4096: $userview=~s/\<body[^\>]*\>//gi;
4097: $userview=~s/\<\/body\>//gi;
4098: $userview=~s/\<html\>//gi;
4099: $userview=~s/\<\/html\>//gi;
4100: $userview=~s/\<head\>//gi;
4101: $userview=~s/\<\/head\>//gi;
4102: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4103: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4104: if (wantarray) {
4105: return ($userview,$response);
4106: } else {
4107: return $userview;
4108: }
4109: }
4110:
4111: sub get_student_view_with_retries {
4112: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4113:
4114: my $ok = 0; # True if we got a good response.
4115: my $content;
4116: my $response;
4117:
4118: # Try to get the student_view done. within the retries count:
4119:
4120: do {
4121: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4122: $ok = $response->is_success;
4123: if (!$ok) {
4124: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4125: }
4126: $retries--;
4127: } while (!$ok && ($retries > 0));
4128:
4129: if (!$ok) {
4130: $content = ''; # On error return an empty content.
4131: }
1.651 www 4132: if (wantarray) {
4133: return ($content, $response);
4134: } else {
4135: return $content;
4136: }
1.11 albertel 4137: }
4138:
1.112 bowersj2 4139: =pod
4140:
1.648 raeburn 4141: =item * &get_student_answers()
1.112 bowersj2 4142:
4143: show a snapshot of how student was answering problem
4144:
4145: =cut
4146:
1.11 albertel 4147: sub get_student_answers {
1.100 sakharuk 4148: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4149: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4150: my (%moreenv);
1.11 albertel 4151: my @elements=('symb','courseid','domain','username');
4152: foreach my $element (@elements) {
1.186 albertel 4153: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4154: }
1.186 albertel 4155: $moreenv{'grade_target'}='answer';
4156: %moreenv=(%form,%moreenv);
1.497 raeburn 4157: $feedurl = &Apache::lonnet::clutter($feedurl);
4158: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4159: return $userview;
1.1 albertel 4160: }
1.116 albertel 4161:
4162: =pod
4163:
4164: =item * &submlink()
4165:
1.242 albertel 4166: Inputs: $text $uname $udom $symb $target
1.116 albertel 4167:
4168: Returns: A link to grades.pm such as to see the SUBM view of a student
4169:
4170: =cut
4171:
4172: ###############################################
4173: sub submlink {
1.242 albertel 4174: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4175: if (!($uname && $udom)) {
4176: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4177: &Apache::lonnet::whichuser($symb);
1.116 albertel 4178: if (!$symb) { $symb=$cursymb; }
4179: }
1.254 matthew 4180: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4181: $symb=&escape($symb);
1.960 bisitz 4182: if ($target) { $target=" target=\"$target\""; }
4183: return
4184: '<a href="/adm/grades?command=submission'.
4185: '&symb='.$symb.
4186: '&student='.$uname.
4187: '&userdom='.$udom.'"'.
4188: $target.'>'.$text.'</a>';
1.242 albertel 4189: }
4190: ##############################################
4191:
4192: =pod
4193:
4194: =item * &pgrdlink()
4195:
4196: Inputs: $text $uname $udom $symb $target
4197:
4198: Returns: A link to grades.pm such as to see the PGRD view of a student
4199:
4200: =cut
4201:
4202: ###############################################
4203: sub pgrdlink {
4204: my $link=&submlink(@_);
4205: $link=~s/(&command=submission)/$1&showgrading=yes/;
4206: return $link;
4207: }
4208: ##############################################
4209:
4210: =pod
4211:
4212: =item * &pprmlink()
4213:
4214: Inputs: $text $uname $udom $symb $target
4215:
4216: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4217: student and a specific resource
1.242 albertel 4218:
4219: =cut
4220:
4221: ###############################################
4222: sub pprmlink {
4223: my ($text,$uname,$udom,$symb,$target)=@_;
4224: if (!($uname && $udom)) {
4225: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4226: &Apache::lonnet::whichuser($symb);
1.242 albertel 4227: if (!$symb) { $symb=$cursymb; }
4228: }
1.254 matthew 4229: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4230: $symb=&escape($symb);
1.242 albertel 4231: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4232: return '<a href="/adm/parmset?command=set&'.
4233: 'symb='.$symb.'&uname='.$uname.
4234: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4235: }
4236: ##############################################
1.37 matthew 4237:
1.112 bowersj2 4238: =pod
4239:
4240: =back
4241:
4242: =cut
4243:
1.37 matthew 4244: ###############################################
1.51 www 4245:
4246:
4247: sub timehash {
1.687 raeburn 4248: my ($thistime) = @_;
4249: my $timezone = &Apache::lonlocal::gettimezone();
4250: my $dt = DateTime->from_epoch(epoch => $thistime)
4251: ->set_time_zone($timezone);
4252: my $wday = $dt->day_of_week();
4253: if ($wday == 7) { $wday = 0; }
4254: return ( 'second' => $dt->second(),
4255: 'minute' => $dt->minute(),
4256: 'hour' => $dt->hour(),
4257: 'day' => $dt->day_of_month(),
4258: 'month' => $dt->month(),
4259: 'year' => $dt->year(),
4260: 'weekday' => $wday,
4261: 'dayyear' => $dt->day_of_year(),
4262: 'dlsav' => $dt->is_dst() );
1.51 www 4263: }
4264:
1.370 www 4265: sub utc_string {
4266: my ($date)=@_;
1.371 www 4267: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4268: }
4269:
1.51 www 4270: sub maketime {
4271: my %th=@_;
1.687 raeburn 4272: my ($epoch_time,$timezone,$dt);
4273: $timezone = &Apache::lonlocal::gettimezone();
4274: eval {
4275: $dt = DateTime->new( year => $th{'year'},
4276: month => $th{'month'},
4277: day => $th{'day'},
4278: hour => $th{'hour'},
4279: minute => $th{'minute'},
4280: second => $th{'second'},
4281: time_zone => $timezone,
4282: );
4283: };
4284: if (!$@) {
4285: $epoch_time = $dt->epoch;
4286: if ($epoch_time) {
4287: return $epoch_time;
4288: }
4289: }
1.51 www 4290: return POSIX::mktime(
4291: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4292: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4293: }
4294:
4295: #########################################
1.51 www 4296:
4297: sub findallcourses {
1.482 raeburn 4298: my ($roles,$uname,$udom) = @_;
1.355 albertel 4299: my %roles;
4300: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4301: my %courses;
1.51 www 4302: my $now=time;
1.482 raeburn 4303: if (!defined($uname)) {
4304: $uname = $env{'user.name'};
4305: }
4306: if (!defined($udom)) {
4307: $udom = $env{'user.domain'};
4308: }
4309: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4310: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4311: if (!%roles) {
4312: %roles = (
4313: cc => 1,
1.907 raeburn 4314: co => 1,
1.482 raeburn 4315: in => 1,
4316: ep => 1,
4317: ta => 1,
4318: cr => 1,
4319: st => 1,
4320: );
4321: }
4322: foreach my $entry (keys(%roleshash)) {
4323: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4324: if ($trole =~ /^cr/) {
4325: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4326: } else {
4327: next if (!exists($roles{$trole}));
4328: }
4329: if ($tend) {
4330: next if ($tend < $now);
4331: }
4332: if ($tstart) {
4333: next if ($tstart > $now);
4334: }
1.1058 raeburn 4335: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4336: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4337: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4338: if ($secpart eq '') {
4339: ($cnum,$role) = split(/_/,$cnumpart);
4340: $sec = 'none';
1.1058 raeburn 4341: $value .= $cnum.'/';
1.482 raeburn 4342: } else {
4343: $cnum = $cnumpart;
4344: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4345: $value .= $cnum.'/'.$sec;
4346: }
4347: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4348: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4349: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4350: }
4351: } else {
4352: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4353: }
1.482 raeburn 4354: }
4355: } else {
4356: foreach my $key (keys(%env)) {
1.483 albertel 4357: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4358: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4359: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4360: next if ($role eq 'ca' || $role eq 'aa');
4361: next if (%roles && !exists($roles{$role}));
4362: my ($starttime,$endtime)=split(/\./,$env{$key});
4363: my $active=1;
4364: if ($starttime) {
4365: if ($now<$starttime) { $active=0; }
4366: }
4367: if ($endtime) {
4368: if ($now>$endtime) { $active=0; }
4369: }
4370: if ($active) {
1.1058 raeburn 4371: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4372: if ($sec eq '') {
4373: $sec = 'none';
1.1058 raeburn 4374: } else {
4375: $value .= $sec;
4376: }
4377: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4378: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4379: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4380: }
4381: } else {
4382: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4383: }
1.474 raeburn 4384: }
4385: }
1.51 www 4386: }
4387: }
1.474 raeburn 4388: return %courses;
1.51 www 4389: }
1.37 matthew 4390:
1.54 www 4391: ###############################################
1.474 raeburn 4392:
4393: sub blockcheck {
1.1189 raeburn 4394: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4395:
1.1189 raeburn 4396: if (defined($udom) && defined($uname)) {
4397: # If uname and udom are for a course, check for blocks in the course.
4398: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4399: my ($startblock,$endblock,$triggerblock) =
4400: &get_blocks($setters,$activity,$udom,$uname,$url);
4401: return ($startblock,$endblock,$triggerblock);
4402: }
4403: } else {
1.490 raeburn 4404: $udom = $env{'user.domain'};
4405: $uname = $env{'user.name'};
4406: }
4407:
1.502 raeburn 4408: my $startblock = 0;
4409: my $endblock = 0;
1.1062 raeburn 4410: my $triggerblock = '';
1.482 raeburn 4411: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4412:
1.490 raeburn 4413: # If uname is for a user, and activity is course-specific, i.e.,
4414: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4415:
1.490 raeburn 4416: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4417: $activity eq 'groups' || $activity eq 'printout') &&
4418: ($env{'request.course.id'})) {
1.490 raeburn 4419: foreach my $key (keys(%live_courses)) {
4420: if ($key ne $env{'request.course.id'}) {
4421: delete($live_courses{$key});
4422: }
4423: }
4424: }
4425:
4426: my $otheruser = 0;
4427: my %own_courses;
4428: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4429: # Resource belongs to user other than current user.
4430: $otheruser = 1;
4431: # Gather courses for current user
4432: %own_courses =
4433: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4434: }
4435:
4436: # Gather active course roles - course coordinator, instructor,
4437: # exam proctor, ta, student, or custom role.
1.474 raeburn 4438:
4439: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4440: my ($cdom,$cnum);
4441: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4442: $cdom = $env{'course.'.$course.'.domain'};
4443: $cnum = $env{'course.'.$course.'.num'};
4444: } else {
1.490 raeburn 4445: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4446: }
4447: my $no_ownblock = 0;
4448: my $no_userblock = 0;
1.533 raeburn 4449: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4450: # Check if current user has 'evb' priv for this
4451: if (defined($own_courses{$course})) {
4452: foreach my $sec (keys(%{$own_courses{$course}})) {
4453: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4454: if ($sec ne 'none') {
4455: $checkrole .= '/'.$sec;
4456: }
4457: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4458: $no_ownblock = 1;
4459: last;
4460: }
4461: }
4462: }
4463: # if they have 'evb' priv and are currently not playing student
4464: next if (($no_ownblock) &&
4465: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4466: }
1.474 raeburn 4467: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4468: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4469: if ($sec ne 'none') {
1.482 raeburn 4470: $checkrole .= '/'.$sec;
1.474 raeburn 4471: }
1.490 raeburn 4472: if ($otheruser) {
4473: # Resource belongs to user other than current user.
4474: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4475: my (%allroles,%userroles);
4476: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4477: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4478: my ($trole,$tdom,$tnum,$tsec);
4479: if ($entry =~ /^cr/) {
4480: ($trole,$tdom,$tnum,$tsec) =
4481: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4482: } else {
4483: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4484: }
4485: my ($spec,$area,$trest);
4486: $area = '/'.$tdom.'/'.$tnum;
4487: $trest = $tnum;
4488: if ($tsec ne '') {
4489: $area .= '/'.$tsec;
4490: $trest .= '/'.$tsec;
4491: }
4492: $spec = $trole.'.'.$area;
4493: if ($trole =~ /^cr/) {
4494: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4495: $tdom,$spec,$trest,$area);
4496: } else {
4497: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4498: $tdom,$spec,$trest,$area);
4499: }
4500: }
4501: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4502: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4503: if ($1) {
4504: $no_userblock = 1;
4505: last;
4506: }
1.486 raeburn 4507: }
4508: }
1.490 raeburn 4509: } else {
4510: # Resource belongs to current user
4511: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4512: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4513: $no_ownblock = 1;
4514: last;
4515: }
1.474 raeburn 4516: }
4517: }
4518: # if they have the evb priv and are currently not playing student
1.482 raeburn 4519: next if (($no_ownblock) &&
1.491 albertel 4520: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4521: next if ($no_userblock);
1.474 raeburn 4522:
1.866 kalberla 4523: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4524: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4525:
1.1062 raeburn 4526: my ($start,$end,$trigger) =
4527: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4528: if (($start != 0) &&
4529: (($startblock == 0) || ($startblock > $start))) {
4530: $startblock = $start;
1.1062 raeburn 4531: if ($trigger ne '') {
4532: $triggerblock = $trigger;
4533: }
1.502 raeburn 4534: }
4535: if (($end != 0) &&
4536: (($endblock == 0) || ($endblock < $end))) {
4537: $endblock = $end;
1.1062 raeburn 4538: if ($trigger ne '') {
4539: $triggerblock = $trigger;
4540: }
1.502 raeburn 4541: }
1.490 raeburn 4542: }
1.1062 raeburn 4543: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4544: }
4545:
4546: sub get_blocks {
1.1062 raeburn 4547: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4548: my $startblock = 0;
4549: my $endblock = 0;
1.1062 raeburn 4550: my $triggerblock = '';
1.490 raeburn 4551: my $course = $cdom.'_'.$cnum;
4552: $setters->{$course} = {};
4553: $setters->{$course}{'staff'} = [];
4554: $setters->{$course}{'times'} = [];
1.1062 raeburn 4555: $setters->{$course}{'triggers'} = [];
4556: my (@blockers,%triggered);
4557: my $now = time;
4558: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4559: if ($activity eq 'docs') {
4560: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4561: foreach my $block (@blockers) {
4562: if ($block =~ /^firstaccess____(.+)$/) {
4563: my $item = $1;
4564: my $type = 'map';
4565: my $timersymb = $item;
4566: if ($item eq 'course') {
4567: $type = 'course';
4568: } elsif ($item =~ /___\d+___/) {
4569: $type = 'resource';
4570: } else {
4571: $timersymb = &Apache::lonnet::symbread($item);
4572: }
4573: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4574: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4575: $triggered{$block} = {
4576: start => $start,
4577: end => $end,
4578: type => $type,
4579: };
4580: }
4581: }
4582: } else {
4583: foreach my $block (keys(%commblocks)) {
4584: if ($block =~ m/^(\d+)____(\d+)$/) {
4585: my ($start,$end) = ($1,$2);
4586: if ($start <= time && $end >= time) {
4587: if (ref($commblocks{$block}) eq 'HASH') {
4588: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4589: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4590: unless(grep(/^\Q$block\E$/,@blockers)) {
4591: push(@blockers,$block);
4592: }
4593: }
4594: }
4595: }
4596: }
4597: } elsif ($block =~ /^firstaccess____(.+)$/) {
4598: my $item = $1;
4599: my $timersymb = $item;
4600: my $type = 'map';
4601: if ($item eq 'course') {
4602: $type = 'course';
4603: } elsif ($item =~ /___\d+___/) {
4604: $type = 'resource';
4605: } else {
4606: $timersymb = &Apache::lonnet::symbread($item);
4607: }
4608: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4609: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4610: if ($start && $end) {
4611: if (($start <= time) && ($end >= time)) {
4612: unless (grep(/^\Q$block\E$/,@blockers)) {
4613: push(@blockers,$block);
4614: $triggered{$block} = {
4615: start => $start,
4616: end => $end,
4617: type => $type,
4618: };
4619: }
4620: }
1.490 raeburn 4621: }
1.1062 raeburn 4622: }
4623: }
4624: }
4625: foreach my $blocker (@blockers) {
4626: my ($staff_name,$staff_dom,$title,$blocks) =
4627: &parse_block_record($commblocks{$blocker});
4628: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4629: my ($start,$end,$triggertype);
4630: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4631: ($start,$end) = ($1,$2);
4632: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4633: $start = $triggered{$blocker}{'start'};
4634: $end = $triggered{$blocker}{'end'};
4635: $triggertype = $triggered{$blocker}{'type'};
4636: }
4637: if ($start) {
4638: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4639: if ($triggertype) {
4640: push(@{$$setters{$course}{'triggers'}},$triggertype);
4641: } else {
4642: push(@{$$setters{$course}{'triggers'}},0);
4643: }
4644: if ( ($startblock == 0) || ($startblock > $start) ) {
4645: $startblock = $start;
4646: if ($triggertype) {
4647: $triggerblock = $blocker;
1.474 raeburn 4648: }
4649: }
1.1062 raeburn 4650: if ( ($endblock == 0) || ($endblock < $end) ) {
4651: $endblock = $end;
4652: if ($triggertype) {
4653: $triggerblock = $blocker;
4654: }
4655: }
1.474 raeburn 4656: }
4657: }
1.1062 raeburn 4658: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4659: }
4660:
4661: sub parse_block_record {
4662: my ($record) = @_;
4663: my ($setuname,$setudom,$title,$blocks);
4664: if (ref($record) eq 'HASH') {
4665: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4666: $title = &unescape($record->{'event'});
4667: $blocks = $record->{'blocks'};
4668: } else {
4669: my @data = split(/:/,$record,3);
4670: if (scalar(@data) eq 2) {
4671: $title = $data[1];
4672: ($setuname,$setudom) = split(/@/,$data[0]);
4673: } else {
4674: ($setuname,$setudom,$title) = @data;
4675: }
4676: $blocks = { 'com' => 'on' };
4677: }
4678: return ($setuname,$setudom,$title,$blocks);
4679: }
4680:
1.854 kalberla 4681: sub blocking_status {
1.1189 raeburn 4682: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4683: my %setters;
1.890 droeschl 4684:
1.1061 raeburn 4685: # check for active blocking
1.1062 raeburn 4686: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4687: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4688: my $blocked = 0;
4689: if ($startblock && $endblock) {
4690: $blocked = 1;
4691: }
1.890 droeschl 4692:
1.1061 raeburn 4693: # caller just wants to know whether a block is active
4694: if (!wantarray) { return $blocked; }
4695:
4696: # build a link to a popup window containing the details
4697: my $querystring = "?activity=$activity";
4698: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4699: if ($activity eq 'port') {
4700: $querystring .= "&udom=$udom" if $udom;
4701: $querystring .= "&uname=$uname" if $uname;
4702: } elsif ($activity eq 'docs') {
4703: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4704: }
1.1061 raeburn 4705:
4706: my $output .= <<'END_MYBLOCK';
4707: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4708: var options = "width=" + w + ",height=" + h + ",";
4709: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4710: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4711: var newWin = window.open(url, wdwName, options);
4712: newWin.focus();
4713: }
1.890 droeschl 4714: END_MYBLOCK
1.854 kalberla 4715:
1.1061 raeburn 4716: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4717:
1.1061 raeburn 4718: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4719: my $text = &mt('Communication Blocked');
4720: if ($activity eq 'docs') {
4721: $text = &mt('Content Access Blocked');
1.1063 raeburn 4722: } elsif ($activity eq 'printout') {
4723: $text = &mt('Printing Blocked');
1.1062 raeburn 4724: }
1.1061 raeburn 4725: $output .= <<"END_BLOCK";
1.867 kalberla 4726: <div class='LC_comblock'>
1.869 kalberla 4727: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4728: title='$text'>
4729: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4730: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4731: title='$text'>$text</a>
1.867 kalberla 4732: </div>
4733:
4734: END_BLOCK
1.474 raeburn 4735:
1.1061 raeburn 4736: return ($blocked, $output);
1.854 kalberla 4737: }
1.490 raeburn 4738:
1.60 matthew 4739: ###############################################
4740:
1.682 raeburn 4741: sub check_ip_acc {
4742: my ($acc)=@_;
4743: &Apache::lonxml::debug("acc is $acc");
4744: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4745: return 1;
4746: }
4747: my $allowed=0;
4748: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4749:
4750: my $name;
4751: foreach my $pattern (split(',',$acc)) {
4752: $pattern =~ s/^\s*//;
4753: $pattern =~ s/\s*$//;
4754: if ($pattern =~ /\*$/) {
4755: #35.8.*
4756: $pattern=~s/\*//;
4757: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4758: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4759: #35.8.3.[34-56]
4760: my $low=$2;
4761: my $high=$3;
4762: $pattern=$1;
4763: if ($ip =~ /^\Q$pattern\E/) {
4764: my $last=(split(/\./,$ip))[3];
4765: if ($last <=$high && $last >=$low) { $allowed=1; }
4766: }
4767: } elsif ($pattern =~ /^\*/) {
4768: #*.msu.edu
4769: $pattern=~s/\*//;
4770: if (!defined($name)) {
4771: use Socket;
4772: my $netaddr=inet_aton($ip);
4773: ($name)=gethostbyaddr($netaddr,AF_INET);
4774: }
4775: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4776: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4777: #127.0.0.1
4778: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4779: } else {
4780: #some.name.com
4781: if (!defined($name)) {
4782: use Socket;
4783: my $netaddr=inet_aton($ip);
4784: ($name)=gethostbyaddr($netaddr,AF_INET);
4785: }
4786: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4787: }
4788: if ($allowed) { last; }
4789: }
4790: return $allowed;
4791: }
4792:
4793: ###############################################
4794:
1.60 matthew 4795: =pod
4796:
1.112 bowersj2 4797: =head1 Domain Template Functions
4798:
4799: =over 4
4800:
4801: =item * &determinedomain()
1.60 matthew 4802:
4803: Inputs: $domain (usually will be undef)
4804:
1.63 www 4805: Returns: Determines which domain should be used for designs
1.60 matthew 4806:
4807: =cut
1.54 www 4808:
1.60 matthew 4809: ###############################################
1.63 www 4810: sub determinedomain {
4811: my $domain=shift;
1.531 albertel 4812: if (! $domain) {
1.60 matthew 4813: # Determine domain if we have not been given one
1.893 raeburn 4814: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4815: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4816: if ($env{'request.role.domain'}) {
4817: $domain=$env{'request.role.domain'};
1.60 matthew 4818: }
4819: }
1.63 www 4820: return $domain;
4821: }
4822: ###############################################
1.517 raeburn 4823:
1.518 albertel 4824: sub devalidate_domconfig_cache {
4825: my ($udom)=@_;
4826: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4827: }
4828:
4829: # ---------------------- Get domain configuration for a domain
4830: sub get_domainconf {
4831: my ($udom) = @_;
4832: my $cachetime=1800;
4833: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4834: if (defined($cached)) { return %{$result}; }
4835:
4836: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4837: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4838: my (%designhash,%legacy);
1.518 albertel 4839: if (keys(%domconfig) > 0) {
4840: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4841: if (keys(%{$domconfig{'login'}})) {
4842: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4843: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4844: if ($key eq 'loginvia') {
4845: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4846: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4847: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4848: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4849: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4850: $designhash{$udom.'.login.loginvia'} = $server;
4851: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4852:
4853: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4854: } else {
1.1013 raeburn 4855: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4856: }
4857: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4858: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4859: }
1.946 raeburn 4860: }
4861: }
4862: }
4863: }
4864: } else {
4865: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4866: $designhash{$udom.'.login.'.$key.'_'.$img} =
4867: $domconfig{'login'}{$key}{$img};
4868: }
1.699 raeburn 4869: }
4870: } else {
4871: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4872: }
1.632 raeburn 4873: }
4874: } else {
4875: $legacy{'login'} = 1;
1.518 albertel 4876: }
1.632 raeburn 4877: } else {
4878: $legacy{'login'} = 1;
1.518 albertel 4879: }
4880: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4881: if (keys(%{$domconfig{'rolecolors'}})) {
4882: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4883: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4884: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4885: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4886: }
1.518 albertel 4887: }
4888: }
1.632 raeburn 4889: } else {
4890: $legacy{'rolecolors'} = 1;
1.518 albertel 4891: }
1.632 raeburn 4892: } else {
4893: $legacy{'rolecolors'} = 1;
1.518 albertel 4894: }
1.948 raeburn 4895: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4896: if ($domconfig{'autoenroll'}{'co-owners'}) {
4897: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4898: }
4899: }
1.632 raeburn 4900: if (keys(%legacy) > 0) {
4901: my %legacyhash = &get_legacy_domconf($udom);
4902: foreach my $item (keys(%legacyhash)) {
4903: if ($item =~ /^\Q$udom\E\.login/) {
4904: if ($legacy{'login'}) {
4905: $designhash{$item} = $legacyhash{$item};
4906: }
4907: } else {
4908: if ($legacy{'rolecolors'}) {
4909: $designhash{$item} = $legacyhash{$item};
4910: }
1.518 albertel 4911: }
4912: }
4913: }
1.632 raeburn 4914: } else {
4915: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4916: }
4917: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4918: $cachetime);
4919: return %designhash;
4920: }
4921:
1.632 raeburn 4922: sub get_legacy_domconf {
4923: my ($udom) = @_;
4924: my %legacyhash;
4925: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4926: my $designfile = $designdir.'/'.$udom.'.tab';
4927: if (-e $designfile) {
4928: if ( open (my $fh,"<$designfile") ) {
4929: while (my $line = <$fh>) {
4930: next if ($line =~ /^\#/);
4931: chomp($line);
4932: my ($key,$val)=(split(/\=/,$line));
4933: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4934: }
4935: close($fh);
4936: }
4937: }
1.1026 raeburn 4938: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4939: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4940: }
4941: return %legacyhash;
4942: }
4943:
1.63 www 4944: =pod
4945:
1.112 bowersj2 4946: =item * &domainlogo()
1.63 www 4947:
4948: Inputs: $domain (usually will be undef)
4949:
4950: Returns: A link to a domain logo, if the domain logo exists.
4951: If the domain logo does not exist, a description of the domain.
4952:
4953: =cut
1.112 bowersj2 4954:
1.63 www 4955: ###############################################
4956: sub domainlogo {
1.517 raeburn 4957: my $domain = &determinedomain(shift);
1.518 albertel 4958: my %designhash = &get_domainconf($domain);
1.517 raeburn 4959: # See if there is a logo
4960: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4961: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4962: if ($imgsrc =~ m{^/(adm|res)/}) {
4963: if ($imgsrc =~ m{^/res/}) {
4964: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4965: &Apache::lonnet::repcopy($local_name);
4966: }
4967: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4968: }
4969: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4970: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4971: return &Apache::lonnet::domain($domain,'description');
1.59 www 4972: } else {
1.60 matthew 4973: return '';
1.59 www 4974: }
4975: }
1.63 www 4976: ##############################################
4977:
4978: =pod
4979:
1.112 bowersj2 4980: =item * &designparm()
1.63 www 4981:
4982: Inputs: $which parameter; $domain (usually will be undef)
4983:
4984: Returns: value of designparamter $which
4985:
4986: =cut
1.112 bowersj2 4987:
1.397 albertel 4988:
1.400 albertel 4989: ##############################################
1.397 albertel 4990: sub designparm {
4991: my ($which,$domain)=@_;
4992: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4993: return $env{'environment.color.'.$which};
1.96 www 4994: }
1.63 www 4995: $domain=&determinedomain($domain);
1.1016 raeburn 4996: my %domdesign;
4997: unless ($domain eq 'public') {
4998: %domdesign = &get_domainconf($domain);
4999: }
1.520 raeburn 5000: my $output;
1.517 raeburn 5001: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5002: $output = $domdesign{$domain.'.'.$which};
1.63 www 5003: } else {
1.520 raeburn 5004: $output = $defaultdesign{$which};
5005: }
5006: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5007: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5008: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5009: if ($output =~ m{^/res/}) {
5010: my $local_name = &Apache::lonnet::filelocation('',$output);
5011: &Apache::lonnet::repcopy($local_name);
5012: }
1.520 raeburn 5013: $output = &lonhttpdurl($output);
5014: }
1.63 www 5015: }
1.520 raeburn 5016: return $output;
1.63 www 5017: }
1.59 www 5018:
1.822 bisitz 5019: ##############################################
5020: =pod
5021:
1.832 bisitz 5022: =item * &authorspace()
5023:
1.1028 raeburn 5024: Inputs: $url (usually will be undef).
1.832 bisitz 5025:
1.1132 raeburn 5026: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5027: directory being viewed (or for which action is being taken).
5028: If $url is provided, and begins /priv/<domain>/<uname>
5029: the path will be that portion of the $context argument.
5030: Otherwise the path will be for the author space of the current
5031: user when the current role is author, or for that of the
5032: co-author/assistant co-author space when the current role
5033: is co-author or assistant co-author.
1.832 bisitz 5034:
5035: =cut
5036:
5037: sub authorspace {
1.1028 raeburn 5038: my ($url) = @_;
5039: if ($url ne '') {
5040: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5041: return $1;
5042: }
5043: }
1.832 bisitz 5044: my $caname = '';
1.1024 www 5045: my $cadom = '';
1.1028 raeburn 5046: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5047: ($cadom,$caname) =
1.832 bisitz 5048: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5049: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5050: $caname = $env{'user.name'};
1.1024 www 5051: $cadom = $env{'user.domain'};
1.832 bisitz 5052: }
1.1028 raeburn 5053: if (($caname ne '') && ($cadom ne '')) {
5054: return "/priv/$cadom/$caname/";
5055: }
5056: return;
1.832 bisitz 5057: }
5058:
5059: ##############################################
5060: =pod
5061:
1.822 bisitz 5062: =item * &head_subbox()
5063:
5064: Inputs: $content (contains HTML code with page functions, etc.)
5065:
5066: Returns: HTML div with $content
5067: To be included in page header
5068:
5069: =cut
5070:
5071: sub head_subbox {
5072: my ($content)=@_;
5073: my $output =
1.993 raeburn 5074: '<div class="LC_head_subbox">'
1.822 bisitz 5075: .$content
5076: .'</div>'
5077: }
5078:
5079: ##############################################
5080: =pod
5081:
5082: =item * &CSTR_pageheader()
5083:
1.1026 raeburn 5084: Input: (optional) filename from which breadcrumb trail is built.
5085: In most cases no input as needed, as $env{'request.filename'}
5086: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5087:
5088: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5089: To be included on Authoring Space pages
1.822 bisitz 5090:
5091: =cut
5092:
5093: sub CSTR_pageheader {
1.1026 raeburn 5094: my ($trailfile) = @_;
5095: if ($trailfile eq '') {
5096: $trailfile = $env{'request.filename'};
5097: }
5098:
5099: # this is for resources; directories have customtitle, and crumbs
5100: # and select recent are created in lonpubdir.pm
5101:
5102: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5103: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5104: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5105: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5106: $formaction =~ s{/+}{/}g;
1.822 bisitz 5107:
5108: my $parentpath = '';
5109: my $lastitem = '';
5110: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5111: $parentpath = $1;
5112: $lastitem = $2;
5113: } else {
5114: $lastitem = $thisdisfn;
5115: }
1.921 bisitz 5116:
5117: my $output =
1.822 bisitz 5118: '<div>'
5119: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5120: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5121: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5122: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5123: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5124:
5125: if ($lastitem) {
5126: $output .=
5127: '<span class="LC_filename">'
5128: .$lastitem
5129: .'</span>';
5130: }
5131: $output .=
5132: '<br />'
1.822 bisitz 5133: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5134: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5135: .'</form>'
5136: .&Apache::lonmenu::constspaceform()
5137: .'</div>';
1.921 bisitz 5138:
5139: return $output;
1.822 bisitz 5140: }
5141:
1.60 matthew 5142: ###############################################
5143: ###############################################
5144:
5145: =pod
5146:
1.112 bowersj2 5147: =back
5148:
1.549 albertel 5149: =head1 HTML Helpers
1.112 bowersj2 5150:
5151: =over 4
5152:
5153: =item * &bodytag()
1.60 matthew 5154:
5155: Returns a uniform header for LON-CAPA web pages.
5156:
5157: Inputs:
5158:
1.112 bowersj2 5159: =over 4
5160:
5161: =item * $title, A title to be displayed on the page.
5162:
5163: =item * $function, the current role (can be undef).
5164:
5165: =item * $addentries, extra parameters for the <body> tag.
5166:
5167: =item * $bodyonly, if defined, only return the <body> tag.
5168:
5169: =item * $domain, if defined, force a given domain.
5170:
5171: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5172: text interface only)
1.60 matthew 5173:
1.814 bisitz 5174: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5175: navigational links
1.317 albertel 5176:
1.338 albertel 5177: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5178:
1.460 albertel 5179: =item * $args, optional argument valid values are
5180: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5181: inherit_jsmath -> when creating popup window in a page,
5182: should it have jsmath forced on by the
5183: current page
1.460 albertel 5184:
1.1096 raeburn 5185: =item * $advtoolsref, optional argument, ref to an array containing
5186: inlineremote items to be added in "Functions" menu below
5187: breadcrumbs.
5188:
1.112 bowersj2 5189: =back
5190:
1.60 matthew 5191: Returns: A uniform header for LON-CAPA web pages.
5192: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5193: If $bodyonly is undef or zero, an html string containing a <body> tag and
5194: other decorations will be returned.
5195:
5196: =cut
5197:
1.54 www 5198: sub bodytag {
1.831 bisitz 5199: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5200: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5201:
1.954 raeburn 5202: my $public;
5203: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5204: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5205: $public = 1;
5206: }
1.460 albertel 5207: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5208: my $httphost = $args->{'use_absolute'};
1.339 albertel 5209:
1.183 matthew 5210: $function = &get_users_function() if (!$function);
1.339 albertel 5211: my $img = &designparm($function.'.img',$domain);
5212: my $font = &designparm($function.'.font',$domain);
5213: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5214:
1.803 bisitz 5215: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5216: 'bgcolor' => $pgbg,
1.339 albertel 5217: 'text' => $font,
5218: 'alink' => &designparm($function.'.alink',$domain),
5219: 'vlink' => &designparm($function.'.vlink',$domain),
5220: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5221: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5222:
1.63 www 5223: # role and realm
1.1178 raeburn 5224: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5225: if ($realm) {
5226: $realm = '/'.$realm;
5227: }
1.378 raeburn 5228: if ($role eq 'ca') {
1.479 albertel 5229: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5230: $realm = &plainname($rname,$rdom);
1.378 raeburn 5231: }
1.55 www 5232: # realm
1.258 albertel 5233: if ($env{'request.course.id'}) {
1.378 raeburn 5234: if ($env{'request.role'} !~ /^cr/) {
5235: $role = &Apache::lonnet::plaintext($role,&course_type());
5236: }
1.898 raeburn 5237: if ($env{'request.course.sec'}) {
5238: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5239: }
1.359 albertel 5240: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5241: } else {
5242: $role = &Apache::lonnet::plaintext($role);
1.54 www 5243: }
1.433 albertel 5244:
1.359 albertel 5245: if (!$realm) { $realm=' '; }
1.330 albertel 5246:
1.438 albertel 5247: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5248:
1.101 www 5249: # construct main body tag
1.359 albertel 5250: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5251: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5252:
1.1131 raeburn 5253: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5254:
1.1130 raeburn 5255: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5256: return $bodytag;
1.1130 raeburn 5257: }
1.359 albertel 5258:
1.954 raeburn 5259: if ($public) {
1.433 albertel 5260: undef($role);
5261: }
1.359 albertel 5262:
1.762 bisitz 5263: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5264: #
5265: # Extra info if you are the DC
5266: my $dc_info = '';
5267: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5268: $env{'course.'.$env{'request.course.id'}.
5269: '.domain'}.'/'})) {
5270: my $cid = $env{'request.course.id'};
1.917 raeburn 5271: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5272: $dc_info =~ s/\s+$//;
1.359 albertel 5273: }
5274:
1.898 raeburn 5275: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5276:
1.903 droeschl 5277: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5278:
5279: # if ($env{'request.state'} eq 'construct') {
5280: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5281: # }
5282:
1.1130 raeburn 5283: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5284: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5285:
1.1130 raeburn 5286: my ($left,$right) = Apache::lonmenu::primary_menu();
1.359 albertel 5287:
1.916 droeschl 5288: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5289: if ($dc_info) {
5290: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5291: }
1.1130 raeburn 5292: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5293: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5294: return $bodytag;
5295: }
1.894 droeschl 5296:
1.927 raeburn 5297: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5298: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5299: }
1.916 droeschl 5300:
1.1130 raeburn 5301: $bodytag .= $right;
1.852 droeschl 5302:
1.917 raeburn 5303: if ($dc_info) {
5304: $dc_info = &dc_courseid_toggle($dc_info);
5305: }
5306: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5307:
1.1169 raeburn 5308: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5309: if ($args->{'no_secondary_menu'}) {
5310: return $bodytag;
5311: }
1.1169 raeburn 5312: #don't show menus for public users
1.954 raeburn 5313: if (!$public){
1.1154 raeburn 5314: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5315: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5316: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5317: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5318: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5319: $args->{'bread_crumbs'});
1.1096 raeburn 5320: } elsif ($forcereg) {
5321: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5322: $args->{'group'});
5323: } else {
5324: $bodytag .=
5325: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5326: $forcereg,$args->{'group'},
5327: $args->{'bread_crumbs'},
5328: $advtoolsref);
1.920 raeburn 5329: }
1.903 droeschl 5330: }else{
5331: # this is to seperate menu from content when there's no secondary
5332: # menu. Especially needed for public accessible ressources.
5333: $bodytag .= '<hr style="clear:both" />';
5334: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5335: }
1.903 droeschl 5336:
1.235 raeburn 5337: return $bodytag;
1.182 matthew 5338: }
5339:
1.917 raeburn 5340: sub dc_courseid_toggle {
5341: my ($dc_info) = @_;
1.980 raeburn 5342: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5343: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5344: &mt('(More ...)').'</a></span>'.
5345: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5346: }
5347:
1.330 albertel 5348: sub make_attr_string {
5349: my ($register,$attr_ref) = @_;
5350:
5351: if ($attr_ref && !ref($attr_ref)) {
5352: die("addentries Must be a hash ref ".
5353: join(':',caller(1))." ".
5354: join(':',caller(0))." ");
5355: }
5356:
5357: if ($register) {
1.339 albertel 5358: my ($on_load,$on_unload);
5359: foreach my $key (keys(%{$attr_ref})) {
5360: if (lc($key) eq 'onload') {
5361: $on_load.=$attr_ref->{$key}.';';
5362: delete($attr_ref->{$key});
5363:
5364: } elsif (lc($key) eq 'onunload') {
5365: $on_unload.=$attr_ref->{$key}.';';
5366: delete($attr_ref->{$key});
5367: }
5368: }
1.953 droeschl 5369: $attr_ref->{'onload'} = $on_load;
5370: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5371: }
1.339 albertel 5372:
1.330 albertel 5373: my $attr_string;
1.1159 raeburn 5374: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5375: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5376: }
5377: return $attr_string;
5378: }
5379:
5380:
1.182 matthew 5381: ###############################################
1.251 albertel 5382: ###############################################
5383:
5384: =pod
5385:
5386: =item * &endbodytag()
5387:
5388: Returns a uniform footer for LON-CAPA web pages.
5389:
1.635 raeburn 5390: Inputs: 1 - optional reference to an args hash
5391: If in the hash, key for noredirectlink has a value which evaluates to true,
5392: a 'Continue' link is not displayed if the page contains an
5393: internal redirect in the <head></head> section,
5394: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5395:
5396: =cut
5397:
5398: sub endbodytag {
1.635 raeburn 5399: my ($args) = @_;
1.1080 raeburn 5400: my $endbodytag;
5401: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5402: $endbodytag='</body>';
5403: }
1.269 albertel 5404: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5405: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5406: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5407: $endbodytag=
5408: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5409: &mt('Continue').'</a>'.
5410: $endbodytag;
5411: }
1.315 albertel 5412: }
1.251 albertel 5413: return $endbodytag;
5414: }
5415:
1.352 albertel 5416: =pod
5417:
5418: =item * &standard_css()
5419:
5420: Returns a style sheet
5421:
5422: Inputs: (all optional)
5423: domain -> force to color decorate a page for a specific
5424: domain
5425: function -> force usage of a specific rolish color scheme
5426: bgcolor -> override the default page bgcolor
5427:
5428: =cut
5429:
1.343 albertel 5430: sub standard_css {
1.345 albertel 5431: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5432: $function = &get_users_function() if (!$function);
5433: my $img = &designparm($function.'.img', $domain);
5434: my $tabbg = &designparm($function.'.tabbg', $domain);
5435: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5436: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5437: #second colour for later usage
1.345 albertel 5438: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5439: my $pgbg_or_bgcolor =
5440: $bgcolor ||
1.352 albertel 5441: &designparm($function.'.pgbg', $domain);
1.382 albertel 5442: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5443: my $alink = &designparm($function.'.alink', $domain);
5444: my $vlink = &designparm($function.'.vlink', $domain);
5445: my $link = &designparm($function.'.link', $domain);
5446:
1.602 albertel 5447: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5448: my $mono = 'monospace';
1.850 bisitz 5449: my $data_table_head = $sidebg;
5450: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5451: my $data_table_dark = '#E0E0E0';
1.470 banghart 5452: my $data_table_darker = '#CCCCCC';
1.349 albertel 5453: my $data_table_highlight = '#FFFF00';
1.352 albertel 5454: my $mail_new = '#FFBB77';
5455: my $mail_new_hover = '#DD9955';
5456: my $mail_read = '#BBBB77';
5457: my $mail_read_hover = '#999944';
5458: my $mail_replied = '#AAAA88';
5459: my $mail_replied_hover = '#888855';
5460: my $mail_other = '#99BBBB';
5461: my $mail_other_hover = '#669999';
1.391 albertel 5462: my $table_header = '#DDDDDD';
1.489 raeburn 5463: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5464: my $lg_border_color = '#C8C8C8';
1.952 onken 5465: my $button_hover = '#BF2317';
1.392 albertel 5466:
1.608 albertel 5467: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5468: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5469: : '0 3px 0 4px';
1.448 albertel 5470:
1.523 albertel 5471:
1.343 albertel 5472: return <<END;
1.947 droeschl 5473:
5474: /* needed for iframe to allow 100% height in FF */
5475: body, html {
5476: margin: 0;
5477: padding: 0 0.5%;
5478: height: 99%; /* to avoid scrollbars */
5479: }
5480:
1.795 www 5481: body {
1.911 bisitz 5482: font-family: $sans;
5483: line-height:130%;
5484: font-size:0.83em;
5485: color:$font;
1.795 www 5486: }
5487:
1.959 onken 5488: a:focus,
5489: a:focus img {
1.795 www 5490: color: red;
5491: }
1.698 harmsja 5492:
1.911 bisitz 5493: form, .inline {
5494: display: inline;
1.795 www 5495: }
1.721 harmsja 5496:
1.795 www 5497: .LC_right {
1.911 bisitz 5498: text-align:right;
1.795 www 5499: }
5500:
5501: .LC_middle {
1.911 bisitz 5502: vertical-align:middle;
1.795 www 5503: }
1.721 harmsja 5504:
1.1130 raeburn 5505: .LC_floatleft {
5506: float: left;
5507: }
5508:
5509: .LC_floatright {
5510: float: right;
5511: }
5512:
1.911 bisitz 5513: .LC_400Box {
5514: width:400px;
5515: }
1.721 harmsja 5516:
1.947 droeschl 5517: .LC_iframecontainer {
5518: width: 98%;
5519: margin: 0;
5520: position: fixed;
5521: top: 8.5em;
5522: bottom: 0;
5523: }
5524:
5525: .LC_iframecontainer iframe{
5526: border: none;
5527: width: 100%;
5528: height: 100%;
5529: }
5530:
1.778 bisitz 5531: .LC_filename {
5532: font-family: $mono;
5533: white-space:pre;
1.921 bisitz 5534: font-size: 120%;
1.778 bisitz 5535: }
5536:
5537: .LC_fileicon {
5538: border: none;
5539: height: 1.3em;
5540: vertical-align: text-bottom;
5541: margin-right: 0.3em;
5542: text-decoration:none;
5543: }
5544:
1.1008 www 5545: .LC_setting {
5546: text-decoration:underline;
5547: }
5548:
1.350 albertel 5549: .LC_error {
5550: color: red;
5551: }
1.795 www 5552:
1.1097 bisitz 5553: .LC_warning {
5554: color: darkorange;
5555: }
5556:
1.457 albertel 5557: .LC_diff_removed {
1.733 bisitz 5558: color: red;
1.394 albertel 5559: }
1.532 albertel 5560:
5561: .LC_info,
1.457 albertel 5562: .LC_success,
5563: .LC_diff_added {
1.350 albertel 5564: color: green;
5565: }
1.795 www 5566:
1.802 bisitz 5567: div.LC_confirm_box {
5568: background-color: #FAFAFA;
5569: border: 1px solid $lg_border_color;
5570: margin-right: 0;
5571: padding: 5px;
5572: }
5573:
5574: div.LC_confirm_box .LC_error img,
5575: div.LC_confirm_box .LC_success img {
5576: vertical-align: middle;
5577: }
5578:
1.440 albertel 5579: .LC_icon {
1.771 droeschl 5580: border: none;
1.790 droeschl 5581: vertical-align: middle;
1.771 droeschl 5582: }
5583:
1.543 albertel 5584: .LC_docs_spacer {
5585: width: 25px;
5586: height: 1px;
1.771 droeschl 5587: border: none;
1.543 albertel 5588: }
1.346 albertel 5589:
1.532 albertel 5590: .LC_internal_info {
1.735 bisitz 5591: color: #999999;
1.532 albertel 5592: }
5593:
1.794 www 5594: .LC_discussion {
1.1050 www 5595: background: $data_table_dark;
1.911 bisitz 5596: border: 1px solid black;
5597: margin: 2px;
1.794 www 5598: }
5599:
5600: .LC_disc_action_left {
1.1050 www 5601: background: $sidebg;
1.911 bisitz 5602: text-align: left;
1.1050 www 5603: padding: 4px;
5604: margin: 2px;
1.794 www 5605: }
5606:
5607: .LC_disc_action_right {
1.1050 www 5608: background: $sidebg;
1.911 bisitz 5609: text-align: right;
1.1050 www 5610: padding: 4px;
5611: margin: 2px;
1.794 www 5612: }
5613:
5614: .LC_disc_new_item {
1.911 bisitz 5615: background: white;
5616: border: 2px solid red;
1.1050 www 5617: margin: 4px;
5618: padding: 4px;
1.794 www 5619: }
5620:
5621: .LC_disc_old_item {
1.911 bisitz 5622: background: white;
1.1050 www 5623: margin: 4px;
5624: padding: 4px;
1.794 www 5625: }
5626:
1.458 albertel 5627: table.LC_pastsubmission {
5628: border: 1px solid black;
5629: margin: 2px;
5630: }
5631:
1.924 bisitz 5632: table#LC_menubuttons {
1.345 albertel 5633: width: 100%;
5634: background: $pgbg;
1.392 albertel 5635: border: 2px;
1.402 albertel 5636: border-collapse: separate;
1.803 bisitz 5637: padding: 0;
1.345 albertel 5638: }
1.392 albertel 5639:
1.801 tempelho 5640: table#LC_title_bar a {
5641: color: $fontmenu;
5642: }
1.836 bisitz 5643:
1.807 droeschl 5644: table#LC_title_bar {
1.819 tempelho 5645: clear: both;
1.836 bisitz 5646: display: none;
1.807 droeschl 5647: }
5648:
1.795 www 5649: table#LC_title_bar,
1.933 droeschl 5650: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5651: table#LC_title_bar.LC_with_remote {
1.359 albertel 5652: width: 100%;
1.392 albertel 5653: border-color: $pgbg;
5654: border-style: solid;
5655: border-width: $border;
1.379 albertel 5656: background: $pgbg;
1.801 tempelho 5657: color: $fontmenu;
1.392 albertel 5658: border-collapse: collapse;
1.803 bisitz 5659: padding: 0;
1.819 tempelho 5660: margin: 0;
1.359 albertel 5661: }
1.795 www 5662:
1.933 droeschl 5663: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5664: margin: 0;
5665: padding: 0;
1.933 droeschl 5666: position: relative;
5667: list-style: none;
1.913 droeschl 5668: }
1.933 droeschl 5669: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5670: display: inline;
5671: }
1.933 droeschl 5672:
5673: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5674: padding: 0;
1.933 droeschl 5675: margin: 0;
5676: float: left;
1.913 droeschl 5677: }
1.933 droeschl 5678: .LC_breadcrumb_tools_tools {
5679: padding: 0;
5680: margin: 0;
1.913 droeschl 5681: float: right;
5682: }
5683:
1.359 albertel 5684: table#LC_title_bar td {
5685: background: $tabbg;
5686: }
1.795 www 5687:
1.911 bisitz 5688: table#LC_menubuttons img {
1.803 bisitz 5689: border: none;
1.346 albertel 5690: }
1.795 www 5691:
1.842 droeschl 5692: .LC_breadcrumbs_component {
1.911 bisitz 5693: float: right;
5694: margin: 0 1em;
1.357 albertel 5695: }
1.842 droeschl 5696: .LC_breadcrumbs_component img {
1.911 bisitz 5697: vertical-align: middle;
1.777 tempelho 5698: }
1.795 www 5699:
1.383 albertel 5700: td.LC_table_cell_checkbox {
5701: text-align: center;
5702: }
1.795 www 5703:
5704: .LC_fontsize_small {
1.911 bisitz 5705: font-size: 70%;
1.705 tempelho 5706: }
5707:
1.844 bisitz 5708: #LC_breadcrumbs {
1.911 bisitz 5709: clear:both;
5710: background: $sidebg;
5711: border-bottom: 1px solid $lg_border_color;
5712: line-height: 2.5em;
1.933 droeschl 5713: overflow: hidden;
1.911 bisitz 5714: margin: 0;
5715: padding: 0;
1.995 raeburn 5716: text-align: left;
1.819 tempelho 5717: }
1.862 bisitz 5718:
1.1098 bisitz 5719: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5720: clear:both;
5721: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5722: border: 1px solid $sidebg;
1.1098 bisitz 5723: margin: 0 0 10px 0;
1.966 bisitz 5724: padding: 3px;
1.995 raeburn 5725: text-align: left;
1.822 bisitz 5726: }
5727:
1.795 www 5728: .LC_fontsize_medium {
1.911 bisitz 5729: font-size: 85%;
1.705 tempelho 5730: }
5731:
1.795 www 5732: .LC_fontsize_large {
1.911 bisitz 5733: font-size: 120%;
1.705 tempelho 5734: }
5735:
1.346 albertel 5736: .LC_menubuttons_inline_text {
5737: color: $font;
1.698 harmsja 5738: font-size: 90%;
1.701 harmsja 5739: padding-left:3px;
1.346 albertel 5740: }
5741:
1.934 droeschl 5742: .LC_menubuttons_inline_text img{
5743: vertical-align: middle;
5744: }
5745:
1.1051 www 5746: li.LC_menubuttons_inline_text img {
1.951 onken 5747: cursor:pointer;
1.1002 droeschl 5748: text-decoration: none;
1.951 onken 5749: }
5750:
1.526 www 5751: .LC_menubuttons_link {
5752: text-decoration: none;
5753: }
1.795 www 5754:
1.522 albertel 5755: .LC_menubuttons_category {
1.521 www 5756: color: $font;
1.526 www 5757: background: $pgbg;
1.521 www 5758: font-size: larger;
5759: font-weight: bold;
5760: }
5761:
1.346 albertel 5762: td.LC_menubuttons_text {
1.911 bisitz 5763: color: $font;
1.346 albertel 5764: }
1.706 harmsja 5765:
1.346 albertel 5766: .LC_current_location {
5767: background: $tabbg;
5768: }
1.795 www 5769:
1.938 bisitz 5770: table.LC_data_table {
1.347 albertel 5771: border: 1px solid #000000;
1.402 albertel 5772: border-collapse: separate;
1.426 albertel 5773: border-spacing: 1px;
1.610 albertel 5774: background: $pgbg;
1.347 albertel 5775: }
1.795 www 5776:
1.422 albertel 5777: .LC_data_table_dense {
5778: font-size: small;
5779: }
1.795 www 5780:
1.507 raeburn 5781: table.LC_nested_outer {
5782: border: 1px solid #000000;
1.589 raeburn 5783: border-collapse: collapse;
1.803 bisitz 5784: border-spacing: 0;
1.507 raeburn 5785: width: 100%;
5786: }
1.795 www 5787:
1.879 raeburn 5788: table.LC_innerpickbox,
1.507 raeburn 5789: table.LC_nested {
1.803 bisitz 5790: border: none;
1.589 raeburn 5791: border-collapse: collapse;
1.803 bisitz 5792: border-spacing: 0;
1.507 raeburn 5793: width: 100%;
5794: }
1.795 www 5795:
1.911 bisitz 5796: table.LC_data_table tr th,
5797: table.LC_calendar tr th,
1.879 raeburn 5798: table.LC_prior_tries tr th,
5799: table.LC_innerpickbox tr th {
1.349 albertel 5800: font-weight: bold;
5801: background-color: $data_table_head;
1.801 tempelho 5802: color:$fontmenu;
1.701 harmsja 5803: font-size:90%;
1.347 albertel 5804: }
1.795 www 5805:
1.879 raeburn 5806: table.LC_innerpickbox tr th,
5807: table.LC_innerpickbox tr td {
5808: vertical-align: top;
5809: }
5810:
1.711 raeburn 5811: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5812: background-color: #CCCCCC;
1.711 raeburn 5813: font-weight: bold;
5814: text-align: left;
5815: }
1.795 www 5816:
1.912 bisitz 5817: table.LC_data_table tr.LC_odd_row > td {
5818: background-color: $data_table_light;
5819: padding: 2px;
5820: vertical-align: top;
5821: }
5822:
1.809 bisitz 5823: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5824: background-color: $data_table_light;
1.912 bisitz 5825: vertical-align: top;
5826: }
5827:
5828: table.LC_data_table tr.LC_even_row > td {
5829: background-color: $data_table_dark;
1.425 albertel 5830: padding: 2px;
1.900 bisitz 5831: vertical-align: top;
1.347 albertel 5832: }
1.795 www 5833:
1.809 bisitz 5834: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5835: background-color: $data_table_dark;
1.900 bisitz 5836: vertical-align: top;
1.347 albertel 5837: }
1.795 www 5838:
1.425 albertel 5839: table.LC_data_table tr.LC_data_table_highlight td {
5840: background-color: $data_table_darker;
5841: }
1.795 www 5842:
1.639 raeburn 5843: table.LC_data_table tr td.LC_leftcol_header {
5844: background-color: $data_table_head;
5845: font-weight: bold;
5846: }
1.795 www 5847:
1.451 albertel 5848: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5849: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5850: font-weight: bold;
5851: font-style: italic;
5852: text-align: center;
5853: padding: 8px;
1.347 albertel 5854: }
1.795 www 5855:
1.1114 raeburn 5856: table.LC_data_table tr.LC_empty_row td,
5857: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5858: background-color: $sidebg;
5859: }
5860:
5861: table.LC_nested tr.LC_empty_row td {
5862: background-color: #FFFFFF;
5863: }
5864:
1.890 droeschl 5865: table.LC_caption {
5866: }
5867:
1.507 raeburn 5868: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5869: padding: 4ex
5870: }
1.795 www 5871:
1.507 raeburn 5872: table.LC_nested_outer tr th {
5873: font-weight: bold;
1.801 tempelho 5874: color:$fontmenu;
1.507 raeburn 5875: background-color: $data_table_head;
1.701 harmsja 5876: font-size: small;
1.507 raeburn 5877: border-bottom: 1px solid #000000;
5878: }
1.795 www 5879:
1.507 raeburn 5880: table.LC_nested_outer tr td.LC_subheader {
5881: background-color: $data_table_head;
5882: font-weight: bold;
5883: font-size: small;
5884: border-bottom: 1px solid #000000;
5885: text-align: right;
1.451 albertel 5886: }
1.795 www 5887:
1.507 raeburn 5888: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5889: background-color: #CCCCCC;
1.451 albertel 5890: font-weight: bold;
5891: font-size: small;
1.507 raeburn 5892: text-align: center;
5893: }
1.795 www 5894:
1.589 raeburn 5895: table.LC_nested tr.LC_info_row td.LC_left_item,
5896: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5897: text-align: left;
1.451 albertel 5898: }
1.795 www 5899:
1.507 raeburn 5900: table.LC_nested td {
1.735 bisitz 5901: background-color: #FFFFFF;
1.451 albertel 5902: font-size: small;
1.507 raeburn 5903: }
1.795 www 5904:
1.507 raeburn 5905: table.LC_nested_outer tr th.LC_right_item,
5906: table.LC_nested tr.LC_info_row td.LC_right_item,
5907: table.LC_nested tr.LC_odd_row td.LC_right_item,
5908: table.LC_nested tr td.LC_right_item {
1.451 albertel 5909: text-align: right;
5910: }
5911:
1.507 raeburn 5912: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5913: background-color: #EEEEEE;
1.451 albertel 5914: }
5915:
1.473 raeburn 5916: table.LC_createuser {
5917: }
5918:
5919: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5920: font-size: small;
1.473 raeburn 5921: }
5922:
5923: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5924: background-color: #CCCCCC;
1.473 raeburn 5925: font-weight: bold;
5926: text-align: center;
5927: }
5928:
1.349 albertel 5929: table.LC_calendar {
5930: border: 1px solid #000000;
5931: border-collapse: collapse;
1.917 raeburn 5932: width: 98%;
1.349 albertel 5933: }
1.795 www 5934:
1.349 albertel 5935: table.LC_calendar_pickdate {
5936: font-size: xx-small;
5937: }
1.795 www 5938:
1.349 albertel 5939: table.LC_calendar tr td {
5940: border: 1px solid #000000;
5941: vertical-align: top;
1.917 raeburn 5942: width: 14%;
1.349 albertel 5943: }
1.795 www 5944:
1.349 albertel 5945: table.LC_calendar tr td.LC_calendar_day_empty {
5946: background-color: $data_table_dark;
5947: }
1.795 www 5948:
1.779 bisitz 5949: table.LC_calendar tr td.LC_calendar_day_current {
5950: background-color: $data_table_highlight;
1.777 tempelho 5951: }
1.795 www 5952:
1.938 bisitz 5953: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5954: background-color: $mail_new;
5955: }
1.795 www 5956:
1.938 bisitz 5957: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5958: background-color: $mail_new_hover;
5959: }
1.795 www 5960:
1.938 bisitz 5961: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5962: background-color: $mail_read;
5963: }
1.795 www 5964:
1.938 bisitz 5965: /*
5966: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5967: background-color: $mail_read_hover;
5968: }
1.938 bisitz 5969: */
1.795 www 5970:
1.938 bisitz 5971: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5972: background-color: $mail_replied;
5973: }
1.795 www 5974:
1.938 bisitz 5975: /*
5976: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5977: background-color: $mail_replied_hover;
5978: }
1.938 bisitz 5979: */
1.795 www 5980:
1.938 bisitz 5981: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5982: background-color: $mail_other;
5983: }
1.795 www 5984:
1.938 bisitz 5985: /*
5986: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5987: background-color: $mail_other_hover;
5988: }
1.938 bisitz 5989: */
1.494 raeburn 5990:
1.777 tempelho 5991: table.LC_data_table tr > td.LC_browser_file,
5992: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5993: background: #AAEE77;
1.389 albertel 5994: }
1.795 www 5995:
1.777 tempelho 5996: table.LC_data_table tr > td.LC_browser_file_locked,
5997: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5998: background: #FFAA99;
1.387 albertel 5999: }
1.795 www 6000:
1.777 tempelho 6001: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6002: background: #888888;
1.779 bisitz 6003: }
1.795 www 6004:
1.777 tempelho 6005: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6006: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6007: background: #F8F866;
1.777 tempelho 6008: }
1.795 www 6009:
1.696 bisitz 6010: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6011: background: #E0E8FF;
1.387 albertel 6012: }
1.696 bisitz 6013:
1.707 bisitz 6014: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6015: /* background: #77FF77; */
1.707 bisitz 6016: }
1.795 www 6017:
1.707 bisitz 6018: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6019: border-right: 8px solid #FFFF77;
1.707 bisitz 6020: }
1.795 www 6021:
1.707 bisitz 6022: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6023: border-right: 8px solid #FFAA77;
1.707 bisitz 6024: }
1.795 www 6025:
1.707 bisitz 6026: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6027: border-right: 8px solid #FF7777;
1.707 bisitz 6028: }
1.795 www 6029:
1.707 bisitz 6030: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6031: border-right: 8px solid #AAFF77;
1.707 bisitz 6032: }
1.795 www 6033:
1.707 bisitz 6034: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6035: border-right: 8px solid #11CC55;
1.707 bisitz 6036: }
6037:
1.388 albertel 6038: span.LC_current_location {
1.701 harmsja 6039: font-size:larger;
1.388 albertel 6040: background: $pgbg;
6041: }
1.387 albertel 6042:
1.1029 www 6043: span.LC_current_nav_location {
6044: font-weight:bold;
6045: background: $sidebg;
6046: }
6047:
1.395 albertel 6048: span.LC_parm_menu_item {
6049: font-size: larger;
6050: }
1.795 www 6051:
1.395 albertel 6052: span.LC_parm_scope_all {
6053: color: red;
6054: }
1.795 www 6055:
1.395 albertel 6056: span.LC_parm_scope_folder {
6057: color: green;
6058: }
1.795 www 6059:
1.395 albertel 6060: span.LC_parm_scope_resource {
6061: color: orange;
6062: }
1.795 www 6063:
1.395 albertel 6064: span.LC_parm_part {
6065: color: blue;
6066: }
1.795 www 6067:
1.911 bisitz 6068: span.LC_parm_folder,
6069: span.LC_parm_symb {
1.395 albertel 6070: font-size: x-small;
6071: font-family: $mono;
6072: color: #AAAAAA;
6073: }
6074:
1.977 bisitz 6075: ul.LC_parm_parmlist li {
6076: display: inline-block;
6077: padding: 0.3em 0.8em;
6078: vertical-align: top;
6079: width: 150px;
6080: border-top:1px solid $lg_border_color;
6081: }
6082:
1.795 www 6083: td.LC_parm_overview_level_menu,
6084: td.LC_parm_overview_map_menu,
6085: td.LC_parm_overview_parm_selectors,
6086: td.LC_parm_overview_restrictions {
1.396 albertel 6087: border: 1px solid black;
6088: border-collapse: collapse;
6089: }
1.795 www 6090:
1.396 albertel 6091: table.LC_parm_overview_restrictions td {
6092: border-width: 1px 4px 1px 4px;
6093: border-style: solid;
6094: border-color: $pgbg;
6095: text-align: center;
6096: }
1.795 www 6097:
1.396 albertel 6098: table.LC_parm_overview_restrictions th {
6099: background: $tabbg;
6100: border-width: 1px 4px 1px 4px;
6101: border-style: solid;
6102: border-color: $pgbg;
6103: }
1.795 www 6104:
1.398 albertel 6105: table#LC_helpmenu {
1.803 bisitz 6106: border: none;
1.398 albertel 6107: height: 55px;
1.803 bisitz 6108: border-spacing: 0;
1.398 albertel 6109: }
6110:
6111: table#LC_helpmenu fieldset legend {
6112: font-size: larger;
6113: }
1.795 www 6114:
1.397 albertel 6115: table#LC_helpmenu_links {
6116: width: 100%;
6117: border: 1px solid black;
6118: background: $pgbg;
1.803 bisitz 6119: padding: 0;
1.397 albertel 6120: border-spacing: 1px;
6121: }
1.795 www 6122:
1.397 albertel 6123: table#LC_helpmenu_links tr td {
6124: padding: 1px;
6125: background: $tabbg;
1.399 albertel 6126: text-align: center;
6127: font-weight: bold;
1.397 albertel 6128: }
1.396 albertel 6129:
1.795 www 6130: table#LC_helpmenu_links a:link,
6131: table#LC_helpmenu_links a:visited,
1.397 albertel 6132: table#LC_helpmenu_links a:active {
6133: text-decoration: none;
6134: color: $font;
6135: }
1.795 www 6136:
1.397 albertel 6137: table#LC_helpmenu_links a:hover {
6138: text-decoration: underline;
6139: color: $vlink;
6140: }
1.396 albertel 6141:
1.417 albertel 6142: .LC_chrt_popup_exists {
6143: border: 1px solid #339933;
6144: margin: -1px;
6145: }
1.795 www 6146:
1.417 albertel 6147: .LC_chrt_popup_up {
6148: border: 1px solid yellow;
6149: margin: -1px;
6150: }
1.795 www 6151:
1.417 albertel 6152: .LC_chrt_popup {
6153: border: 1px solid #8888FF;
6154: background: #CCCCFF;
6155: }
1.795 www 6156:
1.421 albertel 6157: table.LC_pick_box {
6158: border-collapse: separate;
6159: background: white;
6160: border: 1px solid black;
6161: border-spacing: 1px;
6162: }
1.795 www 6163:
1.421 albertel 6164: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6165: background: $sidebg;
1.421 albertel 6166: font-weight: bold;
1.900 bisitz 6167: text-align: left;
1.740 bisitz 6168: vertical-align: top;
1.421 albertel 6169: width: 184px;
6170: padding: 8px;
6171: }
1.795 www 6172:
1.579 raeburn 6173: table.LC_pick_box td.LC_pick_box_value {
6174: text-align: left;
6175: padding: 8px;
6176: }
1.795 www 6177:
1.579 raeburn 6178: table.LC_pick_box td.LC_pick_box_select {
6179: text-align: left;
6180: padding: 8px;
6181: }
1.795 www 6182:
1.424 albertel 6183: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6184: padding: 0;
1.421 albertel 6185: height: 1px;
6186: background: black;
6187: }
1.795 www 6188:
1.421 albertel 6189: table.LC_pick_box td.LC_pick_box_submit {
6190: text-align: right;
6191: }
1.795 www 6192:
1.579 raeburn 6193: table.LC_pick_box td.LC_evenrow_value {
6194: text-align: left;
6195: padding: 8px;
6196: background-color: $data_table_light;
6197: }
1.795 www 6198:
1.579 raeburn 6199: table.LC_pick_box td.LC_oddrow_value {
6200: text-align: left;
6201: padding: 8px;
6202: background-color: $data_table_light;
6203: }
1.795 www 6204:
1.579 raeburn 6205: span.LC_helpform_receipt_cat {
6206: font-weight: bold;
6207: }
1.795 www 6208:
1.424 albertel 6209: table.LC_group_priv_box {
6210: background: white;
6211: border: 1px solid black;
6212: border-spacing: 1px;
6213: }
1.795 www 6214:
1.424 albertel 6215: table.LC_group_priv_box td.LC_pick_box_title {
6216: background: $tabbg;
6217: font-weight: bold;
6218: text-align: right;
6219: width: 184px;
6220: }
1.795 www 6221:
1.424 albertel 6222: table.LC_group_priv_box td.LC_groups_fixed {
6223: background: $data_table_light;
6224: text-align: center;
6225: }
1.795 www 6226:
1.424 albertel 6227: table.LC_group_priv_box td.LC_groups_optional {
6228: background: $data_table_dark;
6229: text-align: center;
6230: }
1.795 www 6231:
1.424 albertel 6232: table.LC_group_priv_box td.LC_groups_functionality {
6233: background: $data_table_darker;
6234: text-align: center;
6235: font-weight: bold;
6236: }
1.795 www 6237:
1.424 albertel 6238: table.LC_group_priv td {
6239: text-align: left;
1.803 bisitz 6240: padding: 0;
1.424 albertel 6241: }
6242:
6243: .LC_navbuttons {
6244: margin: 2ex 0ex 2ex 0ex;
6245: }
1.795 www 6246:
1.423 albertel 6247: .LC_topic_bar {
6248: font-weight: bold;
6249: background: $tabbg;
1.918 wenzelju 6250: margin: 1em 0em 1em 2em;
1.805 bisitz 6251: padding: 3px;
1.918 wenzelju 6252: font-size: 1.2em;
1.423 albertel 6253: }
1.795 www 6254:
1.423 albertel 6255: .LC_topic_bar span {
1.918 wenzelju 6256: left: 0.5em;
6257: position: absolute;
1.423 albertel 6258: vertical-align: middle;
1.918 wenzelju 6259: font-size: 1.2em;
1.423 albertel 6260: }
1.795 www 6261:
1.423 albertel 6262: table.LC_course_group_status {
6263: margin: 20px;
6264: }
1.795 www 6265:
1.423 albertel 6266: table.LC_status_selector td {
6267: vertical-align: top;
6268: text-align: center;
1.424 albertel 6269: padding: 4px;
6270: }
1.795 www 6271:
1.599 albertel 6272: div.LC_feedback_link {
1.616 albertel 6273: clear: both;
1.829 kalberla 6274: background: $sidebg;
1.779 bisitz 6275: width: 100%;
1.829 kalberla 6276: padding-bottom: 10px;
6277: border: 1px $tabbg solid;
1.833 kalberla 6278: height: 22px;
6279: line-height: 22px;
6280: padding-top: 5px;
6281: }
6282:
6283: div.LC_feedback_link img {
6284: height: 22px;
1.867 kalberla 6285: vertical-align:middle;
1.829 kalberla 6286: }
6287:
1.911 bisitz 6288: div.LC_feedback_link a {
1.829 kalberla 6289: text-decoration: none;
1.489 raeburn 6290: }
1.795 www 6291:
1.867 kalberla 6292: div.LC_comblock {
1.911 bisitz 6293: display:inline;
1.867 kalberla 6294: color:$font;
6295: font-size:90%;
6296: }
6297:
6298: div.LC_feedback_link div.LC_comblock {
6299: padding-left:5px;
6300: }
6301:
6302: div.LC_feedback_link div.LC_comblock a {
6303: color:$font;
6304: }
6305:
1.489 raeburn 6306: span.LC_feedback_link {
1.858 bisitz 6307: /* background: $feedback_link_bg; */
1.599 albertel 6308: font-size: larger;
6309: }
1.795 www 6310:
1.599 albertel 6311: span.LC_message_link {
1.858 bisitz 6312: /* background: $feedback_link_bg; */
1.599 albertel 6313: font-size: larger;
6314: position: absolute;
6315: right: 1em;
1.489 raeburn 6316: }
1.421 albertel 6317:
1.515 albertel 6318: table.LC_prior_tries {
1.524 albertel 6319: border: 1px solid #000000;
6320: border-collapse: separate;
6321: border-spacing: 1px;
1.515 albertel 6322: }
1.523 albertel 6323:
1.515 albertel 6324: table.LC_prior_tries td {
1.524 albertel 6325: padding: 2px;
1.515 albertel 6326: }
1.523 albertel 6327:
6328: .LC_answer_correct {
1.795 www 6329: background: lightgreen;
6330: color: darkgreen;
6331: padding: 6px;
1.523 albertel 6332: }
1.795 www 6333:
1.523 albertel 6334: .LC_answer_charged_try {
1.797 www 6335: background: #FFAAAA;
1.795 www 6336: color: darkred;
6337: padding: 6px;
1.523 albertel 6338: }
1.795 www 6339:
1.779 bisitz 6340: .LC_answer_not_charged_try,
1.523 albertel 6341: .LC_answer_no_grade,
6342: .LC_answer_late {
1.795 www 6343: background: lightyellow;
1.523 albertel 6344: color: black;
1.795 www 6345: padding: 6px;
1.523 albertel 6346: }
1.795 www 6347:
1.523 albertel 6348: .LC_answer_previous {
1.795 www 6349: background: lightblue;
6350: color: darkblue;
6351: padding: 6px;
1.523 albertel 6352: }
1.795 www 6353:
1.779 bisitz 6354: .LC_answer_no_message {
1.777 tempelho 6355: background: #FFFFFF;
6356: color: black;
1.795 www 6357: padding: 6px;
1.779 bisitz 6358: }
1.795 www 6359:
1.779 bisitz 6360: .LC_answer_unknown {
6361: background: orange;
6362: color: black;
1.795 www 6363: padding: 6px;
1.777 tempelho 6364: }
1.795 www 6365:
1.529 albertel 6366: span.LC_prior_numerical,
6367: span.LC_prior_string,
6368: span.LC_prior_custom,
6369: span.LC_prior_reaction,
6370: span.LC_prior_math {
1.925 bisitz 6371: font-family: $mono;
1.523 albertel 6372: white-space: pre;
6373: }
6374:
1.525 albertel 6375: span.LC_prior_string {
1.925 bisitz 6376: font-family: $mono;
1.525 albertel 6377: white-space: pre;
6378: }
6379:
1.523 albertel 6380: table.LC_prior_option {
6381: width: 100%;
6382: border-collapse: collapse;
6383: }
1.795 www 6384:
1.911 bisitz 6385: table.LC_prior_rank,
1.795 www 6386: table.LC_prior_match {
1.528 albertel 6387: border-collapse: collapse;
6388: }
1.795 www 6389:
1.528 albertel 6390: table.LC_prior_option tr td,
6391: table.LC_prior_rank tr td,
6392: table.LC_prior_match tr td {
1.524 albertel 6393: border: 1px solid #000000;
1.515 albertel 6394: }
6395:
1.855 bisitz 6396: .LC_nobreak {
1.544 albertel 6397: white-space: nowrap;
1.519 raeburn 6398: }
6399:
1.576 raeburn 6400: span.LC_cusr_emph {
6401: font-style: italic;
6402: }
6403:
1.633 raeburn 6404: span.LC_cusr_subheading {
6405: font-weight: normal;
6406: font-size: 85%;
6407: }
6408:
1.861 bisitz 6409: div.LC_docs_entry_move {
1.859 bisitz 6410: border: 1px solid #BBBBBB;
1.545 albertel 6411: background: #DDDDDD;
1.861 bisitz 6412: width: 22px;
1.859 bisitz 6413: padding: 1px;
6414: margin: 0;
1.545 albertel 6415: }
6416:
1.861 bisitz 6417: table.LC_data_table tr > td.LC_docs_entry_commands,
6418: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6419: font-size: x-small;
6420: }
1.795 www 6421:
1.861 bisitz 6422: .LC_docs_entry_parameter {
6423: white-space: nowrap;
6424: }
6425:
1.544 albertel 6426: .LC_docs_copy {
1.545 albertel 6427: color: #000099;
1.544 albertel 6428: }
1.795 www 6429:
1.544 albertel 6430: .LC_docs_cut {
1.545 albertel 6431: color: #550044;
1.544 albertel 6432: }
1.795 www 6433:
1.544 albertel 6434: .LC_docs_rename {
1.545 albertel 6435: color: #009900;
1.544 albertel 6436: }
1.795 www 6437:
1.544 albertel 6438: .LC_docs_remove {
1.545 albertel 6439: color: #990000;
6440: }
6441:
1.547 albertel 6442: .LC_docs_reinit_warn,
6443: .LC_docs_ext_edit {
6444: font-size: x-small;
6445: }
6446:
1.545 albertel 6447: table.LC_docs_adddocs td,
6448: table.LC_docs_adddocs th {
6449: border: 1px solid #BBBBBB;
6450: padding: 4px;
6451: background: #DDDDDD;
1.543 albertel 6452: }
6453:
1.584 albertel 6454: table.LC_sty_begin {
6455: background: #BBFFBB;
6456: }
1.795 www 6457:
1.584 albertel 6458: table.LC_sty_end {
6459: background: #FFBBBB;
6460: }
6461:
1.589 raeburn 6462: table.LC_double_column {
1.803 bisitz 6463: border-width: 0;
1.589 raeburn 6464: border-collapse: collapse;
6465: width: 100%;
6466: padding: 2px;
6467: }
6468:
6469: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6470: top: 2px;
1.589 raeburn 6471: left: 2px;
6472: width: 47%;
6473: vertical-align: top;
6474: }
6475:
6476: table.LC_double_column tr td.LC_right_col {
6477: top: 2px;
1.779 bisitz 6478: right: 2px;
1.589 raeburn 6479: width: 47%;
6480: vertical-align: top;
6481: }
6482:
1.591 raeburn 6483: div.LC_left_float {
6484: float: left;
6485: padding-right: 5%;
1.597 albertel 6486: padding-bottom: 4px;
1.591 raeburn 6487: }
6488:
6489: div.LC_clear_float_header {
1.597 albertel 6490: padding-bottom: 2px;
1.591 raeburn 6491: }
6492:
6493: div.LC_clear_float_footer {
1.597 albertel 6494: padding-top: 10px;
1.591 raeburn 6495: clear: both;
6496: }
6497:
1.597 albertel 6498: div.LC_grade_show_user {
1.941 bisitz 6499: /* border-left: 5px solid $sidebg; */
6500: border-top: 5px solid #000000;
6501: margin: 50px 0 0 0;
1.936 bisitz 6502: padding: 15px 0 5px 10px;
1.597 albertel 6503: }
1.795 www 6504:
1.936 bisitz 6505: div.LC_grade_show_user_odd_row {
1.941 bisitz 6506: /* border-left: 5px solid #000000; */
6507: }
6508:
6509: div.LC_grade_show_user div.LC_Box {
6510: margin-right: 50px;
1.597 albertel 6511: }
6512:
6513: div.LC_grade_submissions,
6514: div.LC_grade_message_center,
1.936 bisitz 6515: div.LC_grade_info_links {
1.597 albertel 6516: margin: 5px;
6517: width: 99%;
6518: background: #FFFFFF;
6519: }
1.795 www 6520:
1.597 albertel 6521: div.LC_grade_submissions_header,
1.936 bisitz 6522: div.LC_grade_message_center_header {
1.705 tempelho 6523: font-weight: bold;
6524: font-size: large;
1.597 albertel 6525: }
1.795 www 6526:
1.597 albertel 6527: div.LC_grade_submissions_body,
1.936 bisitz 6528: div.LC_grade_message_center_body {
1.597 albertel 6529: border: 1px solid black;
6530: width: 99%;
6531: background: #FFFFFF;
6532: }
1.795 www 6533:
1.613 albertel 6534: table.LC_scantron_action {
6535: width: 100%;
6536: }
1.795 www 6537:
1.613 albertel 6538: table.LC_scantron_action tr th {
1.698 harmsja 6539: font-weight:bold;
6540: font-style:normal;
1.613 albertel 6541: }
1.795 www 6542:
1.779 bisitz 6543: .LC_edit_problem_header,
1.614 albertel 6544: div.LC_edit_problem_footer {
1.705 tempelho 6545: font-weight: normal;
6546: font-size: medium;
1.602 albertel 6547: margin: 2px;
1.1060 bisitz 6548: background-color: $sidebg;
1.600 albertel 6549: }
1.795 www 6550:
1.600 albertel 6551: div.LC_edit_problem_header,
1.602 albertel 6552: div.LC_edit_problem_header div,
1.614 albertel 6553: div.LC_edit_problem_footer,
6554: div.LC_edit_problem_footer div,
1.602 albertel 6555: div.LC_edit_problem_editxml_header,
6556: div.LC_edit_problem_editxml_header div {
1.600 albertel 6557: margin-top: 5px;
6558: }
1.795 www 6559:
1.600 albertel 6560: div.LC_edit_problem_header_title {
1.705 tempelho 6561: font-weight: bold;
6562: font-size: larger;
1.602 albertel 6563: background: $tabbg;
6564: padding: 3px;
1.1060 bisitz 6565: margin: 0 0 5px 0;
1.602 albertel 6566: }
1.795 www 6567:
1.602 albertel 6568: table.LC_edit_problem_header_title {
6569: width: 100%;
1.600 albertel 6570: background: $tabbg;
1.602 albertel 6571: }
6572:
6573: div.LC_edit_problem_discards {
6574: float: left;
6575: padding-bottom: 5px;
6576: }
1.795 www 6577:
1.602 albertel 6578: div.LC_edit_problem_saves {
6579: float: right;
6580: padding-bottom: 5px;
1.600 albertel 6581: }
1.795 www 6582:
1.1124 bisitz 6583: .LC_edit_opt {
6584: padding-left: 1em;
6585: white-space: nowrap;
6586: }
6587:
1.1152 golterma 6588: .LC_edit_problem_latexhelper{
6589: text-align: right;
6590: }
6591:
6592: #LC_edit_problem_colorful div{
6593: margin-left: 40px;
6594: }
6595:
1.911 bisitz 6596: img.stift {
1.803 bisitz 6597: border-width: 0;
6598: vertical-align: middle;
1.677 riegler 6599: }
1.680 riegler 6600:
1.923 bisitz 6601: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6602: vertical-align: top;
1.777 tempelho 6603: }
1.795 www 6604:
1.716 raeburn 6605: div.LC_createcourse {
1.911 bisitz 6606: margin: 10px 10px 10px 10px;
1.716 raeburn 6607: }
6608:
1.917 raeburn 6609: .LC_dccid {
1.1130 raeburn 6610: float: right;
1.917 raeburn 6611: margin: 0.2em 0 0 0;
6612: padding: 0;
6613: font-size: 90%;
6614: display:none;
6615: }
6616:
1.897 wenzelju 6617: ol.LC_primary_menu a:hover,
1.721 harmsja 6618: ol#LC_MenuBreadcrumbs a:hover,
6619: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6620: ul#LC_secondary_menu a:hover,
1.721 harmsja 6621: .LC_FormSectionClearButton input:hover
1.795 www 6622: ul.LC_TabContent li:hover a {
1.952 onken 6623: color:$button_hover;
1.911 bisitz 6624: text-decoration:none;
1.693 droeschl 6625: }
6626:
1.779 bisitz 6627: h1 {
1.911 bisitz 6628: padding: 0;
6629: line-height:130%;
1.693 droeschl 6630: }
1.698 harmsja 6631:
1.911 bisitz 6632: h2,
6633: h3,
6634: h4,
6635: h5,
6636: h6 {
6637: margin: 5px 0 5px 0;
6638: padding: 0;
6639: line-height:130%;
1.693 droeschl 6640: }
1.795 www 6641:
6642: .LC_hcell {
1.911 bisitz 6643: padding:3px 15px 3px 15px;
6644: margin: 0;
6645: background-color:$tabbg;
6646: color:$fontmenu;
6647: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6648: }
1.795 www 6649:
1.840 bisitz 6650: .LC_Box > .LC_hcell {
1.911 bisitz 6651: margin: 0 -10px 10px -10px;
1.835 bisitz 6652: }
6653:
1.721 harmsja 6654: .LC_noBorder {
1.911 bisitz 6655: border: 0;
1.698 harmsja 6656: }
1.693 droeschl 6657:
1.721 harmsja 6658: .LC_FormSectionClearButton input {
1.911 bisitz 6659: background-color:transparent;
6660: border: none;
6661: cursor:pointer;
6662: text-decoration:underline;
1.693 droeschl 6663: }
1.763 bisitz 6664:
6665: .LC_help_open_topic {
1.911 bisitz 6666: color: #FFFFFF;
6667: background-color: #EEEEFF;
6668: margin: 1px;
6669: padding: 4px;
6670: border: 1px solid #000033;
6671: white-space: nowrap;
6672: /* vertical-align: middle; */
1.759 neumanie 6673: }
1.693 droeschl 6674:
1.911 bisitz 6675: dl,
6676: ul,
6677: div,
6678: fieldset {
6679: margin: 10px 10px 10px 0;
6680: /* overflow: hidden; */
1.693 droeschl 6681: }
1.795 www 6682:
1.838 bisitz 6683: fieldset > legend {
1.911 bisitz 6684: font-weight: bold;
6685: padding: 0 5px 0 5px;
1.838 bisitz 6686: }
6687:
1.813 bisitz 6688: #LC_nav_bar {
1.911 bisitz 6689: float: left;
1.995 raeburn 6690: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6691: margin: 0 0 2px 0;
1.807 droeschl 6692: }
6693:
1.916 droeschl 6694: #LC_realm {
6695: margin: 0.2em 0 0 0;
6696: padding: 0;
6697: font-weight: bold;
6698: text-align: center;
1.995 raeburn 6699: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6700: }
6701:
1.911 bisitz 6702: #LC_nav_bar em {
6703: font-weight: bold;
6704: font-style: normal;
1.807 droeschl 6705: }
6706:
1.897 wenzelju 6707: ol.LC_primary_menu {
1.934 droeschl 6708: margin: 0;
1.1076 raeburn 6709: padding: 0;
1.995 raeburn 6710: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6711: }
6712:
1.852 droeschl 6713: ol#LC_PathBreadcrumbs {
1.911 bisitz 6714: margin: 0;
1.693 droeschl 6715: }
6716:
1.897 wenzelju 6717: ol.LC_primary_menu li {
1.1076 raeburn 6718: color: RGB(80, 80, 80);
6719: vertical-align: middle;
6720: text-align: left;
6721: list-style: none;
6722: float: left;
6723: }
6724:
6725: ol.LC_primary_menu li a {
6726: display: block;
6727: margin: 0;
6728: padding: 0 5px 0 10px;
6729: text-decoration: none;
6730: }
6731:
6732: ol.LC_primary_menu li ul {
6733: display: none;
6734: width: 10em;
6735: background-color: $data_table_light;
6736: }
6737:
6738: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6739: display: block;
6740: position: absolute;
6741: margin: 0;
6742: padding: 0;
1.1078 raeburn 6743: z-index: 2;
1.1076 raeburn 6744: }
6745:
6746: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6747: font-size: 90%;
1.911 bisitz 6748: vertical-align: top;
1.1076 raeburn 6749: float: none;
1.1079 raeburn 6750: border-left: 1px solid black;
6751: border-right: 1px solid black;
1.1076 raeburn 6752: }
6753:
6754: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078 raeburn 6755: background-color:$data_table_light;
1.1076 raeburn 6756: }
6757:
6758: ol.LC_primary_menu li li a:hover {
6759: color:$button_hover;
6760: background-color:$data_table_dark;
1.693 droeschl 6761: }
6762:
1.897 wenzelju 6763: ol.LC_primary_menu li img {
1.911 bisitz 6764: vertical-align: bottom;
1.934 droeschl 6765: height: 1.1em;
1.1077 raeburn 6766: margin: 0.2em 0 0 0;
1.693 droeschl 6767: }
6768:
1.897 wenzelju 6769: ol.LC_primary_menu a {
1.911 bisitz 6770: color: RGB(80, 80, 80);
6771: text-decoration: none;
1.693 droeschl 6772: }
1.795 www 6773:
1.949 droeschl 6774: ol.LC_primary_menu a.LC_new_message {
6775: font-weight:bold;
6776: color: darkred;
6777: }
6778:
1.975 raeburn 6779: ol.LC_docs_parameters {
6780: margin-left: 0;
6781: padding: 0;
6782: list-style: none;
6783: }
6784:
6785: ol.LC_docs_parameters li {
6786: margin: 0;
6787: padding-right: 20px;
6788: display: inline;
6789: }
6790:
1.976 raeburn 6791: ol.LC_docs_parameters li:before {
6792: content: "\\002022 \\0020";
6793: }
6794:
6795: li.LC_docs_parameters_title {
6796: font-weight: bold;
6797: }
6798:
6799: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6800: content: "";
6801: }
6802:
1.897 wenzelju 6803: ul#LC_secondary_menu {
1.1107 raeburn 6804: clear: right;
1.911 bisitz 6805: color: $fontmenu;
6806: background: $tabbg;
6807: list-style: none;
6808: padding: 0;
6809: margin: 0;
6810: width: 100%;
1.995 raeburn 6811: text-align: left;
1.1107 raeburn 6812: float: left;
1.808 droeschl 6813: }
6814:
1.897 wenzelju 6815: ul#LC_secondary_menu li {
1.911 bisitz 6816: font-weight: bold;
6817: line-height: 1.8em;
1.1107 raeburn 6818: border-right: 1px solid black;
6819: float: left;
6820: }
6821:
6822: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6823: background-color: $data_table_light;
6824: }
6825:
6826: ul#LC_secondary_menu li a {
1.911 bisitz 6827: padding: 0 0.8em;
1.1107 raeburn 6828: }
6829:
6830: ul#LC_secondary_menu li ul {
6831: display: none;
6832: }
6833:
6834: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6835: display: block;
6836: position: absolute;
6837: margin: 0;
6838: padding: 0;
6839: list-style:none;
6840: float: none;
6841: background-color: $data_table_light;
6842: z-index: 2;
6843: margin-left: -1px;
6844: }
6845:
6846: ul#LC_secondary_menu li ul li {
6847: font-size: 90%;
6848: vertical-align: top;
6849: border-left: 1px solid black;
1.911 bisitz 6850: border-right: 1px solid black;
1.1119 raeburn 6851: background-color: $data_table_light;
1.1107 raeburn 6852: list-style:none;
6853: float: none;
6854: }
6855:
6856: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6857: background-color: $data_table_dark;
1.807 droeschl 6858: }
6859:
1.847 tempelho 6860: ul.LC_TabContent {
1.911 bisitz 6861: display:block;
6862: background: $sidebg;
6863: border-bottom: solid 1px $lg_border_color;
6864: list-style:none;
1.1020 raeburn 6865: margin: -1px -10px 0 -10px;
1.911 bisitz 6866: padding: 0;
1.693 droeschl 6867: }
6868:
1.795 www 6869: ul.LC_TabContent li,
6870: ul.LC_TabContentBigger li {
1.911 bisitz 6871: float:left;
1.741 harmsja 6872: }
1.795 www 6873:
1.897 wenzelju 6874: ul#LC_secondary_menu li a {
1.911 bisitz 6875: color: $fontmenu;
6876: text-decoration: none;
1.693 droeschl 6877: }
1.795 www 6878:
1.721 harmsja 6879: ul.LC_TabContent {
1.952 onken 6880: min-height:20px;
1.721 harmsja 6881: }
1.795 www 6882:
6883: ul.LC_TabContent li {
1.911 bisitz 6884: vertical-align:middle;
1.959 onken 6885: padding: 0 16px 0 10px;
1.911 bisitz 6886: background-color:$tabbg;
6887: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6888: border-left: solid 1px $font;
1.721 harmsja 6889: }
1.795 www 6890:
1.847 tempelho 6891: ul.LC_TabContent .right {
1.911 bisitz 6892: float:right;
1.847 tempelho 6893: }
6894:
1.911 bisitz 6895: ul.LC_TabContent li a,
6896: ul.LC_TabContent li {
6897: color:rgb(47,47,47);
6898: text-decoration:none;
6899: font-size:95%;
6900: font-weight:bold;
1.952 onken 6901: min-height:20px;
6902: }
6903:
1.959 onken 6904: ul.LC_TabContent li a:hover,
6905: ul.LC_TabContent li a:focus {
1.952 onken 6906: color: $button_hover;
1.959 onken 6907: background:none;
6908: outline:none;
1.952 onken 6909: }
6910:
6911: ul.LC_TabContent li:hover {
6912: color: $button_hover;
6913: cursor:pointer;
1.721 harmsja 6914: }
1.795 www 6915:
1.911 bisitz 6916: ul.LC_TabContent li.active {
1.952 onken 6917: color: $font;
1.911 bisitz 6918: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6919: border-bottom:solid 1px #FFFFFF;
6920: cursor: default;
1.744 ehlerst 6921: }
1.795 www 6922:
1.959 onken 6923: ul.LC_TabContent li.active a {
6924: color:$font;
6925: background:#FFFFFF;
6926: outline: none;
6927: }
1.1047 raeburn 6928:
6929: ul.LC_TabContent li.goback {
6930: float: left;
6931: border-left: none;
6932: }
6933:
1.870 tempelho 6934: #maincoursedoc {
1.911 bisitz 6935: clear:both;
1.870 tempelho 6936: }
6937:
6938: ul.LC_TabContentBigger {
1.911 bisitz 6939: display:block;
6940: list-style:none;
6941: padding: 0;
1.870 tempelho 6942: }
6943:
1.795 www 6944: ul.LC_TabContentBigger li {
1.911 bisitz 6945: vertical-align:bottom;
6946: height: 30px;
6947: font-size:110%;
6948: font-weight:bold;
6949: color: #737373;
1.841 tempelho 6950: }
6951:
1.957 onken 6952: ul.LC_TabContentBigger li.active {
6953: position: relative;
6954: top: 1px;
6955: }
6956:
1.870 tempelho 6957: ul.LC_TabContentBigger li a {
1.911 bisitz 6958: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6959: height: 30px;
6960: line-height: 30px;
6961: text-align: center;
6962: display: block;
6963: text-decoration: none;
1.958 onken 6964: outline: none;
1.741 harmsja 6965: }
1.795 www 6966:
1.870 tempelho 6967: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6968: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6969: color:$font;
1.744 ehlerst 6970: }
1.795 www 6971:
1.870 tempelho 6972: ul.LC_TabContentBigger li b {
1.911 bisitz 6973: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6974: display: block;
6975: float: left;
6976: padding: 0 30px;
1.957 onken 6977: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6978: }
6979:
1.956 onken 6980: ul.LC_TabContentBigger li:hover b {
6981: color:$button_hover;
6982: }
6983:
1.870 tempelho 6984: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6985: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6986: color:$font;
1.957 onken 6987: border: 0;
1.741 harmsja 6988: }
1.693 droeschl 6989:
1.870 tempelho 6990:
1.862 bisitz 6991: ul.LC_CourseBreadcrumbs {
6992: background: $sidebg;
1.1020 raeburn 6993: height: 2em;
1.862 bisitz 6994: padding-left: 10px;
1.1020 raeburn 6995: margin: 0;
1.862 bisitz 6996: list-style-position: inside;
6997: }
6998:
1.911 bisitz 6999: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7000: ol#LC_PathBreadcrumbs {
1.911 bisitz 7001: padding-left: 10px;
7002: margin: 0;
1.933 droeschl 7003: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7004: }
7005:
1.911 bisitz 7006: ol#LC_MenuBreadcrumbs li,
7007: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7008: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7009: display: inline;
1.933 droeschl 7010: white-space: normal;
1.693 droeschl 7011: }
7012:
1.823 bisitz 7013: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7014: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7015: text-decoration: none;
7016: font-size:90%;
1.693 droeschl 7017: }
1.795 www 7018:
1.969 droeschl 7019: ol#LC_MenuBreadcrumbs h1 {
7020: display: inline;
7021: font-size: 90%;
7022: line-height: 2.5em;
7023: margin: 0;
7024: padding: 0;
7025: }
7026:
1.795 www 7027: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7028: text-decoration:none;
7029: font-size:100%;
7030: font-weight:bold;
1.693 droeschl 7031: }
1.795 www 7032:
1.840 bisitz 7033: .LC_Box {
1.911 bisitz 7034: border: solid 1px $lg_border_color;
7035: padding: 0 10px 10px 10px;
1.746 neumanie 7036: }
1.795 www 7037:
1.1020 raeburn 7038: .LC_DocsBox {
7039: border: solid 1px $lg_border_color;
7040: padding: 0 0 10px 10px;
7041: }
7042:
1.795 www 7043: .LC_AboutMe_Image {
1.911 bisitz 7044: float:left;
7045: margin-right:10px;
1.747 neumanie 7046: }
1.795 www 7047:
7048: .LC_Clear_AboutMe_Image {
1.911 bisitz 7049: clear:left;
1.747 neumanie 7050: }
1.795 www 7051:
1.721 harmsja 7052: dl.LC_ListStyleClean dt {
1.911 bisitz 7053: padding-right: 5px;
7054: display: table-header-group;
1.693 droeschl 7055: }
7056:
1.721 harmsja 7057: dl.LC_ListStyleClean dd {
1.911 bisitz 7058: display: table-row;
1.693 droeschl 7059: }
7060:
1.721 harmsja 7061: .LC_ListStyleClean,
7062: .LC_ListStyleSimple,
7063: .LC_ListStyleNormal,
1.795 www 7064: .LC_ListStyleSpecial {
1.911 bisitz 7065: /* display:block; */
7066: list-style-position: inside;
7067: list-style-type: none;
7068: overflow: hidden;
7069: padding: 0;
1.693 droeschl 7070: }
7071:
1.721 harmsja 7072: .LC_ListStyleSimple li,
7073: .LC_ListStyleSimple dd,
7074: .LC_ListStyleNormal li,
7075: .LC_ListStyleNormal dd,
7076: .LC_ListStyleSpecial li,
1.795 www 7077: .LC_ListStyleSpecial dd {
1.911 bisitz 7078: margin: 0;
7079: padding: 5px 5px 5px 10px;
7080: clear: both;
1.693 droeschl 7081: }
7082:
1.721 harmsja 7083: .LC_ListStyleClean li,
7084: .LC_ListStyleClean dd {
1.911 bisitz 7085: padding-top: 0;
7086: padding-bottom: 0;
1.693 droeschl 7087: }
7088:
1.721 harmsja 7089: .LC_ListStyleSimple dd,
1.795 www 7090: .LC_ListStyleSimple li {
1.911 bisitz 7091: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7092: }
7093:
1.721 harmsja 7094: .LC_ListStyleSpecial li,
7095: .LC_ListStyleSpecial dd {
1.911 bisitz 7096: list-style-type: none;
7097: background-color: RGB(220, 220, 220);
7098: margin-bottom: 4px;
1.693 droeschl 7099: }
7100:
1.721 harmsja 7101: table.LC_SimpleTable {
1.911 bisitz 7102: margin:5px;
7103: border:solid 1px $lg_border_color;
1.795 www 7104: }
1.693 droeschl 7105:
1.721 harmsja 7106: table.LC_SimpleTable tr {
1.911 bisitz 7107: padding: 0;
7108: border:solid 1px $lg_border_color;
1.693 droeschl 7109: }
1.795 www 7110:
7111: table.LC_SimpleTable thead {
1.911 bisitz 7112: background:rgb(220,220,220);
1.693 droeschl 7113: }
7114:
1.721 harmsja 7115: div.LC_columnSection {
1.911 bisitz 7116: display: block;
7117: clear: both;
7118: overflow: hidden;
7119: margin: 0;
1.693 droeschl 7120: }
7121:
1.721 harmsja 7122: div.LC_columnSection>* {
1.911 bisitz 7123: float: left;
7124: margin: 10px 20px 10px 0;
7125: overflow:hidden;
1.693 droeschl 7126: }
1.721 harmsja 7127:
1.795 www 7128: table em {
1.911 bisitz 7129: font-weight: bold;
7130: font-style: normal;
1.748 schulted 7131: }
1.795 www 7132:
1.779 bisitz 7133: table.LC_tableBrowseRes,
1.795 www 7134: table.LC_tableOfContent {
1.911 bisitz 7135: border:none;
7136: border-spacing: 1px;
7137: padding: 3px;
7138: background-color: #FFFFFF;
7139: font-size: 90%;
1.753 droeschl 7140: }
1.789 droeschl 7141:
1.911 bisitz 7142: table.LC_tableOfContent {
7143: border-collapse: collapse;
1.789 droeschl 7144: }
7145:
1.771 droeschl 7146: table.LC_tableBrowseRes a,
1.768 schulted 7147: table.LC_tableOfContent a {
1.911 bisitz 7148: background-color: transparent;
7149: text-decoration: none;
1.753 droeschl 7150: }
7151:
1.795 www 7152: table.LC_tableOfContent img {
1.911 bisitz 7153: border: none;
7154: height: 1.3em;
7155: vertical-align: text-bottom;
7156: margin-right: 0.3em;
1.753 droeschl 7157: }
1.757 schulted 7158:
1.795 www 7159: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7160: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7161: }
7162:
1.795 www 7163: a#LC_content_toolbar_everything {
1.911 bisitz 7164: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7165: }
7166:
1.795 www 7167: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7168: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7169: }
7170:
1.795 www 7171: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7172: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7173: }
7174:
1.795 www 7175: a#LC_content_toolbar_changefolder {
1.911 bisitz 7176: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7177: }
7178:
1.795 www 7179: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7180: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7181: }
7182:
1.1043 raeburn 7183: a#LC_content_toolbar_edittoplevel {
7184: background-image:url(/res/adm/pages/edittoplevel.gif);
7185: }
7186:
1.795 www 7187: ul#LC_toolbar li a:hover {
1.911 bisitz 7188: background-position: bottom center;
1.757 schulted 7189: }
7190:
1.795 www 7191: ul#LC_toolbar {
1.911 bisitz 7192: padding: 0;
7193: margin: 2px;
7194: list-style:none;
7195: position:relative;
7196: background-color:white;
1.1082 raeburn 7197: overflow: auto;
1.757 schulted 7198: }
7199:
1.795 www 7200: ul#LC_toolbar li {
1.911 bisitz 7201: border:1px solid white;
7202: padding: 0;
7203: margin: 0;
7204: float: left;
7205: display:inline;
7206: vertical-align:middle;
1.1082 raeburn 7207: white-space: nowrap;
1.911 bisitz 7208: }
1.757 schulted 7209:
1.783 amueller 7210:
1.795 www 7211: a.LC_toolbarItem {
1.911 bisitz 7212: display:block;
7213: padding: 0;
7214: margin: 0;
7215: height: 32px;
7216: width: 32px;
7217: color:white;
7218: border: none;
7219: background-repeat:no-repeat;
7220: background-color:transparent;
1.757 schulted 7221: }
7222:
1.915 droeschl 7223: ul.LC_funclist {
7224: margin: 0;
7225: padding: 0.5em 1em 0.5em 0;
7226: }
7227:
1.933 droeschl 7228: ul.LC_funclist > li:first-child {
7229: font-weight:bold;
7230: margin-left:0.8em;
7231: }
7232:
1.915 droeschl 7233: ul.LC_funclist + ul.LC_funclist {
7234: /*
7235: left border as a seperator if we have more than
7236: one list
7237: */
7238: border-left: 1px solid $sidebg;
7239: /*
7240: this hides the left border behind the border of the
7241: outer box if element is wrapped to the next 'line'
7242: */
7243: margin-left: -1px;
7244: }
7245:
1.843 bisitz 7246: ul.LC_funclist li {
1.915 droeschl 7247: display: inline;
1.782 bisitz 7248: white-space: nowrap;
1.915 droeschl 7249: margin: 0 0 0 25px;
7250: line-height: 150%;
1.782 bisitz 7251: }
7252:
1.974 wenzelju 7253: .LC_hidden {
7254: display: none;
7255: }
7256:
1.1030 www 7257: .LCmodal-overlay {
7258: position:fixed;
7259: top:0;
7260: right:0;
7261: bottom:0;
7262: left:0;
7263: height:100%;
7264: width:100%;
7265: margin:0;
7266: padding:0;
7267: background:#999;
7268: opacity:.75;
7269: filter: alpha(opacity=75);
7270: -moz-opacity: 0.75;
7271: z-index:101;
7272: }
7273:
7274: * html .LCmodal-overlay {
7275: position: absolute;
7276: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7277: }
7278:
7279: .LCmodal-window {
7280: position:fixed;
7281: top:50%;
7282: left:50%;
7283: margin:0;
7284: padding:0;
7285: z-index:102;
7286: }
7287:
7288: * html .LCmodal-window {
7289: position:absolute;
7290: }
7291:
7292: .LCclose-window {
7293: position:absolute;
7294: width:32px;
7295: height:32px;
7296: right:8px;
7297: top:8px;
7298: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7299: text-indent:-99999px;
7300: overflow:hidden;
7301: cursor:pointer;
7302: }
7303:
1.1100 raeburn 7304: /*
7305: styles used by TTH when "Default set of options to pass to tth/m
7306: when converting TeX" in course settings has been set
7307:
7308: option passed: -t
7309:
7310: */
7311:
7312: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7313: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7314: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7315: td div.norm {line-height:normal;}
7316:
7317: /*
7318: option passed -y3
7319: */
7320:
7321: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7322: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7323: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7324:
1.343 albertel 7325: END
7326: }
7327:
1.306 albertel 7328: =pod
7329:
7330: =item * &headtag()
7331:
7332: Returns a uniform footer for LON-CAPA web pages.
7333:
1.307 albertel 7334: Inputs: $title - optional title for the head
7335: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7336: $args - optional arguments
1.319 albertel 7337: force_register - if is true call registerurl so the remote is
7338: informed
1.415 albertel 7339: redirect -> array ref of
7340: 1- seconds before redirect occurs
7341: 2- url to redirect to
7342: 3- whether the side effect should occur
1.315 albertel 7343: (side effect of setting
7344: $env{'internal.head.redirect'} to the url
7345: redirected too)
1.352 albertel 7346: domain -> force to color decorate a page for a specific
7347: domain
7348: function -> force usage of a specific rolish color scheme
7349: bgcolor -> override the default page bgcolor
1.460 albertel 7350: no_auto_mt_title
7351: -> prevent &mt()ing the title arg
1.464 albertel 7352:
1.306 albertel 7353: =cut
7354:
7355: sub headtag {
1.313 albertel 7356: my ($title,$head_extra,$args) = @_;
1.306 albertel 7357:
1.363 albertel 7358: my $function = $args->{'function'} || &get_users_function();
7359: my $domain = $args->{'domain'} || &determinedomain();
7360: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7361: my $httphost = $args->{'use_absolute'};
1.418 albertel 7362: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7363: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7364: #time(),
1.418 albertel 7365: $env{'environment.color.timestamp'},
1.363 albertel 7366: $function,$domain,$bgcolor);
7367:
1.369 www 7368: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7369:
1.308 albertel 7370: my $result =
7371: '<head>'.
1.1160 raeburn 7372: &font_settings($args);
1.319 albertel 7373:
1.1188 raeburn 7374: my $inhibitprint;
7375: if ($args->{'print_suppress'}) {
7376: $inhibitprint = &print_suppression();
7377: }
1.1064 raeburn 7378:
1.461 albertel 7379: if (!$args->{'frameset'}) {
7380: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7381: }
1.962 droeschl 7382: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7383: $result .= Apache::lonxml::display_title();
1.319 albertel 7384: }
1.436 albertel 7385: if (!$args->{'no_nav_bar'}
7386: && !$args->{'only_body'}
7387: && !$args->{'frameset'}) {
1.1154 raeburn 7388: $result .= &help_menu_js($httphost);
1.1032 www 7389: $result.=&modal_window();
1.1038 www 7390: $result.=&togglebox_script();
1.1034 www 7391: $result.=&wishlist_window();
1.1041 www 7392: $result.=&LCprogressbarUpdate_script();
1.1034 www 7393: } else {
7394: if ($args->{'add_modal'}) {
7395: $result.=&modal_window();
7396: }
7397: if ($args->{'add_wishlist'}) {
7398: $result.=&wishlist_window();
7399: }
1.1038 www 7400: if ($args->{'add_togglebox'}) {
7401: $result.=&togglebox_script();
7402: }
1.1041 www 7403: if ($args->{'add_progressbar'}) {
7404: $result.=&LCprogressbarUpdate_script();
7405: }
1.436 albertel 7406: }
1.314 albertel 7407: if (ref($args->{'redirect'})) {
1.414 albertel 7408: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7409: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7410: if (!$inhibit_continue) {
7411: $env{'internal.head.redirect'} = $url;
7412: }
1.313 albertel 7413: $result.=<<ADDMETA
7414: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7415: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7416: ADDMETA
7417: }
1.306 albertel 7418: if (!defined($title)) {
7419: $title = 'The LearningOnline Network with CAPA';
7420: }
1.460 albertel 7421: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7422: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7423: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7424: if (!$args->{'frameset'}) {
7425: $result .= ' /';
7426: }
7427: $result .= '>'
1.1064 raeburn 7428: .$inhibitprint
1.414 albertel 7429: .$head_extra;
1.1137 raeburn 7430: if ($env{'browser.mobile'}) {
7431: $result .= '
7432: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7433: <meta name="apple-mobile-web-app-capable" content="yes" />';
7434: }
1.962 droeschl 7435: return $result.'</head>';
1.306 albertel 7436: }
7437:
7438: =pod
7439:
1.340 albertel 7440: =item * &font_settings()
7441:
7442: Returns neccessary <meta> to set the proper encoding
7443:
1.1160 raeburn 7444: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7445:
7446: =cut
7447:
7448: sub font_settings {
1.1160 raeburn 7449: my ($args) = @_;
1.340 albertel 7450: my $headerstring='';
1.1160 raeburn 7451: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7452: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7453: $headerstring.=
7454: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7455: if (!$args->{'frameset'}) {
7456: $headerstring.= ' /';
7457: }
7458: $headerstring .= '>'."\n";
1.340 albertel 7459: }
7460: return $headerstring;
7461: }
7462:
1.341 albertel 7463: =pod
7464:
1.1064 raeburn 7465: =item * &print_suppression()
7466:
7467: In course context returns css which causes the body to be blank when media="print",
7468: if printout generation is unavailable for the current resource.
7469:
7470: This could be because:
7471:
7472: (a) printstartdate is in the future
7473:
7474: (b) printenddate is in the past
7475:
7476: (c) there is an active exam block with "printout"
7477: functionality blocked
7478:
7479: Users with pav, pfo or evb privileges are exempt.
7480:
7481: Inputs: none
7482:
7483: =cut
7484:
7485:
7486: sub print_suppression {
7487: my $noprint;
7488: if ($env{'request.course.id'}) {
7489: my $scope = $env{'request.course.id'};
7490: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7491: (&Apache::lonnet::allowed('pfo',$scope))) {
7492: return;
7493: }
7494: if ($env{'request.course.sec'} ne '') {
7495: $scope .= "/$env{'request.course.sec'}";
7496: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7497: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7498: return;
1.1064 raeburn 7499: }
7500: }
7501: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7502: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 7503: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7504: if ($blocked) {
7505: my $checkrole = "cm./$cdom/$cnum";
7506: if ($env{'request.course.sec'} ne '') {
7507: $checkrole .= "/$env{'request.course.sec'}";
7508: }
7509: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7510: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7511: $noprint = 1;
7512: }
7513: }
7514: unless ($noprint) {
7515: my $symb = &Apache::lonnet::symbread();
7516: if ($symb ne '') {
7517: my $navmap = Apache::lonnavmaps::navmap->new();
7518: if (ref($navmap)) {
7519: my $res = $navmap->getBySymb($symb);
7520: if (ref($res)) {
7521: if (!$res->resprintable()) {
7522: $noprint = 1;
7523: }
7524: }
7525: }
7526: }
7527: }
7528: if ($noprint) {
7529: return <<"ENDSTYLE";
7530: <style type="text/css" media="print">
7531: body { display:none }
7532: </style>
7533: ENDSTYLE
7534: }
7535: }
7536: return;
7537: }
7538:
7539: =pod
7540:
1.341 albertel 7541: =item * &xml_begin()
7542:
7543: Returns the needed doctype and <html>
7544:
7545: Inputs: none
7546:
7547: =cut
7548:
7549: sub xml_begin {
1.1168 raeburn 7550: my ($is_frameset) = @_;
1.341 albertel 7551: my $output='';
7552:
7553: if ($env{'browser.mathml'}) {
7554: $output='<?xml version="1.0"?>'
7555: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7556: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7557:
7558: # .'<!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">] >'
7559: .'<!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">'
7560: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7561: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 7562: } elsif ($is_frameset) {
7563: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7564: '<html>'."\n";
1.341 albertel 7565: } else {
1.1168 raeburn 7566: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7567: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7568: }
7569: return $output;
7570: }
1.340 albertel 7571:
7572: =pod
7573:
1.306 albertel 7574: =item * &start_page()
7575:
7576: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7577:
1.648 raeburn 7578: Inputs:
7579:
7580: =over 4
7581:
7582: $title - optional title for the page
7583:
7584: $head_extra - optional extra HTML to incude inside the <head>
7585:
7586: $args - additional optional args supported are:
7587:
7588: =over 8
7589:
7590: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7591: arg on
1.814 bisitz 7592: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7593: add_entries -> additional attributes to add to the <body>
7594: domain -> force to color decorate a page for a
1.317 albertel 7595: specific domain
1.648 raeburn 7596: function -> force usage of a specific rolish color
1.317 albertel 7597: scheme
1.648 raeburn 7598: redirect -> see &headtag()
7599: bgcolor -> override the default page bg color
7600: js_ready -> return a string ready for being used in
1.317 albertel 7601: a javascript writeln
1.648 raeburn 7602: html_encode -> return a string ready for being used in
1.320 albertel 7603: a html attribute
1.648 raeburn 7604: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7605: $forcereg arg
1.648 raeburn 7606: frameset -> if true will start with a <frameset>
1.330 albertel 7607: rather than <body>
1.648 raeburn 7608: skip_phases -> hash ref of
1.338 albertel 7609: head -> skip the <html><head> generation
7610: body -> skip all <body> generation
1.648 raeburn 7611: no_auto_mt_title -> prevent &mt()ing the title arg
7612: inherit_jsmath -> when creating popup window in a page,
7613: should it have jsmath forced on by the
7614: current page
1.867 kalberla 7615: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7616: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 7617: group -> includes the current group, if page is for a
7618: specific group
1.361 albertel 7619:
1.648 raeburn 7620: =back
1.460 albertel 7621:
1.648 raeburn 7622: =back
1.562 albertel 7623:
1.306 albertel 7624: =cut
7625:
7626: sub start_page {
1.309 albertel 7627: my ($title,$head_extra,$args) = @_;
1.318 albertel 7628: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7629:
1.315 albertel 7630: $env{'internal.start_page'}++;
1.1096 raeburn 7631: my ($result,@advtools);
1.964 droeschl 7632:
1.338 albertel 7633: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 7634: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7635: }
7636:
7637: if (! exists($args->{'skip_phases'}{'body'}) ) {
7638: if ($args->{'frameset'}) {
7639: my $attr_string = &make_attr_string($args->{'force_register'},
7640: $args->{'add_entries'});
7641: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7642: } else {
7643: $result .=
7644: &bodytag($title,
7645: $args->{'function'}, $args->{'add_entries'},
7646: $args->{'only_body'}, $args->{'domain'},
7647: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 7648: $args->{'bgcolor'}, $args,
7649: \@advtools);
1.831 bisitz 7650: }
1.330 albertel 7651: }
1.338 albertel 7652:
1.315 albertel 7653: if ($args->{'js_ready'}) {
1.713 kaisler 7654: $result = &js_ready($result);
1.315 albertel 7655: }
1.320 albertel 7656: if ($args->{'html_encode'}) {
1.713 kaisler 7657: $result = &html_encode($result);
7658: }
7659:
1.813 bisitz 7660: # Preparation for new and consistent functionlist at top of screen
7661: # if ($args->{'functionlist'}) {
7662: # $result .= &build_functionlist();
7663: #}
7664:
1.964 droeschl 7665: # Don't add anything more if only_body wanted or in const space
7666: return $result if $args->{'only_body'}
7667: || $env{'request.state'} eq 'construct';
1.813 bisitz 7668:
7669: #Breadcrumbs
1.758 kaisler 7670: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7671: &Apache::lonhtmlcommon::clear_breadcrumbs();
7672: #if any br links exists, add them to the breadcrumbs
7673: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7674: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7675: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7676: }
7677: }
1.1096 raeburn 7678: # if @advtools array contains items add then to the breadcrumbs
7679: if (@advtools > 0) {
7680: &Apache::lonmenu::advtools_crumbs(@advtools);
7681: }
1.758 kaisler 7682:
7683: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7684: if(exists($args->{'bread_crumbs_component'})){
7685: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7686: }else{
7687: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7688: }
1.320 albertel 7689: }
1.315 albertel 7690: return $result;
1.306 albertel 7691: }
7692:
7693: sub end_page {
1.315 albertel 7694: my ($args) = @_;
7695: $env{'internal.end_page'}++;
1.330 albertel 7696: my $result;
1.335 albertel 7697: if ($args->{'discussion'}) {
7698: my ($target,$parser);
7699: if (ref($args->{'discussion'})) {
7700: ($target,$parser) =($args->{'discussion'}{'target'},
7701: $args->{'discussion'}{'parser'});
7702: }
7703: $result .= &Apache::lonxml::xmlend($target,$parser);
7704: }
1.330 albertel 7705: if ($args->{'frameset'}) {
7706: $result .= '</frameset>';
7707: } else {
1.635 raeburn 7708: $result .= &endbodytag($args);
1.330 albertel 7709: }
1.1080 raeburn 7710: unless ($args->{'notbody'}) {
7711: $result .= "\n</html>";
7712: }
1.330 albertel 7713:
1.315 albertel 7714: if ($args->{'js_ready'}) {
1.317 albertel 7715: $result = &js_ready($result);
1.315 albertel 7716: }
1.335 albertel 7717:
1.320 albertel 7718: if ($args->{'html_encode'}) {
7719: $result = &html_encode($result);
7720: }
1.335 albertel 7721:
1.315 albertel 7722: return $result;
7723: }
7724:
1.1034 www 7725: sub wishlist_window {
7726: return(<<'ENDWISHLIST');
1.1046 raeburn 7727: <script type="text/javascript">
1.1034 www 7728: // <![CDATA[
7729: // <!-- BEGIN LON-CAPA Internal
7730: function set_wishlistlink(title, path) {
7731: if (!title) {
7732: title = document.title;
7733: title = title.replace(/^LON-CAPA /,'');
7734: }
1.1175 raeburn 7735: title = encodeURIComponent(title);
1.1034 www 7736: if (!path) {
7737: path = location.pathname;
7738: }
1.1175 raeburn 7739: path = encodeURIComponent(path);
1.1034 www 7740: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7741: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7742: }
7743: // END LON-CAPA Internal -->
7744: // ]]>
7745: </script>
7746: ENDWISHLIST
7747: }
7748:
1.1030 www 7749: sub modal_window {
7750: return(<<'ENDMODAL');
1.1046 raeburn 7751: <script type="text/javascript">
1.1030 www 7752: // <![CDATA[
7753: // <!-- BEGIN LON-CAPA Internal
7754: var modalWindow = {
7755: parent:"body",
7756: windowId:null,
7757: content:null,
7758: width:null,
7759: height:null,
7760: close:function()
7761: {
7762: $(".LCmodal-window").remove();
7763: $(".LCmodal-overlay").remove();
7764: },
7765: open:function()
7766: {
7767: var modal = "";
7768: modal += "<div class=\"LCmodal-overlay\"></div>";
7769: 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;\">";
7770: modal += this.content;
7771: modal += "</div>";
7772:
7773: $(this.parent).append(modal);
7774:
7775: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7776: $(".LCclose-window").click(function(){modalWindow.close();});
7777: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7778: }
7779: };
1.1140 raeburn 7780: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7781: {
7782: modalWindow.windowId = "myModal";
7783: modalWindow.width = width;
7784: modalWindow.height = height;
1.1196 raeburn 7785: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7786: modalWindow.open();
7787: };
7788: // END LON-CAPA Internal -->
7789: // ]]>
7790: </script>
7791: ENDMODAL
7792: }
7793:
7794: sub modal_link {
1.1140 raeburn 7795: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7796: unless ($width) { $width=480; }
7797: unless ($height) { $height=400; }
1.1031 www 7798: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 7799: unless ($transparency) { $transparency='true'; }
7800:
1.1074 raeburn 7801: my $target_attr;
7802: if (defined($target)) {
7803: $target_attr = 'target="'.$target.'"';
7804: }
7805: return <<"ENDLINK";
1.1140 raeburn 7806: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7807: $linktext</a>
7808: ENDLINK
1.1030 www 7809: }
7810:
1.1032 www 7811: sub modal_adhoc_script {
7812: my ($funcname,$width,$height,$content)=@_;
7813: return (<<ENDADHOC);
1.1046 raeburn 7814: <script type="text/javascript">
1.1032 www 7815: // <![CDATA[
7816: var $funcname = function()
7817: {
7818: modalWindow.windowId = "myModal";
7819: modalWindow.width = $width;
7820: modalWindow.height = $height;
7821: modalWindow.content = '$content';
7822: modalWindow.open();
7823: };
7824: // ]]>
7825: </script>
7826: ENDADHOC
7827: }
7828:
1.1041 www 7829: sub modal_adhoc_inner {
7830: my ($funcname,$width,$height,$content)=@_;
7831: my $innerwidth=$width-20;
7832: $content=&js_ready(
1.1140 raeburn 7833: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
7834: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7835: $content.
1.1041 www 7836: &end_scrollbox().
1.1140 raeburn 7837: &end_page()
1.1041 www 7838: );
7839: return &modal_adhoc_script($funcname,$width,$height,$content);
7840: }
7841:
7842: sub modal_adhoc_window {
7843: my ($funcname,$width,$height,$content,$linktext)=@_;
7844: return &modal_adhoc_inner($funcname,$width,$height,$content).
7845: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7846: }
7847:
7848: sub modal_adhoc_launch {
7849: my ($funcname,$width,$height,$content)=@_;
7850: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7851: <script type="text/javascript">
7852: // <![CDATA[
7853: $funcname();
7854: // ]]>
7855: </script>
7856: ENDLAUNCH
7857: }
7858:
7859: sub modal_adhoc_close {
7860: return (<<ENDCLOSE);
7861: <script type="text/javascript">
7862: // <![CDATA[
7863: modalWindow.close();
7864: // ]]>
7865: </script>
7866: ENDCLOSE
7867: }
7868:
1.1038 www 7869: sub togglebox_script {
7870: return(<<ENDTOGGLE);
7871: <script type="text/javascript">
7872: // <![CDATA[
7873: function LCtoggleDisplay(id,hidetext,showtext) {
7874: link = document.getElementById(id + "link").childNodes[0];
7875: with (document.getElementById(id).style) {
7876: if (display == "none" ) {
7877: display = "inline";
7878: link.nodeValue = hidetext;
7879: } else {
7880: display = "none";
7881: link.nodeValue = showtext;
7882: }
7883: }
7884: }
7885: // ]]>
7886: </script>
7887: ENDTOGGLE
7888: }
7889:
1.1039 www 7890: sub start_togglebox {
7891: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7892: unless ($heading) { $heading=''; } else { $heading.=' '; }
7893: unless ($showtext) { $showtext=&mt('show'); }
7894: unless ($hidetext) { $hidetext=&mt('hide'); }
7895: unless ($headerbg) { $headerbg='#FFFFFF'; }
7896: return &start_data_table().
7897: &start_data_table_header_row().
7898: '<td bgcolor="'.$headerbg.'">'.$heading.
7899: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7900: $showtext.'\')">'.$showtext.'</a>]</td>'.
7901: &end_data_table_header_row().
7902: '<tr id="'.$id.'" style="display:none""><td>';
7903: }
7904:
7905: sub end_togglebox {
7906: return '</td></tr>'.&end_data_table();
7907: }
7908:
1.1041 www 7909: sub LCprogressbar_script {
1.1045 www 7910: my ($id)=@_;
1.1041 www 7911: return(<<ENDPROGRESS);
7912: <script type="text/javascript">
7913: // <![CDATA[
1.1045 www 7914: \$('#progressbar$id').progressbar({
1.1041 www 7915: value: 0,
7916: change: function(event, ui) {
7917: var newVal = \$(this).progressbar('option', 'value');
7918: \$('.pblabel', this).text(LCprogressTxt);
7919: }
7920: });
7921: // ]]>
7922: </script>
7923: ENDPROGRESS
7924: }
7925:
7926: sub LCprogressbarUpdate_script {
7927: return(<<ENDPROGRESSUPDATE);
7928: <style type="text/css">
7929: .ui-progressbar { position:relative; }
7930: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7931: </style>
7932: <script type="text/javascript">
7933: // <![CDATA[
1.1045 www 7934: var LCprogressTxt='---';
7935:
7936: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7937: LCprogressTxt=progresstext;
1.1045 www 7938: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7939: }
7940: // ]]>
7941: </script>
7942: ENDPROGRESSUPDATE
7943: }
7944:
1.1042 www 7945: my $LClastpercent;
1.1045 www 7946: my $LCidcnt;
7947: my $LCcurrentid;
1.1042 www 7948:
1.1041 www 7949: sub LCprogressbar {
1.1042 www 7950: my ($r)=(@_);
7951: $LClastpercent=0;
1.1045 www 7952: $LCidcnt++;
7953: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7954: my $starting=&mt('Starting');
7955: my $content=(<<ENDPROGBAR);
1.1045 www 7956: <div id="progressbar$LCcurrentid">
1.1041 www 7957: <span class="pblabel">$starting</span>
7958: </div>
7959: ENDPROGBAR
1.1045 www 7960: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7961: }
7962:
7963: sub LCprogressbarUpdate {
1.1042 www 7964: my ($r,$val,$text)=@_;
7965: unless ($val) {
7966: if ($LClastpercent) {
7967: $val=$LClastpercent;
7968: } else {
7969: $val=0;
7970: }
7971: }
1.1041 www 7972: if ($val<0) { $val=0; }
7973: if ($val>100) { $val=0; }
1.1042 www 7974: $LClastpercent=$val;
1.1041 www 7975: unless ($text) { $text=$val.'%'; }
7976: $text=&js_ready($text);
1.1044 www 7977: &r_print($r,<<ENDUPDATE);
1.1041 www 7978: <script type="text/javascript">
7979: // <![CDATA[
1.1045 www 7980: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7981: // ]]>
7982: </script>
7983: ENDUPDATE
1.1035 www 7984: }
7985:
1.1042 www 7986: sub LCprogressbarClose {
7987: my ($r)=@_;
7988: $LClastpercent=0;
1.1044 www 7989: &r_print($r,<<ENDCLOSE);
1.1042 www 7990: <script type="text/javascript">
7991: // <![CDATA[
1.1045 www 7992: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7993: // ]]>
7994: </script>
7995: ENDCLOSE
1.1044 www 7996: }
7997:
7998: sub r_print {
7999: my ($r,$to_print)=@_;
8000: if ($r) {
8001: $r->print($to_print);
8002: $r->rflush();
8003: } else {
8004: print($to_print);
8005: }
1.1042 www 8006: }
8007:
1.320 albertel 8008: sub html_encode {
8009: my ($result) = @_;
8010:
1.322 albertel 8011: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8012:
8013: return $result;
8014: }
1.1044 www 8015:
1.317 albertel 8016: sub js_ready {
8017: my ($result) = @_;
8018:
1.323 albertel 8019: $result =~ s/[\n\r]/ /xmsg;
8020: $result =~ s/\\/\\\\/xmsg;
8021: $result =~ s/'/\\'/xmsg;
1.372 albertel 8022: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8023:
8024: return $result;
8025: }
8026:
1.315 albertel 8027: sub validate_page {
8028: if ( exists($env{'internal.start_page'})
1.316 albertel 8029: && $env{'internal.start_page'} > 1) {
8030: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8031: $env{'internal.start_page'}.' '.
1.316 albertel 8032: $ENV{'request.filename'});
1.315 albertel 8033: }
8034: if ( exists($env{'internal.end_page'})
1.316 albertel 8035: && $env{'internal.end_page'} > 1) {
8036: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8037: $env{'internal.end_page'}.' '.
1.316 albertel 8038: $env{'request.filename'});
1.315 albertel 8039: }
8040: if ( exists($env{'internal.start_page'})
8041: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8042: &Apache::lonnet::logthis('start_page called without end_page '.
8043: $env{'request.filename'});
1.315 albertel 8044: }
8045: if ( ! exists($env{'internal.start_page'})
8046: && exists($env{'internal.end_page'})) {
1.316 albertel 8047: &Apache::lonnet::logthis('end_page called without start_page'.
8048: $env{'request.filename'});
1.315 albertel 8049: }
1.306 albertel 8050: }
1.315 albertel 8051:
1.996 www 8052:
8053: sub start_scrollbox {
1.1140 raeburn 8054: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8055: unless ($outerwidth) { $outerwidth='520px'; }
8056: unless ($width) { $width='500px'; }
8057: unless ($height) { $height='200px'; }
1.1075 raeburn 8058: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8059: if ($id ne '') {
1.1140 raeburn 8060: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8061: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8062: }
1.1075 raeburn 8063: if ($bgcolor ne '') {
8064: $tdcol = "background-color: $bgcolor;";
8065: }
1.1137 raeburn 8066: my $nicescroll_js;
8067: if ($env{'browser.mobile'}) {
1.1140 raeburn 8068: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8069: }
8070: return <<"END";
8071: $nicescroll_js
8072:
8073: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8074: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8075: END
8076: }
8077:
8078: sub end_scrollbox {
8079: return '</div></td></tr></table>';
8080: }
8081:
8082: sub nicescroll_javascript {
8083: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8084: my %options;
8085: if (ref($cursor) eq 'HASH') {
8086: %options = %{$cursor};
8087: }
8088: unless ($options{'railalign'} =~ /^left|right$/) {
8089: $options{'railalign'} = 'left';
8090: }
8091: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8092: my $function = &get_users_function();
8093: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8094: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8095: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8096: }
1.1140 raeburn 8097: }
8098: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8099: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8100: $options{'cursoropacity'}='1.0';
8101: }
1.1140 raeburn 8102: } else {
8103: $options{'cursoropacity'}='1.0';
8104: }
8105: if ($options{'cursorfixedheight'} eq 'none') {
8106: delete($options{'cursorfixedheight'});
8107: } else {
8108: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8109: }
8110: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8111: delete($options{'railoffset'});
8112: }
8113: my @niceoptions;
8114: while (my($key,$value) = each(%options)) {
8115: if ($value =~ /^\{.+\}$/) {
8116: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8117: } else {
1.1140 raeburn 8118: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8119: }
1.1140 raeburn 8120: }
8121: my $nicescroll_js = '
1.1137 raeburn 8122: $(document).ready(
1.1140 raeburn 8123: function() {
8124: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8125: }
1.1137 raeburn 8126: );
8127: ';
1.1140 raeburn 8128: if ($framecheck) {
8129: $nicescroll_js .= '
8130: function expand_div(caller) {
8131: if (top === self) {
8132: document.getElementById("'.$id.'").style.width = "auto";
8133: document.getElementById("'.$id.'").style.height = "auto";
8134: } else {
8135: try {
8136: if (parent.frames) {
8137: if (parent.frames.length > 1) {
8138: var framesrc = parent.frames[1].location.href;
8139: var currsrc = framesrc.replace(/\#.*$/,"");
8140: if ((caller == "search") || (currsrc == "'.$location.'")) {
8141: document.getElementById("'.$id.'").style.width = "auto";
8142: document.getElementById("'.$id.'").style.height = "auto";
8143: }
8144: }
8145: }
8146: } catch (e) {
8147: return;
8148: }
1.1137 raeburn 8149: }
1.1140 raeburn 8150: return;
1.996 www 8151: }
1.1140 raeburn 8152: ';
8153: }
8154: if ($needjsready) {
8155: $nicescroll_js = '
8156: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8157: } else {
8158: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8159: }
8160: return $nicescroll_js;
1.996 www 8161: }
8162:
1.318 albertel 8163: sub simple_error_page {
1.1150 bisitz 8164: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8165: if (ref($args) eq 'HASH') {
8166: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8167: } else {
8168: $msg = &mt($msg);
8169: }
1.1150 bisitz 8170:
1.318 albertel 8171: my $page =
8172: &Apache::loncommon::start_page($title).
1.1150 bisitz 8173: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8174: &Apache::loncommon::end_page();
8175: if (ref($r)) {
8176: $r->print($page);
1.327 albertel 8177: return;
1.318 albertel 8178: }
8179: return $page;
8180: }
1.347 albertel 8181:
8182: {
1.610 albertel 8183: my @row_count;
1.961 onken 8184:
8185: sub start_data_table_count {
8186: unshift(@row_count, 0);
8187: return;
8188: }
8189:
8190: sub end_data_table_count {
8191: shift(@row_count);
8192: return;
8193: }
8194:
1.347 albertel 8195: sub start_data_table {
1.1018 raeburn 8196: my ($add_class,$id) = @_;
1.422 albertel 8197: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8198: my $table_id;
8199: if (defined($id)) {
8200: $table_id = ' id="'.$id.'"';
8201: }
1.961 onken 8202: &start_data_table_count();
1.1018 raeburn 8203: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8204: }
8205:
8206: sub end_data_table {
1.961 onken 8207: &end_data_table_count();
1.389 albertel 8208: return '</table>'."\n";;
1.347 albertel 8209: }
8210:
8211: sub start_data_table_row {
1.974 wenzelju 8212: my ($add_class, $id) = @_;
1.610 albertel 8213: $row_count[0]++;
8214: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8215: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8216: $id = (' id="'.$id.'"') unless ($id eq '');
8217: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8218: }
1.471 banghart 8219:
8220: sub continue_data_table_row {
1.974 wenzelju 8221: my ($add_class, $id) = @_;
1.610 albertel 8222: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8223: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8224: $id = (' id="'.$id.'"') unless ($id eq '');
8225: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8226: }
1.347 albertel 8227:
8228: sub end_data_table_row {
1.389 albertel 8229: return '</tr>'."\n";;
1.347 albertel 8230: }
1.367 www 8231:
1.421 albertel 8232: sub start_data_table_empty_row {
1.707 bisitz 8233: # $row_count[0]++;
1.421 albertel 8234: return '<tr class="LC_empty_row" >'."\n";;
8235: }
8236:
8237: sub end_data_table_empty_row {
8238: return '</tr>'."\n";;
8239: }
8240:
1.367 www 8241: sub start_data_table_header_row {
1.389 albertel 8242: return '<tr class="LC_header_row">'."\n";;
1.367 www 8243: }
8244:
8245: sub end_data_table_header_row {
1.389 albertel 8246: return '</tr>'."\n";;
1.367 www 8247: }
1.890 droeschl 8248:
8249: sub data_table_caption {
8250: my $caption = shift;
8251: return "<caption class=\"LC_caption\">$caption</caption>";
8252: }
1.347 albertel 8253: }
8254:
1.548 albertel 8255: =pod
8256:
8257: =item * &inhibit_menu_check($arg)
8258:
8259: Checks for a inhibitmenu state and generates output to preserve it
8260:
8261: Inputs: $arg - can be any of
8262: - undef - in which case the return value is a string
8263: to add into arguments list of a uri
8264: - 'input' - in which case the return value is a HTML
8265: <form> <input> field of type hidden to
8266: preserve the value
8267: - a url - in which case the return value is the url with
8268: the neccesary cgi args added to preserve the
8269: inhibitmenu state
8270: - a ref to a url - no return value, but the string is
8271: updated to include the neccessary cgi
8272: args to preserve the inhibitmenu state
8273:
8274: =cut
8275:
8276: sub inhibit_menu_check {
8277: my ($arg) = @_;
8278: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8279: if ($arg eq 'input') {
8280: if ($env{'form.inhibitmenu'}) {
8281: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8282: } else {
8283: return
8284: }
8285: }
8286: if ($env{'form.inhibitmenu'}) {
8287: if (ref($arg)) {
8288: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8289: } elsif ($arg eq '') {
8290: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8291: } else {
8292: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8293: }
8294: }
8295: if (!ref($arg)) {
8296: return $arg;
8297: }
8298: }
8299:
1.251 albertel 8300: ###############################################
1.182 matthew 8301:
8302: =pod
8303:
1.549 albertel 8304: =back
8305:
8306: =head1 User Information Routines
8307:
8308: =over 4
8309:
1.405 albertel 8310: =item * &get_users_function()
1.182 matthew 8311:
8312: Used by &bodytag to determine the current users primary role.
8313: Returns either 'student','coordinator','admin', or 'author'.
8314:
8315: =cut
8316:
8317: ###############################################
8318: sub get_users_function {
1.815 tempelho 8319: my $function = 'norole';
1.818 tempelho 8320: if ($env{'request.role'}=~/^(st)/) {
8321: $function='student';
8322: }
1.907 raeburn 8323: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8324: $function='coordinator';
8325: }
1.258 albertel 8326: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8327: $function='admin';
8328: }
1.826 bisitz 8329: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8330: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8331: $function='author';
8332: }
8333: return $function;
1.54 www 8334: }
1.99 www 8335:
8336: ###############################################
8337:
1.233 raeburn 8338: =pod
8339:
1.821 raeburn 8340: =item * &show_course()
8341:
8342: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8343: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8344:
8345: Inputs:
8346: None
8347:
8348: Outputs:
8349: Scalar: 1 if 'Course' to be used, 0 otherwise.
8350:
8351: =cut
8352:
8353: ###############################################
8354: sub show_course {
8355: my $course = !$env{'user.adv'};
8356: if (!$env{'user.adv'}) {
8357: foreach my $env (keys(%env)) {
8358: next if ($env !~ m/^user\.priv\./);
8359: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8360: $course = 0;
8361: last;
8362: }
8363: }
8364: }
8365: return $course;
8366: }
8367:
8368: ###############################################
8369:
8370: =pod
8371:
1.542 raeburn 8372: =item * &check_user_status()
1.274 raeburn 8373:
8374: Determines current status of supplied role for a
8375: specific user. Roles can be active, previous or future.
8376:
8377: Inputs:
8378: user's domain, user's username, course's domain,
1.375 raeburn 8379: course's number, optional section ID.
1.274 raeburn 8380:
8381: Outputs:
8382: role status: active, previous or future.
8383:
8384: =cut
8385:
8386: sub check_user_status {
1.412 raeburn 8387: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8388: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8389: my @uroles = keys %userinfo;
8390: my $srchstr;
8391: my $active_chk = 'none';
1.412 raeburn 8392: my $now = time;
1.274 raeburn 8393: if (@uroles > 0) {
1.908 raeburn 8394: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8395: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8396: } else {
1.412 raeburn 8397: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8398: }
8399: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8400: my $role_end = 0;
8401: my $role_start = 0;
8402: $active_chk = 'active';
1.412 raeburn 8403: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8404: $role_end = $1;
8405: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8406: $role_start = $1;
1.274 raeburn 8407: }
8408: }
8409: if ($role_start > 0) {
1.412 raeburn 8410: if ($now < $role_start) {
1.274 raeburn 8411: $active_chk = 'future';
8412: }
8413: }
8414: if ($role_end > 0) {
1.412 raeburn 8415: if ($now > $role_end) {
1.274 raeburn 8416: $active_chk = 'previous';
8417: }
8418: }
8419: }
8420: }
8421: return $active_chk;
8422: }
8423:
8424: ###############################################
8425:
8426: =pod
8427:
1.405 albertel 8428: =item * &get_sections()
1.233 raeburn 8429:
8430: Determines all the sections for a course including
8431: sections with students and sections containing other roles.
1.419 raeburn 8432: Incoming parameters:
8433:
8434: 1. domain
8435: 2. course number
8436: 3. reference to array containing roles for which sections should
8437: be gathered (optional).
8438: 4. reference to array containing status types for which sections
8439: should be gathered (optional).
8440:
8441: If the third argument is undefined, sections are gathered for any role.
8442: If the fourth argument is undefined, sections are gathered for any status.
8443: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8444:
1.374 raeburn 8445: Returns section hash (keys are section IDs, values are
8446: number of users in each section), subject to the
1.419 raeburn 8447: optional roles filter, optional status filter
1.233 raeburn 8448:
8449: =cut
8450:
8451: ###############################################
8452: sub get_sections {
1.419 raeburn 8453: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8454: if (!defined($cdom) || !defined($cnum)) {
8455: my $cid = $env{'request.course.id'};
8456:
8457: return if (!defined($cid));
8458:
8459: $cdom = $env{'course.'.$cid.'.domain'};
8460: $cnum = $env{'course.'.$cid.'.num'};
8461: }
8462:
8463: my %sectioncount;
1.419 raeburn 8464: my $now = time;
1.240 albertel 8465:
1.1118 raeburn 8466: my $check_students = 1;
8467: my $only_students = 0;
8468: if (ref($possible_roles) eq 'ARRAY') {
8469: if (grep(/^st$/,@{$possible_roles})) {
8470: if (@{$possible_roles} == 1) {
8471: $only_students = 1;
8472: }
8473: } else {
8474: $check_students = 0;
8475: }
8476: }
8477:
8478: if ($check_students) {
1.276 albertel 8479: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8480: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8481: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8482: my $start_index = &Apache::loncoursedata::CL_START();
8483: my $end_index = &Apache::loncoursedata::CL_END();
8484: my $status;
1.366 albertel 8485: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8486: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8487: $data->[$status_index],
8488: $data->[$start_index],
8489: $data->[$end_index]);
8490: if ($stu_status eq 'Active') {
8491: $status = 'active';
8492: } elsif ($end < $now) {
8493: $status = 'previous';
8494: } elsif ($start > $now) {
8495: $status = 'future';
8496: }
8497: if ($section ne '-1' && $section !~ /^\s*$/) {
8498: if ((!defined($possible_status)) || (($status ne '') &&
8499: (grep/^\Q$status\E$/,@{$possible_status}))) {
8500: $sectioncount{$section}++;
8501: }
1.240 albertel 8502: }
8503: }
8504: }
1.1118 raeburn 8505: if ($only_students) {
8506: return %sectioncount;
8507: }
1.240 albertel 8508: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8509: foreach my $user (sort(keys(%courseroles))) {
8510: if ($user !~ /^(\w{2})/) { next; }
8511: my ($role) = ($user =~ /^(\w{2})/);
8512: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8513: my ($section,$status);
1.240 albertel 8514: if ($role eq 'cr' &&
8515: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8516: $section=$1;
8517: }
8518: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8519: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8520: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8521: if ($end == -1 && $start == -1) {
8522: next; #deleted role
8523: }
8524: if (!defined($possible_status)) {
8525: $sectioncount{$section}++;
8526: } else {
8527: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8528: $status = 'active';
8529: } elsif ($end < $now) {
8530: $status = 'future';
8531: } elsif ($start > $now) {
8532: $status = 'previous';
8533: }
8534: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8535: $sectioncount{$section}++;
8536: }
8537: }
1.233 raeburn 8538: }
1.366 albertel 8539: return %sectioncount;
1.233 raeburn 8540: }
8541:
1.274 raeburn 8542: ###############################################
1.294 raeburn 8543:
8544: =pod
1.405 albertel 8545:
8546: =item * &get_course_users()
8547:
1.275 raeburn 8548: Retrieves usernames:domains for users in the specified course
8549: with specific role(s), and access status.
8550:
8551: Incoming parameters:
1.277 albertel 8552: 1. course domain
8553: 2. course number
8554: 3. access status: users must have - either active,
1.275 raeburn 8555: previous, future, or all.
1.277 albertel 8556: 4. reference to array of permissible roles
1.288 raeburn 8557: 5. reference to array of section restrictions (optional)
8558: 6. reference to results object (hash of hashes).
8559: 7. reference to optional userdata hash
1.609 raeburn 8560: 8. reference to optional statushash
1.630 raeburn 8561: 9. flag if privileged users (except those set to unhide in
8562: course settings) should be excluded
1.609 raeburn 8563: Keys of top level results hash are roles.
1.275 raeburn 8564: Keys of inner hashes are username:domain, with
8565: values set to access type.
1.288 raeburn 8566: Optional userdata hash returns an array with arguments in the
8567: same order as loncoursedata::get_classlist() for student data.
8568:
1.609 raeburn 8569: Optional statushash returns
8570:
1.288 raeburn 8571: Entries for end, start, section and status are blank because
8572: of the possibility of multiple values for non-student roles.
8573:
1.275 raeburn 8574: =cut
1.405 albertel 8575:
1.275 raeburn 8576: ###############################################
1.405 albertel 8577:
1.275 raeburn 8578: sub get_course_users {
1.630 raeburn 8579: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8580: my %idx = ();
1.419 raeburn 8581: my %seclists;
1.288 raeburn 8582:
8583: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8584: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8585: $idx{end} = &Apache::loncoursedata::CL_END();
8586: $idx{start} = &Apache::loncoursedata::CL_START();
8587: $idx{id} = &Apache::loncoursedata::CL_ID();
8588: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8589: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8590: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8591:
1.290 albertel 8592: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8593: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8594: my $now = time;
1.277 albertel 8595: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8596: my $match = 0;
1.412 raeburn 8597: my $secmatch = 0;
1.419 raeburn 8598: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8599: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8600: if ($section eq '') {
8601: $section = 'none';
8602: }
1.291 albertel 8603: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8604: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8605: $secmatch = 1;
8606: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8607: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8608: $secmatch = 1;
8609: }
8610: } else {
1.419 raeburn 8611: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8612: $secmatch = 1;
8613: }
1.290 albertel 8614: }
1.412 raeburn 8615: if (!$secmatch) {
8616: next;
8617: }
1.419 raeburn 8618: }
1.275 raeburn 8619: if (defined($$types{'active'})) {
1.288 raeburn 8620: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8621: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8622: $match = 1;
1.275 raeburn 8623: }
8624: }
8625: if (defined($$types{'previous'})) {
1.609 raeburn 8626: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8627: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8628: $match = 1;
1.275 raeburn 8629: }
8630: }
8631: if (defined($$types{'future'})) {
1.609 raeburn 8632: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8633: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8634: $match = 1;
1.275 raeburn 8635: }
8636: }
1.609 raeburn 8637: if ($match) {
8638: push(@{$seclists{$student}},$section);
8639: if (ref($userdata) eq 'HASH') {
8640: $$userdata{$student} = $$classlist{$student};
8641: }
8642: if (ref($statushash) eq 'HASH') {
8643: $statushash->{$student}{'st'}{$section} = $status;
8644: }
1.288 raeburn 8645: }
1.275 raeburn 8646: }
8647: }
1.412 raeburn 8648: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8649: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8650: my $now = time;
1.609 raeburn 8651: my %displaystatus = ( previous => 'Expired',
8652: active => 'Active',
8653: future => 'Future',
8654: );
1.1121 raeburn 8655: my (%nothide,@possdoms);
1.630 raeburn 8656: if ($hidepriv) {
8657: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8658: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8659: if ($user !~ /:/) {
8660: $nothide{join(':',split(/[\@]/,$user))}=1;
8661: } else {
8662: $nothide{$user} = 1;
8663: }
8664: }
1.1121 raeburn 8665: my @possdoms = ($cdom);
8666: if ($coursehash{'checkforpriv'}) {
8667: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8668: }
1.630 raeburn 8669: }
1.439 raeburn 8670: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8671: my $match = 0;
1.412 raeburn 8672: my $secmatch = 0;
1.439 raeburn 8673: my $status;
1.412 raeburn 8674: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8675: $user =~ s/:$//;
1.439 raeburn 8676: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8677: if ($end == -1 || $start == -1) {
8678: next;
8679: }
8680: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8681: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8682: my ($uname,$udom) = split(/:/,$user);
8683: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8684: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8685: $secmatch = 1;
8686: } elsif ($usec eq '') {
1.420 albertel 8687: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8688: $secmatch = 1;
8689: }
8690: } else {
8691: if (grep(/^\Q$usec\E$/,@{$sections})) {
8692: $secmatch = 1;
8693: }
8694: }
8695: if (!$secmatch) {
8696: next;
8697: }
1.288 raeburn 8698: }
1.419 raeburn 8699: if ($usec eq '') {
8700: $usec = 'none';
8701: }
1.275 raeburn 8702: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8703: if ($hidepriv) {
1.1121 raeburn 8704: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8705: (!$nothide{$uname.':'.$udom})) {
8706: next;
8707: }
8708: }
1.503 raeburn 8709: if ($end > 0 && $end < $now) {
1.439 raeburn 8710: $status = 'previous';
8711: } elsif ($start > $now) {
8712: $status = 'future';
8713: } else {
8714: $status = 'active';
8715: }
1.277 albertel 8716: foreach my $type (keys(%{$types})) {
1.275 raeburn 8717: if ($status eq $type) {
1.420 albertel 8718: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8719: push(@{$$users{$role}{$user}},$type);
8720: }
1.288 raeburn 8721: $match = 1;
8722: }
8723: }
1.419 raeburn 8724: if (($match) && (ref($userdata) eq 'HASH')) {
8725: if (!exists($$userdata{$uname.':'.$udom})) {
8726: &get_user_info($udom,$uname,\%idx,$userdata);
8727: }
1.420 albertel 8728: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8729: push(@{$seclists{$uname.':'.$udom}},$usec);
8730: }
1.609 raeburn 8731: if (ref($statushash) eq 'HASH') {
8732: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8733: }
1.275 raeburn 8734: }
8735: }
8736: }
8737: }
1.290 albertel 8738: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8739: if ((defined($cdom)) && (defined($cnum))) {
8740: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8741: if ( defined($csettings{'internal.courseowner'}) ) {
8742: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8743: next if ($owner eq '');
8744: my ($ownername,$ownerdom);
8745: if ($owner =~ /^([^:]+):([^:]+)$/) {
8746: $ownername = $1;
8747: $ownerdom = $2;
8748: } else {
8749: $ownername = $owner;
8750: $ownerdom = $cdom;
8751: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8752: }
8753: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8754: if (defined($userdata) &&
1.609 raeburn 8755: !exists($$userdata{$owner})) {
8756: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8757: if (!grep(/^none$/,@{$seclists{$owner}})) {
8758: push(@{$seclists{$owner}},'none');
8759: }
8760: if (ref($statushash) eq 'HASH') {
8761: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8762: }
1.290 albertel 8763: }
1.279 raeburn 8764: }
8765: }
8766: }
1.419 raeburn 8767: foreach my $user (keys(%seclists)) {
8768: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8769: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8770: }
1.275 raeburn 8771: }
8772: return;
8773: }
8774:
1.288 raeburn 8775: sub get_user_info {
8776: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8777: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8778: &plainname($uname,$udom,'lastname');
1.291 albertel 8779: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8780: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8781: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8782: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8783: return;
8784: }
1.275 raeburn 8785:
1.472 raeburn 8786: ###############################################
8787:
8788: =pod
8789:
8790: =item * &get_user_quota()
8791:
1.1134 raeburn 8792: Retrieves quota assigned for storage of user files.
8793: Default is to report quota for portfolio files.
1.472 raeburn 8794:
8795: Incoming parameters:
8796: 1. user's username
8797: 2. user's domain
1.1134 raeburn 8798: 3. quota name - portfolio, author, or course
1.1136 raeburn 8799: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 8800: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 8801: course
1.472 raeburn 8802:
8803: Returns:
1.1163 raeburn 8804: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8805: 2. (Optional) Type of setting: custom or default
8806: (individually assigned or default for user's
8807: institutional status).
8808: 3. (Optional) - User's institutional status (e.g., faculty, staff
8809: or student - types as defined in localenroll::inst_usertypes
8810: for user's domain, which determines default quota for user.
8811: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8812:
8813: If a value has been stored in the user's environment,
1.536 raeburn 8814: it will return that, otherwise it returns the maximal default
1.1134 raeburn 8815: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8816:
8817: =cut
8818:
8819: ###############################################
8820:
8821:
8822: sub get_user_quota {
1.1136 raeburn 8823: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8824: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8825: if (!defined($udom)) {
8826: $udom = $env{'user.domain'};
8827: }
8828: if (!defined($uname)) {
8829: $uname = $env{'user.name'};
8830: }
8831: if (($udom eq '' || $uname eq '') ||
8832: ($udom eq 'public') && ($uname eq 'public')) {
8833: $quota = 0;
1.536 raeburn 8834: $quotatype = 'default';
8835: $defquota = 0;
1.472 raeburn 8836: } else {
1.536 raeburn 8837: my $inststatus;
1.1134 raeburn 8838: if ($quotaname eq 'course') {
8839: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8840: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8841: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8842: } else {
8843: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8844: $quota = $cenv{'internal.uploadquota'};
8845: }
1.536 raeburn 8846: } else {
1.1134 raeburn 8847: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8848: if ($quotaname eq 'author') {
8849: $quota = $env{'environment.authorquota'};
8850: } else {
8851: $quota = $env{'environment.portfolioquota'};
8852: }
8853: $inststatus = $env{'environment.inststatus'};
8854: } else {
8855: my %userenv =
8856: &Apache::lonnet::get('environment',['portfolioquota',
8857: 'authorquota','inststatus'],$udom,$uname);
8858: my ($tmp) = keys(%userenv);
8859: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8860: if ($quotaname eq 'author') {
8861: $quota = $userenv{'authorquota'};
8862: } else {
8863: $quota = $userenv{'portfolioquota'};
8864: }
8865: $inststatus = $userenv{'inststatus'};
8866: } else {
8867: undef(%userenv);
8868: }
8869: }
8870: }
8871: if ($quota eq '' || wantarray) {
8872: if ($quotaname eq 'course') {
8873: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 8874: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8875: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 8876: $defquota = $domdefs{$crstype.'quota'};
8877: }
8878: if ($defquota eq '') {
8879: $defquota = 500;
8880: }
1.1134 raeburn 8881: } else {
8882: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8883: }
8884: if ($quota eq '') {
8885: $quota = $defquota;
8886: $quotatype = 'default';
8887: } else {
8888: $quotatype = 'custom';
8889: }
1.472 raeburn 8890: }
8891: }
1.536 raeburn 8892: if (wantarray) {
8893: return ($quota,$quotatype,$settingstatus,$defquota);
8894: } else {
8895: return $quota;
8896: }
1.472 raeburn 8897: }
8898:
8899: ###############################################
8900:
8901: =pod
8902:
8903: =item * &default_quota()
8904:
1.536 raeburn 8905: Retrieves default quota assigned for storage of user portfolio files,
8906: given an (optional) user's institutional status.
1.472 raeburn 8907:
8908: Incoming parameters:
1.1142 raeburn 8909:
1.472 raeburn 8910: 1. domain
1.536 raeburn 8911: 2. (Optional) institutional status(es). This is a : separated list of
8912: status types (e.g., faculty, staff, student etc.)
8913: which apply to the user for whom the default is being retrieved.
8914: If the institutional status string in undefined, the domain
1.1134 raeburn 8915: default quota will be returned.
8916: 3. quota name - portfolio, author, or course
8917: (if no quota name provided, defaults to portfolio).
1.472 raeburn 8918:
8919: Returns:
1.1142 raeburn 8920:
1.1163 raeburn 8921: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 8922: 2. (Optional) institutional type which determined the value of the
8923: default quota.
1.472 raeburn 8924:
8925: If a value has been stored in the domain's configuration db,
8926: it will return that, otherwise it returns 20 (for backwards
8927: compatibility with domains which have not set up a configuration
1.1163 raeburn 8928: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 8929:
1.536 raeburn 8930: If the user's status includes multiple types (e.g., staff and student),
8931: the largest default quota which applies to the user determines the
8932: default quota returned.
8933:
1.472 raeburn 8934: =cut
8935:
8936: ###############################################
8937:
8938:
8939: sub default_quota {
1.1134 raeburn 8940: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 8941: my ($defquota,$settingstatus);
8942: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8943: ['quotas'],$udom);
1.1134 raeburn 8944: my $key = 'defaultquota';
8945: if ($quotaname eq 'author') {
8946: $key = 'authorquota';
8947: }
1.622 raeburn 8948: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8949: if ($inststatus ne '') {
1.765 raeburn 8950: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8951: foreach my $item (@statuses) {
1.1134 raeburn 8952: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8953: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 8954: if ($defquota eq '') {
1.1134 raeburn 8955: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8956: $settingstatus = $item;
1.1134 raeburn 8957: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
8958: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8959: $settingstatus = $item;
8960: }
8961: }
1.1134 raeburn 8962: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8963: if ($quotahash{'quotas'}{$item} ne '') {
8964: if ($defquota eq '') {
8965: $defquota = $quotahash{'quotas'}{$item};
8966: $settingstatus = $item;
8967: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8968: $defquota = $quotahash{'quotas'}{$item};
8969: $settingstatus = $item;
8970: }
1.536 raeburn 8971: }
8972: }
8973: }
8974: }
8975: if ($defquota eq '') {
1.1134 raeburn 8976: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8977: $defquota = $quotahash{'quotas'}{$key}{'default'};
8978: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8979: $defquota = $quotahash{'quotas'}{'default'};
8980: }
1.536 raeburn 8981: $settingstatus = 'default';
1.1139 raeburn 8982: if ($defquota eq '') {
8983: if ($quotaname eq 'author') {
8984: $defquota = 500;
8985: }
8986: }
1.536 raeburn 8987: }
8988: } else {
8989: $settingstatus = 'default';
1.1134 raeburn 8990: if ($quotaname eq 'author') {
8991: $defquota = 500;
8992: } else {
8993: $defquota = 20;
8994: }
1.536 raeburn 8995: }
8996: if (wantarray) {
8997: return ($defquota,$settingstatus);
1.472 raeburn 8998: } else {
1.536 raeburn 8999: return $defquota;
1.472 raeburn 9000: }
9001: }
9002:
1.1135 raeburn 9003: ###############################################
9004:
9005: =pod
9006:
1.1136 raeburn 9007: =item * &excess_filesize_warning()
1.1135 raeburn 9008:
9009: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9010: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9011: space to be exceeded.
1.1136 raeburn 9012:
9013: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9014: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9015:
1.1165 raeburn 9016: Inputs: 7
1.1136 raeburn 9017: 1. username or coursenum
1.1135 raeburn 9018: 2. domain
1.1136 raeburn 9019: 3. context ('author' or 'course')
1.1135 raeburn 9020: 4. filename of file for which action is being requested
9021: 5. filesize (kB) of file
9022: 6. action being taken: copy or upload.
1.1165 raeburn 9023: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 9024:
9025: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9026: otherwise return null.
9027:
9028: =back
1.1135 raeburn 9029:
9030: =cut
9031:
1.1136 raeburn 9032: sub excess_filesize_warning {
1.1165 raeburn 9033: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9034: my $current_disk_usage = 0;
1.1165 raeburn 9035: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9036: if ($context eq 'author') {
9037: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9038: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9039: } else {
9040: foreach my $subdir ('docs','supplemental') {
9041: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9042: }
9043: }
1.1135 raeburn 9044: $disk_quota = int($disk_quota * 1000);
9045: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9046: return '<p class="LC_warning">'.
1.1135 raeburn 9047: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9048: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9049: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9050: $disk_quota,$current_disk_usage).
9051: '</p>';
9052: }
9053: return;
9054: }
9055:
9056: ###############################################
9057:
9058:
1.1136 raeburn 9059:
9060:
1.384 raeburn 9061: sub get_secgrprole_info {
9062: my ($cdom,$cnum,$needroles,$type) = @_;
9063: my %sections_count = &get_sections($cdom,$cnum);
9064: my @sections = (sort {$a <=> $b} keys(%sections_count));
9065: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9066: my @groups = sort(keys(%curr_groups));
9067: my $allroles = [];
9068: my $rolehash;
9069: my $accesshash = {
9070: active => 'Currently has access',
9071: future => 'Will have future access',
9072: previous => 'Previously had access',
9073: };
9074: if ($needroles) {
9075: $rolehash = {'all' => 'all'};
1.385 albertel 9076: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9077: if (&Apache::lonnet::error(%user_roles)) {
9078: undef(%user_roles);
9079: }
9080: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9081: my ($role)=split(/\:/,$item,2);
9082: if ($role eq 'cr') { next; }
9083: if ($role =~ /^cr/) {
9084: $$rolehash{$role} = (split('/',$role))[3];
9085: } else {
9086: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9087: }
9088: }
9089: foreach my $key (sort(keys(%{$rolehash}))) {
9090: push(@{$allroles},$key);
9091: }
9092: push (@{$allroles},'st');
9093: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9094: }
9095: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9096: }
9097:
1.555 raeburn 9098: sub user_picker {
1.994 raeburn 9099: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9100: my $currdom = $dom;
9101: my %curr_selected = (
9102: srchin => 'dom',
1.580 raeburn 9103: srchby => 'lastname',
1.555 raeburn 9104: );
9105: my $srchterm;
1.625 raeburn 9106: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9107: if ($srch->{'srchby'} ne '') {
9108: $curr_selected{'srchby'} = $srch->{'srchby'};
9109: }
9110: if ($srch->{'srchin'} ne '') {
9111: $curr_selected{'srchin'} = $srch->{'srchin'};
9112: }
9113: if ($srch->{'srchtype'} ne '') {
9114: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9115: }
9116: if ($srch->{'srchdomain'} ne '') {
9117: $currdom = $srch->{'srchdomain'};
9118: }
9119: $srchterm = $srch->{'srchterm'};
9120: }
9121: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9122: 'usr' => 'Search criteria',
1.563 raeburn 9123: 'doma' => 'Domain/institution to search',
1.558 albertel 9124: 'uname' => 'username',
9125: 'lastname' => 'last name',
1.555 raeburn 9126: 'lastfirst' => 'last name, first name',
1.558 albertel 9127: 'crs' => 'in this course',
1.576 raeburn 9128: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9129: 'alc' => 'all LON-CAPA',
1.573 raeburn 9130: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9131: 'exact' => 'is',
9132: 'contains' => 'contains',
1.569 raeburn 9133: 'begins' => 'begins with',
1.571 raeburn 9134: 'youm' => "You must include some text to search for.",
9135: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9136: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9137: 'yomc' => "You must choose a domain when using an institutional directory search.",
9138: 'ymcd' => "You must choose a domain when using a domain search.",
9139: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9140: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9141: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9142: );
1.563 raeburn 9143: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9144: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9145:
9146: my @srchins = ('crs','dom','alc','instd');
9147:
9148: foreach my $option (@srchins) {
9149: # FIXME 'alc' option unavailable until
9150: # loncreateuser::print_user_query_page()
9151: # has been completed.
9152: next if ($option eq 'alc');
1.880 raeburn 9153: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9154: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9155: if ($curr_selected{'srchin'} eq $option) {
9156: $srchinsel .= '
9157: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9158: } else {
9159: $srchinsel .= '
9160: <option value="'.$option.'">'.$lt{$option}.'</option>';
9161: }
1.555 raeburn 9162: }
1.563 raeburn 9163: $srchinsel .= "\n </select>\n";
1.555 raeburn 9164:
9165: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9166: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9167: if ($curr_selected{'srchby'} eq $option) {
9168: $srchbysel .= '
9169: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9170: } else {
9171: $srchbysel .= '
9172: <option value="'.$option.'">'.$lt{$option}.'</option>';
9173: }
9174: }
9175: $srchbysel .= "\n </select>\n";
9176:
9177: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9178: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9179: if ($curr_selected{'srchtype'} eq $option) {
9180: $srchtypesel .= '
9181: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9182: } else {
9183: $srchtypesel .= '
9184: <option value="'.$option.'">'.$lt{$option}.'</option>';
9185: }
9186: }
9187: $srchtypesel .= "\n </select>\n";
9188:
1.558 albertel 9189: my ($newuserscript,$new_user_create);
1.994 raeburn 9190: my $context_dom = $env{'request.role.domain'};
9191: if ($context eq 'requestcrs') {
9192: if ($env{'form.coursedom'} ne '') {
9193: $context_dom = $env{'form.coursedom'};
9194: }
9195: }
1.556 raeburn 9196: if ($forcenewuser) {
1.576 raeburn 9197: if (ref($srch) eq 'HASH') {
1.994 raeburn 9198: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9199: if ($cancreate) {
9200: $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>';
9201: } else {
1.799 bisitz 9202: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9203: my %usertypetext = (
9204: official => 'institutional',
9205: unofficial => 'non-institutional',
9206: );
1.799 bisitz 9207: $new_user_create = '<p class="LC_warning">'
9208: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9209: .' '
9210: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9211: ,'<a href="'.$helplink.'">','</a>')
9212: .'</p><br />';
1.627 raeburn 9213: }
1.576 raeburn 9214: }
9215: }
9216:
1.556 raeburn 9217: $newuserscript = <<"ENDSCRIPT";
9218:
1.570 raeburn 9219: function setSearch(createnew,callingForm) {
1.556 raeburn 9220: if (createnew == 1) {
1.570 raeburn 9221: for (var i=0; i<callingForm.srchby.length; i++) {
9222: if (callingForm.srchby.options[i].value == 'uname') {
9223: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9224: }
9225: }
1.570 raeburn 9226: for (var i=0; i<callingForm.srchin.length; i++) {
9227: if ( callingForm.srchin.options[i].value == 'dom') {
9228: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9229: }
9230: }
1.570 raeburn 9231: for (var i=0; i<callingForm.srchtype.length; i++) {
9232: if (callingForm.srchtype.options[i].value == 'exact') {
9233: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9234: }
9235: }
1.570 raeburn 9236: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9237: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9238: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9239: }
9240: }
9241: }
9242: }
9243: ENDSCRIPT
1.558 albertel 9244:
1.556 raeburn 9245: }
9246:
1.555 raeburn 9247: my $output = <<"END_BLOCK";
1.556 raeburn 9248: <script type="text/javascript">
1.824 bisitz 9249: // <![CDATA[
1.570 raeburn 9250: function validateEntry(callingForm) {
1.558 albertel 9251:
1.556 raeburn 9252: var checkok = 1;
1.558 albertel 9253: var srchin;
1.570 raeburn 9254: for (var i=0; i<callingForm.srchin.length; i++) {
9255: if ( callingForm.srchin[i].checked ) {
9256: srchin = callingForm.srchin[i].value;
1.558 albertel 9257: }
9258: }
9259:
1.570 raeburn 9260: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9261: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9262: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9263: var srchterm = callingForm.srchterm.value;
9264: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9265: var msg = "";
9266:
9267: if (srchterm == "") {
9268: checkok = 0;
1.571 raeburn 9269: msg += "$lt{'youm'}\\n";
1.556 raeburn 9270: }
9271:
1.569 raeburn 9272: if (srchtype== 'begins') {
9273: if (srchterm.length < 2) {
9274: checkok = 0;
1.571 raeburn 9275: msg += "$lt{'thte'}\\n";
1.569 raeburn 9276: }
9277: }
9278:
1.556 raeburn 9279: if (srchtype== 'contains') {
9280: if (srchterm.length < 3) {
9281: checkok = 0;
1.571 raeburn 9282: msg += "$lt{'thet'}\\n";
1.556 raeburn 9283: }
9284: }
9285: if (srchin == 'instd') {
9286: if (srchdomain == '') {
9287: checkok = 0;
1.571 raeburn 9288: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9289: }
9290: }
9291: if (srchin == 'dom') {
9292: if (srchdomain == '') {
9293: checkok = 0;
1.571 raeburn 9294: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9295: }
9296: }
9297: if (srchby == 'lastfirst') {
9298: if (srchterm.indexOf(",") == -1) {
9299: checkok = 0;
1.571 raeburn 9300: msg += "$lt{'whus'}\\n";
1.556 raeburn 9301: }
9302: if (srchterm.indexOf(",") == srchterm.length -1) {
9303: checkok = 0;
1.571 raeburn 9304: msg += "$lt{'whse'}\\n";
1.556 raeburn 9305: }
9306: }
9307: if (checkok == 0) {
1.571 raeburn 9308: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9309: return;
9310: }
9311: if (checkok == 1) {
1.570 raeburn 9312: callingForm.submit();
1.556 raeburn 9313: }
9314: }
9315:
9316: $newuserscript
9317:
1.824 bisitz 9318: // ]]>
1.556 raeburn 9319: </script>
1.558 albertel 9320:
9321: $new_user_create
9322:
1.555 raeburn 9323: END_BLOCK
1.558 albertel 9324:
1.876 raeburn 9325: $output .= &Apache::lonhtmlcommon::start_pick_box().
9326: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9327: $domform.
9328: &Apache::lonhtmlcommon::row_closure().
9329: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9330: $srchbysel.
9331: $srchtypesel.
9332: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9333: $srchinsel.
9334: &Apache::lonhtmlcommon::row_closure(1).
9335: &Apache::lonhtmlcommon::end_pick_box().
9336: '<br />';
1.555 raeburn 9337: return $output;
9338: }
9339:
1.612 raeburn 9340: sub user_rule_check {
1.615 raeburn 9341: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9342: my $response;
9343: if (ref($usershash) eq 'HASH') {
9344: foreach my $user (keys(%{$usershash})) {
9345: my ($uname,$udom) = split(/:/,$user);
9346: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9347: my ($id,$newuser);
1.612 raeburn 9348: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9349: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9350: $id = $usershash->{$user}->{'id'};
9351: }
9352: my $inst_response;
9353: if (ref($checks) eq 'HASH') {
9354: if (defined($checks->{'username'})) {
1.615 raeburn 9355: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9356: &Apache::lonnet::get_instuser($udom,$uname);
9357: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9358: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9359: &Apache::lonnet::get_instuser($udom,undef,$id);
9360: }
1.615 raeburn 9361: } else {
9362: ($inst_response,%{$inst_results->{$user}}) =
9363: &Apache::lonnet::get_instuser($udom,$uname);
9364: return;
1.612 raeburn 9365: }
1.615 raeburn 9366: if (!$got_rules->{$udom}) {
1.612 raeburn 9367: my %domconfig = &Apache::lonnet::get_dom('configuration',
9368: ['usercreation'],$udom);
9369: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9370: foreach my $item ('username','id') {
1.612 raeburn 9371: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9372: $$curr_rules{$udom}{$item} =
9373: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9374: }
9375: }
9376: }
1.615 raeburn 9377: $got_rules->{$udom} = 1;
1.585 raeburn 9378: }
1.612 raeburn 9379: foreach my $item (keys(%{$checks})) {
9380: if (ref($$curr_rules{$udom}) eq 'HASH') {
9381: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9382: if (@{$$curr_rules{$udom}{$item}} > 0) {
9383: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9384: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9385: if ($rule_check{$rule}) {
9386: $$rulematch{$user}{$item} = $rule;
9387: if ($inst_response eq 'ok') {
1.615 raeburn 9388: if (ref($inst_results) eq 'HASH') {
9389: if (ref($inst_results->{$user}) eq 'HASH') {
9390: if (keys(%{$inst_results->{$user}}) == 0) {
9391: $$alerts{$item}{$udom}{$uname} = 1;
9392: }
1.612 raeburn 9393: }
9394: }
1.615 raeburn 9395: }
9396: last;
1.585 raeburn 9397: }
9398: }
9399: }
9400: }
9401: }
9402: }
9403: }
9404: }
1.612 raeburn 9405: return;
9406: }
9407:
9408: sub user_rule_formats {
9409: my ($domain,$domdesc,$curr_rules,$check) = @_;
9410: my %text = (
9411: 'username' => 'Usernames',
9412: 'id' => 'IDs',
9413: );
9414: my $output;
9415: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9416: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9417: if (@{$ruleorder} > 0) {
1.1102 raeburn 9418: $output = '<br />'.
9419: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9420: '<span class="LC_cusr_emph">','</span>',$domdesc).
9421: ' <ul>';
1.612 raeburn 9422: foreach my $rule (@{$ruleorder}) {
9423: if (ref($curr_rules) eq 'ARRAY') {
9424: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9425: if (ref($rules->{$rule}) eq 'HASH') {
9426: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9427: $rules->{$rule}{'desc'}.'</li>';
9428: }
9429: }
9430: }
9431: }
9432: $output .= '</ul>';
9433: }
9434: }
9435: return $output;
9436: }
9437:
9438: sub instrule_disallow_msg {
1.615 raeburn 9439: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9440: my $response;
9441: my %text = (
9442: item => 'username',
9443: items => 'usernames',
9444: match => 'matches',
9445: do => 'does',
9446: action => 'a username',
9447: one => 'one',
9448: );
9449: if ($count > 1) {
9450: $text{'item'} = 'usernames';
9451: $text{'match'} ='match';
9452: $text{'do'} = 'do';
9453: $text{'action'} = 'usernames',
9454: $text{'one'} = 'ones';
9455: }
9456: if ($checkitem eq 'id') {
9457: $text{'items'} = 'IDs';
9458: $text{'item'} = 'ID';
9459: $text{'action'} = 'an ID';
1.615 raeburn 9460: if ($count > 1) {
9461: $text{'item'} = 'IDs';
9462: $text{'action'} = 'IDs';
9463: }
1.612 raeburn 9464: }
1.674 bisitz 9465: $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 9466: if ($mode eq 'upload') {
9467: if ($checkitem eq 'username') {
9468: $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'}.");
9469: } elsif ($checkitem eq 'id') {
1.674 bisitz 9470: $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 9471: }
1.669 raeburn 9472: } elsif ($mode eq 'selfcreate') {
9473: if ($checkitem eq 'id') {
9474: $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.");
9475: }
1.615 raeburn 9476: } else {
9477: if ($checkitem eq 'username') {
9478: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9479: } elsif ($checkitem eq 'id') {
9480: $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.");
9481: }
1.612 raeburn 9482: }
9483: return $response;
1.585 raeburn 9484: }
9485:
1.624 raeburn 9486: sub personal_data_fieldtitles {
9487: my %fieldtitles = &Apache::lonlocal::texthash (
9488: id => 'Student/Employee ID',
9489: permanentemail => 'E-mail address',
9490: lastname => 'Last Name',
9491: firstname => 'First Name',
9492: middlename => 'Middle Name',
9493: generation => 'Generation',
9494: gen => 'Generation',
1.765 raeburn 9495: inststatus => 'Affiliation',
1.624 raeburn 9496: );
9497: return %fieldtitles;
9498: }
9499:
1.642 raeburn 9500: sub sorted_inst_types {
9501: my ($dom) = @_;
1.1185 raeburn 9502: my ($usertypes,$order);
9503: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9504: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9505: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9506: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9507: } else {
9508: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9509: }
1.642 raeburn 9510: my $othertitle = &mt('All users');
9511: if ($env{'request.course.id'}) {
1.668 raeburn 9512: $othertitle = &mt('Any users');
1.642 raeburn 9513: }
9514: my @types;
9515: if (ref($order) eq 'ARRAY') {
9516: @types = @{$order};
9517: }
9518: if (@types == 0) {
9519: if (ref($usertypes) eq 'HASH') {
9520: @types = sort(keys(%{$usertypes}));
9521: }
9522: }
9523: if (keys(%{$usertypes}) > 0) {
9524: $othertitle = &mt('Other users');
9525: }
9526: return ($othertitle,$usertypes,\@types);
9527: }
9528:
1.645 raeburn 9529: sub get_institutional_codes {
9530: my ($settings,$allcourses,$LC_code) = @_;
9531: # Get complete list of course sections to update
9532: my @currsections = ();
9533: my @currxlists = ();
9534: my $coursecode = $$settings{'internal.coursecode'};
9535:
9536: if ($$settings{'internal.sectionnums'} ne '') {
9537: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9538: }
9539:
9540: if ($$settings{'internal.crosslistings'} ne '') {
9541: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9542: }
9543:
9544: if (@currxlists > 0) {
9545: foreach (@currxlists) {
9546: if (m/^([^:]+):(\w*)$/) {
9547: unless (grep/^$1$/,@{$allcourses}) {
9548: push @{$allcourses},$1;
9549: $$LC_code{$1} = $2;
9550: }
9551: }
9552: }
9553: }
9554:
9555: if (@currsections > 0) {
9556: foreach (@currsections) {
9557: if (m/^(\w+):(\w*)$/) {
9558: my $sec = $coursecode.$1;
9559: my $lc_sec = $2;
9560: unless (grep/^$sec$/,@{$allcourses}) {
9561: push @{$allcourses},$sec;
9562: $$LC_code{$sec} = $lc_sec;
9563: }
9564: }
9565: }
9566: }
9567: return;
9568: }
9569:
1.971 raeburn 9570: sub get_standard_codeitems {
9571: return ('Year','Semester','Department','Number','Section');
9572: }
9573:
1.112 bowersj2 9574: =pod
9575:
1.780 raeburn 9576: =head1 Slot Helpers
9577:
9578: =over 4
9579:
9580: =item * sorted_slots()
9581:
1.1040 raeburn 9582: Sorts an array of slot names in order of an optional sort key,
9583: default sort is by slot start time (earliest first).
1.780 raeburn 9584:
9585: Inputs:
9586:
9587: =over 4
9588:
9589: slotsarr - Reference to array of unsorted slot names.
9590:
9591: slots - Reference to hash of hash, where outer hash keys are slot names.
9592:
1.1040 raeburn 9593: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9594:
1.549 albertel 9595: =back
9596:
1.780 raeburn 9597: Returns:
9598:
9599: =over 4
9600:
1.1040 raeburn 9601: sorted - An array of slot names sorted by a specified sort key
9602: (default sort key is start time of the slot).
1.780 raeburn 9603:
9604: =back
9605:
9606: =cut
9607:
9608:
9609: sub sorted_slots {
1.1040 raeburn 9610: my ($slotsarr,$slots,$sortkey) = @_;
9611: if ($sortkey eq '') {
9612: $sortkey = 'starttime';
9613: }
1.780 raeburn 9614: my @sorted;
9615: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9616: @sorted =
9617: sort {
9618: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9619: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9620: }
9621: if (ref($slots->{$a})) { return -1;}
9622: if (ref($slots->{$b})) { return 1;}
9623: return 0;
9624: } @{$slotsarr};
9625: }
9626: return @sorted;
9627: }
9628:
1.1040 raeburn 9629: =pod
9630:
9631: =item * get_future_slots()
9632:
9633: Inputs:
9634:
9635: =over 4
9636:
9637: cnum - course number
9638:
9639: cdom - course domain
9640:
9641: now - current UNIX time
9642:
9643: symb - optional symb
9644:
9645: =back
9646:
9647: Returns:
9648:
9649: =over 4
9650:
9651: sorted_reservable - ref to array of student_schedulable slots currently
9652: reservable, ordered by end date of reservation period.
9653:
9654: reservable_now - ref to hash of student_schedulable slots currently
9655: reservable.
9656:
9657: Keys in inner hash are:
9658: (a) symb: either blank or symb to which slot use is restricted.
9659: (b) endreserve: end date of reservation period.
9660:
9661: sorted_future - ref to array of student_schedulable slots reservable in
9662: the future, ordered by start date of reservation period.
9663:
9664: future_reservable - ref to hash of student_schedulable slots reservable
9665: in the future.
9666:
9667: Keys in inner hash are:
9668: (a) symb: either blank or symb to which slot use is restricted.
9669: (b) startreserve: start date of reservation period.
9670:
9671: =back
9672:
9673: =cut
9674:
9675: sub get_future_slots {
9676: my ($cnum,$cdom,$now,$symb) = @_;
9677: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9678: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9679: foreach my $slot (keys(%slots)) {
9680: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9681: if ($symb) {
9682: next if (($slots{$slot}->{'symb'} ne '') &&
9683: ($slots{$slot}->{'symb'} ne $symb));
9684: }
9685: if (($slots{$slot}->{'starttime'} > $now) &&
9686: ($slots{$slot}->{'endtime'} > $now)) {
9687: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9688: my $userallowed = 0;
9689: if ($slots{$slot}->{'allowedsections'}) {
9690: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9691: if (!defined($env{'request.role.sec'})
9692: && grep(/^No section assigned$/,@allowed_sec)) {
9693: $userallowed=1;
9694: } else {
9695: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9696: $userallowed=1;
9697: }
9698: }
9699: unless ($userallowed) {
9700: if (defined($env{'request.course.groups'})) {
9701: my @groups = split(/:/,$env{'request.course.groups'});
9702: foreach my $group (@groups) {
9703: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9704: $userallowed=1;
9705: last;
9706: }
9707: }
9708: }
9709: }
9710: }
9711: if ($slots{$slot}->{'allowedusers'}) {
9712: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9713: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9714: if (grep(/^\Q$user\E$/,@allowed_users)) {
9715: $userallowed = 1;
9716: }
9717: }
9718: next unless($userallowed);
9719: }
9720: my $startreserve = $slots{$slot}->{'startreserve'};
9721: my $endreserve = $slots{$slot}->{'endreserve'};
9722: my $symb = $slots{$slot}->{'symb'};
9723: if (($startreserve < $now) &&
9724: (!$endreserve || $endreserve > $now)) {
9725: my $lastres = $endreserve;
9726: if (!$lastres) {
9727: $lastres = $slots{$slot}->{'starttime'};
9728: }
9729: $reservable_now{$slot} = {
9730: symb => $symb,
9731: endreserve => $lastres
9732: };
9733: } elsif (($startreserve > $now) &&
9734: (!$endreserve || $endreserve > $startreserve)) {
9735: $future_reservable{$slot} = {
9736: symb => $symb,
9737: startreserve => $startreserve
9738: };
9739: }
9740: }
9741: }
9742: my @unsorted_reservable = keys(%reservable_now);
9743: if (@unsorted_reservable > 0) {
9744: @sorted_reservable =
9745: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9746: }
9747: my @unsorted_future = keys(%future_reservable);
9748: if (@unsorted_future > 0) {
9749: @sorted_future =
9750: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9751: }
9752: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9753: }
1.780 raeburn 9754:
9755: =pod
9756:
1.1057 foxr 9757: =back
9758:
1.549 albertel 9759: =head1 HTTP Helpers
9760:
9761: =over 4
9762:
1.648 raeburn 9763: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9764:
1.258 albertel 9765: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9766: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9767: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9768:
9769: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9770: $possible_names is an ref to an array of form element names. As an example:
9771: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9772: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9773:
9774: =cut
1.1 albertel 9775:
1.6 albertel 9776: sub get_unprocessed_cgi {
1.25 albertel 9777: my ($query,$possible_names)= @_;
1.26 matthew 9778: # $Apache::lonxml::debug=1;
1.356 albertel 9779: foreach my $pair (split(/&/,$query)) {
9780: my ($name, $value) = split(/=/,$pair);
1.369 www 9781: $name = &unescape($name);
1.25 albertel 9782: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9783: $value =~ tr/+/ /;
9784: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9785: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9786: }
1.16 harris41 9787: }
1.6 albertel 9788: }
9789:
1.112 bowersj2 9790: =pod
9791:
1.648 raeburn 9792: =item * &cacheheader()
1.112 bowersj2 9793:
9794: returns cache-controlling header code
9795:
9796: =cut
9797:
1.7 albertel 9798: sub cacheheader {
1.258 albertel 9799: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9800: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9801: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9802: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9803: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9804: return $output;
1.7 albertel 9805: }
9806:
1.112 bowersj2 9807: =pod
9808:
1.648 raeburn 9809: =item * &no_cache($r)
1.112 bowersj2 9810:
9811: specifies header code to not have cache
9812:
9813: =cut
9814:
1.9 albertel 9815: sub no_cache {
1.216 albertel 9816: my ($r) = @_;
9817: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9818: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9819: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9820: $r->no_cache(1);
9821: $r->header_out("Expires" => $date);
9822: $r->header_out("Pragma" => "no-cache");
1.123 www 9823: }
9824:
9825: sub content_type {
1.181 albertel 9826: my ($r,$type,$charset) = @_;
1.299 foxr 9827: if ($r) {
9828: # Note that printout.pl calls this with undef for $r.
9829: &no_cache($r);
9830: }
1.258 albertel 9831: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9832: unless ($charset) {
9833: $charset=&Apache::lonlocal::current_encoding;
9834: }
9835: if ($charset) { $type.='; charset='.$charset; }
9836: if ($r) {
9837: $r->content_type($type);
9838: } else {
9839: print("Content-type: $type\n\n");
9840: }
1.9 albertel 9841: }
1.25 albertel 9842:
1.112 bowersj2 9843: =pod
9844:
1.648 raeburn 9845: =item * &add_to_env($name,$value)
1.112 bowersj2 9846:
1.258 albertel 9847: adds $name to the %env hash with value
1.112 bowersj2 9848: $value, if $name already exists, the entry is converted to an array
9849: reference and $value is added to the array.
9850:
9851: =cut
9852:
1.25 albertel 9853: sub add_to_env {
9854: my ($name,$value)=@_;
1.258 albertel 9855: if (defined($env{$name})) {
9856: if (ref($env{$name})) {
1.25 albertel 9857: #already have multiple values
1.258 albertel 9858: push(@{ $env{$name} },$value);
1.25 albertel 9859: } else {
9860: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9861: my $first=$env{$name};
9862: undef($env{$name});
9863: push(@{ $env{$name} },$first,$value);
1.25 albertel 9864: }
9865: } else {
1.258 albertel 9866: $env{$name}=$value;
1.25 albertel 9867: }
1.31 albertel 9868: }
1.149 albertel 9869:
9870: =pod
9871:
1.648 raeburn 9872: =item * &get_env_multiple($name)
1.149 albertel 9873:
1.258 albertel 9874: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9875: values may be defined and end up as an array ref.
9876:
9877: returns an array of values
9878:
9879: =cut
9880:
9881: sub get_env_multiple {
9882: my ($name) = @_;
9883: my @values;
1.258 albertel 9884: if (defined($env{$name})) {
1.149 albertel 9885: # exists is it an array
1.258 albertel 9886: if (ref($env{$name})) {
9887: @values=@{ $env{$name} };
1.149 albertel 9888: } else {
1.258 albertel 9889: $values[0]=$env{$name};
1.149 albertel 9890: }
9891: }
9892: return(@values);
9893: }
9894:
1.660 raeburn 9895: sub ask_for_embedded_content {
9896: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9897: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9898: %currsubfile,%unused,$rem);
1.1071 raeburn 9899: my $counter = 0;
9900: my $numnew = 0;
1.987 raeburn 9901: my $numremref = 0;
9902: my $numinvalid = 0;
9903: my $numpathchg = 0;
9904: my $numexisting = 0;
1.1071 raeburn 9905: my $numunused = 0;
9906: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 9907: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9908: my $heading = &mt('Upload embedded files');
9909: my $buttontext = &mt('Upload');
9910:
1.1085 raeburn 9911: if ($env{'request.course.id'}) {
1.1123 raeburn 9912: if ($actionurl eq '/adm/dependencies') {
9913: $navmap = Apache::lonnavmaps::navmap->new();
9914: }
9915: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9916: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 9917: }
1.1123 raeburn 9918: if (($actionurl eq '/adm/portfolio') ||
9919: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 9920: my $current_path='/';
9921: if ($env{'form.currentpath'}) {
9922: $current_path = $env{'form.currentpath'};
9923: }
9924: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 9925: $udom = $cdom;
9926: $uname = $cnum;
1.984 raeburn 9927: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9928: } else {
9929: $udom = $env{'user.domain'};
9930: $uname = $env{'user.name'};
9931: $url = '/userfiles/portfolio';
9932: }
1.987 raeburn 9933: $toplevel = $url.'/';
1.984 raeburn 9934: $url .= $current_path;
9935: $getpropath = 1;
1.987 raeburn 9936: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9937: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9938: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9939: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9940: $toplevel = $url;
1.984 raeburn 9941: if ($rest ne '') {
1.987 raeburn 9942: $url .= $rest;
9943: }
9944: } elsif ($actionurl eq '/adm/coursedocs') {
9945: if (ref($args) eq 'HASH') {
1.1071 raeburn 9946: $url = $args->{'docs_url'};
9947: $toplevel = $url;
1.1084 raeburn 9948: if ($args->{'context'} eq 'paste') {
9949: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9950: ($path) =
9951: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9952: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9953: $fileloc =~ s{^/}{};
9954: }
1.1071 raeburn 9955: }
1.1084 raeburn 9956: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9957: if ($env{'request.course.id'} ne '') {
9958: if (ref($args) eq 'HASH') {
9959: $url = $args->{'docs_url'};
9960: $title = $args->{'docs_title'};
1.1126 raeburn 9961: $toplevel = $url;
9962: unless ($toplevel =~ m{^/}) {
9963: $toplevel = "/$url";
9964: }
1.1085 raeburn 9965: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 9966: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
9967: $path = $1;
9968: } else {
9969: ($path) =
9970: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9971: }
1.1195 raeburn 9972: if ($toplevel=~/^\/*(uploaded|editupload)/) {
9973: $fileloc = $toplevel;
9974: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
9975: my ($udom,$uname,$fname) =
9976: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
9977: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
9978: } else {
9979: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9980: }
1.1071 raeburn 9981: $fileloc =~ s{^/}{};
9982: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9983: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9984: }
1.987 raeburn 9985: }
1.1123 raeburn 9986: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9987: $udom = $cdom;
9988: $uname = $cnum;
9989: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
9990: $toplevel = $url;
9991: $path = $url;
9992: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
9993: $fileloc =~ s{^/}{};
1.987 raeburn 9994: }
1.1126 raeburn 9995: foreach my $file (keys(%{$allfiles})) {
9996: my $embed_file;
9997: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
9998: $embed_file = $1;
9999: } else {
10000: $embed_file = $file;
10001: }
1.1158 raeburn 10002: my ($absolutepath,$cleaned_file);
10003: if ($embed_file =~ m{^\w+://}) {
10004: $cleaned_file = $embed_file;
1.1147 raeburn 10005: $newfiles{$cleaned_file} = 1;
10006: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10007: } else {
1.1158 raeburn 10008: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10009: if ($embed_file =~ m{^/}) {
10010: $absolutepath = $embed_file;
10011: }
1.1147 raeburn 10012: if ($cleaned_file =~ m{/}) {
10013: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10014: $path = &check_for_traversal($path,$url,$toplevel);
10015: my $item = $fname;
10016: if ($path ne '') {
10017: $item = $path.'/'.$fname;
10018: $subdependencies{$path}{$fname} = 1;
10019: } else {
10020: $dependencies{$item} = 1;
10021: }
10022: if ($absolutepath) {
10023: $mapping{$item} = $absolutepath;
10024: } else {
10025: $mapping{$item} = $embed_file;
10026: }
10027: } else {
10028: $dependencies{$embed_file} = 1;
10029: if ($absolutepath) {
1.1147 raeburn 10030: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10031: } else {
1.1147 raeburn 10032: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10033: }
10034: }
1.984 raeburn 10035: }
10036: }
1.1071 raeburn 10037: my $dirptr = 16384;
1.984 raeburn 10038: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10039: $currsubfile{$path} = {};
1.1123 raeburn 10040: if (($actionurl eq '/adm/portfolio') ||
10041: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10042: my ($sublistref,$listerror) =
10043: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10044: if (ref($sublistref) eq 'ARRAY') {
10045: foreach my $line (@{$sublistref}) {
10046: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10047: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10048: }
1.984 raeburn 10049: }
1.987 raeburn 10050: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10051: if (opendir(my $dir,$url.'/'.$path)) {
10052: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10053: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10054: }
1.1084 raeburn 10055: } elsif (($actionurl eq '/adm/dependencies') ||
10056: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10057: ($args->{'context'} eq 'paste')) ||
10058: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10059: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10060: my $dir;
10061: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10062: $dir = $fileloc;
10063: } else {
10064: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10065: }
1.1071 raeburn 10066: if ($dir ne '') {
10067: my ($sublistref,$listerror) =
10068: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10069: if (ref($sublistref) eq 'ARRAY') {
10070: foreach my $line (@{$sublistref}) {
10071: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10072: undef,$mtime)=split(/\&/,$line,12);
10073: unless (($testdir&$dirptr) ||
10074: ($file_name =~ /^\.\.?$/)) {
10075: $currsubfile{$path}{$file_name} = [$size,$mtime];
10076: }
10077: }
10078: }
10079: }
1.984 raeburn 10080: }
10081: }
10082: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10083: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10084: my $item = $path.'/'.$file;
10085: unless ($mapping{$item} eq $item) {
10086: $pathchanges{$item} = 1;
10087: }
10088: $existing{$item} = 1;
10089: $numexisting ++;
10090: } else {
10091: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10092: }
10093: }
1.1071 raeburn 10094: if ($actionurl eq '/adm/dependencies') {
10095: foreach my $path (keys(%currsubfile)) {
10096: if (ref($currsubfile{$path}) eq 'HASH') {
10097: foreach my $file (keys(%{$currsubfile{$path}})) {
10098: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10099: next if (($rem ne '') &&
10100: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10101: (ref($navmap) &&
10102: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10103: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10104: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10105: $unused{$path.'/'.$file} = 1;
10106: }
10107: }
10108: }
10109: }
10110: }
1.984 raeburn 10111: }
1.987 raeburn 10112: my %currfile;
1.1123 raeburn 10113: if (($actionurl eq '/adm/portfolio') ||
10114: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10115: my ($dirlistref,$listerror) =
10116: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10117: if (ref($dirlistref) eq 'ARRAY') {
10118: foreach my $line (@{$dirlistref}) {
10119: my ($file_name,$rest) = split(/\&/,$line,2);
10120: $currfile{$file_name} = 1;
10121: }
1.984 raeburn 10122: }
1.987 raeburn 10123: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10124: if (opendir(my $dir,$url)) {
1.987 raeburn 10125: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10126: map {$currfile{$_} = 1;} @dir_list;
10127: }
1.1084 raeburn 10128: } elsif (($actionurl eq '/adm/dependencies') ||
10129: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10130: ($args->{'context'} eq 'paste')) ||
10131: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10132: if ($env{'request.course.id'} ne '') {
10133: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10134: if ($dir ne '') {
10135: my ($dirlistref,$listerror) =
10136: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10137: if (ref($dirlistref) eq 'ARRAY') {
10138: foreach my $line (@{$dirlistref}) {
10139: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10140: $size,undef,$mtime)=split(/\&/,$line,12);
10141: unless (($testdir&$dirptr) ||
10142: ($file_name =~ /^\.\.?$/)) {
10143: $currfile{$file_name} = [$size,$mtime];
10144: }
10145: }
10146: }
10147: }
10148: }
1.984 raeburn 10149: }
10150: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10151: if (exists($currfile{$file})) {
1.987 raeburn 10152: unless ($mapping{$file} eq $file) {
10153: $pathchanges{$file} = 1;
10154: }
10155: $existing{$file} = 1;
10156: $numexisting ++;
10157: } else {
1.984 raeburn 10158: $newfiles{$file} = 1;
10159: }
10160: }
1.1071 raeburn 10161: foreach my $file (keys(%currfile)) {
10162: unless (($file eq $filename) ||
10163: ($file eq $filename.'.bak') ||
10164: ($dependencies{$file})) {
1.1085 raeburn 10165: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10166: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10167: next if (($rem ne '') &&
10168: (($env{"httpref.$rem".$file} ne '') ||
10169: (ref($navmap) &&
10170: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10171: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10172: ($navmap->getResourceByUrl($rem.$1)))))));
10173: }
1.1085 raeburn 10174: }
1.1071 raeburn 10175: $unused{$file} = 1;
10176: }
10177: }
1.1084 raeburn 10178: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10179: ($args->{'context'} eq 'paste')) {
10180: $counter = scalar(keys(%existing));
10181: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10182: return ($output,$counter,$numpathchg,\%existing);
10183: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10184: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10185: $counter = scalar(keys(%existing));
10186: $numpathchg = scalar(keys(%pathchanges));
10187: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10188: }
1.984 raeburn 10189: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10190: if ($actionurl eq '/adm/dependencies') {
10191: next if ($embed_file =~ m{^\w+://});
10192: }
1.660 raeburn 10193: $upload_output .= &start_data_table_row().
1.1123 raeburn 10194: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10195: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10196: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10197: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10198: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10199: }
1.1123 raeburn 10200: $upload_output .= '</td>';
1.1071 raeburn 10201: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10202: $upload_output.='<td align="right">'.
10203: '<span class="LC_info LC_fontsize_medium">'.
10204: &mt("URL points to web address").'</span>';
1.987 raeburn 10205: $numremref++;
1.660 raeburn 10206: } elsif ($args->{'error_on_invalid_names'}
10207: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10208: $upload_output.='<td align="right"><span class="LC_warning">'.
10209: &mt('Invalid characters').'</span>';
1.987 raeburn 10210: $numinvalid++;
1.660 raeburn 10211: } else {
1.1123 raeburn 10212: $upload_output .= '<td>'.
10213: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10214: $embed_file,\%mapping,
1.1071 raeburn 10215: $allfiles,$codebase,'upload');
10216: $counter ++;
10217: $numnew ++;
1.987 raeburn 10218: }
10219: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10220: }
10221: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10222: if ($actionurl eq '/adm/dependencies') {
10223: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10224: $modify_output .= &start_data_table_row().
10225: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10226: '<img src="'.&icon($embed_file).'" border="0" />'.
10227: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10228: '<td>'.$size.'</td>'.
10229: '<td>'.$mtime.'</td>'.
10230: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10231: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10232: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10233: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10234: &embedded_file_element('upload_embedded',$counter,
10235: $embed_file,\%mapping,
10236: $allfiles,$codebase,'modify').
10237: '</div></td>'.
10238: &end_data_table_row()."\n";
10239: $counter ++;
10240: } else {
10241: $upload_output .= &start_data_table_row().
1.1123 raeburn 10242: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10243: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10244: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10245: &Apache::loncommon::end_data_table_row()."\n";
10246: }
10247: }
10248: my $delidx = $counter;
10249: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10250: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10251: $delete_output .= &start_data_table_row().
10252: '<td><img src="'.&icon($oldfile).'" />'.
10253: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10254: '<td>'.$size.'</td>'.
10255: '<td>'.$mtime.'</td>'.
10256: '<td><label><input type="checkbox" name="del_upload_dep" '.
10257: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10258: &embedded_file_element('upload_embedded',$delidx,
10259: $oldfile,\%mapping,$allfiles,
10260: $codebase,'delete').'</td>'.
10261: &end_data_table_row()."\n";
10262: $numunused ++;
10263: $delidx ++;
1.987 raeburn 10264: }
10265: if ($upload_output) {
10266: $upload_output = &start_data_table().
10267: $upload_output.
10268: &end_data_table()."\n";
10269: }
1.1071 raeburn 10270: if ($modify_output) {
10271: $modify_output = &start_data_table().
10272: &start_data_table_header_row().
10273: '<th>'.&mt('File').'</th>'.
10274: '<th>'.&mt('Size (KB)').'</th>'.
10275: '<th>'.&mt('Modified').'</th>'.
10276: '<th>'.&mt('Upload replacement?').'</th>'.
10277: &end_data_table_header_row().
10278: $modify_output.
10279: &end_data_table()."\n";
10280: }
10281: if ($delete_output) {
10282: $delete_output = &start_data_table().
10283: &start_data_table_header_row().
10284: '<th>'.&mt('File').'</th>'.
10285: '<th>'.&mt('Size (KB)').'</th>'.
10286: '<th>'.&mt('Modified').'</th>'.
10287: '<th>'.&mt('Delete?').'</th>'.
10288: &end_data_table_header_row().
10289: $delete_output.
10290: &end_data_table()."\n";
10291: }
1.987 raeburn 10292: my $applies = 0;
10293: if ($numremref) {
10294: $applies ++;
10295: }
10296: if ($numinvalid) {
10297: $applies ++;
10298: }
10299: if ($numexisting) {
10300: $applies ++;
10301: }
1.1071 raeburn 10302: if ($counter || $numunused) {
1.987 raeburn 10303: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10304: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10305: $state.'<h3>'.$heading.'</h3>';
10306: if ($actionurl eq '/adm/dependencies') {
10307: if ($numnew) {
10308: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10309: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10310: $upload_output.'<br />'."\n";
10311: }
10312: if ($numexisting) {
10313: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10314: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10315: $modify_output.'<br />'."\n";
10316: $buttontext = &mt('Save changes');
10317: }
10318: if ($numunused) {
10319: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10320: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10321: $delete_output.'<br />'."\n";
10322: $buttontext = &mt('Save changes');
10323: }
10324: } else {
10325: $output .= $upload_output.'<br />'."\n";
10326: }
10327: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10328: $counter.'" />'."\n";
10329: if ($actionurl eq '/adm/dependencies') {
10330: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10331: $numnew.'" />'."\n";
10332: } elsif ($actionurl eq '') {
1.987 raeburn 10333: $output .= '<input type="hidden" name="phase" value="three" />';
10334: }
10335: } elsif ($applies) {
10336: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10337: if ($applies > 1) {
10338: $output .=
1.1123 raeburn 10339: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10340: if ($numremref) {
10341: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10342: }
10343: if ($numinvalid) {
10344: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10345: }
10346: if ($numexisting) {
10347: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10348: }
10349: $output .= '</ul><br />';
10350: } elsif ($numremref) {
10351: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10352: } elsif ($numinvalid) {
10353: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10354: } elsif ($numexisting) {
10355: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10356: }
10357: $output .= $upload_output.'<br />';
10358: }
10359: my ($pathchange_output,$chgcount);
1.1071 raeburn 10360: $chgcount = $counter;
1.987 raeburn 10361: if (keys(%pathchanges) > 0) {
10362: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10363: if ($counter) {
1.987 raeburn 10364: $output .= &embedded_file_element('pathchange',$chgcount,
10365: $embed_file,\%mapping,
1.1071 raeburn 10366: $allfiles,$codebase,'change');
1.987 raeburn 10367: } else {
10368: $pathchange_output .=
10369: &start_data_table_row().
10370: '<td><input type ="checkbox" name="namechange" value="'.
10371: $chgcount.'" checked="checked" /></td>'.
10372: '<td>'.$mapping{$embed_file}.'</td>'.
10373: '<td>'.$embed_file.
10374: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10375: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10376: '</td>'.&end_data_table_row();
1.660 raeburn 10377: }
1.987 raeburn 10378: $numpathchg ++;
10379: $chgcount ++;
1.660 raeburn 10380: }
10381: }
1.1127 raeburn 10382: if (($counter) || ($numunused)) {
1.987 raeburn 10383: if ($numpathchg) {
10384: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10385: $numpathchg.'" />'."\n";
10386: }
10387: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10388: ($actionurl eq '/adm/imsimport')) {
10389: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10390: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10391: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10392: } elsif ($actionurl eq '/adm/dependencies') {
10393: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10394: }
1.1123 raeburn 10395: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10396: } elsif ($numpathchg) {
10397: my %pathchange = ();
10398: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10399: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10400: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10401: }
1.987 raeburn 10402: }
1.1071 raeburn 10403: return ($output,$counter,$numpathchg);
1.987 raeburn 10404: }
10405:
1.1147 raeburn 10406: =pod
10407:
10408: =item * clean_path($name)
10409:
10410: Performs clean-up of directories, subdirectories and filename in an
10411: embedded object, referenced in an HTML file which is being uploaded
10412: to a course or portfolio, where
10413: "Upload embedded images/multimedia files if HTML file" checkbox was
10414: checked.
10415:
10416: Clean-up is similar to replacements in lonnet::clean_filename()
10417: except each / between sub-directory and next level is preserved.
10418:
10419: =cut
10420:
10421: sub clean_path {
10422: my ($embed_file) = @_;
10423: $embed_file =~s{^/+}{};
10424: my @contents;
10425: if ($embed_file =~ m{/}) {
10426: @contents = split(/\//,$embed_file);
10427: } else {
10428: @contents = ($embed_file);
10429: }
10430: my $lastidx = scalar(@contents)-1;
10431: for (my $i=0; $i<=$lastidx; $i++) {
10432: $contents[$i]=~s{\\}{/}g;
10433: $contents[$i]=~s/\s+/\_/g;
10434: $contents[$i]=~s{[^/\w\.\-]}{}g;
10435: if ($i == $lastidx) {
10436: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10437: }
10438: }
10439: if ($lastidx > 0) {
10440: return join('/',@contents);
10441: } else {
10442: return $contents[0];
10443: }
10444: }
10445:
1.987 raeburn 10446: sub embedded_file_element {
1.1071 raeburn 10447: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10448: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10449: (ref($codebase) eq 'HASH'));
10450: my $output;
1.1071 raeburn 10451: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10452: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10453: }
10454: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10455: &escape($embed_file).'" />';
10456: unless (($context eq 'upload_embedded') &&
10457: ($mapping->{$embed_file} eq $embed_file)) {
10458: $output .='
10459: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10460: }
10461: my $attrib;
10462: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10463: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10464: }
10465: $output .=
10466: "\n\t\t".
10467: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10468: $attrib.'" />';
10469: if (exists($codebase->{$mapping->{$embed_file}})) {
10470: $output .=
10471: "\n\t\t".
10472: '<input name="codebase_'.$num.'" type="hidden" value="'.
10473: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10474: }
1.987 raeburn 10475: return $output;
1.660 raeburn 10476: }
10477:
1.1071 raeburn 10478: sub get_dependency_details {
10479: my ($currfile,$currsubfile,$embed_file) = @_;
10480: my ($size,$mtime,$showsize,$showmtime);
10481: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10482: if ($embed_file =~ m{/}) {
10483: my ($path,$fname) = split(/\//,$embed_file);
10484: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10485: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10486: }
10487: } else {
10488: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10489: ($size,$mtime) = @{$currfile->{$embed_file}};
10490: }
10491: }
10492: $showsize = $size/1024.0;
10493: $showsize = sprintf("%.1f",$showsize);
10494: if ($mtime > 0) {
10495: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10496: }
10497: }
10498: return ($showsize,$showmtime);
10499: }
10500:
10501: sub ask_embedded_js {
10502: return <<"END";
10503: <script type="text/javascript"">
10504: // <![CDATA[
10505: function toggleBrowse(counter) {
10506: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10507: var fileid = document.getElementById('embedded_item_'+counter);
10508: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10509: if (chkboxid.checked == true) {
10510: uploaddivid.style.display='block';
10511: } else {
10512: uploaddivid.style.display='none';
10513: fileid.value = '';
10514: }
10515: }
10516: // ]]>
10517: </script>
10518:
10519: END
10520: }
10521:
1.661 raeburn 10522: sub upload_embedded {
10523: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10524: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10525: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10526: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10527: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10528: my $orig_uploaded_filename =
10529: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10530: foreach my $type ('orig','ref','attrib','codebase') {
10531: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10532: $env{'form.embedded_'.$type.'_'.$i} =
10533: &unescape($env{'form.embedded_'.$type.'_'.$i});
10534: }
10535: }
1.661 raeburn 10536: my ($path,$fname) =
10537: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10538: # no path, whole string is fname
10539: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10540: $fname = &Apache::lonnet::clean_filename($fname);
10541: # See if there is anything left
10542: next if ($fname eq '');
10543:
10544: # Check if file already exists as a file or directory.
10545: my ($state,$msg);
10546: if ($context eq 'portfolio') {
10547: my $port_path = $dirpath;
10548: if ($group ne '') {
10549: $port_path = "groups/$group/$port_path";
10550: }
1.987 raeburn 10551: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10552: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10553: $dir_root,$port_path,$disk_quota,
10554: $current_disk_usage,$uname,$udom);
10555: if ($state eq 'will_exceed_quota'
1.984 raeburn 10556: || $state eq 'file_locked') {
1.661 raeburn 10557: $output .= $msg;
10558: next;
10559: }
10560: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10561: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10562: if ($state eq 'exists') {
10563: $output .= $msg;
10564: next;
10565: }
10566: }
10567: # Check if extension is valid
10568: if (($fname =~ /\.(\w+)$/) &&
10569: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10570: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10571: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10572: next;
10573: } elsif (($fname =~ /\.(\w+)$/) &&
10574: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10575: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10576: next;
10577: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10578: $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 10579: next;
10580: }
10581: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10582: my $subdir = $path;
10583: $subdir =~ s{/+$}{};
1.661 raeburn 10584: if ($context eq 'portfolio') {
1.984 raeburn 10585: my $result;
10586: if ($state eq 'existingfile') {
10587: $result=
10588: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 10589: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10590: } else {
1.984 raeburn 10591: $result=
10592: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10593: $dirpath.
1.1123 raeburn 10594: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10595: if ($result !~ m|^/uploaded/|) {
10596: $output .= '<span class="LC_error">'
10597: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10598: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10599: .'</span><br />';
10600: next;
10601: } else {
1.987 raeburn 10602: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10603: $path.$fname.'</span>').'<br />';
1.984 raeburn 10604: }
1.661 raeburn 10605: }
1.1123 raeburn 10606: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 10607: my $extendedsubdir = $dirpath.'/'.$subdir;
10608: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10609: my $result =
1.1126 raeburn 10610: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10611: if ($result !~ m|^/uploaded/|) {
10612: $output .= '<span class="LC_error">'
10613: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10614: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10615: .'</span><br />';
10616: next;
10617: } else {
10618: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10619: $path.$fname.'</span>').'<br />';
1.1125 raeburn 10620: if ($context eq 'syllabus') {
10621: &Apache::lonnet::make_public_indefinitely($result);
10622: }
1.987 raeburn 10623: }
1.661 raeburn 10624: } else {
10625: # Save the file
10626: my $target = $env{'form.embedded_item_'.$i};
10627: my $fullpath = $dir_root.$dirpath.'/'.$path;
10628: my $dest = $fullpath.$fname;
10629: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10630: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10631: my $count;
10632: my $filepath = $dir_root;
1.1027 raeburn 10633: foreach my $subdir (@parts) {
10634: $filepath .= "/$subdir";
10635: if (!-e $filepath) {
1.661 raeburn 10636: mkdir($filepath,0770);
10637: }
10638: }
10639: my $fh;
10640: if (!open($fh,'>'.$dest)) {
10641: &Apache::lonnet::logthis('Failed to create '.$dest);
10642: $output .= '<span class="LC_error">'.
1.1071 raeburn 10643: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10644: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10645: '</span><br />';
10646: } else {
10647: if (!print $fh $env{'form.embedded_item_'.$i}) {
10648: &Apache::lonnet::logthis('Failed to write to '.$dest);
10649: $output .= '<span class="LC_error">'.
1.1071 raeburn 10650: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10651: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10652: '</span><br />';
10653: } else {
1.987 raeburn 10654: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10655: $url.'</span>').'<br />';
10656: unless ($context eq 'testbank') {
10657: $footer .= &mt('View embedded file: [_1]',
10658: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10659: }
10660: }
10661: close($fh);
10662: }
10663: }
10664: if ($env{'form.embedded_ref_'.$i}) {
10665: $pathchange{$i} = 1;
10666: }
10667: }
10668: if ($output) {
10669: $output = '<p>'.$output.'</p>';
10670: }
10671: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10672: $returnflag = 'ok';
1.1071 raeburn 10673: my $numpathchgs = scalar(keys(%pathchange));
10674: if ($numpathchgs > 0) {
1.987 raeburn 10675: if ($context eq 'portfolio') {
10676: $output .= '<p>'.&mt('or').'</p>';
10677: } elsif ($context eq 'testbank') {
1.1071 raeburn 10678: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10679: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10680: $returnflag = 'modify_orightml';
10681: }
10682: }
1.1071 raeburn 10683: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10684: }
10685:
10686: sub modify_html_form {
10687: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10688: my $end = 0;
10689: my $modifyform;
10690: if ($context eq 'upload_embedded') {
10691: return unless (ref($pathchange) eq 'HASH');
10692: if ($env{'form.number_embedded_items'}) {
10693: $end += $env{'form.number_embedded_items'};
10694: }
10695: if ($env{'form.number_pathchange_items'}) {
10696: $end += $env{'form.number_pathchange_items'};
10697: }
10698: if ($end) {
10699: for (my $i=0; $i<$end; $i++) {
10700: if ($i < $env{'form.number_embedded_items'}) {
10701: next unless($pathchange->{$i});
10702: }
10703: $modifyform .=
10704: &start_data_table_row().
10705: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10706: 'checked="checked" /></td>'.
10707: '<td>'.$env{'form.embedded_ref_'.$i}.
10708: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10709: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10710: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10711: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10712: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10713: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10714: '<td>'.$env{'form.embedded_orig_'.$i}.
10715: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10716: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10717: &end_data_table_row();
1.1071 raeburn 10718: }
1.987 raeburn 10719: }
10720: } else {
10721: $modifyform = $pathchgtable;
10722: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10723: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10724: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10725: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10726: }
10727: }
10728: if ($modifyform) {
1.1071 raeburn 10729: if ($actionurl eq '/adm/dependencies') {
10730: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10731: }
1.987 raeburn 10732: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10733: '<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".
10734: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10735: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10736: '</ol></p>'."\n".'<p>'.
10737: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10738: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10739: &start_data_table()."\n".
10740: &start_data_table_header_row().
10741: '<th>'.&mt('Change?').'</th>'.
10742: '<th>'.&mt('Current reference').'</th>'.
10743: '<th>'.&mt('Required reference').'</th>'.
10744: &end_data_table_header_row()."\n".
10745: $modifyform.
10746: &end_data_table().'<br />'."\n".$hiddenstate.
10747: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10748: '</form>'."\n";
10749: }
10750: return;
10751: }
10752:
10753: sub modify_html_refs {
1.1123 raeburn 10754: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10755: my $container;
10756: if ($context eq 'portfolio') {
10757: $container = $env{'form.container'};
10758: } elsif ($context eq 'coursedoc') {
10759: $container = $env{'form.primaryurl'};
1.1071 raeburn 10760: } elsif ($context eq 'manage_dependencies') {
10761: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10762: $container = "/$container";
1.1123 raeburn 10763: } elsif ($context eq 'syllabus') {
10764: $container = $url;
1.987 raeburn 10765: } else {
1.1027 raeburn 10766: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10767: }
10768: my (%allfiles,%codebase,$output,$content);
10769: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 10770: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10771: if (wantarray) {
10772: return ('',0,0);
10773: } else {
10774: return;
10775: }
10776: }
10777: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10778: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10779: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10780: if (wantarray) {
10781: return ('',0,0);
10782: } else {
10783: return;
10784: }
10785: }
1.987 raeburn 10786: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10787: if ($content eq '-1') {
10788: if (wantarray) {
10789: return ('',0,0);
10790: } else {
10791: return;
10792: }
10793: }
1.987 raeburn 10794: } else {
1.1071 raeburn 10795: unless ($container =~ /^\Q$dir_root\E/) {
10796: if (wantarray) {
10797: return ('',0,0);
10798: } else {
10799: return;
10800: }
10801: }
1.987 raeburn 10802: if (open(my $fh,"<$container")) {
10803: $content = join('', <$fh>);
10804: close($fh);
10805: } else {
1.1071 raeburn 10806: if (wantarray) {
10807: return ('',0,0);
10808: } else {
10809: return;
10810: }
1.987 raeburn 10811: }
10812: }
10813: my ($count,$codebasecount) = (0,0);
10814: my $mm = new File::MMagic;
10815: my $mime_type = $mm->checktype_contents($content);
10816: if ($mime_type eq 'text/html') {
10817: my $parse_result =
10818: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10819: \%codebase,\$content);
10820: if ($parse_result eq 'ok') {
10821: foreach my $i (@changes) {
10822: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10823: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10824: if ($allfiles{$ref}) {
10825: my $newname = $orig;
10826: my ($attrib_regexp,$codebase);
1.1006 raeburn 10827: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10828: if ($attrib_regexp =~ /:/) {
10829: $attrib_regexp =~ s/\:/|/g;
10830: }
10831: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10832: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10833: $count += $numchg;
1.1123 raeburn 10834: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 10835: delete($allfiles{$ref});
1.987 raeburn 10836: }
10837: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10838: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10839: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10840: $codebasecount ++;
10841: }
10842: }
10843: }
1.1123 raeburn 10844: my $skiprewrites;
1.987 raeburn 10845: if ($count || $codebasecount) {
10846: my $saveresult;
1.1071 raeburn 10847: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10848: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10849: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10850: if ($url eq $container) {
10851: my ($fname) = ($container =~ m{/([^/]+)$});
10852: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10853: $count,'<span class="LC_filename">'.
1.1071 raeburn 10854: $fname.'</span>').'</p>';
1.987 raeburn 10855: } else {
10856: $output = '<p class="LC_error">'.
10857: &mt('Error: update failed for: [_1].',
10858: '<span class="LC_filename">'.
10859: $container.'</span>').'</p>';
10860: }
1.1123 raeburn 10861: if ($context eq 'syllabus') {
10862: unless ($saveresult eq 'ok') {
10863: $skiprewrites = 1;
10864: }
10865: }
1.987 raeburn 10866: } else {
10867: if (open(my $fh,">$container")) {
10868: print $fh $content;
10869: close($fh);
10870: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10871: $count,'<span class="LC_filename">'.
10872: $container.'</span>').'</p>';
1.661 raeburn 10873: } else {
1.987 raeburn 10874: $output = '<p class="LC_error">'.
10875: &mt('Error: could not update [_1].',
10876: '<span class="LC_filename">'.
10877: $container.'</span>').'</p>';
1.661 raeburn 10878: }
10879: }
10880: }
1.1123 raeburn 10881: if (($context eq 'syllabus') && (!$skiprewrites)) {
10882: my ($actionurl,$state);
10883: $actionurl = "/public/$udom/$uname/syllabus";
10884: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10885: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10886: \%codebase,
10887: {'context' => 'rewrites',
10888: 'ignore_remote_references' => 1,});
10889: if (ref($mapping) eq 'HASH') {
10890: my $rewrites = 0;
10891: foreach my $key (keys(%{$mapping})) {
10892: next if ($key =~ m{^https?://});
10893: my $ref = $mapping->{$key};
10894: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10895: my $attrib;
10896: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10897: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10898: }
10899: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10900: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10901: $rewrites += $numchg;
10902: }
10903: }
10904: if ($rewrites) {
10905: my $saveresult;
10906: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10907: if ($url eq $container) {
10908: my ($fname) = ($container =~ m{/([^/]+)$});
10909: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10910: $count,'<span class="LC_filename">'.
10911: $fname.'</span>').'</p>';
10912: } else {
10913: $output .= '<p class="LC_error">'.
10914: &mt('Error: could not update links in [_1].',
10915: '<span class="LC_filename">'.
10916: $container.'</span>').'</p>';
10917:
10918: }
10919: }
10920: }
10921: }
1.987 raeburn 10922: } else {
10923: &logthis('Failed to parse '.$container.
10924: ' to modify references: '.$parse_result);
1.661 raeburn 10925: }
10926: }
1.1071 raeburn 10927: if (wantarray) {
10928: return ($output,$count,$codebasecount);
10929: } else {
10930: return $output;
10931: }
1.661 raeburn 10932: }
10933:
10934: sub check_for_existing {
10935: my ($path,$fname,$element) = @_;
10936: my ($state,$msg);
10937: if (-d $path.'/'.$fname) {
10938: $state = 'exists';
10939: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10940: } elsif (-e $path.'/'.$fname) {
10941: $state = 'exists';
10942: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10943: }
10944: if ($state eq 'exists') {
10945: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10946: }
10947: return ($state,$msg);
10948: }
10949:
10950: sub check_for_upload {
10951: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10952: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10953: my $filesize = length($env{'form.'.$element});
10954: if (!$filesize) {
10955: my $msg = '<span class="LC_error">'.
10956: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10957: '<span class="LC_filename">'.$fname.'</span>',
10958: $filesize).'<br />'.
1.1007 raeburn 10959: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10960: '</span>';
10961: return ('zero_bytes',$msg);
10962: }
10963: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10964: my $getpropath = 1;
1.1021 raeburn 10965: my ($dirlistref,$listerror) =
10966: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10967: my $found_file = 0;
10968: my $locked_file = 0;
1.991 raeburn 10969: my @lockers;
10970: my $navmap;
10971: if ($env{'request.course.id'}) {
10972: $navmap = Apache::lonnavmaps::navmap->new();
10973: }
1.1021 raeburn 10974: if (ref($dirlistref) eq 'ARRAY') {
10975: foreach my $line (@{$dirlistref}) {
10976: my ($file_name,$rest)=split(/\&/,$line,2);
10977: if ($file_name eq $fname){
10978: $file_name = $path.$file_name;
10979: if ($group ne '') {
10980: $file_name = $group.$file_name;
10981: }
10982: $found_file = 1;
10983: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10984: foreach my $lock (@lockers) {
10985: if (ref($lock) eq 'ARRAY') {
10986: my ($symb,$crsid) = @{$lock};
10987: if ($crsid eq $env{'request.course.id'}) {
10988: if (ref($navmap)) {
10989: my $res = $navmap->getBySymb($symb);
10990: foreach my $part (@{$res->parts()}) {
10991: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10992: unless (($slot_status == $res->RESERVED) ||
10993: ($slot_status == $res->RESERVED_LOCATION)) {
10994: $locked_file = 1;
10995: }
1.991 raeburn 10996: }
1.1021 raeburn 10997: } else {
10998: $locked_file = 1;
1.991 raeburn 10999: }
11000: } else {
11001: $locked_file = 1;
11002: }
11003: }
1.1021 raeburn 11004: }
11005: } else {
11006: my @info = split(/\&/,$rest);
11007: my $currsize = $info[6]/1000;
11008: if ($currsize < $filesize) {
11009: my $extra = $filesize - $currsize;
11010: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11011: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11012: &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 11013: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11014: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11015: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11016: return ('will_exceed_quota',$msg);
11017: }
1.984 raeburn 11018: }
11019: }
1.661 raeburn 11020: }
11021: }
11022: }
11023: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11024: my $msg = '<p class="LC_warning">'.
11025: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11026: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11027: return ('will_exceed_quota',$msg);
11028: } elsif ($found_file) {
11029: if ($locked_file) {
1.1179 bisitz 11030: my $msg = '<p class="LC_warning">';
1.661 raeburn 11031: $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 11032: $msg .= '</p>';
1.661 raeburn 11033: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11034: return ('file_locked',$msg);
11035: } else {
1.1179 bisitz 11036: my $msg = '<p class="LC_error">';
1.984 raeburn 11037: $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 11038: $msg .= '</p>';
1.984 raeburn 11039: return ('existingfile',$msg);
1.661 raeburn 11040: }
11041: }
11042: }
11043:
1.987 raeburn 11044: sub check_for_traversal {
11045: my ($path,$url,$toplevel) = @_;
11046: my @parts=split(/\//,$path);
11047: my $cleanpath;
11048: my $fullpath = $url;
11049: for (my $i=0;$i<@parts;$i++) {
11050: next if ($parts[$i] eq '.');
11051: if ($parts[$i] eq '..') {
11052: $fullpath =~ s{([^/]+/)$}{};
11053: } else {
11054: $fullpath .= $parts[$i].'/';
11055: }
11056: }
11057: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11058: $cleanpath = $1;
11059: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11060: my $curr_toprel = $1;
11061: my @parts = split(/\//,$curr_toprel);
11062: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11063: my @urlparts = split(/\//,$url_toprel);
11064: my $doubledots;
11065: my $startdiff = -1;
11066: for (my $i=0; $i<@urlparts; $i++) {
11067: if ($startdiff == -1) {
11068: unless ($urlparts[$i] eq $parts[$i]) {
11069: $startdiff = $i;
11070: $doubledots .= '../';
11071: }
11072: } else {
11073: $doubledots .= '../';
11074: }
11075: }
11076: if ($startdiff > -1) {
11077: $cleanpath = $doubledots;
11078: for (my $i=$startdiff; $i<@parts; $i++) {
11079: $cleanpath .= $parts[$i].'/';
11080: }
11081: }
11082: }
11083: $cleanpath =~ s{(/)$}{};
11084: return $cleanpath;
11085: }
1.31 albertel 11086:
1.1053 raeburn 11087: sub is_archive_file {
11088: my ($mimetype) = @_;
11089: if (($mimetype eq 'application/octet-stream') ||
11090: ($mimetype eq 'application/x-stuffit') ||
11091: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11092: return 1;
11093: }
11094: return;
11095: }
11096:
11097: sub decompress_form {
1.1065 raeburn 11098: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11099: my %lt = &Apache::lonlocal::texthash (
11100: this => 'This file is an archive file.',
1.1067 raeburn 11101: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11102: itsc => 'Its contents are as follows:',
1.1053 raeburn 11103: youm => 'You may wish to extract its contents.',
11104: extr => 'Extract contents',
1.1067 raeburn 11105: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11106: proa => 'Process automatically?',
1.1053 raeburn 11107: yes => 'Yes',
11108: no => 'No',
1.1067 raeburn 11109: fold => 'Title for folder containing movie',
11110: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11111: );
1.1065 raeburn 11112: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11113: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11114: my $info = &list_archive_contents($fileloc,\@paths);
11115: if (@paths) {
11116: foreach my $path (@paths) {
11117: $path =~ s{^/}{};
1.1067 raeburn 11118: if ($path =~ m{^([^/]+)/$}) {
11119: $topdir = $1;
11120: }
1.1065 raeburn 11121: if ($path =~ m{^([^/]+)/}) {
11122: $toplevel{$1} = $path;
11123: } else {
11124: $toplevel{$path} = $path;
11125: }
11126: }
11127: }
1.1067 raeburn 11128: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11129: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11130: "$topdir/media/",
11131: "$topdir/media/$topdir.mp4",
11132: "$topdir/media/FirstFrame.png",
11133: "$topdir/media/player.swf",
11134: "$topdir/media/swfobject.js",
11135: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11136: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11137: "$topdir/$topdir.mp4",
11138: "$topdir/$topdir\_config.xml",
11139: "$topdir/$topdir\_controller.swf",
11140: "$topdir/$topdir\_embed.css",
11141: "$topdir/$topdir\_First_Frame.png",
11142: "$topdir/$topdir\_player.html",
11143: "$topdir/$topdir\_Thumbnails.png",
11144: "$topdir/playerProductInstall.swf",
11145: "$topdir/scripts/",
11146: "$topdir/scripts/config_xml.js",
11147: "$topdir/scripts/handlebars.js",
11148: "$topdir/scripts/jquery-1.7.1.min.js",
11149: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11150: "$topdir/scripts/modernizr.js",
11151: "$topdir/scripts/player-min.js",
11152: "$topdir/scripts/swfobject.js",
11153: "$topdir/skins/",
11154: "$topdir/skins/configuration_express.xml",
11155: "$topdir/skins/express_show/",
11156: "$topdir/skins/express_show/player-min.css",
11157: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11158: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11159: "$topdir/$topdir.mp4",
11160: "$topdir/$topdir\_config.xml",
11161: "$topdir/$topdir\_controller.swf",
11162: "$topdir/$topdir\_embed.css",
11163: "$topdir/$topdir\_First_Frame.png",
11164: "$topdir/$topdir\_player.html",
11165: "$topdir/$topdir\_Thumbnails.png",
11166: "$topdir/playerProductInstall.swf",
11167: "$topdir/scripts/",
11168: "$topdir/scripts/config_xml.js",
11169: "$topdir/scripts/techsmith-smart-player.min.js",
11170: "$topdir/skins/",
11171: "$topdir/skins/configuration_express.xml",
11172: "$topdir/skins/express_show/",
11173: "$topdir/skins/express_show/spritesheet.min.css",
11174: "$topdir/skins/express_show/spritesheet.png",
11175: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11176: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11177: if (@diffs == 0) {
1.1164 raeburn 11178: $is_camtasia = 6;
11179: } else {
1.1197 raeburn 11180: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11181: if (@diffs == 0) {
11182: $is_camtasia = 8;
1.1197 raeburn 11183: } else {
11184: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11185: if (@diffs == 0) {
11186: $is_camtasia = 8;
11187: }
1.1164 raeburn 11188: }
1.1067 raeburn 11189: }
11190: }
11191: my $output;
11192: if ($is_camtasia) {
11193: $output = <<"ENDCAM";
11194: <script type="text/javascript" language="Javascript">
11195: // <![CDATA[
11196:
11197: function camtasiaToggle() {
11198: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11199: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11200: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11201:
11202: document.getElementById('camtasia_titles').style.display='block';
11203: } else {
11204: document.getElementById('camtasia_titles').style.display='none';
11205: }
11206: }
11207: }
11208: return;
11209: }
11210:
11211: // ]]>
11212: </script>
11213: <p>$lt{'camt'}</p>
11214: ENDCAM
1.1065 raeburn 11215: } else {
1.1067 raeburn 11216: $output = '<p>'.$lt{'this'};
11217: if ($info eq '') {
11218: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11219: } else {
11220: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11221: '<div><pre>'.$info.'</pre></div>';
11222: }
1.1065 raeburn 11223: }
1.1067 raeburn 11224: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11225: my $duplicates;
11226: my $num = 0;
11227: if (ref($dirlist) eq 'ARRAY') {
11228: foreach my $item (@{$dirlist}) {
11229: if (ref($item) eq 'ARRAY') {
11230: if (exists($toplevel{$item->[0]})) {
11231: $duplicates .=
11232: &start_data_table_row().
11233: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11234: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11235: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11236: 'value="1" />'.&mt('Yes').'</label>'.
11237: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11238: '<td>'.$item->[0].'</td>';
11239: if ($item->[2]) {
11240: $duplicates .= '<td>'.&mt('Directory').'</td>';
11241: } else {
11242: $duplicates .= '<td>'.&mt('File').'</td>';
11243: }
11244: $duplicates .= '<td>'.$item->[3].'</td>'.
11245: '<td>'.
11246: &Apache::lonlocal::locallocaltime($item->[4]).
11247: '</td>'.
11248: &end_data_table_row();
11249: $num ++;
11250: }
11251: }
11252: }
11253: }
11254: my $itemcount;
11255: if (@paths > 0) {
11256: $itemcount = scalar(@paths);
11257: } else {
11258: $itemcount = 1;
11259: }
1.1067 raeburn 11260: if ($is_camtasia) {
11261: $output .= $lt{'auto'}.'<br />'.
11262: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11263: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11264: $lt{'yes'}.'</label> <label>'.
11265: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11266: $lt{'no'}.'</label></span><br />'.
11267: '<div id="camtasia_titles" style="display:block">'.
11268: &Apache::lonhtmlcommon::start_pick_box().
11269: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11270: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11271: &Apache::lonhtmlcommon::row_closure().
11272: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11273: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11274: &Apache::lonhtmlcommon::row_closure(1).
11275: &Apache::lonhtmlcommon::end_pick_box().
11276: '</div>';
11277: }
1.1065 raeburn 11278: $output .=
11279: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11280: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11281: "\n";
1.1065 raeburn 11282: if ($duplicates ne '') {
11283: $output .= '<p><span class="LC_warning">'.
11284: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11285: &start_data_table().
11286: &start_data_table_header_row().
11287: '<th>'.&mt('Overwrite?').'</th>'.
11288: '<th>'.&mt('Name').'</th>'.
11289: '<th>'.&mt('Type').'</th>'.
11290: '<th>'.&mt('Size').'</th>'.
11291: '<th>'.&mt('Last modified').'</th>'.
11292: &end_data_table_header_row().
11293: $duplicates.
11294: &end_data_table().
11295: '</p>';
11296: }
1.1067 raeburn 11297: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11298: if (ref($hiddenelements) eq 'HASH') {
11299: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11300: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11301: }
11302: }
11303: $output .= <<"END";
1.1067 raeburn 11304: <br />
1.1053 raeburn 11305: <input type="submit" name="decompress" value="$lt{'extr'}" />
11306: </form>
11307: $noextract
11308: END
11309: return $output;
11310: }
11311:
1.1065 raeburn 11312: sub decompression_utility {
11313: my ($program) = @_;
11314: my @utilities = ('tar','gunzip','bunzip2','unzip');
11315: my $location;
11316: if (grep(/^\Q$program\E$/,@utilities)) {
11317: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11318: '/usr/sbin/') {
11319: if (-x $dir.$program) {
11320: $location = $dir.$program;
11321: last;
11322: }
11323: }
11324: }
11325: return $location;
11326: }
11327:
11328: sub list_archive_contents {
11329: my ($file,$pathsref) = @_;
11330: my (@cmd,$output);
11331: my $needsregexp;
11332: if ($file =~ /\.zip$/) {
11333: @cmd = (&decompression_utility('unzip'),"-l");
11334: $needsregexp = 1;
11335: } elsif (($file =~ m/\.tar\.gz$/) ||
11336: ($file =~ /\.tgz$/)) {
11337: @cmd = (&decompression_utility('tar'),"-ztf");
11338: } elsif ($file =~ /\.tar\.bz2$/) {
11339: @cmd = (&decompression_utility('tar'),"-jtf");
11340: } elsif ($file =~ m|\.tar$|) {
11341: @cmd = (&decompression_utility('tar'),"-tf");
11342: }
11343: if (@cmd) {
11344: undef($!);
11345: undef($@);
11346: if (open(my $fh,"-|", @cmd, $file)) {
11347: while (my $line = <$fh>) {
11348: $output .= $line;
11349: chomp($line);
11350: my $item;
11351: if ($needsregexp) {
11352: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11353: } else {
11354: $item = $line;
11355: }
11356: if ($item ne '') {
11357: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11358: push(@{$pathsref},$item);
11359: }
11360: }
11361: }
11362: close($fh);
11363: }
11364: }
11365: return $output;
11366: }
11367:
1.1053 raeburn 11368: sub decompress_uploaded_file {
11369: my ($file,$dir) = @_;
11370: &Apache::lonnet::appenv({'cgi.file' => $file});
11371: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11372: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11373: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11374: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11375: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11376: my $decompressed = $env{'cgi.decompressed'};
11377: &Apache::lonnet::delenv('cgi.file');
11378: &Apache::lonnet::delenv('cgi.dir');
11379: &Apache::lonnet::delenv('cgi.decompressed');
11380: return ($decompressed,$result);
11381: }
11382:
1.1055 raeburn 11383: sub process_decompression {
11384: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11385: my ($dir,$error,$warning,$output);
1.1180 raeburn 11386: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11387: $error = &mt('Filename not a supported archive file type.').
11388: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11389: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11390: } else {
11391: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11392: if ($docuhome eq 'no_host') {
11393: $error = &mt('Could not determine home server for course.');
11394: } else {
11395: my @ids=&Apache::lonnet::current_machine_ids();
11396: my $currdir = "$dir_root/$destination";
11397: if (grep(/^\Q$docuhome\E$/,@ids)) {
11398: $dir = &LONCAPA::propath($docudom,$docuname).
11399: "$dir_root/$destination";
11400: } else {
11401: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11402: "$dir_root/$docudom/$docuname/$destination";
11403: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11404: $error = &mt('Archive file not found.');
11405: }
11406: }
1.1065 raeburn 11407: my (@to_overwrite,@to_skip);
11408: if ($env{'form.archive_overwrite_total'} > 0) {
11409: my $total = $env{'form.archive_overwrite_total'};
11410: for (my $i=0; $i<$total; $i++) {
11411: if ($env{'form.archive_overwrite_'.$i} == 1) {
11412: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11413: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11414: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11415: }
11416: }
11417: }
11418: my $numskip = scalar(@to_skip);
11419: if (($numskip > 0) &&
11420: ($numskip == $env{'form.archive_itemcount'})) {
11421: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11422: } elsif ($dir eq '') {
1.1055 raeburn 11423: $error = &mt('Directory containing archive file unavailable.');
11424: } elsif (!$error) {
1.1065 raeburn 11425: my ($decompressed,$display);
11426: if ($numskip > 0) {
11427: my $tempdir = time.'_'.$$.int(rand(10000));
11428: mkdir("$dir/$tempdir",0755);
11429: system("mv $dir/$file $dir/$tempdir/$file");
11430: ($decompressed,$display) =
11431: &decompress_uploaded_file($file,"$dir/$tempdir");
11432: foreach my $item (@to_skip) {
11433: if (($item ne '') && ($item !~ /\.\./)) {
11434: if (-f "$dir/$tempdir/$item") {
11435: unlink("$dir/$tempdir/$item");
11436: } elsif (-d "$dir/$tempdir/$item") {
11437: system("rm -rf $dir/$tempdir/$item");
11438: }
11439: }
11440: }
11441: system("mv $dir/$tempdir/* $dir");
11442: rmdir("$dir/$tempdir");
11443: } else {
11444: ($decompressed,$display) =
11445: &decompress_uploaded_file($file,$dir);
11446: }
1.1055 raeburn 11447: if ($decompressed eq 'ok') {
1.1065 raeburn 11448: $output = '<p class="LC_info">'.
11449: &mt('Files extracted successfully from archive.').
11450: '</p>'."\n";
1.1055 raeburn 11451: my ($warning,$result,@contents);
11452: my ($newdirlistref,$newlisterror) =
11453: &Apache::lonnet::dirlist($currdir,$docudom,
11454: $docuname,1);
11455: my (%is_dir,%changes,@newitems);
11456: my $dirptr = 16384;
1.1065 raeburn 11457: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11458: foreach my $dir_line (@{$newdirlistref}) {
11459: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11460: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11461: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11462: push(@newitems,$item);
11463: if ($dirptr&$testdir) {
11464: $is_dir{$item} = 1;
11465: }
11466: $changes{$item} = 1;
11467: }
11468: }
11469: }
11470: if (keys(%changes) > 0) {
11471: foreach my $item (sort(@newitems)) {
11472: if ($changes{$item}) {
11473: push(@contents,$item);
11474: }
11475: }
11476: }
11477: if (@contents > 0) {
1.1067 raeburn 11478: my $wantform;
11479: unless ($env{'form.autoextract_camtasia'}) {
11480: $wantform = 1;
11481: }
1.1056 raeburn 11482: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11483: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11484: $currdir,\%is_dir,
11485: \%children,\%parent,
1.1056 raeburn 11486: \@contents,\%dirorder,
11487: \%titles,$wantform);
1.1055 raeburn 11488: if ($datatable ne '') {
11489: $output .= &archive_options_form('decompressed',$datatable,
11490: $count,$hiddenelem);
1.1065 raeburn 11491: my $startcount = 6;
1.1055 raeburn 11492: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11493: \%titles,\%children);
1.1055 raeburn 11494: }
1.1067 raeburn 11495: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11496: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11497: my %displayed;
11498: my $total = 1;
11499: $env{'form.archive_directory'} = [];
11500: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11501: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11502: $path =~ s{/$}{};
11503: my $item;
11504: if ($path ne '') {
11505: $item = "$path/$titles{$i}";
11506: } else {
11507: $item = $titles{$i};
11508: }
11509: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11510: if ($item eq $contents[0]) {
11511: push(@{$env{'form.archive_directory'}},$i);
11512: $env{'form.archive_'.$i} = 'display';
11513: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11514: $displayed{'folder'} = $i;
1.1164 raeburn 11515: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11516: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11517: $env{'form.archive_'.$i} = 'display';
11518: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11519: $displayed{'web'} = $i;
11520: } else {
1.1164 raeburn 11521: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11522: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11523: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11524: push(@{$env{'form.archive_directory'}},$i);
11525: }
11526: $env{'form.archive_'.$i} = 'dependency';
11527: }
11528: $total ++;
11529: }
11530: for (my $i=1; $i<$total; $i++) {
11531: next if ($i == $displayed{'web'});
11532: next if ($i == $displayed{'folder'});
11533: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11534: }
11535: $env{'form.phase'} = 'decompress_cleanup';
11536: $env{'form.archivedelete'} = 1;
11537: $env{'form.archive_count'} = $total-1;
11538: $output .=
11539: &process_extracted_files('coursedocs',$docudom,
11540: $docuname,$destination,
11541: $dir_root,$hiddenelem);
11542: }
1.1055 raeburn 11543: } else {
11544: $warning = &mt('No new items extracted from archive file.');
11545: }
11546: } else {
11547: $output = $display;
11548: $error = &mt('An error occurred during extraction from the archive file.');
11549: }
11550: }
11551: }
11552: }
11553: if ($error) {
11554: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11555: $error.'</p>'."\n";
11556: }
11557: if ($warning) {
11558: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11559: }
11560: return $output;
11561: }
11562:
11563: sub get_extracted {
1.1056 raeburn 11564: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11565: $titles,$wantform) = @_;
1.1055 raeburn 11566: my $count = 0;
11567: my $depth = 0;
11568: my $datatable;
1.1056 raeburn 11569: my @hierarchy;
1.1055 raeburn 11570: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11571: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11572: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11573: foreach my $item (@{$contents}) {
11574: $count ++;
1.1056 raeburn 11575: @{$dirorder->{$count}} = @hierarchy;
11576: $titles->{$count} = $item;
1.1055 raeburn 11577: &archive_hierarchy($depth,$count,$parent,$children);
11578: if ($wantform) {
11579: $datatable .= &archive_row($is_dir->{$item},$item,
11580: $currdir,$depth,$count);
11581: }
11582: if ($is_dir->{$item}) {
11583: $depth ++;
1.1056 raeburn 11584: push(@hierarchy,$count);
11585: $parent->{$depth} = $count;
1.1055 raeburn 11586: $datatable .=
11587: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11588: \$depth,\$count,\@hierarchy,$dirorder,
11589: $children,$parent,$titles,$wantform);
1.1055 raeburn 11590: $depth --;
1.1056 raeburn 11591: pop(@hierarchy);
1.1055 raeburn 11592: }
11593: }
11594: return ($count,$datatable);
11595: }
11596:
11597: sub recurse_extracted_archive {
1.1056 raeburn 11598: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11599: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11600: my $result='';
1.1056 raeburn 11601: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11602: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11603: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11604: return $result;
11605: }
11606: my $dirptr = 16384;
11607: my ($newdirlistref,$newlisterror) =
11608: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11609: if (ref($newdirlistref) eq 'ARRAY') {
11610: foreach my $dir_line (@{$newdirlistref}) {
11611: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11612: unless ($item =~ /^\.+$/) {
11613: $$count ++;
1.1056 raeburn 11614: @{$dirorder->{$$count}} = @{$hierarchy};
11615: $titles->{$$count} = $item;
1.1055 raeburn 11616: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11617:
1.1055 raeburn 11618: my $is_dir;
11619: if ($dirptr&$testdir) {
11620: $is_dir = 1;
11621: }
11622: if ($wantform) {
11623: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11624: }
11625: if ($is_dir) {
11626: $$depth ++;
1.1056 raeburn 11627: push(@{$hierarchy},$$count);
11628: $parent->{$$depth} = $$count;
1.1055 raeburn 11629: $result .=
11630: &recurse_extracted_archive("$currdir/$item",$docudom,
11631: $docuname,$depth,$count,
1.1056 raeburn 11632: $hierarchy,$dirorder,$children,
11633: $parent,$titles,$wantform);
1.1055 raeburn 11634: $$depth --;
1.1056 raeburn 11635: pop(@{$hierarchy});
1.1055 raeburn 11636: }
11637: }
11638: }
11639: }
11640: return $result;
11641: }
11642:
11643: sub archive_hierarchy {
11644: my ($depth,$count,$parent,$children) =@_;
11645: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11646: if (exists($parent->{$depth})) {
11647: $children->{$parent->{$depth}} .= $count.':';
11648: }
11649: }
11650: return;
11651: }
11652:
11653: sub archive_row {
11654: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11655: my ($name) = ($item =~ m{([^/]+)$});
11656: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11657: 'display' => 'Add as file',
1.1055 raeburn 11658: 'dependency' => 'Include as dependency',
11659: 'discard' => 'Discard',
11660: );
11661: if ($is_dir) {
1.1059 raeburn 11662: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11663: }
1.1056 raeburn 11664: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11665: my $offset = 0;
1.1055 raeburn 11666: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11667: $offset ++;
1.1065 raeburn 11668: if ($action ne 'display') {
11669: $offset ++;
11670: }
1.1055 raeburn 11671: $output .= '<td><span class="LC_nobreak">'.
11672: '<label><input type="radio" name="archive_'.$count.
11673: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11674: my $text = $choices{$action};
11675: if ($is_dir) {
11676: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11677: if ($action eq 'display') {
1.1059 raeburn 11678: $text = &mt('Add as folder');
1.1055 raeburn 11679: }
1.1056 raeburn 11680: } else {
11681: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11682:
11683: }
11684: $output .= ' /> '.$choices{$action}.'</label></span>';
11685: if ($action eq 'dependency') {
11686: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11687: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11688: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11689: '<option value=""></option>'."\n".
11690: '</select>'."\n".
11691: '</div>';
1.1059 raeburn 11692: } elsif ($action eq 'display') {
11693: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11694: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11695: '</div>';
1.1055 raeburn 11696: }
1.1056 raeburn 11697: $output .= '</td>';
1.1055 raeburn 11698: }
11699: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11700: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11701: for (my $i=0; $i<$depth; $i++) {
11702: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11703: }
11704: if ($is_dir) {
11705: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11706: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11707: } else {
11708: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11709: }
11710: $output .= ' '.$name.'</td>'."\n".
11711: &end_data_table_row();
11712: return $output;
11713: }
11714:
11715: sub archive_options_form {
1.1065 raeburn 11716: my ($form,$display,$count,$hiddenelem) = @_;
11717: my %lt = &Apache::lonlocal::texthash(
11718: perm => 'Permanently remove archive file?',
11719: hows => 'How should each extracted item be incorporated in the course?',
11720: cont => 'Content actions for all',
11721: addf => 'Add as folder/file',
11722: incd => 'Include as dependency for a displayed file',
11723: disc => 'Discard',
11724: no => 'No',
11725: yes => 'Yes',
11726: save => 'Save',
11727: );
11728: my $output = <<"END";
11729: <form name="$form" method="post" action="">
11730: <p><span class="LC_nobreak">$lt{'perm'}
11731: <label>
11732: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11733: </label>
11734:
11735: <label>
11736: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11737: </span>
11738: </p>
11739: <input type="hidden" name="phase" value="decompress_cleanup" />
11740: <br />$lt{'hows'}
11741: <div class="LC_columnSection">
11742: <fieldset>
11743: <legend>$lt{'cont'}</legend>
11744: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11745: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11746: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11747: </fieldset>
11748: </div>
11749: END
11750: return $output.
1.1055 raeburn 11751: &start_data_table()."\n".
1.1065 raeburn 11752: $display."\n".
1.1055 raeburn 11753: &end_data_table()."\n".
11754: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11755: $hiddenelem.
1.1065 raeburn 11756: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11757: '</form>';
11758: }
11759:
11760: sub archive_javascript {
1.1056 raeburn 11761: my ($startcount,$numitems,$titles,$children) = @_;
11762: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11763: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11764: my $scripttag = <<START;
11765: <script type="text/javascript">
11766: // <![CDATA[
11767:
11768: function checkAll(form,prefix) {
11769: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11770: for (var i=0; i < form.elements.length; i++) {
11771: var id = form.elements[i].id;
11772: if ((id != '') && (id != undefined)) {
11773: if (idstr.test(id)) {
11774: if (form.elements[i].type == 'radio') {
11775: form.elements[i].checked = true;
1.1056 raeburn 11776: var nostart = i-$startcount;
1.1059 raeburn 11777: var offset = nostart%7;
11778: var count = (nostart-offset)/7;
1.1056 raeburn 11779: dependencyCheck(form,count,offset);
1.1055 raeburn 11780: }
11781: }
11782: }
11783: }
11784: }
11785:
11786: function propagateCheck(form,count) {
11787: if (count > 0) {
1.1059 raeburn 11788: var startelement = $startcount + ((count-1) * 7);
11789: for (var j=1; j<6; j++) {
11790: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11791: var item = startelement + j;
11792: if (form.elements[item].type == 'radio') {
11793: if (form.elements[item].checked) {
11794: containerCheck(form,count,j);
11795: break;
11796: }
1.1055 raeburn 11797: }
11798: }
11799: }
11800: }
11801: }
11802:
11803: numitems = $numitems
1.1056 raeburn 11804: var titles = new Array(numitems);
11805: var parents = new Array(numitems);
1.1055 raeburn 11806: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11807: parents[i] = new Array;
1.1055 raeburn 11808: }
1.1059 raeburn 11809: var maintitle = '$maintitle';
1.1055 raeburn 11810:
11811: START
11812:
1.1056 raeburn 11813: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11814: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11815: for (my $i=0; $i<@contents; $i ++) {
11816: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11817: }
11818: }
11819:
1.1056 raeburn 11820: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11821: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11822: }
11823:
1.1055 raeburn 11824: $scripttag .= <<END;
11825:
11826: function containerCheck(form,count,offset) {
11827: if (count > 0) {
1.1056 raeburn 11828: dependencyCheck(form,count,offset);
1.1059 raeburn 11829: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11830: form.elements[item].checked = true;
11831: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11832: if (parents[count].length > 0) {
11833: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11834: containerCheck(form,parents[count][j],offset);
11835: }
11836: }
11837: }
11838: }
11839: }
11840:
11841: function dependencyCheck(form,count,offset) {
11842: if (count > 0) {
1.1059 raeburn 11843: var chosen = (offset+$startcount)+7*(count-1);
11844: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11845: var currtype = form.elements[depitem].type;
11846: if (form.elements[chosen].value == 'dependency') {
11847: document.getElementById('arc_depon_'+count).style.display='block';
11848: form.elements[depitem].options.length = 0;
11849: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11850: for (var i=1; i<=numitems; i++) {
11851: if (i == count) {
11852: continue;
11853: }
1.1059 raeburn 11854: var startelement = $startcount + (i-1) * 7;
11855: for (var j=1; j<6; j++) {
11856: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11857: var item = startelement + j;
11858: if (form.elements[item].type == 'radio') {
11859: if (form.elements[item].checked) {
11860: if (form.elements[item].value == 'display') {
11861: var n = form.elements[depitem].options.length;
11862: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11863: }
11864: }
11865: }
11866: }
11867: }
11868: }
11869: } else {
11870: document.getElementById('arc_depon_'+count).style.display='none';
11871: form.elements[depitem].options.length = 0;
11872: form.elements[depitem].options[0] = new Option('Select','',true,true);
11873: }
1.1059 raeburn 11874: titleCheck(form,count,offset);
1.1056 raeburn 11875: }
11876: }
11877:
11878: function propagateSelect(form,count,offset) {
11879: if (count > 0) {
1.1065 raeburn 11880: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11881: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11882: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11883: if (parents[count].length > 0) {
11884: for (var j=0; j<parents[count].length; j++) {
11885: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11886: }
11887: }
11888: }
11889: }
11890: }
1.1056 raeburn 11891:
11892: function containerSelect(form,count,offset,picked) {
11893: if (count > 0) {
1.1065 raeburn 11894: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11895: if (form.elements[item].type == 'radio') {
11896: if (form.elements[item].value == 'dependency') {
11897: if (form.elements[item+1].type == 'select-one') {
11898: for (var i=0; i<form.elements[item+1].options.length; i++) {
11899: if (form.elements[item+1].options[i].value == picked) {
11900: form.elements[item+1].selectedIndex = i;
11901: break;
11902: }
11903: }
11904: }
11905: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11906: if (parents[count].length > 0) {
11907: for (var j=0; j<parents[count].length; j++) {
11908: containerSelect(form,parents[count][j],offset,picked);
11909: }
11910: }
11911: }
11912: }
11913: }
11914: }
11915: }
11916:
1.1059 raeburn 11917: function titleCheck(form,count,offset) {
11918: if (count > 0) {
11919: var chosen = (offset+$startcount)+7*(count-1);
11920: var depitem = $startcount + ((count-1) * 7) + 2;
11921: var currtype = form.elements[depitem].type;
11922: if (form.elements[chosen].value == 'display') {
11923: document.getElementById('arc_title_'+count).style.display='block';
11924: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11925: document.getElementById('archive_title_'+count).value=maintitle;
11926: }
11927: } else {
11928: document.getElementById('arc_title_'+count).style.display='none';
11929: if (currtype == 'text') {
11930: document.getElementById('archive_title_'+count).value='';
11931: }
11932: }
11933: }
11934: return;
11935: }
11936:
1.1055 raeburn 11937: // ]]>
11938: </script>
11939: END
11940: return $scripttag;
11941: }
11942:
11943: sub process_extracted_files {
1.1067 raeburn 11944: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11945: my $numitems = $env{'form.archive_count'};
11946: return unless ($numitems);
11947: my @ids=&Apache::lonnet::current_machine_ids();
11948: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11949: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11950: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11951: if (grep(/^\Q$docuhome\E$/,@ids)) {
11952: $prefix = &LONCAPA::propath($docudom,$docuname);
11953: $pathtocheck = "$dir_root/$destination";
11954: $dir = $dir_root;
11955: $ishome = 1;
11956: } else {
11957: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11958: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11959: $dir = "$dir_root/$docudom/$docuname";
11960: }
11961: my $currdir = "$dir_root/$destination";
11962: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11963: if ($env{'form.folderpath'}) {
11964: my @items = split('&',$env{'form.folderpath'});
11965: $folders{'0'} = $items[-2];
1.1099 raeburn 11966: if ($env{'form.folderpath'} =~ /\:1$/) {
11967: $containers{'0'}='page';
11968: } else {
11969: $containers{'0'}='sequence';
11970: }
1.1055 raeburn 11971: }
11972: my @archdirs = &get_env_multiple('form.archive_directory');
11973: if ($numitems) {
11974: for (my $i=1; $i<=$numitems; $i++) {
11975: my $path = $env{'form.archive_content_'.$i};
11976: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11977: my $item = $1;
11978: $toplevelitems{$item} = $i;
11979: if (grep(/^\Q$i\E$/,@archdirs)) {
11980: $is_dir{$item} = 1;
11981: }
11982: }
11983: }
11984: }
1.1067 raeburn 11985: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11986: if (keys(%toplevelitems) > 0) {
11987: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11988: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11989: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11990: }
1.1066 raeburn 11991: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11992: if ($numitems) {
11993: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11994: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11995: my $path = $env{'form.archive_content_'.$i};
11996: if ($path =~ /^\Q$pathtocheck\E/) {
11997: if ($env{'form.archive_'.$i} eq 'discard') {
11998: if ($prefix ne '' && $path ne '') {
11999: if (-e $prefix.$path) {
1.1066 raeburn 12000: if ((@archdirs > 0) &&
12001: (grep(/^\Q$i\E$/,@archdirs))) {
12002: $todeletedir{$prefix.$path} = 1;
12003: } else {
12004: $todelete{$prefix.$path} = 1;
12005: }
1.1055 raeburn 12006: }
12007: }
12008: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12009: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12010: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12011: $docstitle = $env{'form.archive_title_'.$i};
12012: if ($docstitle eq '') {
12013: $docstitle = $title;
12014: }
1.1055 raeburn 12015: $outer = 0;
1.1056 raeburn 12016: if (ref($dirorder{$i}) eq 'ARRAY') {
12017: if (@{$dirorder{$i}} > 0) {
12018: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12019: if ($env{'form.archive_'.$item} eq 'display') {
12020: $outer = $item;
12021: last;
12022: }
12023: }
12024: }
12025: }
12026: my ($errtext,$fatal) =
12027: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12028: '/'.$folders{$outer}.'.'.
12029: $containers{$outer});
12030: next if ($fatal);
12031: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12032: if ($context eq 'coursedocs') {
1.1056 raeburn 12033: $mapinner{$i} = time;
1.1055 raeburn 12034: $folders{$i} = 'default_'.$mapinner{$i};
12035: $containers{$i} = 'sequence';
12036: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12037: $folders{$i}.'.'.$containers{$i};
12038: my $newidx = &LONCAPA::map::getresidx();
12039: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12040: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12041: push(@LONCAPA::map::order,$newidx);
12042: my ($outtext,$errtext) =
12043: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12044: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12045: '.'.$containers{$outer},1,1);
1.1056 raeburn 12046: $newseqid{$i} = $newidx;
1.1067 raeburn 12047: unless ($errtext) {
12048: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12049: }
1.1055 raeburn 12050: }
12051: } else {
12052: if ($context eq 'coursedocs') {
12053: my $newidx=&LONCAPA::map::getresidx();
12054: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12055: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12056: $title;
12057: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12058: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12059: }
12060: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12061: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12062: }
12063: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12064: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12065: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12066: unless ($ishome) {
12067: my $fetch = "$newdest{$i}/$title";
12068: $fetch =~ s/^\Q$prefix$dir\E//;
12069: $prompttofetch{$fetch} = 1;
12070: }
1.1055 raeburn 12071: }
12072: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12073: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12074: push(@LONCAPA::map::order, $newidx);
12075: my ($outtext,$errtext)=
12076: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12077: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12078: '.'.$containers{$outer},1,1);
1.1067 raeburn 12079: unless ($errtext) {
12080: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12081: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12082: }
12083: }
1.1055 raeburn 12084: }
12085: }
1.1086 raeburn 12086: }
12087: } else {
12088: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12089: }
12090: }
12091: for (my $i=1; $i<=$numitems; $i++) {
12092: next unless ($env{'form.archive_'.$i} eq 'dependency');
12093: my $path = $env{'form.archive_content_'.$i};
12094: if ($path =~ /^\Q$pathtocheck\E/) {
12095: my ($title) = ($path =~ m{/([^/]+)$});
12096: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12097: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12098: if (ref($dirorder{$i}) eq 'ARRAY') {
12099: my ($itemidx,$fullpath,$relpath);
12100: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12101: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12102: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12103: if ($dirorder{$i}->[$j] eq $container) {
12104: $itemidx = $j;
1.1056 raeburn 12105: }
12106: }
1.1086 raeburn 12107: }
12108: if ($itemidx eq '') {
12109: $itemidx = 0;
12110: }
12111: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12112: if ($mapinner{$referrer{$i}}) {
12113: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12114: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12115: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12116: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12117: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12118: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12119: if (!-e $fullpath) {
12120: mkdir($fullpath,0755);
1.1056 raeburn 12121: }
12122: }
1.1086 raeburn 12123: } else {
12124: last;
1.1056 raeburn 12125: }
1.1086 raeburn 12126: }
12127: }
12128: } elsif ($newdest{$referrer{$i}}) {
12129: $fullpath = $newdest{$referrer{$i}};
12130: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12131: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12132: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12133: last;
12134: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12135: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12136: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12137: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12138: if (!-e $fullpath) {
12139: mkdir($fullpath,0755);
1.1056 raeburn 12140: }
12141: }
1.1086 raeburn 12142: } else {
12143: last;
1.1056 raeburn 12144: }
1.1055 raeburn 12145: }
12146: }
1.1086 raeburn 12147: if ($fullpath ne '') {
12148: if (-e "$prefix$path") {
12149: system("mv $prefix$path $fullpath/$title");
12150: }
12151: if (-e "$fullpath/$title") {
12152: my $showpath;
12153: if ($relpath ne '') {
12154: $showpath = "$relpath/$title";
12155: } else {
12156: $showpath = "/$title";
12157: }
12158: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12159: }
12160: unless ($ishome) {
12161: my $fetch = "$fullpath/$title";
12162: $fetch =~ s/^\Q$prefix$dir\E//;
12163: $prompttofetch{$fetch} = 1;
12164: }
12165: }
1.1055 raeburn 12166: }
1.1086 raeburn 12167: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12168: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12169: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12170: }
12171: } else {
12172: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12173: }
12174: }
12175: if (keys(%todelete)) {
12176: foreach my $key (keys(%todelete)) {
12177: unlink($key);
1.1066 raeburn 12178: }
12179: }
12180: if (keys(%todeletedir)) {
12181: foreach my $key (keys(%todeletedir)) {
12182: rmdir($key);
12183: }
12184: }
12185: foreach my $dir (sort(keys(%is_dir))) {
12186: if (($pathtocheck ne '') && ($dir ne '')) {
12187: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12188: }
12189: }
1.1067 raeburn 12190: if ($result ne '') {
12191: $output .= '<ul>'."\n".
12192: $result."\n".
12193: '</ul>';
12194: }
12195: unless ($ishome) {
12196: my $replicationfail;
12197: foreach my $item (keys(%prompttofetch)) {
12198: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12199: unless ($fetchresult eq 'ok') {
12200: $replicationfail .= '<li>'.$item.'</li>'."\n";
12201: }
12202: }
12203: if ($replicationfail) {
12204: $output .= '<p class="LC_error">'.
12205: &mt('Course home server failed to retrieve:').'<ul>'.
12206: $replicationfail.
12207: '</ul></p>';
12208: }
12209: }
1.1055 raeburn 12210: } else {
12211: $warning = &mt('No items found in archive.');
12212: }
12213: if ($error) {
12214: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12215: $error.'</p>'."\n";
12216: }
12217: if ($warning) {
12218: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12219: }
12220: return $output;
12221: }
12222:
1.1066 raeburn 12223: sub cleanup_empty_dirs {
12224: my ($path) = @_;
12225: if (($path ne '') && (-d $path)) {
12226: if (opendir(my $dirh,$path)) {
12227: my @dircontents = grep(!/^\./,readdir($dirh));
12228: my $numitems = 0;
12229: foreach my $item (@dircontents) {
12230: if (-d "$path/$item") {
1.1111 raeburn 12231: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12232: if (-e "$path/$item") {
12233: $numitems ++;
12234: }
12235: } else {
12236: $numitems ++;
12237: }
12238: }
12239: if ($numitems == 0) {
12240: rmdir($path);
12241: }
12242: closedir($dirh);
12243: }
12244: }
12245: return;
12246: }
12247:
1.41 ng 12248: =pod
1.45 matthew 12249:
1.1162 raeburn 12250: =item * &get_folder_hierarchy()
1.1068 raeburn 12251:
12252: Provides hierarchy of names of folders/sub-folders containing the current
12253: item,
12254:
12255: Inputs: 3
12256: - $navmap - navmaps object
12257:
12258: - $map - url for map (either the trigger itself, or map containing
12259: the resource, which is the trigger).
12260:
12261: - $showitem - 1 => show title for map itself; 0 => do not show.
12262:
12263: Outputs: 1 @pathitems - array of folder/subfolder names.
12264:
12265: =cut
12266:
12267: sub get_folder_hierarchy {
12268: my ($navmap,$map,$showitem) = @_;
12269: my @pathitems;
12270: if (ref($navmap)) {
12271: my $mapres = $navmap->getResourceByUrl($map);
12272: if (ref($mapres)) {
12273: my $pcslist = $mapres->map_hierarchy();
12274: if ($pcslist ne '') {
12275: my @pcs = split(/,/,$pcslist);
12276: foreach my $pc (@pcs) {
12277: if ($pc == 1) {
1.1129 raeburn 12278: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12279: } else {
12280: my $res = $navmap->getByMapPc($pc);
12281: if (ref($res)) {
12282: my $title = $res->compTitle();
12283: $title =~ s/\W+/_/g;
12284: if ($title ne '') {
12285: push(@pathitems,$title);
12286: }
12287: }
12288: }
12289: }
12290: }
1.1071 raeburn 12291: if ($showitem) {
12292: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12293: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12294: } else {
12295: my $maptitle = $mapres->compTitle();
12296: $maptitle =~ s/\W+/_/g;
12297: if ($maptitle ne '') {
12298: push(@pathitems,$maptitle);
12299: }
1.1068 raeburn 12300: }
12301: }
12302: }
12303: }
12304: return @pathitems;
12305: }
12306:
12307: =pod
12308:
1.1015 raeburn 12309: =item * &get_turnedin_filepath()
12310:
12311: Determines path in a user's portfolio file for storage of files uploaded
12312: to a specific essayresponse or dropbox item.
12313:
12314: Inputs: 3 required + 1 optional.
12315: $symb is symb for resource, $uname and $udom are for current user (required).
12316: $caller is optional (can be "submission", if routine is called when storing
12317: an upoaded file when "Submit Answer" button was pressed).
12318:
12319: Returns array containing $path and $multiresp.
12320: $path is path in portfolio. $multiresp is 1 if this resource contains more
12321: than one file upload item. Callers of routine should append partid as a
12322: subdirectory to $path in cases where $multiresp is 1.
12323:
12324: Called by: homework/essayresponse.pm and homework/structuretags.pm
12325:
12326: =cut
12327:
12328: sub get_turnedin_filepath {
12329: my ($symb,$uname,$udom,$caller) = @_;
12330: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12331: my $turnindir;
12332: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12333: $turnindir = $userhash{'turnindir'};
12334: my ($path,$multiresp);
12335: if ($turnindir eq '') {
12336: if ($caller eq 'submission') {
12337: $turnindir = &mt('turned in');
12338: $turnindir =~ s/\W+/_/g;
12339: my %newhash = (
12340: 'turnindir' => $turnindir,
12341: );
12342: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12343: }
12344: }
12345: if ($turnindir ne '') {
12346: $path = '/'.$turnindir.'/';
12347: my ($multipart,$turnin,@pathitems);
12348: my $navmap = Apache::lonnavmaps::navmap->new();
12349: if (defined($navmap)) {
12350: my $mapres = $navmap->getResourceByUrl($map);
12351: if (ref($mapres)) {
12352: my $pcslist = $mapres->map_hierarchy();
12353: if ($pcslist ne '') {
12354: foreach my $pc (split(/,/,$pcslist)) {
12355: my $res = $navmap->getByMapPc($pc);
12356: if (ref($res)) {
12357: my $title = $res->compTitle();
12358: $title =~ s/\W+/_/g;
12359: if ($title ne '') {
1.1149 raeburn 12360: if (($pc > 1) && (length($title) > 12)) {
12361: $title = substr($title,0,12);
12362: }
1.1015 raeburn 12363: push(@pathitems,$title);
12364: }
12365: }
12366: }
12367: }
12368: my $maptitle = $mapres->compTitle();
12369: $maptitle =~ s/\W+/_/g;
12370: if ($maptitle ne '') {
1.1149 raeburn 12371: if (length($maptitle) > 12) {
12372: $maptitle = substr($maptitle,0,12);
12373: }
1.1015 raeburn 12374: push(@pathitems,$maptitle);
12375: }
12376: unless ($env{'request.state'} eq 'construct') {
12377: my $res = $navmap->getBySymb($symb);
12378: if (ref($res)) {
12379: my $partlist = $res->parts();
12380: my $totaluploads = 0;
12381: if (ref($partlist) eq 'ARRAY') {
12382: foreach my $part (@{$partlist}) {
12383: my @types = $res->responseType($part);
12384: my @ids = $res->responseIds($part);
12385: for (my $i=0; $i < scalar(@ids); $i++) {
12386: if ($types[$i] eq 'essay') {
12387: my $partid = $part.'_'.$ids[$i];
12388: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12389: $totaluploads ++;
12390: }
12391: }
12392: }
12393: }
12394: if ($totaluploads > 1) {
12395: $multiresp = 1;
12396: }
12397: }
12398: }
12399: }
12400: } else {
12401: return;
12402: }
12403: } else {
12404: return;
12405: }
12406: my $restitle=&Apache::lonnet::gettitle($symb);
12407: $restitle =~ s/\W+/_/g;
12408: if ($restitle eq '') {
12409: $restitle = ($resurl =~ m{/[^/]+$});
12410: if ($restitle eq '') {
12411: $restitle = time;
12412: }
12413: }
1.1149 raeburn 12414: if (length($restitle) > 12) {
12415: $restitle = substr($restitle,0,12);
12416: }
1.1015 raeburn 12417: push(@pathitems,$restitle);
12418: $path .= join('/',@pathitems);
12419: }
12420: return ($path,$multiresp);
12421: }
12422:
12423: =pod
12424:
1.464 albertel 12425: =back
1.41 ng 12426:
1.112 bowersj2 12427: =head1 CSV Upload/Handling functions
1.38 albertel 12428:
1.41 ng 12429: =over 4
12430:
1.648 raeburn 12431: =item * &upfile_store($r)
1.41 ng 12432:
12433: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12434: needs $env{'form.upfile'}
1.41 ng 12435: returns $datatoken to be put into hidden field
12436:
12437: =cut
1.31 albertel 12438:
12439: sub upfile_store {
12440: my $r=shift;
1.258 albertel 12441: $env{'form.upfile'}=~s/\r/\n/gs;
12442: $env{'form.upfile'}=~s/\f/\n/gs;
12443: $env{'form.upfile'}=~s/\n+/\n/gs;
12444: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12445:
1.258 albertel 12446: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12447: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12448: {
1.158 raeburn 12449: my $datafile = $r->dir_config('lonDaemons').
12450: '/tmp/'.$datatoken.'.tmp';
12451: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12452: print $fh $env{'form.upfile'};
1.158 raeburn 12453: close($fh);
12454: }
1.31 albertel 12455: }
12456: return $datatoken;
12457: }
12458:
1.56 matthew 12459: =pod
12460:
1.648 raeburn 12461: =item * &load_tmp_file($r)
1.41 ng 12462:
12463: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12464: needs $env{'form.datatoken'},
12465: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12466:
12467: =cut
1.31 albertel 12468:
12469: sub load_tmp_file {
12470: my $r=shift;
12471: my @studentdata=();
12472: {
1.158 raeburn 12473: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12474: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12475: if ( open(my $fh,"<$studentfile") ) {
12476: @studentdata=<$fh>;
12477: close($fh);
12478: }
1.31 albertel 12479: }
1.258 albertel 12480: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12481: }
12482:
1.56 matthew 12483: =pod
12484:
1.648 raeburn 12485: =item * &upfile_record_sep()
1.41 ng 12486:
12487: Separate uploaded file into records
12488: returns array of records,
1.258 albertel 12489: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12490:
12491: =cut
1.31 albertel 12492:
12493: sub upfile_record_sep {
1.258 albertel 12494: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12495: } else {
1.248 albertel 12496: my @records;
1.258 albertel 12497: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12498: if ($line=~/^\s*$/) { next; }
12499: push(@records,$line);
12500: }
12501: return @records;
1.31 albertel 12502: }
12503: }
12504:
1.56 matthew 12505: =pod
12506:
1.648 raeburn 12507: =item * &record_sep($record)
1.41 ng 12508:
1.258 albertel 12509: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12510:
12511: =cut
12512:
1.263 www 12513: sub takeleft {
12514: my $index=shift;
12515: return substr('0000'.$index,-4,4);
12516: }
12517:
1.31 albertel 12518: sub record_sep {
12519: my $record=shift;
12520: my %components=();
1.258 albertel 12521: if ($env{'form.upfiletype'} eq 'xml') {
12522: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12523: my $i=0;
1.356 albertel 12524: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12525: $field=~s/^(\"|\')//;
12526: $field=~s/(\"|\')$//;
1.263 www 12527: $components{&takeleft($i)}=$field;
1.31 albertel 12528: $i++;
12529: }
1.258 albertel 12530: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12531: my $i=0;
1.356 albertel 12532: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12533: $field=~s/^(\"|\')//;
12534: $field=~s/(\"|\')$//;
1.263 www 12535: $components{&takeleft($i)}=$field;
1.31 albertel 12536: $i++;
12537: }
12538: } else {
1.561 www 12539: my $separator=',';
1.480 banghart 12540: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12541: $separator=';';
1.480 banghart 12542: }
1.31 albertel 12543: my $i=0;
1.561 www 12544: # the character we are looking for to indicate the end of a quote or a record
12545: my $looking_for=$separator;
12546: # do not add the characters to the fields
12547: my $ignore=0;
12548: # we just encountered a separator (or the beginning of the record)
12549: my $just_found_separator=1;
12550: # store the field we are working on here
12551: my $field='';
12552: # work our way through all characters in record
12553: foreach my $character ($record=~/(.)/g) {
12554: if ($character eq $looking_for) {
12555: if ($character ne $separator) {
12556: # Found the end of a quote, again looking for separator
12557: $looking_for=$separator;
12558: $ignore=1;
12559: } else {
12560: # Found a separator, store away what we got
12561: $components{&takeleft($i)}=$field;
12562: $i++;
12563: $just_found_separator=1;
12564: $ignore=0;
12565: $field='';
12566: }
12567: next;
12568: }
12569: # single or double quotation marks after a separator indicate beginning of a quote
12570: # we are now looking for the end of the quote and need to ignore separators
12571: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12572: $looking_for=$character;
12573: next;
12574: }
12575: # ignore would be true after we reached the end of a quote
12576: if ($ignore) { next; }
12577: if (($just_found_separator) && ($character=~/\s/)) { next; }
12578: $field.=$character;
12579: $just_found_separator=0;
1.31 albertel 12580: }
1.561 www 12581: # catch the very last entry, since we never encountered the separator
12582: $components{&takeleft($i)}=$field;
1.31 albertel 12583: }
12584: return %components;
12585: }
12586:
1.144 matthew 12587: ######################################################
12588: ######################################################
12589:
1.56 matthew 12590: =pod
12591:
1.648 raeburn 12592: =item * &upfile_select_html()
1.41 ng 12593:
1.144 matthew 12594: Return HTML code to select a file from the users machine and specify
12595: the file type.
1.41 ng 12596:
12597: =cut
12598:
1.144 matthew 12599: ######################################################
12600: ######################################################
1.31 albertel 12601: sub upfile_select_html {
1.144 matthew 12602: my %Types = (
12603: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12604: semisv => &mt('Semicolon separated values'),
1.144 matthew 12605: space => &mt('Space separated'),
12606: tab => &mt('Tabulator separated'),
12607: # xml => &mt('HTML/XML'),
12608: );
12609: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12610: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12611: foreach my $type (sort(keys(%Types))) {
12612: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12613: }
12614: $Str .= "</select>\n";
12615: return $Str;
1.31 albertel 12616: }
12617:
1.301 albertel 12618: sub get_samples {
12619: my ($records,$toget) = @_;
12620: my @samples=({});
12621: my $got=0;
12622: foreach my $rec (@$records) {
12623: my %temp = &record_sep($rec);
12624: if (! grep(/\S/, values(%temp))) { next; }
12625: if (%temp) {
12626: $samples[$got]=\%temp;
12627: $got++;
12628: if ($got == $toget) { last; }
12629: }
12630: }
12631: return \@samples;
12632: }
12633:
1.144 matthew 12634: ######################################################
12635: ######################################################
12636:
1.56 matthew 12637: =pod
12638:
1.648 raeburn 12639: =item * &csv_print_samples($r,$records)
1.41 ng 12640:
12641: Prints a table of sample values from each column uploaded $r is an
12642: Apache Request ref, $records is an arrayref from
12643: &Apache::loncommon::upfile_record_sep
12644:
12645: =cut
12646:
1.144 matthew 12647: ######################################################
12648: ######################################################
1.31 albertel 12649: sub csv_print_samples {
12650: my ($r,$records) = @_;
1.662 bisitz 12651: my $samples = &get_samples($records,5);
1.301 albertel 12652:
1.594 raeburn 12653: $r->print(&mt('Samples').'<br />'.&start_data_table().
12654: &start_data_table_header_row());
1.356 albertel 12655: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12656: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12657: $r->print(&end_data_table_header_row());
1.301 albertel 12658: foreach my $hash (@$samples) {
1.594 raeburn 12659: $r->print(&start_data_table_row());
1.356 albertel 12660: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12661: $r->print('<td>');
1.356 albertel 12662: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12663: $r->print('</td>');
12664: }
1.594 raeburn 12665: $r->print(&end_data_table_row());
1.31 albertel 12666: }
1.594 raeburn 12667: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12668: }
12669:
1.144 matthew 12670: ######################################################
12671: ######################################################
12672:
1.56 matthew 12673: =pod
12674:
1.648 raeburn 12675: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12676:
12677: Prints a table to create associations between values and table columns.
1.144 matthew 12678:
1.41 ng 12679: $r is an Apache Request ref,
12680: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12681: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12682:
12683: =cut
12684:
1.144 matthew 12685: ######################################################
12686: ######################################################
1.31 albertel 12687: sub csv_print_select_table {
12688: my ($r,$records,$d) = @_;
1.301 albertel 12689: my $i=0;
12690: my $samples = &get_samples($records,1);
1.144 matthew 12691: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12692: &start_data_table().&start_data_table_header_row().
1.144 matthew 12693: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12694: '<th>'.&mt('Column').'</th>'.
12695: &end_data_table_header_row()."\n");
1.356 albertel 12696: foreach my $array_ref (@$d) {
12697: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12698: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12699:
1.875 bisitz 12700: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12701: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12702: $r->print('<option value="none"></option>');
1.356 albertel 12703: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12704: $r->print('<option value="'.$sample.'"'.
12705: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12706: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12707: }
1.594 raeburn 12708: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12709: $i++;
12710: }
1.594 raeburn 12711: $r->print(&end_data_table());
1.31 albertel 12712: $i--;
12713: return $i;
12714: }
1.56 matthew 12715:
1.144 matthew 12716: ######################################################
12717: ######################################################
12718:
1.56 matthew 12719: =pod
1.31 albertel 12720:
1.648 raeburn 12721: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12722:
12723: Prints a table of sample values from the upload and can make associate samples to internal names.
12724:
12725: $r is an Apache Request ref,
12726: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12727: $d is an array of 2 element arrays (internal name, displayed name)
12728:
12729: =cut
12730:
1.144 matthew 12731: ######################################################
12732: ######################################################
1.31 albertel 12733: sub csv_samples_select_table {
12734: my ($r,$records,$d) = @_;
12735: my $i=0;
1.144 matthew 12736: #
1.662 bisitz 12737: my $max_samples = 5;
12738: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12739: $r->print(&start_data_table().
12740: &start_data_table_header_row().'<th>'.
12741: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12742: &end_data_table_header_row());
1.301 albertel 12743:
12744: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12745: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12746: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12747: foreach my $option (@$d) {
12748: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12749: $r->print('<option value="'.$value.'"'.
1.253 albertel 12750: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12751: $display.'</option>');
1.31 albertel 12752: }
12753: $r->print('</select></td><td>');
1.662 bisitz 12754: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12755: if (defined($samples->[$line]{$key})) {
12756: $r->print($samples->[$line]{$key}."<br />\n");
12757: }
12758: }
1.594 raeburn 12759: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12760: $i++;
12761: }
1.594 raeburn 12762: $r->print(&end_data_table());
1.31 albertel 12763: $i--;
12764: return($i);
1.115 matthew 12765: }
12766:
1.144 matthew 12767: ######################################################
12768: ######################################################
12769:
1.115 matthew 12770: =pod
12771:
1.648 raeburn 12772: =item * &clean_excel_name($name)
1.115 matthew 12773:
12774: Returns a replacement for $name which does not contain any illegal characters.
12775:
12776: =cut
12777:
1.144 matthew 12778: ######################################################
12779: ######################################################
1.115 matthew 12780: sub clean_excel_name {
12781: my ($name) = @_;
12782: $name =~ s/[:\*\?\/\\]//g;
12783: if (length($name) > 31) {
12784: $name = substr($name,0,31);
12785: }
12786: return $name;
1.25 albertel 12787: }
1.84 albertel 12788:
1.85 albertel 12789: =pod
12790:
1.648 raeburn 12791: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12792:
12793: Returns either 1 or undef
12794:
12795: 1 if the part is to be hidden, undef if it is to be shown
12796:
12797: Arguments are:
12798:
12799: $id the id of the part to be checked
12800: $symb, optional the symb of the resource to check
12801: $udom, optional the domain of the user to check for
12802: $uname, optional the username of the user to check for
12803:
12804: =cut
1.84 albertel 12805:
12806: sub check_if_partid_hidden {
12807: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12808: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12809: $symb,$udom,$uname);
1.141 albertel 12810: my $truth=1;
12811: #if the string starts with !, then the list is the list to show not hide
12812: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12813: my @hiddenlist=split(/,/,$hiddenparts);
12814: foreach my $checkid (@hiddenlist) {
1.141 albertel 12815: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12816: }
1.141 albertel 12817: return !$truth;
1.84 albertel 12818: }
1.127 matthew 12819:
1.138 matthew 12820:
12821: ############################################################
12822: ############################################################
12823:
12824: =pod
12825:
1.157 matthew 12826: =back
12827:
1.138 matthew 12828: =head1 cgi-bin script and graphing routines
12829:
1.157 matthew 12830: =over 4
12831:
1.648 raeburn 12832: =item * &get_cgi_id()
1.138 matthew 12833:
12834: Inputs: none
12835:
12836: Returns an id which can be used to pass environment variables
12837: to various cgi-bin scripts. These environment variables will
12838: be removed from the users environment after a given time by
12839: the routine &Apache::lonnet::transfer_profile_to_env.
12840:
12841: =cut
12842:
12843: ############################################################
12844: ############################################################
1.152 albertel 12845: my $uniq=0;
1.136 matthew 12846: sub get_cgi_id {
1.154 albertel 12847: $uniq=($uniq+1)%100000;
1.280 albertel 12848: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12849: }
12850:
1.127 matthew 12851: ############################################################
12852: ############################################################
12853:
12854: =pod
12855:
1.648 raeburn 12856: =item * &DrawBarGraph()
1.127 matthew 12857:
1.138 matthew 12858: Facilitates the plotting of data in a (stacked) bar graph.
12859: Puts plot definition data into the users environment in order for
12860: graph.png to plot it. Returns an <img> tag for the plot.
12861: The bars on the plot are labeled '1','2',...,'n'.
12862:
12863: Inputs:
12864:
12865: =over 4
12866:
12867: =item $Title: string, the title of the plot
12868:
12869: =item $xlabel: string, text describing the X-axis of the plot
12870:
12871: =item $ylabel: string, text describing the Y-axis of the plot
12872:
12873: =item $Max: scalar, the maximum Y value to use in the plot
12874: If $Max is < any data point, the graph will not be rendered.
12875:
1.140 matthew 12876: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12877: they are plotted. If undefined, default values will be used.
12878:
1.178 matthew 12879: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12880:
1.138 matthew 12881: =item @Values: An array of array references. Each array reference holds data
12882: to be plotted in a stacked bar chart.
12883:
1.239 matthew 12884: =item If the final element of @Values is a hash reference the key/value
12885: pairs will be added to the graph definition.
12886:
1.138 matthew 12887: =back
12888:
12889: Returns:
12890:
12891: An <img> tag which references graph.png and the appropriate identifying
12892: information for the plot.
12893:
1.127 matthew 12894: =cut
12895:
12896: ############################################################
12897: ############################################################
1.134 matthew 12898: sub DrawBarGraph {
1.178 matthew 12899: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12900: #
12901: if (! defined($colors)) {
12902: $colors = ['#33ff00',
12903: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12904: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12905: ];
12906: }
1.228 matthew 12907: my $extra_settings = {};
12908: if (ref($Values[-1]) eq 'HASH') {
12909: $extra_settings = pop(@Values);
12910: }
1.127 matthew 12911: #
1.136 matthew 12912: my $identifier = &get_cgi_id();
12913: my $id = 'cgi.'.$identifier;
1.129 matthew 12914: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12915: return '';
12916: }
1.225 matthew 12917: #
12918: my @Labels;
12919: if (defined($labels)) {
12920: @Labels = @$labels;
12921: } else {
12922: for (my $i=0;$i<@{$Values[0]};$i++) {
12923: push (@Labels,$i+1);
12924: }
12925: }
12926: #
1.129 matthew 12927: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12928: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12929: my %ValuesHash;
12930: my $NumSets=1;
12931: foreach my $array (@Values) {
12932: next if (! ref($array));
1.136 matthew 12933: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12934: join(',',@$array);
1.129 matthew 12935: }
1.127 matthew 12936: #
1.136 matthew 12937: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12938: if ($NumBars < 3) {
12939: $width = 120+$NumBars*32;
1.220 matthew 12940: $xskip = 1;
1.225 matthew 12941: $bar_width = 30;
12942: } elsif ($NumBars < 5) {
12943: $width = 120+$NumBars*20;
12944: $xskip = 1;
12945: $bar_width = 20;
1.220 matthew 12946: } elsif ($NumBars < 10) {
1.136 matthew 12947: $width = 120+$NumBars*15;
12948: $xskip = 1;
12949: $bar_width = 15;
12950: } elsif ($NumBars <= 25) {
12951: $width = 120+$NumBars*11;
12952: $xskip = 5;
12953: $bar_width = 8;
12954: } elsif ($NumBars <= 50) {
12955: $width = 120+$NumBars*8;
12956: $xskip = 5;
12957: $bar_width = 4;
12958: } else {
12959: $width = 120+$NumBars*8;
12960: $xskip = 5;
12961: $bar_width = 4;
12962: }
12963: #
1.137 matthew 12964: $Max = 1 if ($Max < 1);
12965: if ( int($Max) < $Max ) {
12966: $Max++;
12967: $Max = int($Max);
12968: }
1.127 matthew 12969: $Title = '' if (! defined($Title));
12970: $xlabel = '' if (! defined($xlabel));
12971: $ylabel = '' if (! defined($ylabel));
1.369 www 12972: $ValuesHash{$id.'.title'} = &escape($Title);
12973: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12974: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12975: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12976: $ValuesHash{$id.'.NumBars'} = $NumBars;
12977: $ValuesHash{$id.'.NumSets'} = $NumSets;
12978: $ValuesHash{$id.'.PlotType'} = 'bar';
12979: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12980: $ValuesHash{$id.'.height'} = $height;
12981: $ValuesHash{$id.'.width'} = $width;
12982: $ValuesHash{$id.'.xskip'} = $xskip;
12983: $ValuesHash{$id.'.bar_width'} = $bar_width;
12984: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12985: #
1.228 matthew 12986: # Deal with other parameters
12987: while (my ($key,$value) = each(%$extra_settings)) {
12988: $ValuesHash{$id.'.'.$key} = $value;
12989: }
12990: #
1.646 raeburn 12991: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12992: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12993: }
12994:
12995: ############################################################
12996: ############################################################
12997:
12998: =pod
12999:
1.648 raeburn 13000: =item * &DrawXYGraph()
1.137 matthew 13001:
1.138 matthew 13002: Facilitates the plotting of data in an XY graph.
13003: Puts plot definition data into the users environment in order for
13004: graph.png to plot it. Returns an <img> tag for the plot.
13005:
13006: Inputs:
13007:
13008: =over 4
13009:
13010: =item $Title: string, the title of the plot
13011:
13012: =item $xlabel: string, text describing the X-axis of the plot
13013:
13014: =item $ylabel: string, text describing the Y-axis of the plot
13015:
13016: =item $Max: scalar, the maximum Y value to use in the plot
13017: If $Max is < any data point, the graph will not be rendered.
13018:
13019: =item $colors: Array ref containing the hex color codes for the data to be
13020: plotted in. If undefined, default values will be used.
13021:
13022: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13023:
13024: =item $Ydata: Array ref containing Array refs.
1.185 www 13025: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13026:
13027: =item %Values: hash indicating or overriding any default values which are
13028: passed to graph.png.
13029: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13030:
13031: =back
13032:
13033: Returns:
13034:
13035: An <img> tag which references graph.png and the appropriate identifying
13036: information for the plot.
13037:
1.137 matthew 13038: =cut
13039:
13040: ############################################################
13041: ############################################################
13042: sub DrawXYGraph {
13043: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13044: #
13045: # Create the identifier for the graph
13046: my $identifier = &get_cgi_id();
13047: my $id = 'cgi.'.$identifier;
13048: #
13049: $Title = '' if (! defined($Title));
13050: $xlabel = '' if (! defined($xlabel));
13051: $ylabel = '' if (! defined($ylabel));
13052: my %ValuesHash =
13053: (
1.369 www 13054: $id.'.title' => &escape($Title),
13055: $id.'.xlabel' => &escape($xlabel),
13056: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13057: $id.'.y_max_value'=> $Max,
13058: $id.'.labels' => join(',',@$Xlabels),
13059: $id.'.PlotType' => 'XY',
13060: );
13061: #
13062: if (defined($colors) && ref($colors) eq 'ARRAY') {
13063: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13064: }
13065: #
13066: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13067: return '';
13068: }
13069: my $NumSets=1;
1.138 matthew 13070: foreach my $array (@{$Ydata}){
1.137 matthew 13071: next if (! ref($array));
13072: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13073: }
1.138 matthew 13074: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13075: #
13076: # Deal with other parameters
13077: while (my ($key,$value) = each(%Values)) {
13078: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13079: }
13080: #
1.646 raeburn 13081: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13082: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13083: }
13084:
13085: ############################################################
13086: ############################################################
13087:
13088: =pod
13089:
1.648 raeburn 13090: =item * &DrawXYYGraph()
1.138 matthew 13091:
13092: Facilitates the plotting of data in an XY graph with two Y axes.
13093: Puts plot definition data into the users environment in order for
13094: graph.png to plot it. Returns an <img> tag for the plot.
13095:
13096: Inputs:
13097:
13098: =over 4
13099:
13100: =item $Title: string, the title of the plot
13101:
13102: =item $xlabel: string, text describing the X-axis of the plot
13103:
13104: =item $ylabel: string, text describing the Y-axis of the plot
13105:
13106: =item $colors: Array ref containing the hex color codes for the data to be
13107: plotted in. If undefined, default values will be used.
13108:
13109: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13110:
13111: =item $Ydata1: The first data set
13112:
13113: =item $Min1: The minimum value of the left Y-axis
13114:
13115: =item $Max1: The maximum value of the left Y-axis
13116:
13117: =item $Ydata2: The second data set
13118:
13119: =item $Min2: The minimum value of the right Y-axis
13120:
13121: =item $Max2: The maximum value of the left Y-axis
13122:
13123: =item %Values: hash indicating or overriding any default values which are
13124: passed to graph.png.
13125: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13126:
13127: =back
13128:
13129: Returns:
13130:
13131: An <img> tag which references graph.png and the appropriate identifying
13132: information for the plot.
1.136 matthew 13133:
13134: =cut
13135:
13136: ############################################################
13137: ############################################################
1.137 matthew 13138: sub DrawXYYGraph {
13139: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13140: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13141: #
13142: # Create the identifier for the graph
13143: my $identifier = &get_cgi_id();
13144: my $id = 'cgi.'.$identifier;
13145: #
13146: $Title = '' if (! defined($Title));
13147: $xlabel = '' if (! defined($xlabel));
13148: $ylabel = '' if (! defined($ylabel));
13149: my %ValuesHash =
13150: (
1.369 www 13151: $id.'.title' => &escape($Title),
13152: $id.'.xlabel' => &escape($xlabel),
13153: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13154: $id.'.labels' => join(',',@$Xlabels),
13155: $id.'.PlotType' => 'XY',
13156: $id.'.NumSets' => 2,
1.137 matthew 13157: $id.'.two_axes' => 1,
13158: $id.'.y1_max_value' => $Max1,
13159: $id.'.y1_min_value' => $Min1,
13160: $id.'.y2_max_value' => $Max2,
13161: $id.'.y2_min_value' => $Min2,
1.136 matthew 13162: );
13163: #
1.137 matthew 13164: if (defined($colors) && ref($colors) eq 'ARRAY') {
13165: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13166: }
13167: #
13168: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13169: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13170: return '';
13171: }
13172: my $NumSets=1;
1.137 matthew 13173: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13174: next if (! ref($array));
13175: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13176: }
13177: #
13178: # Deal with other parameters
13179: while (my ($key,$value) = each(%Values)) {
13180: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13181: }
13182: #
1.646 raeburn 13183: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13184: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13185: }
13186:
13187: ############################################################
13188: ############################################################
13189:
13190: =pod
13191:
1.157 matthew 13192: =back
13193:
1.139 matthew 13194: =head1 Statistics helper routines?
13195:
13196: Bad place for them but what the hell.
13197:
1.157 matthew 13198: =over 4
13199:
1.648 raeburn 13200: =item * &chartlink()
1.139 matthew 13201:
13202: Returns a link to the chart for a specific student.
13203:
13204: Inputs:
13205:
13206: =over 4
13207:
13208: =item $linktext: The text of the link
13209:
13210: =item $sname: The students username
13211:
13212: =item $sdomain: The students domain
13213:
13214: =back
13215:
1.157 matthew 13216: =back
13217:
1.139 matthew 13218: =cut
13219:
13220: ############################################################
13221: ############################################################
13222: sub chartlink {
13223: my ($linktext, $sname, $sdomain) = @_;
13224: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13225: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13226: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13227: '">'.$linktext.'</a>';
1.153 matthew 13228: }
13229:
13230: #######################################################
13231: #######################################################
13232:
13233: =pod
13234:
13235: =head1 Course Environment Routines
1.157 matthew 13236:
13237: =over 4
1.153 matthew 13238:
1.648 raeburn 13239: =item * &restore_course_settings()
1.153 matthew 13240:
1.648 raeburn 13241: =item * &store_course_settings()
1.153 matthew 13242:
13243: Restores/Store indicated form parameters from the course environment.
13244: Will not overwrite existing values of the form parameters.
13245:
13246: Inputs:
13247: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13248:
13249: a hash ref describing the data to be stored. For example:
13250:
13251: %Save_Parameters = ('Status' => 'scalar',
13252: 'chartoutputmode' => 'scalar',
13253: 'chartoutputdata' => 'scalar',
13254: 'Section' => 'array',
1.373 raeburn 13255: 'Group' => 'array',
1.153 matthew 13256: 'StudentData' => 'array',
13257: 'Maps' => 'array');
13258:
13259: Returns: both routines return nothing
13260:
1.631 raeburn 13261: =back
13262:
1.153 matthew 13263: =cut
13264:
13265: #######################################################
13266: #######################################################
13267: sub store_course_settings {
1.496 albertel 13268: return &store_settings($env{'request.course.id'},@_);
13269: }
13270:
13271: sub store_settings {
1.153 matthew 13272: # save to the environment
13273: # appenv the same items, just to be safe
1.300 albertel 13274: my $udom = $env{'user.domain'};
13275: my $uname = $env{'user.name'};
1.496 albertel 13276: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13277: my %SaveHash;
13278: my %AppHash;
13279: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13280: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13281: my $envname = 'environment.'.$basename;
1.258 albertel 13282: if (exists($env{'form.'.$setting})) {
1.153 matthew 13283: # Save this value away
13284: if ($type eq 'scalar' &&
1.258 albertel 13285: (! exists($env{$envname}) ||
13286: $env{$envname} ne $env{'form.'.$setting})) {
13287: $SaveHash{$basename} = $env{'form.'.$setting};
13288: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13289: } elsif ($type eq 'array') {
13290: my $stored_form;
1.258 albertel 13291: if (ref($env{'form.'.$setting})) {
1.153 matthew 13292: $stored_form = join(',',
13293: map {
1.369 www 13294: &escape($_);
1.258 albertel 13295: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13296: } else {
13297: $stored_form =
1.369 www 13298: &escape($env{'form.'.$setting});
1.153 matthew 13299: }
13300: # Determine if the array contents are the same.
1.258 albertel 13301: if ($stored_form ne $env{$envname}) {
1.153 matthew 13302: $SaveHash{$basename} = $stored_form;
13303: $AppHash{$envname} = $stored_form;
13304: }
13305: }
13306: }
13307: }
13308: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13309: $udom,$uname);
1.153 matthew 13310: if ($put_result !~ /^(ok|delayed)/) {
13311: &Apache::lonnet::logthis('unable to save form parameters, '.
13312: 'got error:'.$put_result);
13313: }
13314: # Make sure these settings stick around in this session, too
1.646 raeburn 13315: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13316: return;
13317: }
13318:
13319: sub restore_course_settings {
1.499 albertel 13320: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13321: }
13322:
13323: sub restore_settings {
13324: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13325: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13326: next if (exists($env{'form.'.$setting}));
1.496 albertel 13327: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13328: '.'.$setting;
1.258 albertel 13329: if (exists($env{$envname})) {
1.153 matthew 13330: if ($type eq 'scalar') {
1.258 albertel 13331: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13332: } elsif ($type eq 'array') {
1.258 albertel 13333: $env{'form.'.$setting} = [
1.153 matthew 13334: map {
1.369 www 13335: &unescape($_);
1.258 albertel 13336: } split(',',$env{$envname})
1.153 matthew 13337: ];
13338: }
13339: }
13340: }
1.127 matthew 13341: }
13342:
1.618 raeburn 13343: #######################################################
13344: #######################################################
13345:
13346: =pod
13347:
13348: =head1 Domain E-mail Routines
13349:
13350: =over 4
13351:
1.648 raeburn 13352: =item * &build_recipient_list()
1.618 raeburn 13353:
1.1144 raeburn 13354: Build recipient lists for following types of e-mail:
1.766 raeburn 13355: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13356: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13357: module change checking, student/employee ID conflict checks, as
13358: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13359: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13360:
13361: Inputs:
1.619 raeburn 13362: defmail (scalar - email address of default recipient),
1.1144 raeburn 13363: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13364: requestsmail, updatesmail, or idconflictsmail).
13365:
1.619 raeburn 13366: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13367:
1.619 raeburn 13368: origmail (scalar - email address of recipient from loncapa.conf,
13369: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13370:
1.655 raeburn 13371: Returns: comma separated list of addresses to which to send e-mail.
13372:
13373: =back
1.618 raeburn 13374:
13375: =cut
13376:
13377: ############################################################
13378: ############################################################
13379: sub build_recipient_list {
1.619 raeburn 13380: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13381: my @recipients;
13382: my $otheremails;
13383: my %domconfig =
13384: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13385: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13386: if (exists($domconfig{'contacts'}{$mailing})) {
13387: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13388: my @contacts = ('adminemail','supportemail');
13389: foreach my $item (@contacts) {
13390: if ($domconfig{'contacts'}{$mailing}{$item}) {
13391: my $addr = $domconfig{'contacts'}{$item};
13392: if (!grep(/^\Q$addr\E$/,@recipients)) {
13393: push(@recipients,$addr);
13394: }
1.619 raeburn 13395: }
1.766 raeburn 13396: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13397: }
13398: }
1.766 raeburn 13399: } elsif ($origmail ne '') {
13400: push(@recipients,$origmail);
1.618 raeburn 13401: }
1.619 raeburn 13402: } elsif ($origmail ne '') {
13403: push(@recipients,$origmail);
1.618 raeburn 13404: }
1.688 raeburn 13405: if (defined($defmail)) {
13406: if ($defmail ne '') {
13407: push(@recipients,$defmail);
13408: }
1.618 raeburn 13409: }
13410: if ($otheremails) {
1.619 raeburn 13411: my @others;
13412: if ($otheremails =~ /,/) {
13413: @others = split(/,/,$otheremails);
1.618 raeburn 13414: } else {
1.619 raeburn 13415: push(@others,$otheremails);
13416: }
13417: foreach my $addr (@others) {
13418: if (!grep(/^\Q$addr\E$/,@recipients)) {
13419: push(@recipients,$addr);
13420: }
1.618 raeburn 13421: }
13422: }
1.619 raeburn 13423: my $recipientlist = join(',',@recipients);
1.618 raeburn 13424: return $recipientlist;
13425: }
13426:
1.127 matthew 13427: ############################################################
13428: ############################################################
1.154 albertel 13429:
1.655 raeburn 13430: =pod
13431:
13432: =head1 Course Catalog Routines
13433:
13434: =over 4
13435:
13436: =item * &gather_categories()
13437:
13438: Converts category definitions - keys of categories hash stored in
13439: coursecategories in configuration.db on the primary library server in a
13440: domain - to an array. Also generates javascript and idx hash used to
13441: generate Domain Coordinator interface for editing Course Categories.
13442:
13443: Inputs:
1.663 raeburn 13444:
1.655 raeburn 13445: categories (reference to hash of category definitions).
1.663 raeburn 13446:
1.655 raeburn 13447: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13448: categories and subcategories).
1.663 raeburn 13449:
1.655 raeburn 13450: idx (reference to hash of counters used in Domain Coordinator interface for
13451: editing Course Categories).
1.663 raeburn 13452:
1.655 raeburn 13453: jsarray (reference to array of categories used to create Javascript arrays for
13454: Domain Coordinator interface for editing Course Categories).
13455:
13456: Returns: nothing
13457:
13458: Side effects: populates cats, idx and jsarray.
13459:
13460: =cut
13461:
13462: sub gather_categories {
13463: my ($categories,$cats,$idx,$jsarray) = @_;
13464: my %counters;
13465: my $num = 0;
13466: foreach my $item (keys(%{$categories})) {
13467: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13468: if ($container eq '' && $depth == 0) {
13469: $cats->[$depth][$categories->{$item}] = $cat;
13470: } else {
13471: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13472: }
13473: my ($escitem,$tail) = split(/:/,$item,2);
13474: if ($counters{$tail} eq '') {
13475: $counters{$tail} = $num;
13476: $num ++;
13477: }
13478: if (ref($idx) eq 'HASH') {
13479: $idx->{$item} = $counters{$tail};
13480: }
13481: if (ref($jsarray) eq 'ARRAY') {
13482: push(@{$jsarray->[$counters{$tail}]},$item);
13483: }
13484: }
13485: return;
13486: }
13487:
13488: =pod
13489:
13490: =item * &extract_categories()
13491:
13492: Used to generate breadcrumb trails for course categories.
13493:
13494: Inputs:
1.663 raeburn 13495:
1.655 raeburn 13496: categories (reference to hash of category definitions).
1.663 raeburn 13497:
1.655 raeburn 13498: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13499: categories and subcategories).
1.663 raeburn 13500:
1.655 raeburn 13501: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13502:
1.655 raeburn 13503: allitems (reference to hash - key is category key
13504: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13505:
1.655 raeburn 13506: idx (reference to hash of counters used in Domain Coordinator interface for
13507: editing Course Categories).
1.663 raeburn 13508:
1.655 raeburn 13509: jsarray (reference to array of categories used to create Javascript arrays for
13510: Domain Coordinator interface for editing Course Categories).
13511:
1.665 raeburn 13512: subcats (reference to hash of arrays containing all subcategories within each
13513: category, -recursive)
13514:
1.655 raeburn 13515: Returns: nothing
13516:
13517: Side effects: populates trails and allitems hash references.
13518:
13519: =cut
13520:
13521: sub extract_categories {
1.665 raeburn 13522: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13523: if (ref($categories) eq 'HASH') {
13524: &gather_categories($categories,$cats,$idx,$jsarray);
13525: if (ref($cats->[0]) eq 'ARRAY') {
13526: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13527: my $name = $cats->[0][$i];
13528: my $item = &escape($name).'::0';
13529: my $trailstr;
13530: if ($name eq 'instcode') {
13531: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13532: } elsif ($name eq 'communities') {
13533: $trailstr = &mt('Communities');
1.655 raeburn 13534: } else {
13535: $trailstr = $name;
13536: }
13537: if ($allitems->{$item} eq '') {
13538: push(@{$trails},$trailstr);
13539: $allitems->{$item} = scalar(@{$trails})-1;
13540: }
13541: my @parents = ($name);
13542: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13543: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13544: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13545: if (ref($subcats) eq 'HASH') {
13546: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13547: }
13548: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13549: }
13550: } else {
13551: if (ref($subcats) eq 'HASH') {
13552: $subcats->{$item} = [];
1.655 raeburn 13553: }
13554: }
13555: }
13556: }
13557: }
13558: return;
13559: }
13560:
13561: =pod
13562:
1.1162 raeburn 13563: =item * &recurse_categories()
1.655 raeburn 13564:
13565: Recursively used to generate breadcrumb trails for course categories.
13566:
13567: Inputs:
1.663 raeburn 13568:
1.655 raeburn 13569: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13570: categories and subcategories).
1.663 raeburn 13571:
1.655 raeburn 13572: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13573:
13574: category (current course category, for which breadcrumb trail is being generated).
13575:
13576: trails (reference to array of breadcrumb trails for each category).
13577:
1.655 raeburn 13578: allitems (reference to hash - key is category key
13579: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13580:
1.655 raeburn 13581: parents (array containing containers directories for current category,
13582: back to top level).
13583:
13584: Returns: nothing
13585:
13586: Side effects: populates trails and allitems hash references
13587:
13588: =cut
13589:
13590: sub recurse_categories {
1.665 raeburn 13591: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13592: my $shallower = $depth - 1;
13593: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13594: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13595: my $name = $cats->[$depth]{$category}[$k];
13596: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13597: my $trailstr = join(' -> ',(@{$parents},$category));
13598: if ($allitems->{$item} eq '') {
13599: push(@{$trails},$trailstr);
13600: $allitems->{$item} = scalar(@{$trails})-1;
13601: }
13602: my $deeper = $depth+1;
13603: push(@{$parents},$category);
1.665 raeburn 13604: if (ref($subcats) eq 'HASH') {
13605: my $subcat = &escape($name).':'.$category.':'.$depth;
13606: for (my $j=@{$parents}; $j>=0; $j--) {
13607: my $higher;
13608: if ($j > 0) {
13609: $higher = &escape($parents->[$j]).':'.
13610: &escape($parents->[$j-1]).':'.$j;
13611: } else {
13612: $higher = &escape($parents->[$j]).'::'.$j;
13613: }
13614: push(@{$subcats->{$higher}},$subcat);
13615: }
13616: }
13617: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13618: $subcats);
1.655 raeburn 13619: pop(@{$parents});
13620: }
13621: } else {
13622: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13623: my $trailstr = join(' -> ',(@{$parents},$category));
13624: if ($allitems->{$item} eq '') {
13625: push(@{$trails},$trailstr);
13626: $allitems->{$item} = scalar(@{$trails})-1;
13627: }
13628: }
13629: return;
13630: }
13631:
1.663 raeburn 13632: =pod
13633:
1.1162 raeburn 13634: =item * &assign_categories_table()
1.663 raeburn 13635:
13636: Create a datatable for display of hierarchical categories in a domain,
13637: with checkboxes to allow a course to be categorized.
13638:
13639: Inputs:
13640:
13641: cathash - reference to hash of categories defined for the domain (from
13642: configuration.db)
13643:
13644: currcat - scalar with an & separated list of categories assigned to a course.
13645:
1.919 raeburn 13646: type - scalar contains course type (Course or Community).
13647:
1.663 raeburn 13648: Returns: $output (markup to be displayed)
13649:
13650: =cut
13651:
13652: sub assign_categories_table {
1.919 raeburn 13653: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13654: my $output;
13655: if (ref($cathash) eq 'HASH') {
13656: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13657: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13658: $maxdepth = scalar(@cats);
13659: if (@cats > 0) {
13660: my $itemcount = 0;
13661: if (ref($cats[0]) eq 'ARRAY') {
13662: my @currcategories;
13663: if ($currcat ne '') {
13664: @currcategories = split('&',$currcat);
13665: }
1.919 raeburn 13666: my $table;
1.663 raeburn 13667: for (my $i=0; $i<@{$cats[0]}; $i++) {
13668: my $parent = $cats[0][$i];
1.919 raeburn 13669: next if ($parent eq 'instcode');
13670: if ($type eq 'Community') {
13671: next unless ($parent eq 'communities');
13672: } else {
13673: next if ($parent eq 'communities');
13674: }
1.663 raeburn 13675: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13676: my $item = &escape($parent).'::0';
13677: my $checked = '';
13678: if (@currcategories > 0) {
13679: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13680: $checked = ' checked="checked"';
1.663 raeburn 13681: }
13682: }
1.919 raeburn 13683: my $parent_title = $parent;
13684: if ($parent eq 'communities') {
13685: $parent_title = &mt('Communities');
13686: }
13687: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13688: '<input type="checkbox" name="usecategory" value="'.
13689: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13690: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13691: my $depth = 1;
13692: push(@path,$parent);
1.919 raeburn 13693: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13694: pop(@path);
1.919 raeburn 13695: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13696: $itemcount ++;
13697: }
1.919 raeburn 13698: if ($itemcount) {
13699: $output = &Apache::loncommon::start_data_table().
13700: $table.
13701: &Apache::loncommon::end_data_table();
13702: }
1.663 raeburn 13703: }
13704: }
13705: }
13706: return $output;
13707: }
13708:
13709: =pod
13710:
1.1162 raeburn 13711: =item * &assign_category_rows()
1.663 raeburn 13712:
13713: Create a datatable row for display of nested categories in a domain,
13714: with checkboxes to allow a course to be categorized,called recursively.
13715:
13716: Inputs:
13717:
13718: itemcount - track row number for alternating colors
13719:
13720: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13721: categories and subcategories.
13722:
13723: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13724:
13725: parent - parent of current category item
13726:
13727: path - Array containing all categories back up through the hierarchy from the
13728: current category to the top level.
13729:
13730: currcategories - reference to array of current categories assigned to the course
13731:
13732: Returns: $output (markup to be displayed).
13733:
13734: =cut
13735:
13736: sub assign_category_rows {
13737: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13738: my ($text,$name,$item,$chgstr);
13739: if (ref($cats) eq 'ARRAY') {
13740: my $maxdepth = scalar(@{$cats});
13741: if (ref($cats->[$depth]) eq 'HASH') {
13742: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13743: my $numchildren = @{$cats->[$depth]{$parent}};
13744: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 13745: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13746: for (my $j=0; $j<$numchildren; $j++) {
13747: $name = $cats->[$depth]{$parent}[$j];
13748: $item = &escape($name).':'.&escape($parent).':'.$depth;
13749: my $deeper = $depth+1;
13750: my $checked = '';
13751: if (ref($currcategories) eq 'ARRAY') {
13752: if (@{$currcategories} > 0) {
13753: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13754: $checked = ' checked="checked"';
1.663 raeburn 13755: }
13756: }
13757: }
1.664 raeburn 13758: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13759: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13760: $item.'"'.$checked.' />'.$name.'</label></span>'.
13761: '<input type="hidden" name="catname" value="'.$name.'" />'.
13762: '</td><td>';
1.663 raeburn 13763: if (ref($path) eq 'ARRAY') {
13764: push(@{$path},$name);
13765: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13766: pop(@{$path});
13767: }
13768: $text .= '</td></tr>';
13769: }
13770: $text .= '</table></td>';
13771: }
13772: }
13773: }
13774: return $text;
13775: }
13776:
1.1181 raeburn 13777: =pod
13778:
13779: =back
13780:
13781: =cut
13782:
1.655 raeburn 13783: ############################################################
13784: ############################################################
13785:
13786:
1.443 albertel 13787: sub commit_customrole {
1.664 raeburn 13788: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13789: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13790: ($start?', '.&mt('starting').' '.localtime($start):'').
13791: ($end?', ending '.localtime($end):'').': <b>'.
13792: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13793: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13794: '</b><br />';
13795: return $output;
13796: }
13797:
13798: sub commit_standardrole {
1.1116 raeburn 13799: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13800: my ($output,$logmsg,$linefeed);
13801: if ($context eq 'auto') {
13802: $linefeed = "\n";
13803: } else {
13804: $linefeed = "<br />\n";
13805: }
1.443 albertel 13806: if ($three eq 'st') {
1.541 raeburn 13807: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 13808: $one,$two,$sec,$context,$credits);
1.541 raeburn 13809: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13810: ($result eq 'unknown_course') || ($result eq 'refused')) {
13811: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13812: } else {
1.541 raeburn 13813: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13814: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13815: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13816: if ($context eq 'auto') {
13817: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13818: } else {
13819: $output .= '<b>'.$result.'</b>'.$linefeed.
13820: &mt('Add to classlist').': <b>ok</b>';
13821: }
13822: $output .= $linefeed;
1.443 albertel 13823: }
13824: } else {
13825: $output = &mt('Assigning').' '.$three.' in '.$url.
13826: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13827: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13828: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13829: if ($context eq 'auto') {
13830: $output .= $result.$linefeed;
13831: } else {
13832: $output .= '<b>'.$result.'</b>'.$linefeed;
13833: }
1.443 albertel 13834: }
13835: return $output;
13836: }
13837:
13838: sub commit_studentrole {
1.1116 raeburn 13839: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13840: $credits) = @_;
1.626 raeburn 13841: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13842: if ($context eq 'auto') {
13843: $linefeed = "\n";
13844: } else {
13845: $linefeed = '<br />'."\n";
13846: }
1.443 albertel 13847: if (defined($one) && defined($two)) {
13848: my $cid=$one.'_'.$two;
13849: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13850: my $secchange = 0;
13851: my $expire_role_result;
13852: my $modify_section_result;
1.628 raeburn 13853: if ($oldsec ne '-1') {
13854: if ($oldsec ne $sec) {
1.443 albertel 13855: $secchange = 1;
1.628 raeburn 13856: my $now = time;
1.443 albertel 13857: my $uurl='/'.$cid;
13858: $uurl=~s/\_/\//g;
13859: if ($oldsec) {
13860: $uurl.='/'.$oldsec;
13861: }
1.626 raeburn 13862: $oldsecurl = $uurl;
1.628 raeburn 13863: $expire_role_result =
1.652 raeburn 13864: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13865: if ($env{'request.course.sec'} ne '') {
13866: if ($expire_role_result eq 'refused') {
13867: my @roles = ('st');
13868: my @statuses = ('previous');
13869: my @roledoms = ($one);
13870: my $withsec = 1;
13871: my %roleshash =
13872: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13873: \@statuses,\@roles,\@roledoms,$withsec);
13874: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13875: my ($oldstart,$oldend) =
13876: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13877: if ($oldend > 0 && $oldend <= $now) {
13878: $expire_role_result = 'ok';
13879: }
13880: }
13881: }
13882: }
1.443 albertel 13883: $result = $expire_role_result;
13884: }
13885: }
13886: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 13887: $modify_section_result =
13888: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13889: undef,undef,undef,$sec,
13890: $end,$start,'','',$cid,
13891: '',$context,$credits);
1.443 albertel 13892: if ($modify_section_result =~ /^ok/) {
13893: if ($secchange == 1) {
1.628 raeburn 13894: if ($sec eq '') {
13895: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13896: } else {
13897: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13898: }
1.443 albertel 13899: } elsif ($oldsec eq '-1') {
1.628 raeburn 13900: if ($sec eq '') {
13901: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13902: } else {
13903: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13904: }
1.443 albertel 13905: } else {
1.628 raeburn 13906: if ($sec eq '') {
13907: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13908: } else {
13909: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13910: }
1.443 albertel 13911: }
13912: } else {
1.1115 raeburn 13913: if ($secchange) {
1.628 raeburn 13914: $$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;
13915: } else {
13916: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13917: }
1.443 albertel 13918: }
13919: $result = $modify_section_result;
13920: } elsif ($secchange == 1) {
1.628 raeburn 13921: if ($oldsec eq '') {
1.1103 raeburn 13922: $$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 13923: } else {
13924: $$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;
13925: }
1.626 raeburn 13926: if ($expire_role_result eq 'refused') {
13927: my $newsecurl = '/'.$cid;
13928: $newsecurl =~ s/\_/\//g;
13929: if ($sec ne '') {
13930: $newsecurl.='/'.$sec;
13931: }
13932: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13933: if ($sec eq '') {
13934: $$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;
13935: } else {
13936: $$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;
13937: }
13938: }
13939: }
1.443 albertel 13940: }
13941: } else {
1.626 raeburn 13942: $$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 13943: $result = "error: incomplete course id\n";
13944: }
13945: return $result;
13946: }
13947:
1.1108 raeburn 13948: sub show_role_extent {
13949: my ($scope,$context,$role) = @_;
13950: $scope =~ s{^/}{};
13951: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13952: push(@courseroles,'co');
13953: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13954: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13955: $scope =~ s{/}{_};
13956: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13957: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13958: my ($audom,$auname) = split(/\//,$scope);
13959: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13960: &Apache::loncommon::plainname($auname,$audom).'</span>');
13961: } else {
13962: $scope =~ s{/$}{};
13963: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13964: &Apache::lonnet::domain($scope,'description').'</span>');
13965: }
13966: }
13967:
1.443 albertel 13968: ############################################################
13969: ############################################################
13970:
1.566 albertel 13971: sub check_clone {
1.578 raeburn 13972: my ($args,$linefeed) = @_;
1.566 albertel 13973: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13974: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13975: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13976: my $clonemsg;
13977: my $can_clone = 0;
1.944 raeburn 13978: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13979: if ($lctype ne 'community') {
13980: $lctype = 'course';
13981: }
1.566 albertel 13982: if ($clonehome eq 'no_host') {
1.944 raeburn 13983: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13984: $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'});
13985: } else {
13986: $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'});
13987: }
1.566 albertel 13988: } else {
13989: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13990: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13991: if ($clonedesc{'type'} ne 'Community') {
13992: $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'});
13993: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13994: }
13995: }
1.882 raeburn 13996: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13997: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13998: $can_clone = 1;
13999: } else {
14000: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14001: $args->{'clonedomain'},$args->{'clonecourse'});
14002: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14003: if (grep(/^\*$/,@cloners)) {
14004: $can_clone = 1;
14005: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14006: $can_clone = 1;
14007: } else {
1.908 raeburn 14008: my $ccrole = 'cc';
1.944 raeburn 14009: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14010: $ccrole = 'co';
14011: }
1.578 raeburn 14012: my %roleshash =
14013: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14014: $args->{'ccdomain'},
1.908 raeburn 14015: 'userroles',['active'],[$ccrole],
1.578 raeburn 14016: [$args->{'clonedomain'}]);
1.908 raeburn 14017: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14018: $can_clone = 1;
14019: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14020: $can_clone = 1;
14021: } else {
1.944 raeburn 14022: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14023: $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'});
14024: } else {
14025: $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'});
14026: }
1.578 raeburn 14027: }
1.566 albertel 14028: }
1.578 raeburn 14029: }
1.566 albertel 14030: }
14031: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14032: }
14033:
1.444 albertel 14034: sub construct_course {
1.1166 raeburn 14035: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14036: my $outcome;
1.541 raeburn 14037: my $linefeed = '<br />'."\n";
14038: if ($context eq 'auto') {
14039: $linefeed = "\n";
14040: }
1.566 albertel 14041:
14042: #
14043: # Are we cloning?
14044: #
14045: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14046: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14047: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14048: if ($context ne 'auto') {
1.578 raeburn 14049: if ($clonemsg ne '') {
14050: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14051: }
1.566 albertel 14052: }
14053: $outcome .= $clonemsg.$linefeed;
14054:
14055: if (!$can_clone) {
14056: return (0,$outcome);
14057: }
14058: }
14059:
1.444 albertel 14060: #
14061: # Open course
14062: #
14063: my $crstype = lc($args->{'crstype'});
14064: my %cenv=();
14065: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14066: $args->{'cdescr'},
14067: $args->{'curl'},
14068: $args->{'course_home'},
14069: $args->{'nonstandard'},
14070: $args->{'crscode'},
14071: $args->{'ccuname'}.':'.
14072: $args->{'ccdomain'},
1.882 raeburn 14073: $args->{'crstype'},
1.885 raeburn 14074: $cnum,$context,$category);
1.444 albertel 14075:
14076: # Note: The testing routines depend on this being output; see
14077: # Utils::Course. This needs to at least be output as a comment
14078: # if anyone ever decides to not show this, and Utils::Course::new
14079: # will need to be suitably modified.
1.541 raeburn 14080: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14081: if ($$courseid =~ /^error:/) {
14082: return (0,$outcome);
14083: }
14084:
1.444 albertel 14085: #
14086: # Check if created correctly
14087: #
1.479 albertel 14088: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14089: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14090: if ($crsuhome eq 'no_host') {
14091: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14092: return (0,$outcome);
14093: }
1.541 raeburn 14094: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14095:
1.444 albertel 14096: #
1.566 albertel 14097: # Do the cloning
14098: #
14099: if ($can_clone && $cloneid) {
14100: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14101: if ($context ne 'auto') {
14102: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14103: }
14104: $outcome .= $clonemsg.$linefeed;
14105: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14106: # Copy all files
1.637 www 14107: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14108: # Restore URL
1.566 albertel 14109: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14110: # Restore title
1.566 albertel 14111: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14112: # Restore creation date, creator and creation context.
14113: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14114: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14115: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14116: # Mark as cloned
1.566 albertel 14117: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14118: # Need to clone grading mode
14119: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14120: $cenv{'grading'}=$newenv{'grading'};
14121: # Do not clone these environment entries
14122: &Apache::lonnet::del('environment',
14123: ['default_enrollment_start_date',
14124: 'default_enrollment_end_date',
14125: 'question.email',
14126: 'policy.email',
14127: 'comment.email',
14128: 'pch.users.denied',
1.725 raeburn 14129: 'plc.users.denied',
14130: 'hidefromcat',
1.1121 raeburn 14131: 'checkforpriv',
1.1166 raeburn 14132: 'categories',
14133: 'internal.uniquecode'],
1.638 www 14134: $$crsudom,$$crsunum);
1.1170 raeburn 14135: if ($args->{'textbook'}) {
14136: $cenv{'internal.textbook'} = $args->{'textbook'};
14137: }
1.444 albertel 14138: }
1.566 albertel 14139:
1.444 albertel 14140: #
14141: # Set environment (will override cloned, if existing)
14142: #
14143: my @sections = ();
14144: my @xlists = ();
14145: if ($args->{'crstype'}) {
14146: $cenv{'type'}=$args->{'crstype'};
14147: }
14148: if ($args->{'crsid'}) {
14149: $cenv{'courseid'}=$args->{'crsid'};
14150: }
14151: if ($args->{'crscode'}) {
14152: $cenv{'internal.coursecode'}=$args->{'crscode'};
14153: }
14154: if ($args->{'crsquota'} ne '') {
14155: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14156: } else {
14157: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14158: }
14159: if ($args->{'ccuname'}) {
14160: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14161: ':'.$args->{'ccdomain'};
14162: } else {
14163: $cenv{'internal.courseowner'} = $args->{'curruser'};
14164: }
1.1116 raeburn 14165: if ($args->{'defaultcredits'}) {
14166: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14167: }
1.444 albertel 14168: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14169: if ($args->{'crssections'}) {
14170: $cenv{'internal.sectionnums'} = '';
14171: if ($args->{'crssections'} =~ m/,/) {
14172: @sections = split/,/,$args->{'crssections'};
14173: } else {
14174: $sections[0] = $args->{'crssections'};
14175: }
14176: if (@sections > 0) {
14177: foreach my $item (@sections) {
14178: my ($sec,$gp) = split/:/,$item;
14179: my $class = $args->{'crscode'}.$sec;
14180: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14181: $cenv{'internal.sectionnums'} .= $item.',';
14182: unless ($addcheck eq 'ok') {
14183: push @badclasses, $class;
14184: }
14185: }
14186: $cenv{'internal.sectionnums'} =~ s/,$//;
14187: }
14188: }
14189: # do not hide course coordinator from staff listing,
14190: # even if privileged
14191: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14192: # add course coordinator's domain to domains to check for privileged users
14193: # if different to course domain
14194: if ($$crsudom ne $args->{'ccdomain'}) {
14195: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14196: }
1.444 albertel 14197: # add crosslistings
14198: if ($args->{'crsxlist'}) {
14199: $cenv{'internal.crosslistings'}='';
14200: if ($args->{'crsxlist'} =~ m/,/) {
14201: @xlists = split/,/,$args->{'crsxlist'};
14202: } else {
14203: $xlists[0] = $args->{'crsxlist'};
14204: }
14205: if (@xlists > 0) {
14206: foreach my $item (@xlists) {
14207: my ($xl,$gp) = split/:/,$item;
14208: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14209: $cenv{'internal.crosslistings'} .= $item.',';
14210: unless ($addcheck eq 'ok') {
14211: push @badclasses, $xl;
14212: }
14213: }
14214: $cenv{'internal.crosslistings'} =~ s/,$//;
14215: }
14216: }
14217: if ($args->{'autoadds'}) {
14218: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14219: }
14220: if ($args->{'autodrops'}) {
14221: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14222: }
14223: # check for notification of enrollment changes
14224: my @notified = ();
14225: if ($args->{'notify_owner'}) {
14226: if ($args->{'ccuname'} ne '') {
14227: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14228: }
14229: }
14230: if ($args->{'notify_dc'}) {
14231: if ($uname ne '') {
1.630 raeburn 14232: push(@notified,$uname.':'.$udom);
1.444 albertel 14233: }
14234: }
14235: if (@notified > 0) {
14236: my $notifylist;
14237: if (@notified > 1) {
14238: $notifylist = join(',',@notified);
14239: } else {
14240: $notifylist = $notified[0];
14241: }
14242: $cenv{'internal.notifylist'} = $notifylist;
14243: }
14244: if (@badclasses > 0) {
14245: my %lt=&Apache::lonlocal::texthash(
14246: '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',
14247: 'dnhr' => 'does not have rights to access enrollment in these classes',
14248: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14249: );
1.541 raeburn 14250: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14251: ' ('.$lt{'adby'}.')';
14252: if ($context eq 'auto') {
14253: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14254: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14255: foreach my $item (@badclasses) {
14256: if ($context eq 'auto') {
14257: $outcome .= " - $item\n";
14258: } else {
14259: $outcome .= "<li>$item</li>\n";
14260: }
14261: }
14262: if ($context eq 'auto') {
14263: $outcome .= $linefeed;
14264: } else {
1.566 albertel 14265: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14266: }
14267: }
1.444 albertel 14268: }
14269: if ($args->{'no_end_date'}) {
14270: $args->{'endaccess'} = 0;
14271: }
14272: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14273: $cenv{'internal.autoend'}=$args->{'enrollend'};
14274: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14275: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14276: if ($args->{'showphotos'}) {
14277: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14278: }
14279: $cenv{'internal.authtype'} = $args->{'authtype'};
14280: $cenv{'internal.autharg'} = $args->{'autharg'};
14281: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14282: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14283: 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');
14284: if ($context eq 'auto') {
14285: $outcome .= $krb_msg;
14286: } else {
1.566 albertel 14287: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14288: }
14289: $outcome .= $linefeed;
1.444 albertel 14290: }
14291: }
14292: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14293: if ($args->{'setpolicy'}) {
14294: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14295: }
14296: if ($args->{'setcontent'}) {
14297: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14298: }
14299: }
14300: if ($args->{'reshome'}) {
14301: $cenv{'reshome'}=$args->{'reshome'}.'/';
14302: $cenv{'reshome'}=~s/\/+$/\//;
14303: }
14304: #
14305: # course has keyed access
14306: #
14307: if ($args->{'setkeys'}) {
14308: $cenv{'keyaccess'}='yes';
14309: }
14310: # if specified, key authority is not course, but user
14311: # only active if keyaccess is yes
14312: if ($args->{'keyauth'}) {
1.487 albertel 14313: my ($user,$domain) = split(':',$args->{'keyauth'});
14314: $user = &LONCAPA::clean_username($user);
14315: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14316: if ($user ne '' && $domain ne '') {
1.487 albertel 14317: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14318: }
14319: }
14320:
1.1166 raeburn 14321: #
1.1167 raeburn 14322: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14323: #
14324: if ($args->{'uniquecode'}) {
14325: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14326: if ($code) {
14327: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14328: my %crsinfo =
14329: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14330: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14331: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14332: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14333: }
1.1166 raeburn 14334: if (ref($coderef)) {
14335: $$coderef = $code;
14336: }
14337: }
14338: }
14339:
1.444 albertel 14340: if ($args->{'disresdis'}) {
14341: $cenv{'pch.roles.denied'}='st';
14342: }
14343: if ($args->{'disablechat'}) {
14344: $cenv{'plc.roles.denied'}='st';
14345: }
14346:
14347: # Record we've not yet viewed the Course Initialization Helper for this
14348: # course
14349: $cenv{'course.helper.not.run'} = 1;
14350: #
14351: # Use new Randomseed
14352: #
14353: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14354: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14355: #
14356: # The encryption code and receipt prefix for this course
14357: #
14358: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14359: $cenv{'internal.encpref'}=100+int(9*rand(99));
14360: #
14361: # By default, use standard grading
14362: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14363:
1.541 raeburn 14364: $outcome .= $linefeed.&mt('Setting environment').': '.
14365: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14366: #
14367: # Open all assignments
14368: #
14369: if ($args->{'openall'}) {
14370: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14371: my %storecontent = ($storeunder => time,
14372: $storeunder.'.type' => 'date_start');
14373:
14374: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14375: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14376: }
14377: #
14378: # Set first page
14379: #
14380: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14381: || ($cloneid)) {
1.445 albertel 14382: use LONCAPA::map;
1.444 albertel 14383: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14384:
14385: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14386: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14387:
1.444 albertel 14388: $outcome .= ($fatal?$errtext:'read ok').' - ';
14389: my $title; my $url;
14390: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14391: $title=&mt('Syllabus');
1.444 albertel 14392: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14393: } else {
1.963 raeburn 14394: $title=&mt('Table of Contents');
1.444 albertel 14395: $url='/adm/navmaps';
14396: }
1.445 albertel 14397:
14398: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14399: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14400:
14401: if ($errtext) { $fatal=2; }
1.541 raeburn 14402: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14403: }
1.566 albertel 14404:
14405: return (1,$outcome);
1.444 albertel 14406: }
14407:
1.1166 raeburn 14408: sub make_unique_code {
14409: my ($cdom,$cnum) = @_;
14410: # get lock on uniquecodes db
14411: my $lockhash = {
14412: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14413: ':'.$env{'user.domain'},
14414: };
14415: my $tries = 0;
14416: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14417: my ($code,$error);
14418:
14419: while (($gotlock ne 'ok') && ($tries<3)) {
14420: $tries ++;
14421: sleep 1;
14422: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14423: }
14424: if ($gotlock eq 'ok') {
14425: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14426: my $gotcode;
14427: my $attempts = 0;
14428: while ((!$gotcode) && ($attempts < 100)) {
14429: $code = &generate_code();
14430: if (!exists($currcodes{$code})) {
14431: $gotcode = 1;
14432: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14433: $error = 'nostore';
14434: }
14435: }
14436: $attempts ++;
14437: }
14438: my @del_lock = ($cnum."\0".'uniquecodes');
14439: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14440: } else {
14441: $error = 'nolock';
14442: }
14443: return ($code,$error);
14444: }
14445:
14446: sub generate_code {
14447: my $code;
14448: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14449: for (my $i=0; $i<6; $i++) {
14450: my $lettnum = int (rand 2);
14451: my $item = '';
14452: if ($lettnum) {
14453: $item = $letts[int( rand(18) )];
14454: } else {
14455: $item = 1+int( rand(8) );
14456: }
14457: $code .= $item;
14458: }
14459: return $code;
14460: }
14461:
1.444 albertel 14462: ############################################################
14463: ############################################################
14464:
1.953 droeschl 14465: #SD
14466: # only Community and Course, or anything else?
1.378 raeburn 14467: sub course_type {
14468: my ($cid) = @_;
14469: if (!defined($cid)) {
14470: $cid = $env{'request.course.id'};
14471: }
1.404 albertel 14472: if (defined($env{'course.'.$cid.'.type'})) {
14473: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14474: } else {
14475: return 'Course';
1.377 raeburn 14476: }
14477: }
1.156 albertel 14478:
1.406 raeburn 14479: sub group_term {
14480: my $crstype = &course_type();
14481: my %names = (
14482: 'Course' => 'group',
1.865 raeburn 14483: 'Community' => 'group',
1.406 raeburn 14484: );
14485: return $names{$crstype};
14486: }
14487:
1.902 raeburn 14488: sub course_types {
1.1165 raeburn 14489: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14490: my %typename = (
14491: official => 'Official course',
14492: unofficial => 'Unofficial course',
14493: community => 'Community',
1.1165 raeburn 14494: textbook => 'Textbook course',
1.902 raeburn 14495: );
14496: return (\@types,\%typename);
14497: }
14498:
1.156 albertel 14499: sub icon {
14500: my ($file)=@_;
1.505 albertel 14501: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14502: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14503: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14504: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14505: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14506: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14507: $curfext.".gif") {
14508: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14509: $curfext.".gif";
14510: }
14511: }
1.249 albertel 14512: return &lonhttpdurl($iconname);
1.154 albertel 14513: }
1.84 albertel 14514:
1.575 albertel 14515: sub lonhttpdurl {
1.692 www 14516: #
14517: # Had been used for "small fry" static images on separate port 8080.
14518: # Modify here if lightweight http functionality desired again.
14519: # Currently eliminated due to increasing firewall issues.
14520: #
1.575 albertel 14521: my ($url)=@_;
1.692 www 14522: return $url;
1.215 albertel 14523: }
14524:
1.213 albertel 14525: sub connection_aborted {
14526: my ($r)=@_;
14527: $r->print(" ");$r->rflush();
14528: my $c = $r->connection;
14529: return $c->aborted();
14530: }
14531:
1.221 foxr 14532: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14533: # strings as 'strings'.
14534: sub escape_single {
1.221 foxr 14535: my ($input) = @_;
1.223 albertel 14536: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14537: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14538: return $input;
14539: }
1.223 albertel 14540:
1.222 foxr 14541: # Same as escape_single, but escape's "'s This
14542: # can be used for "strings"
14543: sub escape_double {
14544: my ($input) = @_;
14545: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14546: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14547: return $input;
14548: }
1.223 albertel 14549:
1.222 foxr 14550: # Escapes the last element of a full URL.
14551: sub escape_url {
14552: my ($url) = @_;
1.238 raeburn 14553: my @urlslices = split(/\//, $url,-1);
1.369 www 14554: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 14555: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 14556: }
1.462 albertel 14557:
1.820 raeburn 14558: sub compare_arrays {
14559: my ($arrayref1,$arrayref2) = @_;
14560: my (@difference,%count);
14561: @difference = ();
14562: %count = ();
14563: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14564: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14565: foreach my $element (keys(%count)) {
14566: if ($count{$element} == 1) {
14567: push(@difference,$element);
14568: }
14569: }
14570: }
14571: return @difference;
14572: }
14573:
1.817 bisitz 14574: # -------------------------------------------------------- Initialize user login
1.462 albertel 14575: sub init_user_environment {
1.463 albertel 14576: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14577: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14578:
14579: my $public=($username eq 'public' && $domain eq 'public');
14580:
14581: # See if old ID present, if so, remove
14582:
1.1062 raeburn 14583: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14584: my $now=time;
14585:
14586: if ($public) {
14587: my $max_public=100;
14588: my $oldest;
14589: my $oldest_time=0;
14590: for(my $next=1;$next<=$max_public;$next++) {
14591: if (-e $lonids."/publicuser_$next.id") {
14592: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14593: if ($mtime<$oldest_time || !$oldest_time) {
14594: $oldest_time=$mtime;
14595: $oldest=$next;
14596: }
14597: } else {
14598: $cookie="publicuser_$next";
14599: last;
14600: }
14601: }
14602: if (!$cookie) { $cookie="publicuser_$oldest"; }
14603: } else {
1.463 albertel 14604: # if this isn't a robot, kill any existing non-robot sessions
14605: if (!$args->{'robot'}) {
14606: opendir(DIR,$lonids);
14607: while ($filename=readdir(DIR)) {
14608: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14609: unlink($lonids.'/'.$filename);
14610: }
1.462 albertel 14611: }
1.463 albertel 14612: closedir(DIR);
1.462 albertel 14613: }
14614: # Give them a new cookie
1.463 albertel 14615: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14616: : $now.$$.int(rand(10000)));
1.463 albertel 14617: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14618:
14619: # Initialize roles
14620:
1.1062 raeburn 14621: ($userroles,$firstaccenv,$timerintenv) =
14622: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14623: }
14624: # ------------------------------------ Check browser type and MathML capability
14625:
1.1194 raeburn 14626: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14627: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14628:
14629: # ------------------------------------------------------------- Get environment
14630:
14631: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14632: my ($tmp) = keys(%userenv);
14633: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14634: } else {
14635: undef(%userenv);
14636: }
14637: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14638: $form->{'interface'}=$userenv{'interface'};
14639: }
14640: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14641:
14642: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14643: foreach my $option ('interface','localpath','localres') {
14644: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14645: }
14646: # --------------------------------------------------------- Write first profile
14647:
14648: {
14649: my %initial_env =
14650: ("user.name" => $username,
14651: "user.domain" => $domain,
14652: "user.home" => $authhost,
14653: "browser.type" => $clientbrowser,
14654: "browser.version" => $clientversion,
14655: "browser.mathml" => $clientmathml,
14656: "browser.unicode" => $clientunicode,
14657: "browser.os" => $clientos,
1.1137 raeburn 14658: "browser.mobile" => $clientmobile,
1.1141 raeburn 14659: "browser.info" => $clientinfo,
1.1194 raeburn 14660: "browser.osversion" => $clientosversion,
1.462 albertel 14661: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14662: "request.course.fn" => '',
14663: "request.course.uri" => '',
14664: "request.course.sec" => '',
14665: "request.role" => 'cm',
14666: "request.role.adv" => $env{'user.adv'},
14667: "request.host" => $ENV{'REMOTE_ADDR'},);
14668:
14669: if ($form->{'localpath'}) {
14670: $initial_env{"browser.localpath"} = $form->{'localpath'};
14671: $initial_env{"browser.localres"} = $form->{'localres'};
14672: }
14673:
14674: if ($form->{'interface'}) {
14675: $form->{'interface'}=~s/\W//gs;
14676: $initial_env{"browser.interface"} = $form->{'interface'};
14677: $env{'browser.interface'}=$form->{'interface'};
14678: }
14679:
1.1157 raeburn 14680: if ($form->{'iptoken'}) {
14681: my $lonhost = $r->dir_config('lonHostID');
14682: $initial_env{"user.noloadbalance"} = $lonhost;
14683: $env{'user.noloadbalance'} = $lonhost;
14684: }
14685:
1.981 raeburn 14686: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14687: my %domdef;
14688: unless ($domain eq 'public') {
14689: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14690: }
1.980 raeburn 14691:
1.1081 raeburn 14692: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14693: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14694: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14695: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14696: }
14697:
1.1165 raeburn 14698: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14699: $userenv{'canrequest.'.$crstype} =
14700: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14701: 'reload','requestcourses',
14702: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14703: }
14704:
1.1092 raeburn 14705: $userenv{'canrequest.author'} =
14706: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14707: 'reload','requestauthor',
14708: \%userenv,\%domdef,\%is_adv);
14709: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14710: $domain,$username);
14711: my $reqstatus = $reqauthor{'author_status'};
14712: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14713: if (ref($reqauthor{'author'}) eq 'HASH') {
14714: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14715: $reqauthor{'author'}{'timestamp'};
14716: }
14717: }
14718:
1.462 albertel 14719: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14720:
1.462 albertel 14721: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14722: &GDBM_WRCREAT(),0640)) {
14723: &_add_to_env(\%disk_env,\%initial_env);
14724: &_add_to_env(\%disk_env,\%userenv,'environment.');
14725: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14726: if (ref($firstaccenv) eq 'HASH') {
14727: &_add_to_env(\%disk_env,$firstaccenv);
14728: }
14729: if (ref($timerintenv) eq 'HASH') {
14730: &_add_to_env(\%disk_env,$timerintenv);
14731: }
1.463 albertel 14732: if (ref($args->{'extra_env'})) {
14733: &_add_to_env(\%disk_env,$args->{'extra_env'});
14734: }
1.462 albertel 14735: untie(%disk_env);
14736: } else {
1.705 tempelho 14737: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14738: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14739: return 'error: '.$!;
14740: }
14741: }
14742: $env{'request.role'}='cm';
14743: $env{'request.role.adv'}=$env{'user.adv'};
14744: $env{'browser.type'}=$clientbrowser;
14745:
14746: return $cookie;
14747:
14748: }
14749:
14750: sub _add_to_env {
14751: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14752: if (ref($env_data) eq 'HASH') {
14753: while (my ($key,$value) = each(%$env_data)) {
14754: $idf->{$prefix.$key} = $value;
14755: $env{$prefix.$key} = $value;
14756: }
1.462 albertel 14757: }
14758: }
14759:
1.685 tempelho 14760: # --- Get the symbolic name of a problem and the url
14761: sub get_symb {
14762: my ($request,$silent) = @_;
1.726 raeburn 14763: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14764: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14765: if ($symb eq '') {
14766: if (!$silent) {
1.1071 raeburn 14767: if (ref($request)) {
14768: $request->print("Unable to handle ambiguous references:$url:.");
14769: }
1.685 tempelho 14770: return ();
14771: }
14772: }
14773: &Apache::lonenc::check_decrypt(\$symb);
14774: return ($symb);
14775: }
14776:
14777: # --------------------------------------------------------------Get annotation
14778:
14779: sub get_annotation {
14780: my ($symb,$enc) = @_;
14781:
14782: my $key = $symb;
14783: if (!$enc) {
14784: $key =
14785: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14786: }
14787: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14788: return $annotation{$key};
14789: }
14790:
14791: sub clean_symb {
1.731 raeburn 14792: my ($symb,$delete_enc) = @_;
1.685 tempelho 14793:
14794: &Apache::lonenc::check_decrypt(\$symb);
14795: my $enc = $env{'request.enc'};
1.731 raeburn 14796: if ($delete_enc) {
1.730 raeburn 14797: delete($env{'request.enc'});
14798: }
1.685 tempelho 14799:
14800: return ($symb,$enc);
14801: }
1.462 albertel 14802:
1.1181 raeburn 14803: ############################################################
14804: ############################################################
14805:
14806: =pod
14807:
14808: =head1 Routines for building display used to search for courses
14809:
14810:
14811: =over 4
14812:
14813: =item * &build_filters()
14814:
14815: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 14816: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14817: and quotacheck.pl
14818:
1.1181 raeburn 14819:
14820: Inputs:
14821:
14822: filterlist - anonymous array of fields to include as potential filters
14823:
14824: crstype - course type
14825:
14826: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14827: to pop-open a course selector (will contain "extra element").
14828:
14829: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14830:
14831: filter - anonymous hash of criteria and their values
14832:
14833: action - form action
14834:
14835: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14836:
1.1182 raeburn 14837: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 14838:
14839: cloneruname - username of owner of new course who wants to clone
14840:
14841: clonerudom - domain of owner of new course who wants to clone
14842:
14843: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14844:
14845: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14846:
14847: codedom - domain
14848:
14849: formname - value of form element named "form".
14850:
14851: fixeddom - domain, if fixed.
14852:
14853: prevphase - value to assign to form element named "phase" when going back to the previous screen
14854:
14855: cnameelement - name of form element in form on opener page which will receive title of selected course
14856:
14857: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14858:
14859: cdomelement - name of form element in form on opener page which will receive domain of selected course
14860:
14861: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14862:
14863: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14864:
14865: clonewarning - warning message about missing information for intended course owner when DC creates a course
14866:
1.1182 raeburn 14867:
1.1181 raeburn 14868: Returns: $output - HTML for display of search criteria, and hidden form elements.
14869:
1.1182 raeburn 14870:
1.1181 raeburn 14871: Side Effects: None
14872:
14873: =cut
14874:
14875: # ---------------------------------------------- search for courses based on last activity etc.
14876:
14877: sub build_filters {
14878: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14879: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14880: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14881: $cnameelement,$cnumelement,$cdomelement,$setroles,
14882: $clonetext,$clonewarning) = @_;
1.1182 raeburn 14883: my ($list,$jscript);
1.1181 raeburn 14884: my $onchange = 'javascript:updateFilters(this)';
14885: my ($domainselectform,$sincefilterform,$createdfilterform,
14886: $ownerdomselectform,$persondomselectform,$instcodeform,
14887: $typeselectform,$instcodetitle);
14888: if ($formname eq '') {
14889: $formname = $caller;
14890: }
14891: foreach my $item (@{$filterlist}) {
14892: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
14893: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
14894: if ($item eq 'domainfilter') {
14895: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
14896: } elsif ($item eq 'coursefilter') {
14897: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
14898: } elsif ($item eq 'ownerfilter') {
14899: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14900: } elsif ($item eq 'ownerdomfilter') {
14901: $filter->{'ownerdomfilter'} =
14902: &LONCAPA::clean_domain($filter->{$item});
14903: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
14904: 'ownerdomfilter',1);
14905: } elsif ($item eq 'personfilter') {
14906: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14907: } elsif ($item eq 'persondomfilter') {
14908: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
14909: 'persondomfilter',1);
14910: } else {
14911: $filter->{$item} =~ s/\W//g;
14912: }
14913: if (!$filter->{$item}) {
14914: $filter->{$item} = '';
14915: }
14916: }
14917: if ($item eq 'domainfilter') {
14918: my $allow_blank = 1;
14919: if ($formname eq 'portform') {
14920: $allow_blank=0;
14921: } elsif ($formname eq 'studentform') {
14922: $allow_blank=0;
14923: }
14924: if ($fixeddom) {
14925: $domainselectform = '<input type="hidden" name="domainfilter"'.
14926: ' value="'.$codedom.'" />'.
14927: &Apache::lonnet::domain($codedom,'description');
14928: } else {
14929: $domainselectform = &select_dom_form($filter->{$item},
14930: 'domainfilter',
14931: $allow_blank,'',$onchange);
14932: }
14933: } else {
14934: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
14935: }
14936: }
14937:
14938: # last course activity filter and selection
14939: $sincefilterform = &timebased_select_form('sincefilter',$filter);
14940:
14941: # course created filter and selection
14942: if (exists($filter->{'createdfilter'})) {
14943: $createdfilterform = &timebased_select_form('createdfilter',$filter);
14944: }
14945:
14946: my %lt = &Apache::lonlocal::texthash(
14947: 'cac' => "$crstype Activity",
14948: 'ccr' => "$crstype Created",
14949: 'cde' => "$crstype Title",
14950: 'cdo' => "$crstype Domain",
14951: 'ins' => 'Institutional Code',
14952: 'inc' => 'Institutional Categorization',
14953: 'cow' => "$crstype Owner/Co-owner",
14954: 'cop' => "$crstype Personnel Includes",
14955: 'cog' => 'Type',
14956: );
14957:
14958: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
14959: my $typeval = 'Course';
14960: if ($crstype eq 'Community') {
14961: $typeval = 'Community';
14962: }
14963: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
14964: } else {
14965: $typeselectform = '<select name="type" size="1"';
14966: if ($onchange) {
14967: $typeselectform .= ' onchange="'.$onchange.'"';
14968: }
14969: $typeselectform .= '>'."\n";
14970: foreach my $posstype ('Course','Community') {
14971: $typeselectform.='<option value="'.$posstype.'"'.
14972: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
14973: }
14974: $typeselectform.="</select>";
14975: }
14976:
14977: my ($cloneableonlyform,$cloneabletitle);
14978: if (exists($filter->{'cloneableonly'})) {
14979: my $cloneableon = '';
14980: my $cloneableoff = ' checked="checked"';
14981: if ($filter->{'cloneableonly'}) {
14982: $cloneableon = $cloneableoff;
14983: $cloneableoff = '';
14984: }
14985: $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>';
14986: if ($formname eq 'ccrs') {
1.1187 bisitz 14987: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 14988: } else {
14989: $cloneabletitle = &mt('Cloneable by you');
14990: }
14991: }
14992: my $officialjs;
14993: if ($crstype eq 'Course') {
14994: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 14995: # if (($fixeddom) || ($formname eq 'requestcrs') ||
14996: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
14997: if ($codedom) {
1.1181 raeburn 14998: $officialjs = 1;
14999: ($instcodeform,$jscript,$$numtitlesref) =
15000: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15001: $officialjs,$codetitlesref);
15002: if ($jscript) {
1.1182 raeburn 15003: $jscript = '<script type="text/javascript">'."\n".
15004: '// <![CDATA['."\n".
15005: $jscript."\n".
15006: '// ]]>'."\n".
15007: '</script>'."\n";
1.1181 raeburn 15008: }
15009: }
15010: if ($instcodeform eq '') {
15011: $instcodeform =
15012: '<input type="text" name="instcodefilter" size="10" value="'.
15013: $list->{'instcodefilter'}.'" />';
15014: $instcodetitle = $lt{'ins'};
15015: } else {
15016: $instcodetitle = $lt{'inc'};
15017: }
15018: if ($fixeddom) {
15019: $instcodetitle .= '<br />('.$codedom.')';
15020: }
15021: }
15022: }
15023: my $output = qq|
15024: <form method="post" name="filterpicker" action="$action">
15025: <input type="hidden" name="form" value="$formname" />
15026: |;
15027: if ($formname eq 'modifycourse') {
15028: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15029: '<input type="hidden" name="prevphase" value="'.
15030: $prevphase.'" />'."\n";
1.1198 musolffc 15031: } elsif ($formname eq 'quotacheck') {
15032: $output .= qq|
15033: <input type="hidden" name="sortby" value="" />
15034: <input type="hidden" name="sortorder" value="" />
15035: |;
15036: } else {
1.1181 raeburn 15037: my $name_input;
15038: if ($cnameelement ne '') {
15039: $name_input = '<input type="hidden" name="cnameelement" value="'.
15040: $cnameelement.'" />';
15041: }
15042: $output .= qq|
1.1182 raeburn 15043: <input type="hidden" name="cnumelement" value="$cnumelement" />
15044: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15045: $name_input
15046: $roleelement
15047: $multelement
15048: $typeelement
15049: |;
15050: if ($formname eq 'portform') {
15051: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15052: }
15053: }
15054: if ($fixeddom) {
15055: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15056: }
15057: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15058: if ($sincefilterform) {
15059: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15060: .$sincefilterform
15061: .&Apache::lonhtmlcommon::row_closure();
15062: }
15063: if ($createdfilterform) {
15064: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15065: .$createdfilterform
15066: .&Apache::lonhtmlcommon::row_closure();
15067: }
15068: if ($domainselectform) {
15069: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15070: .$domainselectform
15071: .&Apache::lonhtmlcommon::row_closure();
15072: }
15073: if ($typeselectform) {
15074: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15075: $output .= $typeselectform;
15076: } else {
15077: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15078: .$typeselectform
15079: .&Apache::lonhtmlcommon::row_closure();
15080: }
15081: }
15082: if ($instcodeform) {
15083: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15084: .$instcodeform
15085: .&Apache::lonhtmlcommon::row_closure();
15086: }
15087: if (exists($filter->{'ownerfilter'})) {
15088: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15089: '<table><tr><td>'.&mt('Username').'<br />'.
15090: '<input type="text" name="ownerfilter" size="20" value="'.
15091: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15092: $ownerdomselectform.'</td></tr></table>'.
15093: &Apache::lonhtmlcommon::row_closure();
15094: }
15095: if (exists($filter->{'personfilter'})) {
15096: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15097: '<table><tr><td>'.&mt('Username').'<br />'.
15098: '<input type="text" name="personfilter" size="20" value="'.
15099: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15100: $persondomselectform.'</td></tr></table>'.
15101: &Apache::lonhtmlcommon::row_closure();
15102: }
15103: if (exists($filter->{'coursefilter'})) {
15104: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15105: .'<input type="text" name="coursefilter" size="25" value="'
15106: .$list->{'coursefilter'}.'" />'
15107: .&Apache::lonhtmlcommon::row_closure();
15108: }
15109: if ($cloneableonlyform) {
15110: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15111: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15112: }
15113: if (exists($filter->{'descriptfilter'})) {
15114: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15115: .'<input type="text" name="descriptfilter" size="40" value="'
15116: .$list->{'descriptfilter'}.'" />'
15117: .&Apache::lonhtmlcommon::row_closure(1);
15118: }
15119: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15120: '<input type="hidden" name="updater" value="" />'."\n".
15121: '<input type="submit" name="gosearch" value="'.
15122: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15123: return $jscript.$clonewarning.$output;
15124: }
15125:
15126: =pod
15127:
15128: =item * &timebased_select_form()
15129:
1.1182 raeburn 15130: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15131: filter e.g., Course Activity, Course Created, when searching for courses
15132: or communities
15133:
15134: Inputs:
15135:
15136: item - name of form element (sincefilter or createdfilter)
15137:
15138: filter - anonymous hash of criteria and their values
15139:
15140: Returns: HTML for a select box contained a blank, then six time selections,
15141: with value set in incoming form variables currently selected.
15142:
15143: Side Effects: None
15144:
15145: =cut
15146:
15147: sub timebased_select_form {
15148: my ($item,$filter) = @_;
15149: if (ref($filter) eq 'HASH') {
15150: $filter->{$item} =~ s/[^\d-]//g;
15151: if (!$filter->{$item}) { $filter->{$item}=-1; }
15152: return &select_form(
15153: $filter->{$item},
15154: $item,
15155: { '-1' => '',
15156: '86400' => &mt('today'),
15157: '604800' => &mt('last week'),
15158: '2592000' => &mt('last month'),
15159: '7776000' => &mt('last three months'),
15160: '15552000' => &mt('last six months'),
15161: '31104000' => &mt('last year'),
15162: 'select_form_order' =>
15163: ['-1','86400','604800','2592000','7776000',
15164: '15552000','31104000']});
15165: }
15166: }
15167:
15168: =pod
15169:
15170: =item * &js_changer()
15171:
15172: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15173: when course type or domain is changed, and also to hide 'Searching ...' on
15174: page load completion for page showing search result.
1.1181 raeburn 15175:
15176: Inputs: None
15177:
1.1183 raeburn 15178: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15179:
15180: Side Effects: None
15181:
15182: =cut
15183:
15184: sub js_changer {
15185: return <<ENDJS;
15186: <script type="text/javascript">
15187: // <![CDATA[
15188: function updateFilters(caller) {
15189: if (typeof(caller) != "undefined") {
15190: document.filterpicker.updater.value = caller.name;
15191: }
15192: document.filterpicker.submit();
15193: }
1.1183 raeburn 15194:
15195: function hideSearching() {
15196: if (document.getElementById('searching')) {
15197: document.getElementById('searching').style.display = 'none';
15198: }
15199: return;
15200: }
15201:
1.1181 raeburn 15202: // ]]>
15203: </script>
15204:
15205: ENDJS
15206: }
15207:
15208: =pod
15209:
1.1182 raeburn 15210: =item * &search_courses()
15211:
15212: Process selected filters form course search form and pass to lonnet::courseiddump
15213: to retrieve a hash for which keys are courseIDs which match the selected filters.
15214:
15215: Inputs:
15216:
15217: dom - domain being searched
15218:
15219: type - course type ('Course' or 'Community' or '.' if any).
15220:
15221: filter - anonymous hash of criteria and their values
15222:
15223: numtitles - for institutional codes - number of categories
15224:
15225: cloneruname - optional username of new course owner
15226:
15227: clonerudom - optional domain of new course owner
15228:
15229: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15230: (used when DC is using course creation form)
15231:
15232: codetitles - reference to array of titles of components in institutional codes (official courses).
15233:
15234:
15235: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15236:
15237:
15238: Side Effects: None
15239:
15240: =cut
15241:
15242:
15243: sub search_courses {
15244: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15245: my (%courses,%showcourses,$cloner);
15246: if (($filter->{'ownerfilter'} ne '') ||
15247: ($filter->{'ownerdomfilter'} ne '')) {
15248: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15249: $filter->{'ownerdomfilter'};
15250: }
15251: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15252: if (!$filter->{$item}) {
15253: $filter->{$item}='.';
15254: }
15255: }
15256: my $now = time;
15257: my $timefilter =
15258: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15259: my ($createdbefore,$createdafter);
15260: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15261: $createdbefore = $now;
15262: $createdafter = $now-$filter->{'createdfilter'};
15263: }
15264: my ($instcodefilter,$regexpok);
15265: if ($numtitles) {
15266: if ($env{'form.official'} eq 'on') {
15267: $instcodefilter =
15268: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15269: $regexpok = 1;
15270: } elsif ($env{'form.official'} eq 'off') {
15271: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15272: unless ($instcodefilter eq '') {
15273: $regexpok = -1;
15274: }
15275: }
15276: } else {
15277: $instcodefilter = $filter->{'instcodefilter'};
15278: }
15279: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15280: if ($type eq '') { $type = '.'; }
15281:
15282: if (($clonerudom ne '') && ($cloneruname ne '')) {
15283: $cloner = $cloneruname.':'.$clonerudom;
15284: }
15285: %courses = &Apache::lonnet::courseiddump($dom,
15286: $filter->{'descriptfilter'},
15287: $timefilter,
15288: $instcodefilter,
15289: $filter->{'combownerfilter'},
15290: $filter->{'coursefilter'},
15291: undef,undef,$type,$regexpok,undef,undef,
15292: undef,undef,$cloner,$env{'form.cc_clone'},
15293: $filter->{'cloneableonly'},
15294: $createdbefore,$createdafter,undef,
15295: $domcloner);
15296: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15297: my $ccrole;
15298: if ($type eq 'Community') {
15299: $ccrole = 'co';
15300: } else {
15301: $ccrole = 'cc';
15302: }
15303: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15304: $filter->{'persondomfilter'},
15305: 'userroles',undef,
15306: [$ccrole,'in','ad','ep','ta','cr'],
15307: $dom);
15308: foreach my $role (keys(%rolehash)) {
15309: my ($cnum,$cdom,$courserole) = split(':',$role);
15310: my $cid = $cdom.'_'.$cnum;
15311: if (exists($courses{$cid})) {
15312: if (ref($courses{$cid}) eq 'HASH') {
15313: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15314: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15315: push (@{$courses{$cid}{roles}},$courserole);
15316: }
15317: } else {
15318: $courses{$cid}{roles} = [$courserole];
15319: }
15320: $showcourses{$cid} = $courses{$cid};
15321: }
15322: }
15323: }
15324: %courses = %showcourses;
15325: }
15326: return %courses;
15327: }
15328:
15329: =pod
15330:
1.1181 raeburn 15331: =back
15332:
15333: =cut
15334:
15335:
1.1083 raeburn 15336: sub update_content_constraints {
15337: my ($cdom,$cnum,$chome,$cid) = @_;
15338: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15339: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15340: my %checkresponsetypes;
15341: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15342: my ($item,$name,$value) = split(/:/,$key);
15343: if ($item eq 'resourcetag') {
15344: if ($name eq 'responsetype') {
15345: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15346: }
15347: }
15348: }
15349: my $navmap = Apache::lonnavmaps::navmap->new();
15350: if (defined($navmap)) {
15351: my %allresponses;
15352: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15353: my %responses = $res->responseTypes();
15354: foreach my $key (keys(%responses)) {
15355: next unless(exists($checkresponsetypes{$key}));
15356: $allresponses{$key} += $responses{$key};
15357: }
15358: }
15359: foreach my $key (keys(%allresponses)) {
15360: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15361: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15362: ($reqdmajor,$reqdminor) = ($major,$minor);
15363: }
15364: }
15365: undef($navmap);
15366: }
15367: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15368: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15369: }
15370: return;
15371: }
15372:
1.1110 raeburn 15373: sub allmaps_incourse {
15374: my ($cdom,$cnum,$chome,$cid) = @_;
15375: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15376: $cid = $env{'request.course.id'};
15377: $cdom = $env{'course.'.$cid.'.domain'};
15378: $cnum = $env{'course.'.$cid.'.num'};
15379: $chome = $env{'course.'.$cid.'.home'};
15380: }
15381: my %allmaps = ();
15382: my $lastchange =
15383: &Apache::lonnet::get_coursechange($cdom,$cnum);
15384: if ($lastchange > $env{'request.course.tied'}) {
15385: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15386: unless ($ferr) {
15387: &update_content_constraints($cdom,$cnum,$chome,$cid);
15388: }
15389: }
15390: my $navmap = Apache::lonnavmaps::navmap->new();
15391: if (defined($navmap)) {
15392: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15393: $allmaps{$res->src()} = 1;
15394: }
15395: }
15396: return \%allmaps;
15397: }
15398:
1.1083 raeburn 15399: sub parse_supplemental_title {
15400: my ($title) = @_;
15401:
15402: my ($foldertitle,$renametitle);
15403: if ($title =~ /&&&/) {
15404: $title = &HTML::Entites::decode($title);
15405: }
15406: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15407: $renametitle=$4;
15408: my ($time,$uname,$udom) = ($1,$2,$3);
15409: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15410: my $name = &plainname($uname,$udom);
15411: $name = &HTML::Entities::encode($name,'"<>&\'');
15412: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15413: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15414: $name.': <br />'.$foldertitle;
15415: }
15416: if (wantarray) {
15417: return ($title,$foldertitle,$renametitle);
15418: }
15419: return $title;
15420: }
15421:
1.1143 raeburn 15422: sub recurse_supplemental {
15423: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15424: if ($suppmap) {
15425: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15426: if ($fatal) {
15427: $errors ++;
15428: } else {
15429: if ($#LONCAPA::map::resources > 0) {
15430: foreach my $res (@LONCAPA::map::resources) {
15431: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15432: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 15433: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15434: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 15435: } else {
15436: $numfiles ++;
15437: }
15438: }
15439: }
15440: }
15441: }
15442: }
15443: return ($numfiles,$errors);
15444: }
15445:
1.1101 raeburn 15446: sub symb_to_docspath {
15447: my ($symb) = @_;
15448: return unless ($symb);
15449: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15450: if ($resurl=~/\.(sequence|page)$/) {
15451: $mapurl=$resurl;
15452: } elsif ($resurl eq 'adm/navmaps') {
15453: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15454: }
15455: my $mapresobj;
15456: my $navmap = Apache::lonnavmaps::navmap->new();
15457: if (ref($navmap)) {
15458: $mapresobj = $navmap->getResourceByUrl($mapurl);
15459: }
15460: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15461: my $type=$2;
15462: my $path;
15463: if (ref($mapresobj)) {
15464: my $pcslist = $mapresobj->map_hierarchy();
15465: if ($pcslist ne '') {
15466: foreach my $pc (split(/,/,$pcslist)) {
15467: next if ($pc <= 1);
15468: my $res = $navmap->getByMapPc($pc);
15469: if (ref($res)) {
15470: my $thisurl = $res->src();
15471: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15472: my $thistitle = $res->title();
15473: $path .= '&'.
15474: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 15475: &escape($thistitle).
1.1101 raeburn 15476: ':'.$res->randompick().
15477: ':'.$res->randomout().
15478: ':'.$res->encrypted().
15479: ':'.$res->randomorder().
15480: ':'.$res->is_page();
15481: }
15482: }
15483: }
15484: $path =~ s/^\&//;
15485: my $maptitle = $mapresobj->title();
15486: if ($mapurl eq 'default') {
1.1129 raeburn 15487: $maptitle = 'Main Content';
1.1101 raeburn 15488: }
15489: $path .= (($path ne '')? '&' : '').
15490: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15491: &escape($maptitle).
1.1101 raeburn 15492: ':'.$mapresobj->randompick().
15493: ':'.$mapresobj->randomout().
15494: ':'.$mapresobj->encrypted().
15495: ':'.$mapresobj->randomorder().
15496: ':'.$mapresobj->is_page();
15497: } else {
15498: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15499: my $ispage = (($type eq 'page')? 1 : '');
15500: if ($mapurl eq 'default') {
1.1129 raeburn 15501: $maptitle = 'Main Content';
1.1101 raeburn 15502: }
15503: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15504: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 15505: }
15506: unless ($mapurl eq 'default') {
15507: $path = 'default&'.
1.1146 raeburn 15508: &escape('Main Content').
1.1101 raeburn 15509: ':::::&'.$path;
15510: }
15511: return $path;
15512: }
15513:
1.1094 raeburn 15514: sub captcha_display {
15515: my ($context,$lonhost) = @_;
15516: my ($output,$error);
15517: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15518: if ($captcha eq 'original') {
1.1094 raeburn 15519: $output = &create_captcha();
15520: unless ($output) {
1.1172 raeburn 15521: $error = 'captcha';
1.1094 raeburn 15522: }
15523: } elsif ($captcha eq 'recaptcha') {
15524: $output = &create_recaptcha($pubkey);
15525: unless ($output) {
1.1172 raeburn 15526: $error = 'recaptcha';
1.1094 raeburn 15527: }
15528: }
1.1176 raeburn 15529: return ($output,$error,$captcha);
1.1094 raeburn 15530: }
15531:
15532: sub captcha_response {
15533: my ($context,$lonhost) = @_;
15534: my ($captcha_chk,$captcha_error);
15535: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15536: if ($captcha eq 'original') {
1.1094 raeburn 15537: ($captcha_chk,$captcha_error) = &check_captcha();
15538: } elsif ($captcha eq 'recaptcha') {
15539: $captcha_chk = &check_recaptcha($privkey);
15540: } else {
15541: $captcha_chk = 1;
15542: }
15543: return ($captcha_chk,$captcha_error);
15544: }
15545:
15546: sub get_captcha_config {
15547: my ($context,$lonhost) = @_;
1.1095 raeburn 15548: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 15549: my $hostname = &Apache::lonnet::hostname($lonhost);
15550: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15551: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 15552: if ($context eq 'usercreation') {
15553: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15554: if (ref($domconfig{$context}) eq 'HASH') {
15555: $hashtocheck = $domconfig{$context}{'cancreate'};
15556: if (ref($hashtocheck) eq 'HASH') {
15557: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15558: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15559: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15560: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15561: }
15562: if ($privkey && $pubkey) {
15563: $captcha = 'recaptcha';
15564: } else {
15565: $captcha = 'original';
15566: }
15567: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15568: $captcha = 'original';
15569: }
1.1094 raeburn 15570: }
1.1095 raeburn 15571: } else {
15572: $captcha = 'captcha';
15573: }
15574: } elsif ($context eq 'login') {
15575: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15576: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15577: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15578: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 15579: if ($privkey && $pubkey) {
15580: $captcha = 'recaptcha';
1.1095 raeburn 15581: } else {
15582: $captcha = 'original';
1.1094 raeburn 15583: }
1.1095 raeburn 15584: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15585: $captcha = 'original';
1.1094 raeburn 15586: }
15587: }
15588: return ($captcha,$pubkey,$privkey);
15589: }
15590:
15591: sub create_captcha {
15592: my %captcha_params = &captcha_settings();
15593: my ($output,$maxtries,$tries) = ('',10,0);
15594: while ($tries < $maxtries) {
15595: $tries ++;
15596: my $captcha = Authen::Captcha->new (
15597: output_folder => $captcha_params{'output_dir'},
15598: data_folder => $captcha_params{'db_dir'},
15599: );
15600: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15601:
15602: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15603: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15604: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 15605: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15606: '<br />'.
15607: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 15608: last;
15609: }
15610: }
15611: return $output;
15612: }
15613:
15614: sub captcha_settings {
15615: my %captcha_params = (
15616: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15617: www_output_dir => "/captchaspool",
15618: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15619: numchars => '5',
15620: );
15621: return %captcha_params;
15622: }
15623:
15624: sub check_captcha {
15625: my ($captcha_chk,$captcha_error);
15626: my $code = $env{'form.code'};
15627: my $md5sum = $env{'form.crypt'};
15628: my %captcha_params = &captcha_settings();
15629: my $captcha = Authen::Captcha->new(
15630: output_folder => $captcha_params{'output_dir'},
15631: data_folder => $captcha_params{'db_dir'},
15632: );
1.1109 raeburn 15633: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 15634: my %captcha_hash = (
15635: 0 => 'Code not checked (file error)',
15636: -1 => 'Failed: code expired',
15637: -2 => 'Failed: invalid code (not in database)',
15638: -3 => 'Failed: invalid code (code does not match crypt)',
15639: );
15640: if ($captcha_chk != 1) {
15641: $captcha_error = $captcha_hash{$captcha_chk}
15642: }
15643: return ($captcha_chk,$captcha_error);
15644: }
15645:
15646: sub create_recaptcha {
15647: my ($pubkey) = @_;
1.1153 raeburn 15648: my $use_ssl;
15649: if ($ENV{'SERVER_PORT'} == 443) {
15650: $use_ssl = 1;
15651: }
1.1094 raeburn 15652: my $captcha = Captcha::reCAPTCHA->new;
15653: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 15654: $captcha->get_html($pubkey,undef,$use_ssl).
1.1094 raeburn 15655: &mt('If either word is hard to read, [_1] will replace them.',
1.1133 raeburn 15656: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 15657: '<br /><br />';
15658: }
15659:
15660: sub check_recaptcha {
15661: my ($privkey) = @_;
15662: my $captcha_chk;
15663: my $captcha = Captcha::reCAPTCHA->new;
15664: my $captcha_result =
15665: $captcha->check_answer(
15666: $privkey,
15667: $ENV{'REMOTE_ADDR'},
15668: $env{'form.recaptcha_challenge_field'},
15669: $env{'form.recaptcha_response_field'},
15670: );
15671: if ($captcha_result->{is_valid}) {
15672: $captcha_chk = 1;
15673: }
15674: return $captcha_chk;
15675: }
15676:
1.1174 raeburn 15677: sub emailusername_info {
1.1177 raeburn 15678: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 15679: my %titles = &Apache::lonlocal::texthash (
15680: lastname => 'Last Name',
15681: firstname => 'First Name',
15682: institution => 'School/college/university',
15683: location => "School's city, state/province, country",
15684: web => "School's web address",
15685: officialemail => 'E-mail address at institution (if different)',
15686: );
15687: return (\@fields,\%titles);
15688: }
15689:
1.1161 raeburn 15690: sub cleanup_html {
15691: my ($incoming) = @_;
15692: my $outgoing;
15693: if ($incoming ne '') {
15694: $outgoing = $incoming;
15695: $outgoing =~ s/;/;/g;
15696: $outgoing =~ s/\#/#/g;
15697: $outgoing =~ s/\&/&/g;
15698: $outgoing =~ s/</</g;
15699: $outgoing =~ s/>/>/g;
15700: $outgoing =~ s/\(/(/g;
15701: $outgoing =~ s/\)/)/g;
15702: $outgoing =~ s/"/"/g;
15703: $outgoing =~ s/'/'/g;
15704: $outgoing =~ s/\$/$/g;
15705: $outgoing =~ s{/}{/}g;
15706: $outgoing =~ s/=/=/g;
15707: $outgoing =~ s/\\/\/g
15708: }
15709: return $outgoing;
15710: }
15711:
1.1190 musolffc 15712: # Checks for critical messages and returns a redirect url if one exists.
15713: # $interval indicates how often to check for messages.
15714: sub critical_redirect {
15715: my ($interval) = @_;
15716: if ((time-$env{'user.criticalcheck.time'})>$interval) {
15717: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
15718: $env{'user.name'});
15719: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 15720: my $redirecturl;
1.1190 musolffc 15721: if ($what[0]) {
15722: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
15723: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 15724: my $url=&Apache::lonnet::absolute_url().$redirecturl;
15725: return (1, $url);
1.1190 musolffc 15726: }
1.1191 raeburn 15727: }
15728: }
15729: return ();
1.1190 musolffc 15730: }
15731:
1.1174 raeburn 15732: # Use:
15733: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
15734: #
15735: ##################################################
15736: # password associated functions #
15737: ##################################################
15738: sub des_keys {
15739: # Make a new key for DES encryption.
15740: # Each key has two parts which are returned separately.
15741: # Please note: Each key must be passed through the &hex function
15742: # before it is output to the web browser. The hex versions cannot
15743: # be used to decrypt.
15744: my @hexstr=('0','1','2','3','4','5','6','7',
15745: '8','9','a','b','c','d','e','f');
15746: my $lkey='';
15747: for (0..7) {
15748: $lkey.=$hexstr[rand(15)];
15749: }
15750: my $ukey='';
15751: for (0..7) {
15752: $ukey.=$hexstr[rand(15)];
15753: }
15754: return ($lkey,$ukey);
15755: }
15756:
15757: sub des_decrypt {
15758: my ($key,$cyphertext) = @_;
15759: my $keybin=pack("H16",$key);
15760: my $cypher;
15761: if ($Crypt::DES::VERSION>=2.03) {
15762: $cypher=new Crypt::DES $keybin;
15763: } else {
15764: $cypher=new DES $keybin;
15765: }
15766: my $plaintext=
15767: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
15768: $plaintext.=
15769: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
15770: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
15771: return $plaintext;
15772: }
15773:
1.112 bowersj2 15774: 1;
15775: __END__;
1.41 ng 15776:
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