Annotation of loncom/interface/loncommon.pm, revision 1.1204
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1204 ! raeburn 4: # $Id: loncommon.pm,v 1.1203 2014/12/20 15:35:40 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 {
1.1201 raeburn 4742: my ($acc,$clientip)=@_;
1.682 raeburn 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;
1.1201 raeburn 4748: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682 raeburn 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.1203 raeburn 7736: title = title.replace("'","\\\'");
1.1034 www 7737: if (!path) {
7738: path = location.pathname;
7739: }
1.1175 raeburn 7740: path = encodeURIComponent(path);
1.1203 raeburn 7741: path = path.replace("'","\\\'");
1.1034 www 7742: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7743: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7744: }
7745: // END LON-CAPA Internal -->
7746: // ]]>
7747: </script>
7748: ENDWISHLIST
7749: }
7750:
1.1030 www 7751: sub modal_window {
7752: return(<<'ENDMODAL');
1.1046 raeburn 7753: <script type="text/javascript">
1.1030 www 7754: // <![CDATA[
7755: // <!-- BEGIN LON-CAPA Internal
7756: var modalWindow = {
7757: parent:"body",
7758: windowId:null,
7759: content:null,
7760: width:null,
7761: height:null,
7762: close:function()
7763: {
7764: $(".LCmodal-window").remove();
7765: $(".LCmodal-overlay").remove();
7766: },
7767: open:function()
7768: {
7769: var modal = "";
7770: modal += "<div class=\"LCmodal-overlay\"></div>";
7771: 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;\">";
7772: modal += this.content;
7773: modal += "</div>";
7774:
7775: $(this.parent).append(modal);
7776:
7777: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7778: $(".LCclose-window").click(function(){modalWindow.close();});
7779: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7780: }
7781: };
1.1140 raeburn 7782: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7783: {
1.1203 raeburn 7784: source = source.replace("'","'");
1.1030 www 7785: modalWindow.windowId = "myModal";
7786: modalWindow.width = width;
7787: modalWindow.height = height;
1.1196 raeburn 7788: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7789: modalWindow.open();
7790: };
7791: // END LON-CAPA Internal -->
7792: // ]]>
7793: </script>
7794: ENDMODAL
7795: }
7796:
7797: sub modal_link {
1.1140 raeburn 7798: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7799: unless ($width) { $width=480; }
7800: unless ($height) { $height=400; }
1.1031 www 7801: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 7802: unless ($transparency) { $transparency='true'; }
7803:
1.1074 raeburn 7804: my $target_attr;
7805: if (defined($target)) {
7806: $target_attr = 'target="'.$target.'"';
7807: }
7808: return <<"ENDLINK";
1.1140 raeburn 7809: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7810: $linktext</a>
7811: ENDLINK
1.1030 www 7812: }
7813:
1.1032 www 7814: sub modal_adhoc_script {
7815: my ($funcname,$width,$height,$content)=@_;
7816: return (<<ENDADHOC);
1.1046 raeburn 7817: <script type="text/javascript">
1.1032 www 7818: // <![CDATA[
7819: var $funcname = function()
7820: {
7821: modalWindow.windowId = "myModal";
7822: modalWindow.width = $width;
7823: modalWindow.height = $height;
7824: modalWindow.content = '$content';
7825: modalWindow.open();
7826: };
7827: // ]]>
7828: </script>
7829: ENDADHOC
7830: }
7831:
1.1041 www 7832: sub modal_adhoc_inner {
7833: my ($funcname,$width,$height,$content)=@_;
7834: my $innerwidth=$width-20;
7835: $content=&js_ready(
1.1140 raeburn 7836: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
7837: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7838: $content.
1.1041 www 7839: &end_scrollbox().
1.1140 raeburn 7840: &end_page()
1.1041 www 7841: );
7842: return &modal_adhoc_script($funcname,$width,$height,$content);
7843: }
7844:
7845: sub modal_adhoc_window {
7846: my ($funcname,$width,$height,$content,$linktext)=@_;
7847: return &modal_adhoc_inner($funcname,$width,$height,$content).
7848: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7849: }
7850:
7851: sub modal_adhoc_launch {
7852: my ($funcname,$width,$height,$content)=@_;
7853: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7854: <script type="text/javascript">
7855: // <![CDATA[
7856: $funcname();
7857: // ]]>
7858: </script>
7859: ENDLAUNCH
7860: }
7861:
7862: sub modal_adhoc_close {
7863: return (<<ENDCLOSE);
7864: <script type="text/javascript">
7865: // <![CDATA[
7866: modalWindow.close();
7867: // ]]>
7868: </script>
7869: ENDCLOSE
7870: }
7871:
1.1038 www 7872: sub togglebox_script {
7873: return(<<ENDTOGGLE);
7874: <script type="text/javascript">
7875: // <![CDATA[
7876: function LCtoggleDisplay(id,hidetext,showtext) {
7877: link = document.getElementById(id + "link").childNodes[0];
7878: with (document.getElementById(id).style) {
7879: if (display == "none" ) {
7880: display = "inline";
7881: link.nodeValue = hidetext;
7882: } else {
7883: display = "none";
7884: link.nodeValue = showtext;
7885: }
7886: }
7887: }
7888: // ]]>
7889: </script>
7890: ENDTOGGLE
7891: }
7892:
1.1039 www 7893: sub start_togglebox {
7894: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7895: unless ($heading) { $heading=''; } else { $heading.=' '; }
7896: unless ($showtext) { $showtext=&mt('show'); }
7897: unless ($hidetext) { $hidetext=&mt('hide'); }
7898: unless ($headerbg) { $headerbg='#FFFFFF'; }
7899: return &start_data_table().
7900: &start_data_table_header_row().
7901: '<td bgcolor="'.$headerbg.'">'.$heading.
7902: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7903: $showtext.'\')">'.$showtext.'</a>]</td>'.
7904: &end_data_table_header_row().
7905: '<tr id="'.$id.'" style="display:none""><td>';
7906: }
7907:
7908: sub end_togglebox {
7909: return '</td></tr>'.&end_data_table();
7910: }
7911:
1.1041 www 7912: sub LCprogressbar_script {
1.1045 www 7913: my ($id)=@_;
1.1041 www 7914: return(<<ENDPROGRESS);
7915: <script type="text/javascript">
7916: // <![CDATA[
1.1045 www 7917: \$('#progressbar$id').progressbar({
1.1041 www 7918: value: 0,
7919: change: function(event, ui) {
7920: var newVal = \$(this).progressbar('option', 'value');
7921: \$('.pblabel', this).text(LCprogressTxt);
7922: }
7923: });
7924: // ]]>
7925: </script>
7926: ENDPROGRESS
7927: }
7928:
7929: sub LCprogressbarUpdate_script {
7930: return(<<ENDPROGRESSUPDATE);
7931: <style type="text/css">
7932: .ui-progressbar { position:relative; }
7933: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7934: </style>
7935: <script type="text/javascript">
7936: // <![CDATA[
1.1045 www 7937: var LCprogressTxt='---';
7938:
7939: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7940: LCprogressTxt=progresstext;
1.1045 www 7941: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7942: }
7943: // ]]>
7944: </script>
7945: ENDPROGRESSUPDATE
7946: }
7947:
1.1042 www 7948: my $LClastpercent;
1.1045 www 7949: my $LCidcnt;
7950: my $LCcurrentid;
1.1042 www 7951:
1.1041 www 7952: sub LCprogressbar {
1.1042 www 7953: my ($r)=(@_);
7954: $LClastpercent=0;
1.1045 www 7955: $LCidcnt++;
7956: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7957: my $starting=&mt('Starting');
7958: my $content=(<<ENDPROGBAR);
1.1045 www 7959: <div id="progressbar$LCcurrentid">
1.1041 www 7960: <span class="pblabel">$starting</span>
7961: </div>
7962: ENDPROGBAR
1.1045 www 7963: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7964: }
7965:
7966: sub LCprogressbarUpdate {
1.1042 www 7967: my ($r,$val,$text)=@_;
7968: unless ($val) {
7969: if ($LClastpercent) {
7970: $val=$LClastpercent;
7971: } else {
7972: $val=0;
7973: }
7974: }
1.1041 www 7975: if ($val<0) { $val=0; }
7976: if ($val>100) { $val=0; }
1.1042 www 7977: $LClastpercent=$val;
1.1041 www 7978: unless ($text) { $text=$val.'%'; }
7979: $text=&js_ready($text);
1.1044 www 7980: &r_print($r,<<ENDUPDATE);
1.1041 www 7981: <script type="text/javascript">
7982: // <![CDATA[
1.1045 www 7983: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7984: // ]]>
7985: </script>
7986: ENDUPDATE
1.1035 www 7987: }
7988:
1.1042 www 7989: sub LCprogressbarClose {
7990: my ($r)=@_;
7991: $LClastpercent=0;
1.1044 www 7992: &r_print($r,<<ENDCLOSE);
1.1042 www 7993: <script type="text/javascript">
7994: // <![CDATA[
1.1045 www 7995: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7996: // ]]>
7997: </script>
7998: ENDCLOSE
1.1044 www 7999: }
8000:
8001: sub r_print {
8002: my ($r,$to_print)=@_;
8003: if ($r) {
8004: $r->print($to_print);
8005: $r->rflush();
8006: } else {
8007: print($to_print);
8008: }
1.1042 www 8009: }
8010:
1.320 albertel 8011: sub html_encode {
8012: my ($result) = @_;
8013:
1.322 albertel 8014: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8015:
8016: return $result;
8017: }
1.1044 www 8018:
1.317 albertel 8019: sub js_ready {
8020: my ($result) = @_;
8021:
1.323 albertel 8022: $result =~ s/[\n\r]/ /xmsg;
8023: $result =~ s/\\/\\\\/xmsg;
8024: $result =~ s/'/\\'/xmsg;
1.372 albertel 8025: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8026:
8027: return $result;
8028: }
8029:
1.315 albertel 8030: sub validate_page {
8031: if ( exists($env{'internal.start_page'})
1.316 albertel 8032: && $env{'internal.start_page'} > 1) {
8033: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8034: $env{'internal.start_page'}.' '.
1.316 albertel 8035: $ENV{'request.filename'});
1.315 albertel 8036: }
8037: if ( exists($env{'internal.end_page'})
1.316 albertel 8038: && $env{'internal.end_page'} > 1) {
8039: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8040: $env{'internal.end_page'}.' '.
1.316 albertel 8041: $env{'request.filename'});
1.315 albertel 8042: }
8043: if ( exists($env{'internal.start_page'})
8044: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8045: &Apache::lonnet::logthis('start_page called without end_page '.
8046: $env{'request.filename'});
1.315 albertel 8047: }
8048: if ( ! exists($env{'internal.start_page'})
8049: && exists($env{'internal.end_page'})) {
1.316 albertel 8050: &Apache::lonnet::logthis('end_page called without start_page'.
8051: $env{'request.filename'});
1.315 albertel 8052: }
1.306 albertel 8053: }
1.315 albertel 8054:
1.996 www 8055:
8056: sub start_scrollbox {
1.1140 raeburn 8057: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8058: unless ($outerwidth) { $outerwidth='520px'; }
8059: unless ($width) { $width='500px'; }
8060: unless ($height) { $height='200px'; }
1.1075 raeburn 8061: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8062: if ($id ne '') {
1.1140 raeburn 8063: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8064: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8065: }
1.1075 raeburn 8066: if ($bgcolor ne '') {
8067: $tdcol = "background-color: $bgcolor;";
8068: }
1.1137 raeburn 8069: my $nicescroll_js;
8070: if ($env{'browser.mobile'}) {
1.1140 raeburn 8071: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8072: }
8073: return <<"END";
8074: $nicescroll_js
8075:
8076: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8077: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8078: END
8079: }
8080:
8081: sub end_scrollbox {
8082: return '</div></td></tr></table>';
8083: }
8084:
8085: sub nicescroll_javascript {
8086: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8087: my %options;
8088: if (ref($cursor) eq 'HASH') {
8089: %options = %{$cursor};
8090: }
8091: unless ($options{'railalign'} =~ /^left|right$/) {
8092: $options{'railalign'} = 'left';
8093: }
8094: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8095: my $function = &get_users_function();
8096: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8097: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8098: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8099: }
1.1140 raeburn 8100: }
8101: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8102: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8103: $options{'cursoropacity'}='1.0';
8104: }
1.1140 raeburn 8105: } else {
8106: $options{'cursoropacity'}='1.0';
8107: }
8108: if ($options{'cursorfixedheight'} eq 'none') {
8109: delete($options{'cursorfixedheight'});
8110: } else {
8111: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8112: }
8113: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8114: delete($options{'railoffset'});
8115: }
8116: my @niceoptions;
8117: while (my($key,$value) = each(%options)) {
8118: if ($value =~ /^\{.+\}$/) {
8119: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8120: } else {
1.1140 raeburn 8121: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8122: }
1.1140 raeburn 8123: }
8124: my $nicescroll_js = '
1.1137 raeburn 8125: $(document).ready(
1.1140 raeburn 8126: function() {
8127: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8128: }
1.1137 raeburn 8129: );
8130: ';
1.1140 raeburn 8131: if ($framecheck) {
8132: $nicescroll_js .= '
8133: function expand_div(caller) {
8134: if (top === self) {
8135: document.getElementById("'.$id.'").style.width = "auto";
8136: document.getElementById("'.$id.'").style.height = "auto";
8137: } else {
8138: try {
8139: if (parent.frames) {
8140: if (parent.frames.length > 1) {
8141: var framesrc = parent.frames[1].location.href;
8142: var currsrc = framesrc.replace(/\#.*$/,"");
8143: if ((caller == "search") || (currsrc == "'.$location.'")) {
8144: document.getElementById("'.$id.'").style.width = "auto";
8145: document.getElementById("'.$id.'").style.height = "auto";
8146: }
8147: }
8148: }
8149: } catch (e) {
8150: return;
8151: }
1.1137 raeburn 8152: }
1.1140 raeburn 8153: return;
1.996 www 8154: }
1.1140 raeburn 8155: ';
8156: }
8157: if ($needjsready) {
8158: $nicescroll_js = '
8159: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8160: } else {
8161: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8162: }
8163: return $nicescroll_js;
1.996 www 8164: }
8165:
1.318 albertel 8166: sub simple_error_page {
1.1150 bisitz 8167: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8168: if (ref($args) eq 'HASH') {
8169: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8170: } else {
8171: $msg = &mt($msg);
8172: }
1.1150 bisitz 8173:
1.318 albertel 8174: my $page =
8175: &Apache::loncommon::start_page($title).
1.1150 bisitz 8176: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8177: &Apache::loncommon::end_page();
8178: if (ref($r)) {
8179: $r->print($page);
1.327 albertel 8180: return;
1.318 albertel 8181: }
8182: return $page;
8183: }
1.347 albertel 8184:
8185: {
1.610 albertel 8186: my @row_count;
1.961 onken 8187:
8188: sub start_data_table_count {
8189: unshift(@row_count, 0);
8190: return;
8191: }
8192:
8193: sub end_data_table_count {
8194: shift(@row_count);
8195: return;
8196: }
8197:
1.347 albertel 8198: sub start_data_table {
1.1018 raeburn 8199: my ($add_class,$id) = @_;
1.422 albertel 8200: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8201: my $table_id;
8202: if (defined($id)) {
8203: $table_id = ' id="'.$id.'"';
8204: }
1.961 onken 8205: &start_data_table_count();
1.1018 raeburn 8206: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8207: }
8208:
8209: sub end_data_table {
1.961 onken 8210: &end_data_table_count();
1.389 albertel 8211: return '</table>'."\n";;
1.347 albertel 8212: }
8213:
8214: sub start_data_table_row {
1.974 wenzelju 8215: my ($add_class, $id) = @_;
1.610 albertel 8216: $row_count[0]++;
8217: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8218: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8219: $id = (' id="'.$id.'"') unless ($id eq '');
8220: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8221: }
1.471 banghart 8222:
8223: sub continue_data_table_row {
1.974 wenzelju 8224: my ($add_class, $id) = @_;
1.610 albertel 8225: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8226: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8227: $id = (' id="'.$id.'"') unless ($id eq '');
8228: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8229: }
1.347 albertel 8230:
8231: sub end_data_table_row {
1.389 albertel 8232: return '</tr>'."\n";;
1.347 albertel 8233: }
1.367 www 8234:
1.421 albertel 8235: sub start_data_table_empty_row {
1.707 bisitz 8236: # $row_count[0]++;
1.421 albertel 8237: return '<tr class="LC_empty_row" >'."\n";;
8238: }
8239:
8240: sub end_data_table_empty_row {
8241: return '</tr>'."\n";;
8242: }
8243:
1.367 www 8244: sub start_data_table_header_row {
1.389 albertel 8245: return '<tr class="LC_header_row">'."\n";;
1.367 www 8246: }
8247:
8248: sub end_data_table_header_row {
1.389 albertel 8249: return '</tr>'."\n";;
1.367 www 8250: }
1.890 droeschl 8251:
8252: sub data_table_caption {
8253: my $caption = shift;
8254: return "<caption class=\"LC_caption\">$caption</caption>";
8255: }
1.347 albertel 8256: }
8257:
1.548 albertel 8258: =pod
8259:
8260: =item * &inhibit_menu_check($arg)
8261:
8262: Checks for a inhibitmenu state and generates output to preserve it
8263:
8264: Inputs: $arg - can be any of
8265: - undef - in which case the return value is a string
8266: to add into arguments list of a uri
8267: - 'input' - in which case the return value is a HTML
8268: <form> <input> field of type hidden to
8269: preserve the value
8270: - a url - in which case the return value is the url with
8271: the neccesary cgi args added to preserve the
8272: inhibitmenu state
8273: - a ref to a url - no return value, but the string is
8274: updated to include the neccessary cgi
8275: args to preserve the inhibitmenu state
8276:
8277: =cut
8278:
8279: sub inhibit_menu_check {
8280: my ($arg) = @_;
8281: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8282: if ($arg eq 'input') {
8283: if ($env{'form.inhibitmenu'}) {
8284: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8285: } else {
8286: return
8287: }
8288: }
8289: if ($env{'form.inhibitmenu'}) {
8290: if (ref($arg)) {
8291: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8292: } elsif ($arg eq '') {
8293: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8294: } else {
8295: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8296: }
8297: }
8298: if (!ref($arg)) {
8299: return $arg;
8300: }
8301: }
8302:
1.251 albertel 8303: ###############################################
1.182 matthew 8304:
8305: =pod
8306:
1.549 albertel 8307: =back
8308:
8309: =head1 User Information Routines
8310:
8311: =over 4
8312:
1.405 albertel 8313: =item * &get_users_function()
1.182 matthew 8314:
8315: Used by &bodytag to determine the current users primary role.
8316: Returns either 'student','coordinator','admin', or 'author'.
8317:
8318: =cut
8319:
8320: ###############################################
8321: sub get_users_function {
1.815 tempelho 8322: my $function = 'norole';
1.818 tempelho 8323: if ($env{'request.role'}=~/^(st)/) {
8324: $function='student';
8325: }
1.907 raeburn 8326: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8327: $function='coordinator';
8328: }
1.258 albertel 8329: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8330: $function='admin';
8331: }
1.826 bisitz 8332: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8333: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8334: $function='author';
8335: }
8336: return $function;
1.54 www 8337: }
1.99 www 8338:
8339: ###############################################
8340:
1.233 raeburn 8341: =pod
8342:
1.821 raeburn 8343: =item * &show_course()
8344:
8345: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8346: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8347:
8348: Inputs:
8349: None
8350:
8351: Outputs:
8352: Scalar: 1 if 'Course' to be used, 0 otherwise.
8353:
8354: =cut
8355:
8356: ###############################################
8357: sub show_course {
8358: my $course = !$env{'user.adv'};
8359: if (!$env{'user.adv'}) {
8360: foreach my $env (keys(%env)) {
8361: next if ($env !~ m/^user\.priv\./);
8362: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8363: $course = 0;
8364: last;
8365: }
8366: }
8367: }
8368: return $course;
8369: }
8370:
8371: ###############################################
8372:
8373: =pod
8374:
1.542 raeburn 8375: =item * &check_user_status()
1.274 raeburn 8376:
8377: Determines current status of supplied role for a
8378: specific user. Roles can be active, previous or future.
8379:
8380: Inputs:
8381: user's domain, user's username, course's domain,
1.375 raeburn 8382: course's number, optional section ID.
1.274 raeburn 8383:
8384: Outputs:
8385: role status: active, previous or future.
8386:
8387: =cut
8388:
8389: sub check_user_status {
1.412 raeburn 8390: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8391: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 8392: my @uroles = keys(%userinfo);
1.274 raeburn 8393: my $srchstr;
8394: my $active_chk = 'none';
1.412 raeburn 8395: my $now = time;
1.274 raeburn 8396: if (@uroles > 0) {
1.908 raeburn 8397: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8398: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8399: } else {
1.412 raeburn 8400: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8401: }
8402: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8403: my $role_end = 0;
8404: my $role_start = 0;
8405: $active_chk = 'active';
1.412 raeburn 8406: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8407: $role_end = $1;
8408: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8409: $role_start = $1;
1.274 raeburn 8410: }
8411: }
8412: if ($role_start > 0) {
1.412 raeburn 8413: if ($now < $role_start) {
1.274 raeburn 8414: $active_chk = 'future';
8415: }
8416: }
8417: if ($role_end > 0) {
1.412 raeburn 8418: if ($now > $role_end) {
1.274 raeburn 8419: $active_chk = 'previous';
8420: }
8421: }
8422: }
8423: }
8424: return $active_chk;
8425: }
8426:
8427: ###############################################
8428:
8429: =pod
8430:
1.405 albertel 8431: =item * &get_sections()
1.233 raeburn 8432:
8433: Determines all the sections for a course including
8434: sections with students and sections containing other roles.
1.419 raeburn 8435: Incoming parameters:
8436:
8437: 1. domain
8438: 2. course number
8439: 3. reference to array containing roles for which sections should
8440: be gathered (optional).
8441: 4. reference to array containing status types for which sections
8442: should be gathered (optional).
8443:
8444: If the third argument is undefined, sections are gathered for any role.
8445: If the fourth argument is undefined, sections are gathered for any status.
8446: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8447:
1.374 raeburn 8448: Returns section hash (keys are section IDs, values are
8449: number of users in each section), subject to the
1.419 raeburn 8450: optional roles filter, optional status filter
1.233 raeburn 8451:
8452: =cut
8453:
8454: ###############################################
8455: sub get_sections {
1.419 raeburn 8456: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8457: if (!defined($cdom) || !defined($cnum)) {
8458: my $cid = $env{'request.course.id'};
8459:
8460: return if (!defined($cid));
8461:
8462: $cdom = $env{'course.'.$cid.'.domain'};
8463: $cnum = $env{'course.'.$cid.'.num'};
8464: }
8465:
8466: my %sectioncount;
1.419 raeburn 8467: my $now = time;
1.240 albertel 8468:
1.1118 raeburn 8469: my $check_students = 1;
8470: my $only_students = 0;
8471: if (ref($possible_roles) eq 'ARRAY') {
8472: if (grep(/^st$/,@{$possible_roles})) {
8473: if (@{$possible_roles} == 1) {
8474: $only_students = 1;
8475: }
8476: } else {
8477: $check_students = 0;
8478: }
8479: }
8480:
8481: if ($check_students) {
1.276 albertel 8482: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8483: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8484: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8485: my $start_index = &Apache::loncoursedata::CL_START();
8486: my $end_index = &Apache::loncoursedata::CL_END();
8487: my $status;
1.366 albertel 8488: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8489: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8490: $data->[$status_index],
8491: $data->[$start_index],
8492: $data->[$end_index]);
8493: if ($stu_status eq 'Active') {
8494: $status = 'active';
8495: } elsif ($end < $now) {
8496: $status = 'previous';
8497: } elsif ($start > $now) {
8498: $status = 'future';
8499: }
8500: if ($section ne '-1' && $section !~ /^\s*$/) {
8501: if ((!defined($possible_status)) || (($status ne '') &&
8502: (grep/^\Q$status\E$/,@{$possible_status}))) {
8503: $sectioncount{$section}++;
8504: }
1.240 albertel 8505: }
8506: }
8507: }
1.1118 raeburn 8508: if ($only_students) {
8509: return %sectioncount;
8510: }
1.240 albertel 8511: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8512: foreach my $user (sort(keys(%courseroles))) {
8513: if ($user !~ /^(\w{2})/) { next; }
8514: my ($role) = ($user =~ /^(\w{2})/);
8515: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8516: my ($section,$status);
1.240 albertel 8517: if ($role eq 'cr' &&
8518: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8519: $section=$1;
8520: }
8521: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8522: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8523: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8524: if ($end == -1 && $start == -1) {
8525: next; #deleted role
8526: }
8527: if (!defined($possible_status)) {
8528: $sectioncount{$section}++;
8529: } else {
8530: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8531: $status = 'active';
8532: } elsif ($end < $now) {
8533: $status = 'future';
8534: } elsif ($start > $now) {
8535: $status = 'previous';
8536: }
8537: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8538: $sectioncount{$section}++;
8539: }
8540: }
1.233 raeburn 8541: }
1.366 albertel 8542: return %sectioncount;
1.233 raeburn 8543: }
8544:
1.274 raeburn 8545: ###############################################
1.294 raeburn 8546:
8547: =pod
1.405 albertel 8548:
8549: =item * &get_course_users()
8550:
1.275 raeburn 8551: Retrieves usernames:domains for users in the specified course
8552: with specific role(s), and access status.
8553:
8554: Incoming parameters:
1.277 albertel 8555: 1. course domain
8556: 2. course number
8557: 3. access status: users must have - either active,
1.275 raeburn 8558: previous, future, or all.
1.277 albertel 8559: 4. reference to array of permissible roles
1.288 raeburn 8560: 5. reference to array of section restrictions (optional)
8561: 6. reference to results object (hash of hashes).
8562: 7. reference to optional userdata hash
1.609 raeburn 8563: 8. reference to optional statushash
1.630 raeburn 8564: 9. flag if privileged users (except those set to unhide in
8565: course settings) should be excluded
1.609 raeburn 8566: Keys of top level results hash are roles.
1.275 raeburn 8567: Keys of inner hashes are username:domain, with
8568: values set to access type.
1.288 raeburn 8569: Optional userdata hash returns an array with arguments in the
8570: same order as loncoursedata::get_classlist() for student data.
8571:
1.609 raeburn 8572: Optional statushash returns
8573:
1.288 raeburn 8574: Entries for end, start, section and status are blank because
8575: of the possibility of multiple values for non-student roles.
8576:
1.275 raeburn 8577: =cut
1.405 albertel 8578:
1.275 raeburn 8579: ###############################################
1.405 albertel 8580:
1.275 raeburn 8581: sub get_course_users {
1.630 raeburn 8582: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8583: my %idx = ();
1.419 raeburn 8584: my %seclists;
1.288 raeburn 8585:
8586: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8587: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8588: $idx{end} = &Apache::loncoursedata::CL_END();
8589: $idx{start} = &Apache::loncoursedata::CL_START();
8590: $idx{id} = &Apache::loncoursedata::CL_ID();
8591: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8592: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8593: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8594:
1.290 albertel 8595: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8596: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8597: my $now = time;
1.277 albertel 8598: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8599: my $match = 0;
1.412 raeburn 8600: my $secmatch = 0;
1.419 raeburn 8601: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8602: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8603: if ($section eq '') {
8604: $section = 'none';
8605: }
1.291 albertel 8606: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8607: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8608: $secmatch = 1;
8609: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8610: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8611: $secmatch = 1;
8612: }
8613: } else {
1.419 raeburn 8614: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8615: $secmatch = 1;
8616: }
1.290 albertel 8617: }
1.412 raeburn 8618: if (!$secmatch) {
8619: next;
8620: }
1.419 raeburn 8621: }
1.275 raeburn 8622: if (defined($$types{'active'})) {
1.288 raeburn 8623: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8624: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8625: $match = 1;
1.275 raeburn 8626: }
8627: }
8628: if (defined($$types{'previous'})) {
1.609 raeburn 8629: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8630: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8631: $match = 1;
1.275 raeburn 8632: }
8633: }
8634: if (defined($$types{'future'})) {
1.609 raeburn 8635: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8636: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8637: $match = 1;
1.275 raeburn 8638: }
8639: }
1.609 raeburn 8640: if ($match) {
8641: push(@{$seclists{$student}},$section);
8642: if (ref($userdata) eq 'HASH') {
8643: $$userdata{$student} = $$classlist{$student};
8644: }
8645: if (ref($statushash) eq 'HASH') {
8646: $statushash->{$student}{'st'}{$section} = $status;
8647: }
1.288 raeburn 8648: }
1.275 raeburn 8649: }
8650: }
1.412 raeburn 8651: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8652: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8653: my $now = time;
1.609 raeburn 8654: my %displaystatus = ( previous => 'Expired',
8655: active => 'Active',
8656: future => 'Future',
8657: );
1.1121 raeburn 8658: my (%nothide,@possdoms);
1.630 raeburn 8659: if ($hidepriv) {
8660: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8661: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8662: if ($user !~ /:/) {
8663: $nothide{join(':',split(/[\@]/,$user))}=1;
8664: } else {
8665: $nothide{$user} = 1;
8666: }
8667: }
1.1121 raeburn 8668: my @possdoms = ($cdom);
8669: if ($coursehash{'checkforpriv'}) {
8670: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8671: }
1.630 raeburn 8672: }
1.439 raeburn 8673: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8674: my $match = 0;
1.412 raeburn 8675: my $secmatch = 0;
1.439 raeburn 8676: my $status;
1.412 raeburn 8677: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8678: $user =~ s/:$//;
1.439 raeburn 8679: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8680: if ($end == -1 || $start == -1) {
8681: next;
8682: }
8683: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8684: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8685: my ($uname,$udom) = split(/:/,$user);
8686: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8687: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8688: $secmatch = 1;
8689: } elsif ($usec eq '') {
1.420 albertel 8690: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8691: $secmatch = 1;
8692: }
8693: } else {
8694: if (grep(/^\Q$usec\E$/,@{$sections})) {
8695: $secmatch = 1;
8696: }
8697: }
8698: if (!$secmatch) {
8699: next;
8700: }
1.288 raeburn 8701: }
1.419 raeburn 8702: if ($usec eq '') {
8703: $usec = 'none';
8704: }
1.275 raeburn 8705: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8706: if ($hidepriv) {
1.1121 raeburn 8707: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8708: (!$nothide{$uname.':'.$udom})) {
8709: next;
8710: }
8711: }
1.503 raeburn 8712: if ($end > 0 && $end < $now) {
1.439 raeburn 8713: $status = 'previous';
8714: } elsif ($start > $now) {
8715: $status = 'future';
8716: } else {
8717: $status = 'active';
8718: }
1.277 albertel 8719: foreach my $type (keys(%{$types})) {
1.275 raeburn 8720: if ($status eq $type) {
1.420 albertel 8721: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8722: push(@{$$users{$role}{$user}},$type);
8723: }
1.288 raeburn 8724: $match = 1;
8725: }
8726: }
1.419 raeburn 8727: if (($match) && (ref($userdata) eq 'HASH')) {
8728: if (!exists($$userdata{$uname.':'.$udom})) {
8729: &get_user_info($udom,$uname,\%idx,$userdata);
8730: }
1.420 albertel 8731: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8732: push(@{$seclists{$uname.':'.$udom}},$usec);
8733: }
1.609 raeburn 8734: if (ref($statushash) eq 'HASH') {
8735: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8736: }
1.275 raeburn 8737: }
8738: }
8739: }
8740: }
1.290 albertel 8741: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8742: if ((defined($cdom)) && (defined($cnum))) {
8743: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8744: if ( defined($csettings{'internal.courseowner'}) ) {
8745: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8746: next if ($owner eq '');
8747: my ($ownername,$ownerdom);
8748: if ($owner =~ /^([^:]+):([^:]+)$/) {
8749: $ownername = $1;
8750: $ownerdom = $2;
8751: } else {
8752: $ownername = $owner;
8753: $ownerdom = $cdom;
8754: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8755: }
8756: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8757: if (defined($userdata) &&
1.609 raeburn 8758: !exists($$userdata{$owner})) {
8759: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8760: if (!grep(/^none$/,@{$seclists{$owner}})) {
8761: push(@{$seclists{$owner}},'none');
8762: }
8763: if (ref($statushash) eq 'HASH') {
8764: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8765: }
1.290 albertel 8766: }
1.279 raeburn 8767: }
8768: }
8769: }
1.419 raeburn 8770: foreach my $user (keys(%seclists)) {
8771: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8772: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8773: }
1.275 raeburn 8774: }
8775: return;
8776: }
8777:
1.288 raeburn 8778: sub get_user_info {
8779: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8780: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8781: &plainname($uname,$udom,'lastname');
1.291 albertel 8782: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8783: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8784: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8785: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8786: return;
8787: }
1.275 raeburn 8788:
1.472 raeburn 8789: ###############################################
8790:
8791: =pod
8792:
8793: =item * &get_user_quota()
8794:
1.1134 raeburn 8795: Retrieves quota assigned for storage of user files.
8796: Default is to report quota for portfolio files.
1.472 raeburn 8797:
8798: Incoming parameters:
8799: 1. user's username
8800: 2. user's domain
1.1134 raeburn 8801: 3. quota name - portfolio, author, or course
1.1136 raeburn 8802: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 8803: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 8804: course
1.472 raeburn 8805:
8806: Returns:
1.1163 raeburn 8807: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8808: 2. (Optional) Type of setting: custom or default
8809: (individually assigned or default for user's
8810: institutional status).
8811: 3. (Optional) - User's institutional status (e.g., faculty, staff
8812: or student - types as defined in localenroll::inst_usertypes
8813: for user's domain, which determines default quota for user.
8814: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8815:
8816: If a value has been stored in the user's environment,
1.536 raeburn 8817: it will return that, otherwise it returns the maximal default
1.1134 raeburn 8818: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8819:
8820: =cut
8821:
8822: ###############################################
8823:
8824:
8825: sub get_user_quota {
1.1136 raeburn 8826: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8827: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8828: if (!defined($udom)) {
8829: $udom = $env{'user.domain'};
8830: }
8831: if (!defined($uname)) {
8832: $uname = $env{'user.name'};
8833: }
8834: if (($udom eq '' || $uname eq '') ||
8835: ($udom eq 'public') && ($uname eq 'public')) {
8836: $quota = 0;
1.536 raeburn 8837: $quotatype = 'default';
8838: $defquota = 0;
1.472 raeburn 8839: } else {
1.536 raeburn 8840: my $inststatus;
1.1134 raeburn 8841: if ($quotaname eq 'course') {
8842: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8843: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8844: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8845: } else {
8846: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8847: $quota = $cenv{'internal.uploadquota'};
8848: }
1.536 raeburn 8849: } else {
1.1134 raeburn 8850: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8851: if ($quotaname eq 'author') {
8852: $quota = $env{'environment.authorquota'};
8853: } else {
8854: $quota = $env{'environment.portfolioquota'};
8855: }
8856: $inststatus = $env{'environment.inststatus'};
8857: } else {
8858: my %userenv =
8859: &Apache::lonnet::get('environment',['portfolioquota',
8860: 'authorquota','inststatus'],$udom,$uname);
8861: my ($tmp) = keys(%userenv);
8862: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8863: if ($quotaname eq 'author') {
8864: $quota = $userenv{'authorquota'};
8865: } else {
8866: $quota = $userenv{'portfolioquota'};
8867: }
8868: $inststatus = $userenv{'inststatus'};
8869: } else {
8870: undef(%userenv);
8871: }
8872: }
8873: }
8874: if ($quota eq '' || wantarray) {
8875: if ($quotaname eq 'course') {
8876: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 8877: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8878: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 8879: $defquota = $domdefs{$crstype.'quota'};
8880: }
8881: if ($defquota eq '') {
8882: $defquota = 500;
8883: }
1.1134 raeburn 8884: } else {
8885: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8886: }
8887: if ($quota eq '') {
8888: $quota = $defquota;
8889: $quotatype = 'default';
8890: } else {
8891: $quotatype = 'custom';
8892: }
1.472 raeburn 8893: }
8894: }
1.536 raeburn 8895: if (wantarray) {
8896: return ($quota,$quotatype,$settingstatus,$defquota);
8897: } else {
8898: return $quota;
8899: }
1.472 raeburn 8900: }
8901:
8902: ###############################################
8903:
8904: =pod
8905:
8906: =item * &default_quota()
8907:
1.536 raeburn 8908: Retrieves default quota assigned for storage of user portfolio files,
8909: given an (optional) user's institutional status.
1.472 raeburn 8910:
8911: Incoming parameters:
1.1142 raeburn 8912:
1.472 raeburn 8913: 1. domain
1.536 raeburn 8914: 2. (Optional) institutional status(es). This is a : separated list of
8915: status types (e.g., faculty, staff, student etc.)
8916: which apply to the user for whom the default is being retrieved.
8917: If the institutional status string in undefined, the domain
1.1134 raeburn 8918: default quota will be returned.
8919: 3. quota name - portfolio, author, or course
8920: (if no quota name provided, defaults to portfolio).
1.472 raeburn 8921:
8922: Returns:
1.1142 raeburn 8923:
1.1163 raeburn 8924: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 8925: 2. (Optional) institutional type which determined the value of the
8926: default quota.
1.472 raeburn 8927:
8928: If a value has been stored in the domain's configuration db,
8929: it will return that, otherwise it returns 20 (for backwards
8930: compatibility with domains which have not set up a configuration
1.1163 raeburn 8931: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 8932:
1.536 raeburn 8933: If the user's status includes multiple types (e.g., staff and student),
8934: the largest default quota which applies to the user determines the
8935: default quota returned.
8936:
1.472 raeburn 8937: =cut
8938:
8939: ###############################################
8940:
8941:
8942: sub default_quota {
1.1134 raeburn 8943: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 8944: my ($defquota,$settingstatus);
8945: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8946: ['quotas'],$udom);
1.1134 raeburn 8947: my $key = 'defaultquota';
8948: if ($quotaname eq 'author') {
8949: $key = 'authorquota';
8950: }
1.622 raeburn 8951: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8952: if ($inststatus ne '') {
1.765 raeburn 8953: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8954: foreach my $item (@statuses) {
1.1134 raeburn 8955: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8956: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 8957: if ($defquota eq '') {
1.1134 raeburn 8958: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8959: $settingstatus = $item;
1.1134 raeburn 8960: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
8961: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8962: $settingstatus = $item;
8963: }
8964: }
1.1134 raeburn 8965: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8966: if ($quotahash{'quotas'}{$item} ne '') {
8967: if ($defquota eq '') {
8968: $defquota = $quotahash{'quotas'}{$item};
8969: $settingstatus = $item;
8970: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8971: $defquota = $quotahash{'quotas'}{$item};
8972: $settingstatus = $item;
8973: }
1.536 raeburn 8974: }
8975: }
8976: }
8977: }
8978: if ($defquota eq '') {
1.1134 raeburn 8979: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8980: $defquota = $quotahash{'quotas'}{$key}{'default'};
8981: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8982: $defquota = $quotahash{'quotas'}{'default'};
8983: }
1.536 raeburn 8984: $settingstatus = 'default';
1.1139 raeburn 8985: if ($defquota eq '') {
8986: if ($quotaname eq 'author') {
8987: $defquota = 500;
8988: }
8989: }
1.536 raeburn 8990: }
8991: } else {
8992: $settingstatus = 'default';
1.1134 raeburn 8993: if ($quotaname eq 'author') {
8994: $defquota = 500;
8995: } else {
8996: $defquota = 20;
8997: }
1.536 raeburn 8998: }
8999: if (wantarray) {
9000: return ($defquota,$settingstatus);
1.472 raeburn 9001: } else {
1.536 raeburn 9002: return $defquota;
1.472 raeburn 9003: }
9004: }
9005:
1.1135 raeburn 9006: ###############################################
9007:
9008: =pod
9009:
1.1136 raeburn 9010: =item * &excess_filesize_warning()
1.1135 raeburn 9011:
9012: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9013: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9014: space to be exceeded.
1.1136 raeburn 9015:
9016: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9017: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9018:
1.1165 raeburn 9019: Inputs: 7
1.1136 raeburn 9020: 1. username or coursenum
1.1135 raeburn 9021: 2. domain
1.1136 raeburn 9022: 3. context ('author' or 'course')
1.1135 raeburn 9023: 4. filename of file for which action is being requested
9024: 5. filesize (kB) of file
9025: 6. action being taken: copy or upload.
1.1165 raeburn 9026: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 9027:
9028: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9029: otherwise return null.
9030:
9031: =back
1.1135 raeburn 9032:
9033: =cut
9034:
1.1136 raeburn 9035: sub excess_filesize_warning {
1.1165 raeburn 9036: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9037: my $current_disk_usage = 0;
1.1165 raeburn 9038: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9039: if ($context eq 'author') {
9040: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9041: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9042: } else {
9043: foreach my $subdir ('docs','supplemental') {
9044: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9045: }
9046: }
1.1135 raeburn 9047: $disk_quota = int($disk_quota * 1000);
9048: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9049: return '<p class="LC_warning">'.
1.1135 raeburn 9050: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9051: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9052: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9053: $disk_quota,$current_disk_usage).
9054: '</p>';
9055: }
9056: return;
9057: }
9058:
9059: ###############################################
9060:
9061:
1.1136 raeburn 9062:
9063:
1.384 raeburn 9064: sub get_secgrprole_info {
9065: my ($cdom,$cnum,$needroles,$type) = @_;
9066: my %sections_count = &get_sections($cdom,$cnum);
9067: my @sections = (sort {$a <=> $b} keys(%sections_count));
9068: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9069: my @groups = sort(keys(%curr_groups));
9070: my $allroles = [];
9071: my $rolehash;
9072: my $accesshash = {
9073: active => 'Currently has access',
9074: future => 'Will have future access',
9075: previous => 'Previously had access',
9076: };
9077: if ($needroles) {
9078: $rolehash = {'all' => 'all'};
1.385 albertel 9079: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9080: if (&Apache::lonnet::error(%user_roles)) {
9081: undef(%user_roles);
9082: }
9083: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9084: my ($role)=split(/\:/,$item,2);
9085: if ($role eq 'cr') { next; }
9086: if ($role =~ /^cr/) {
9087: $$rolehash{$role} = (split('/',$role))[3];
9088: } else {
9089: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9090: }
9091: }
9092: foreach my $key (sort(keys(%{$rolehash}))) {
9093: push(@{$allroles},$key);
9094: }
9095: push (@{$allroles},'st');
9096: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9097: }
9098: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9099: }
9100:
1.555 raeburn 9101: sub user_picker {
1.994 raeburn 9102: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9103: my $currdom = $dom;
9104: my %curr_selected = (
9105: srchin => 'dom',
1.580 raeburn 9106: srchby => 'lastname',
1.555 raeburn 9107: );
9108: my $srchterm;
1.625 raeburn 9109: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9110: if ($srch->{'srchby'} ne '') {
9111: $curr_selected{'srchby'} = $srch->{'srchby'};
9112: }
9113: if ($srch->{'srchin'} ne '') {
9114: $curr_selected{'srchin'} = $srch->{'srchin'};
9115: }
9116: if ($srch->{'srchtype'} ne '') {
9117: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9118: }
9119: if ($srch->{'srchdomain'} ne '') {
9120: $currdom = $srch->{'srchdomain'};
9121: }
9122: $srchterm = $srch->{'srchterm'};
9123: }
9124: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9125: 'usr' => 'Search criteria',
1.563 raeburn 9126: 'doma' => 'Domain/institution to search',
1.558 albertel 9127: 'uname' => 'username',
9128: 'lastname' => 'last name',
1.555 raeburn 9129: 'lastfirst' => 'last name, first name',
1.558 albertel 9130: 'crs' => 'in this course',
1.576 raeburn 9131: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9132: 'alc' => 'all LON-CAPA',
1.573 raeburn 9133: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9134: 'exact' => 'is',
9135: 'contains' => 'contains',
1.569 raeburn 9136: 'begins' => 'begins with',
1.571 raeburn 9137: 'youm' => "You must include some text to search for.",
9138: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9139: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9140: 'yomc' => "You must choose a domain when using an institutional directory search.",
9141: 'ymcd' => "You must choose a domain when using a domain search.",
9142: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9143: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9144: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9145: );
1.563 raeburn 9146: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9147: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9148:
9149: my @srchins = ('crs','dom','alc','instd');
9150:
9151: foreach my $option (@srchins) {
9152: # FIXME 'alc' option unavailable until
9153: # loncreateuser::print_user_query_page()
9154: # has been completed.
9155: next if ($option eq 'alc');
1.880 raeburn 9156: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9157: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9158: if ($curr_selected{'srchin'} eq $option) {
9159: $srchinsel .= '
9160: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9161: } else {
9162: $srchinsel .= '
9163: <option value="'.$option.'">'.$lt{$option}.'</option>';
9164: }
1.555 raeburn 9165: }
1.563 raeburn 9166: $srchinsel .= "\n </select>\n";
1.555 raeburn 9167:
9168: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9169: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9170: if ($curr_selected{'srchby'} eq $option) {
9171: $srchbysel .= '
9172: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9173: } else {
9174: $srchbysel .= '
9175: <option value="'.$option.'">'.$lt{$option}.'</option>';
9176: }
9177: }
9178: $srchbysel .= "\n </select>\n";
9179:
9180: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9181: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9182: if ($curr_selected{'srchtype'} eq $option) {
9183: $srchtypesel .= '
9184: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9185: } else {
9186: $srchtypesel .= '
9187: <option value="'.$option.'">'.$lt{$option}.'</option>';
9188: }
9189: }
9190: $srchtypesel .= "\n </select>\n";
9191:
1.558 albertel 9192: my ($newuserscript,$new_user_create);
1.994 raeburn 9193: my $context_dom = $env{'request.role.domain'};
9194: if ($context eq 'requestcrs') {
9195: if ($env{'form.coursedom'} ne '') {
9196: $context_dom = $env{'form.coursedom'};
9197: }
9198: }
1.556 raeburn 9199: if ($forcenewuser) {
1.576 raeburn 9200: if (ref($srch) eq 'HASH') {
1.994 raeburn 9201: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9202: if ($cancreate) {
9203: $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>';
9204: } else {
1.799 bisitz 9205: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9206: my %usertypetext = (
9207: official => 'institutional',
9208: unofficial => 'non-institutional',
9209: );
1.799 bisitz 9210: $new_user_create = '<p class="LC_warning">'
9211: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9212: .' '
9213: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9214: ,'<a href="'.$helplink.'">','</a>')
9215: .'</p><br />';
1.627 raeburn 9216: }
1.576 raeburn 9217: }
9218: }
9219:
1.556 raeburn 9220: $newuserscript = <<"ENDSCRIPT";
9221:
1.570 raeburn 9222: function setSearch(createnew,callingForm) {
1.556 raeburn 9223: if (createnew == 1) {
1.570 raeburn 9224: for (var i=0; i<callingForm.srchby.length; i++) {
9225: if (callingForm.srchby.options[i].value == 'uname') {
9226: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9227: }
9228: }
1.570 raeburn 9229: for (var i=0; i<callingForm.srchin.length; i++) {
9230: if ( callingForm.srchin.options[i].value == 'dom') {
9231: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9232: }
9233: }
1.570 raeburn 9234: for (var i=0; i<callingForm.srchtype.length; i++) {
9235: if (callingForm.srchtype.options[i].value == 'exact') {
9236: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9237: }
9238: }
1.570 raeburn 9239: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9240: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9241: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9242: }
9243: }
9244: }
9245: }
9246: ENDSCRIPT
1.558 albertel 9247:
1.556 raeburn 9248: }
9249:
1.555 raeburn 9250: my $output = <<"END_BLOCK";
1.556 raeburn 9251: <script type="text/javascript">
1.824 bisitz 9252: // <![CDATA[
1.570 raeburn 9253: function validateEntry(callingForm) {
1.558 albertel 9254:
1.556 raeburn 9255: var checkok = 1;
1.558 albertel 9256: var srchin;
1.570 raeburn 9257: for (var i=0; i<callingForm.srchin.length; i++) {
9258: if ( callingForm.srchin[i].checked ) {
9259: srchin = callingForm.srchin[i].value;
1.558 albertel 9260: }
9261: }
9262:
1.570 raeburn 9263: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9264: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9265: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9266: var srchterm = callingForm.srchterm.value;
9267: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9268: var msg = "";
9269:
9270: if (srchterm == "") {
9271: checkok = 0;
1.571 raeburn 9272: msg += "$lt{'youm'}\\n";
1.556 raeburn 9273: }
9274:
1.569 raeburn 9275: if (srchtype== 'begins') {
9276: if (srchterm.length < 2) {
9277: checkok = 0;
1.571 raeburn 9278: msg += "$lt{'thte'}\\n";
1.569 raeburn 9279: }
9280: }
9281:
1.556 raeburn 9282: if (srchtype== 'contains') {
9283: if (srchterm.length < 3) {
9284: checkok = 0;
1.571 raeburn 9285: msg += "$lt{'thet'}\\n";
1.556 raeburn 9286: }
9287: }
9288: if (srchin == 'instd') {
9289: if (srchdomain == '') {
9290: checkok = 0;
1.571 raeburn 9291: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9292: }
9293: }
9294: if (srchin == 'dom') {
9295: if (srchdomain == '') {
9296: checkok = 0;
1.571 raeburn 9297: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9298: }
9299: }
9300: if (srchby == 'lastfirst') {
9301: if (srchterm.indexOf(",") == -1) {
9302: checkok = 0;
1.571 raeburn 9303: msg += "$lt{'whus'}\\n";
1.556 raeburn 9304: }
9305: if (srchterm.indexOf(",") == srchterm.length -1) {
9306: checkok = 0;
1.571 raeburn 9307: msg += "$lt{'whse'}\\n";
1.556 raeburn 9308: }
9309: }
9310: if (checkok == 0) {
1.571 raeburn 9311: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9312: return;
9313: }
9314: if (checkok == 1) {
1.570 raeburn 9315: callingForm.submit();
1.556 raeburn 9316: }
9317: }
9318:
9319: $newuserscript
9320:
1.824 bisitz 9321: // ]]>
1.556 raeburn 9322: </script>
1.558 albertel 9323:
9324: $new_user_create
9325:
1.555 raeburn 9326: END_BLOCK
1.558 albertel 9327:
1.876 raeburn 9328: $output .= &Apache::lonhtmlcommon::start_pick_box().
9329: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9330: $domform.
9331: &Apache::lonhtmlcommon::row_closure().
9332: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9333: $srchbysel.
9334: $srchtypesel.
9335: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9336: $srchinsel.
9337: &Apache::lonhtmlcommon::row_closure(1).
9338: &Apache::lonhtmlcommon::end_pick_box().
9339: '<br />';
1.555 raeburn 9340: return $output;
9341: }
9342:
1.612 raeburn 9343: sub user_rule_check {
1.615 raeburn 9344: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9345: my $response;
9346: if (ref($usershash) eq 'HASH') {
9347: foreach my $user (keys(%{$usershash})) {
9348: my ($uname,$udom) = split(/:/,$user);
9349: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9350: my ($id,$newuser);
1.612 raeburn 9351: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9352: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9353: $id = $usershash->{$user}->{'id'};
9354: }
9355: my $inst_response;
9356: if (ref($checks) eq 'HASH') {
9357: if (defined($checks->{'username'})) {
1.615 raeburn 9358: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9359: &Apache::lonnet::get_instuser($udom,$uname);
9360: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9361: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9362: &Apache::lonnet::get_instuser($udom,undef,$id);
9363: }
1.615 raeburn 9364: } else {
9365: ($inst_response,%{$inst_results->{$user}}) =
9366: &Apache::lonnet::get_instuser($udom,$uname);
9367: return;
1.612 raeburn 9368: }
1.615 raeburn 9369: if (!$got_rules->{$udom}) {
1.612 raeburn 9370: my %domconfig = &Apache::lonnet::get_dom('configuration',
9371: ['usercreation'],$udom);
9372: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9373: foreach my $item ('username','id') {
1.612 raeburn 9374: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9375: $$curr_rules{$udom}{$item} =
9376: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9377: }
9378: }
9379: }
1.615 raeburn 9380: $got_rules->{$udom} = 1;
1.585 raeburn 9381: }
1.612 raeburn 9382: foreach my $item (keys(%{$checks})) {
9383: if (ref($$curr_rules{$udom}) eq 'HASH') {
9384: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9385: if (@{$$curr_rules{$udom}{$item}} > 0) {
9386: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9387: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9388: if ($rule_check{$rule}) {
9389: $$rulematch{$user}{$item} = $rule;
9390: if ($inst_response eq 'ok') {
1.615 raeburn 9391: if (ref($inst_results) eq 'HASH') {
9392: if (ref($inst_results->{$user}) eq 'HASH') {
9393: if (keys(%{$inst_results->{$user}}) == 0) {
9394: $$alerts{$item}{$udom}{$uname} = 1;
9395: }
1.612 raeburn 9396: }
9397: }
1.615 raeburn 9398: }
9399: last;
1.585 raeburn 9400: }
9401: }
9402: }
9403: }
9404: }
9405: }
9406: }
9407: }
1.612 raeburn 9408: return;
9409: }
9410:
9411: sub user_rule_formats {
9412: my ($domain,$domdesc,$curr_rules,$check) = @_;
9413: my %text = (
9414: 'username' => 'Usernames',
9415: 'id' => 'IDs',
9416: );
9417: my $output;
9418: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9419: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9420: if (@{$ruleorder} > 0) {
1.1102 raeburn 9421: $output = '<br />'.
9422: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9423: '<span class="LC_cusr_emph">','</span>',$domdesc).
9424: ' <ul>';
1.612 raeburn 9425: foreach my $rule (@{$ruleorder}) {
9426: if (ref($curr_rules) eq 'ARRAY') {
9427: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9428: if (ref($rules->{$rule}) eq 'HASH') {
9429: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9430: $rules->{$rule}{'desc'}.'</li>';
9431: }
9432: }
9433: }
9434: }
9435: $output .= '</ul>';
9436: }
9437: }
9438: return $output;
9439: }
9440:
9441: sub instrule_disallow_msg {
1.615 raeburn 9442: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9443: my $response;
9444: my %text = (
9445: item => 'username',
9446: items => 'usernames',
9447: match => 'matches',
9448: do => 'does',
9449: action => 'a username',
9450: one => 'one',
9451: );
9452: if ($count > 1) {
9453: $text{'item'} = 'usernames';
9454: $text{'match'} ='match';
9455: $text{'do'} = 'do';
9456: $text{'action'} = 'usernames',
9457: $text{'one'} = 'ones';
9458: }
9459: if ($checkitem eq 'id') {
9460: $text{'items'} = 'IDs';
9461: $text{'item'} = 'ID';
9462: $text{'action'} = 'an ID';
1.615 raeburn 9463: if ($count > 1) {
9464: $text{'item'} = 'IDs';
9465: $text{'action'} = 'IDs';
9466: }
1.612 raeburn 9467: }
1.674 bisitz 9468: $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 9469: if ($mode eq 'upload') {
9470: if ($checkitem eq 'username') {
9471: $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'}.");
9472: } elsif ($checkitem eq 'id') {
1.674 bisitz 9473: $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 9474: }
1.669 raeburn 9475: } elsif ($mode eq 'selfcreate') {
9476: if ($checkitem eq 'id') {
9477: $response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
9478: }
1.615 raeburn 9479: } else {
9480: if ($checkitem eq 'username') {
9481: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9482: } elsif ($checkitem eq 'id') {
9483: $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.");
9484: }
1.612 raeburn 9485: }
9486: return $response;
1.585 raeburn 9487: }
9488:
1.624 raeburn 9489: sub personal_data_fieldtitles {
9490: my %fieldtitles = &Apache::lonlocal::texthash (
9491: id => 'Student/Employee ID',
9492: permanentemail => 'E-mail address',
9493: lastname => 'Last Name',
9494: firstname => 'First Name',
9495: middlename => 'Middle Name',
9496: generation => 'Generation',
9497: gen => 'Generation',
1.765 raeburn 9498: inststatus => 'Affiliation',
1.624 raeburn 9499: );
9500: return %fieldtitles;
9501: }
9502:
1.642 raeburn 9503: sub sorted_inst_types {
9504: my ($dom) = @_;
1.1185 raeburn 9505: my ($usertypes,$order);
9506: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9507: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9508: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9509: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9510: } else {
9511: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9512: }
1.642 raeburn 9513: my $othertitle = &mt('All users');
9514: if ($env{'request.course.id'}) {
1.668 raeburn 9515: $othertitle = &mt('Any users');
1.642 raeburn 9516: }
9517: my @types;
9518: if (ref($order) eq 'ARRAY') {
9519: @types = @{$order};
9520: }
9521: if (@types == 0) {
9522: if (ref($usertypes) eq 'HASH') {
9523: @types = sort(keys(%{$usertypes}));
9524: }
9525: }
9526: if (keys(%{$usertypes}) > 0) {
9527: $othertitle = &mt('Other users');
9528: }
9529: return ($othertitle,$usertypes,\@types);
9530: }
9531:
1.645 raeburn 9532: sub get_institutional_codes {
9533: my ($settings,$allcourses,$LC_code) = @_;
9534: # Get complete list of course sections to update
9535: my @currsections = ();
9536: my @currxlists = ();
9537: my $coursecode = $$settings{'internal.coursecode'};
9538:
9539: if ($$settings{'internal.sectionnums'} ne '') {
9540: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9541: }
9542:
9543: if ($$settings{'internal.crosslistings'} ne '') {
9544: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9545: }
9546:
9547: if (@currxlists > 0) {
9548: foreach (@currxlists) {
9549: if (m/^([^:]+):(\w*)$/) {
9550: unless (grep/^$1$/,@{$allcourses}) {
9551: push @{$allcourses},$1;
9552: $$LC_code{$1} = $2;
9553: }
9554: }
9555: }
9556: }
9557:
9558: if (@currsections > 0) {
9559: foreach (@currsections) {
9560: if (m/^(\w+):(\w*)$/) {
9561: my $sec = $coursecode.$1;
9562: my $lc_sec = $2;
9563: unless (grep/^$sec$/,@{$allcourses}) {
9564: push @{$allcourses},$sec;
9565: $$LC_code{$sec} = $lc_sec;
9566: }
9567: }
9568: }
9569: }
9570: return;
9571: }
9572:
1.971 raeburn 9573: sub get_standard_codeitems {
9574: return ('Year','Semester','Department','Number','Section');
9575: }
9576:
1.112 bowersj2 9577: =pod
9578:
1.780 raeburn 9579: =head1 Slot Helpers
9580:
9581: =over 4
9582:
9583: =item * sorted_slots()
9584:
1.1040 raeburn 9585: Sorts an array of slot names in order of an optional sort key,
9586: default sort is by slot start time (earliest first).
1.780 raeburn 9587:
9588: Inputs:
9589:
9590: =over 4
9591:
9592: slotsarr - Reference to array of unsorted slot names.
9593:
9594: slots - Reference to hash of hash, where outer hash keys are slot names.
9595:
1.1040 raeburn 9596: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9597:
1.549 albertel 9598: =back
9599:
1.780 raeburn 9600: Returns:
9601:
9602: =over 4
9603:
1.1040 raeburn 9604: sorted - An array of slot names sorted by a specified sort key
9605: (default sort key is start time of the slot).
1.780 raeburn 9606:
9607: =back
9608:
9609: =cut
9610:
9611:
9612: sub sorted_slots {
1.1040 raeburn 9613: my ($slotsarr,$slots,$sortkey) = @_;
9614: if ($sortkey eq '') {
9615: $sortkey = 'starttime';
9616: }
1.780 raeburn 9617: my @sorted;
9618: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9619: @sorted =
9620: sort {
9621: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9622: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9623: }
9624: if (ref($slots->{$a})) { return -1;}
9625: if (ref($slots->{$b})) { return 1;}
9626: return 0;
9627: } @{$slotsarr};
9628: }
9629: return @sorted;
9630: }
9631:
1.1040 raeburn 9632: =pod
9633:
9634: =item * get_future_slots()
9635:
9636: Inputs:
9637:
9638: =over 4
9639:
9640: cnum - course number
9641:
9642: cdom - course domain
9643:
9644: now - current UNIX time
9645:
9646: symb - optional symb
9647:
9648: =back
9649:
9650: Returns:
9651:
9652: =over 4
9653:
9654: sorted_reservable - ref to array of student_schedulable slots currently
9655: reservable, ordered by end date of reservation period.
9656:
9657: reservable_now - ref to hash of student_schedulable slots currently
9658: reservable.
9659:
9660: Keys in inner hash are:
9661: (a) symb: either blank or symb to which slot use is restricted.
9662: (b) endreserve: end date of reservation period.
9663:
9664: sorted_future - ref to array of student_schedulable slots reservable in
9665: the future, ordered by start date of reservation period.
9666:
9667: future_reservable - ref to hash of student_schedulable slots reservable
9668: in the future.
9669:
9670: Keys in inner hash are:
9671: (a) symb: either blank or symb to which slot use is restricted.
9672: (b) startreserve: start date of reservation period.
9673:
9674: =back
9675:
9676: =cut
9677:
9678: sub get_future_slots {
9679: my ($cnum,$cdom,$now,$symb) = @_;
9680: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9681: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9682: foreach my $slot (keys(%slots)) {
9683: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9684: if ($symb) {
9685: next if (($slots{$slot}->{'symb'} ne '') &&
9686: ($slots{$slot}->{'symb'} ne $symb));
9687: }
9688: if (($slots{$slot}->{'starttime'} > $now) &&
9689: ($slots{$slot}->{'endtime'} > $now)) {
9690: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9691: my $userallowed = 0;
9692: if ($slots{$slot}->{'allowedsections'}) {
9693: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9694: if (!defined($env{'request.role.sec'})
9695: && grep(/^No section assigned$/,@allowed_sec)) {
9696: $userallowed=1;
9697: } else {
9698: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9699: $userallowed=1;
9700: }
9701: }
9702: unless ($userallowed) {
9703: if (defined($env{'request.course.groups'})) {
9704: my @groups = split(/:/,$env{'request.course.groups'});
9705: foreach my $group (@groups) {
9706: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9707: $userallowed=1;
9708: last;
9709: }
9710: }
9711: }
9712: }
9713: }
9714: if ($slots{$slot}->{'allowedusers'}) {
9715: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9716: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9717: if (grep(/^\Q$user\E$/,@allowed_users)) {
9718: $userallowed = 1;
9719: }
9720: }
9721: next unless($userallowed);
9722: }
9723: my $startreserve = $slots{$slot}->{'startreserve'};
9724: my $endreserve = $slots{$slot}->{'endreserve'};
9725: my $symb = $slots{$slot}->{'symb'};
9726: if (($startreserve < $now) &&
9727: (!$endreserve || $endreserve > $now)) {
9728: my $lastres = $endreserve;
9729: if (!$lastres) {
9730: $lastres = $slots{$slot}->{'starttime'};
9731: }
9732: $reservable_now{$slot} = {
9733: symb => $symb,
9734: endreserve => $lastres
9735: };
9736: } elsif (($startreserve > $now) &&
9737: (!$endreserve || $endreserve > $startreserve)) {
9738: $future_reservable{$slot} = {
9739: symb => $symb,
9740: startreserve => $startreserve
9741: };
9742: }
9743: }
9744: }
9745: my @unsorted_reservable = keys(%reservable_now);
9746: if (@unsorted_reservable > 0) {
9747: @sorted_reservable =
9748: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9749: }
9750: my @unsorted_future = keys(%future_reservable);
9751: if (@unsorted_future > 0) {
9752: @sorted_future =
9753: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9754: }
9755: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9756: }
1.780 raeburn 9757:
9758: =pod
9759:
1.1057 foxr 9760: =back
9761:
1.549 albertel 9762: =head1 HTTP Helpers
9763:
9764: =over 4
9765:
1.648 raeburn 9766: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9767:
1.258 albertel 9768: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9769: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9770: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9771:
9772: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9773: $possible_names is an ref to an array of form element names. As an example:
9774: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9775: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9776:
9777: =cut
1.1 albertel 9778:
1.6 albertel 9779: sub get_unprocessed_cgi {
1.25 albertel 9780: my ($query,$possible_names)= @_;
1.26 matthew 9781: # $Apache::lonxml::debug=1;
1.356 albertel 9782: foreach my $pair (split(/&/,$query)) {
9783: my ($name, $value) = split(/=/,$pair);
1.369 www 9784: $name = &unescape($name);
1.25 albertel 9785: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9786: $value =~ tr/+/ /;
9787: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9788: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9789: }
1.16 harris41 9790: }
1.6 albertel 9791: }
9792:
1.112 bowersj2 9793: =pod
9794:
1.648 raeburn 9795: =item * &cacheheader()
1.112 bowersj2 9796:
9797: returns cache-controlling header code
9798:
9799: =cut
9800:
1.7 albertel 9801: sub cacheheader {
1.258 albertel 9802: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9803: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9804: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9805: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9806: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9807: return $output;
1.7 albertel 9808: }
9809:
1.112 bowersj2 9810: =pod
9811:
1.648 raeburn 9812: =item * &no_cache($r)
1.112 bowersj2 9813:
9814: specifies header code to not have cache
9815:
9816: =cut
9817:
1.9 albertel 9818: sub no_cache {
1.216 albertel 9819: my ($r) = @_;
9820: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9821: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9822: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9823: $r->no_cache(1);
9824: $r->header_out("Expires" => $date);
9825: $r->header_out("Pragma" => "no-cache");
1.123 www 9826: }
9827:
9828: sub content_type {
1.181 albertel 9829: my ($r,$type,$charset) = @_;
1.299 foxr 9830: if ($r) {
9831: # Note that printout.pl calls this with undef for $r.
9832: &no_cache($r);
9833: }
1.258 albertel 9834: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9835: unless ($charset) {
9836: $charset=&Apache::lonlocal::current_encoding;
9837: }
9838: if ($charset) { $type.='; charset='.$charset; }
9839: if ($r) {
9840: $r->content_type($type);
9841: } else {
9842: print("Content-type: $type\n\n");
9843: }
1.9 albertel 9844: }
1.25 albertel 9845:
1.112 bowersj2 9846: =pod
9847:
1.648 raeburn 9848: =item * &add_to_env($name,$value)
1.112 bowersj2 9849:
1.258 albertel 9850: adds $name to the %env hash with value
1.112 bowersj2 9851: $value, if $name already exists, the entry is converted to an array
9852: reference and $value is added to the array.
9853:
9854: =cut
9855:
1.25 albertel 9856: sub add_to_env {
9857: my ($name,$value)=@_;
1.258 albertel 9858: if (defined($env{$name})) {
9859: if (ref($env{$name})) {
1.25 albertel 9860: #already have multiple values
1.258 albertel 9861: push(@{ $env{$name} },$value);
1.25 albertel 9862: } else {
9863: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9864: my $first=$env{$name};
9865: undef($env{$name});
9866: push(@{ $env{$name} },$first,$value);
1.25 albertel 9867: }
9868: } else {
1.258 albertel 9869: $env{$name}=$value;
1.25 albertel 9870: }
1.31 albertel 9871: }
1.149 albertel 9872:
9873: =pod
9874:
1.648 raeburn 9875: =item * &get_env_multiple($name)
1.149 albertel 9876:
1.258 albertel 9877: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9878: values may be defined and end up as an array ref.
9879:
9880: returns an array of values
9881:
9882: =cut
9883:
9884: sub get_env_multiple {
9885: my ($name) = @_;
9886: my @values;
1.258 albertel 9887: if (defined($env{$name})) {
1.149 albertel 9888: # exists is it an array
1.258 albertel 9889: if (ref($env{$name})) {
9890: @values=@{ $env{$name} };
1.149 albertel 9891: } else {
1.258 albertel 9892: $values[0]=$env{$name};
1.149 albertel 9893: }
9894: }
9895: return(@values);
9896: }
9897:
1.660 raeburn 9898: sub ask_for_embedded_content {
9899: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9900: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9901: %currsubfile,%unused,$rem);
1.1071 raeburn 9902: my $counter = 0;
9903: my $numnew = 0;
1.987 raeburn 9904: my $numremref = 0;
9905: my $numinvalid = 0;
9906: my $numpathchg = 0;
9907: my $numexisting = 0;
1.1071 raeburn 9908: my $numunused = 0;
9909: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 9910: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9911: my $heading = &mt('Upload embedded files');
9912: my $buttontext = &mt('Upload');
9913:
1.1085 raeburn 9914: if ($env{'request.course.id'}) {
1.1123 raeburn 9915: if ($actionurl eq '/adm/dependencies') {
9916: $navmap = Apache::lonnavmaps::navmap->new();
9917: }
9918: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9919: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 9920: }
1.1123 raeburn 9921: if (($actionurl eq '/adm/portfolio') ||
9922: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 9923: my $current_path='/';
9924: if ($env{'form.currentpath'}) {
9925: $current_path = $env{'form.currentpath'};
9926: }
9927: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 9928: $udom = $cdom;
9929: $uname = $cnum;
1.984 raeburn 9930: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9931: } else {
9932: $udom = $env{'user.domain'};
9933: $uname = $env{'user.name'};
9934: $url = '/userfiles/portfolio';
9935: }
1.987 raeburn 9936: $toplevel = $url.'/';
1.984 raeburn 9937: $url .= $current_path;
9938: $getpropath = 1;
1.987 raeburn 9939: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9940: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9941: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9942: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9943: $toplevel = $url;
1.984 raeburn 9944: if ($rest ne '') {
1.987 raeburn 9945: $url .= $rest;
9946: }
9947: } elsif ($actionurl eq '/adm/coursedocs') {
9948: if (ref($args) eq 'HASH') {
1.1071 raeburn 9949: $url = $args->{'docs_url'};
9950: $toplevel = $url;
1.1084 raeburn 9951: if ($args->{'context'} eq 'paste') {
9952: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9953: ($path) =
9954: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9955: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9956: $fileloc =~ s{^/}{};
9957: }
1.1071 raeburn 9958: }
1.1084 raeburn 9959: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9960: if ($env{'request.course.id'} ne '') {
9961: if (ref($args) eq 'HASH') {
9962: $url = $args->{'docs_url'};
9963: $title = $args->{'docs_title'};
1.1126 raeburn 9964: $toplevel = $url;
9965: unless ($toplevel =~ m{^/}) {
9966: $toplevel = "/$url";
9967: }
1.1085 raeburn 9968: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 9969: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
9970: $path = $1;
9971: } else {
9972: ($path) =
9973: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9974: }
1.1195 raeburn 9975: if ($toplevel=~/^\/*(uploaded|editupload)/) {
9976: $fileloc = $toplevel;
9977: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
9978: my ($udom,$uname,$fname) =
9979: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
9980: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
9981: } else {
9982: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9983: }
1.1071 raeburn 9984: $fileloc =~ s{^/}{};
9985: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9986: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9987: }
1.987 raeburn 9988: }
1.1123 raeburn 9989: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9990: $udom = $cdom;
9991: $uname = $cnum;
9992: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
9993: $toplevel = $url;
9994: $path = $url;
9995: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
9996: $fileloc =~ s{^/}{};
1.987 raeburn 9997: }
1.1126 raeburn 9998: foreach my $file (keys(%{$allfiles})) {
9999: my $embed_file;
10000: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10001: $embed_file = $1;
10002: } else {
10003: $embed_file = $file;
10004: }
1.1158 raeburn 10005: my ($absolutepath,$cleaned_file);
10006: if ($embed_file =~ m{^\w+://}) {
10007: $cleaned_file = $embed_file;
1.1147 raeburn 10008: $newfiles{$cleaned_file} = 1;
10009: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10010: } else {
1.1158 raeburn 10011: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10012: if ($embed_file =~ m{^/}) {
10013: $absolutepath = $embed_file;
10014: }
1.1147 raeburn 10015: if ($cleaned_file =~ m{/}) {
10016: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10017: $path = &check_for_traversal($path,$url,$toplevel);
10018: my $item = $fname;
10019: if ($path ne '') {
10020: $item = $path.'/'.$fname;
10021: $subdependencies{$path}{$fname} = 1;
10022: } else {
10023: $dependencies{$item} = 1;
10024: }
10025: if ($absolutepath) {
10026: $mapping{$item} = $absolutepath;
10027: } else {
10028: $mapping{$item} = $embed_file;
10029: }
10030: } else {
10031: $dependencies{$embed_file} = 1;
10032: if ($absolutepath) {
1.1147 raeburn 10033: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10034: } else {
1.1147 raeburn 10035: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10036: }
10037: }
1.984 raeburn 10038: }
10039: }
1.1071 raeburn 10040: my $dirptr = 16384;
1.984 raeburn 10041: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10042: $currsubfile{$path} = {};
1.1123 raeburn 10043: if (($actionurl eq '/adm/portfolio') ||
10044: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10045: my ($sublistref,$listerror) =
10046: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10047: if (ref($sublistref) eq 'ARRAY') {
10048: foreach my $line (@{$sublistref}) {
10049: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10050: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10051: }
1.984 raeburn 10052: }
1.987 raeburn 10053: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10054: if (opendir(my $dir,$url.'/'.$path)) {
10055: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10056: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10057: }
1.1084 raeburn 10058: } elsif (($actionurl eq '/adm/dependencies') ||
10059: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10060: ($args->{'context'} eq 'paste')) ||
10061: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10062: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10063: my $dir;
10064: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10065: $dir = $fileloc;
10066: } else {
10067: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10068: }
1.1071 raeburn 10069: if ($dir ne '') {
10070: my ($sublistref,$listerror) =
10071: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10072: if (ref($sublistref) eq 'ARRAY') {
10073: foreach my $line (@{$sublistref}) {
10074: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10075: undef,$mtime)=split(/\&/,$line,12);
10076: unless (($testdir&$dirptr) ||
10077: ($file_name =~ /^\.\.?$/)) {
10078: $currsubfile{$path}{$file_name} = [$size,$mtime];
10079: }
10080: }
10081: }
10082: }
1.984 raeburn 10083: }
10084: }
10085: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10086: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10087: my $item = $path.'/'.$file;
10088: unless ($mapping{$item} eq $item) {
10089: $pathchanges{$item} = 1;
10090: }
10091: $existing{$item} = 1;
10092: $numexisting ++;
10093: } else {
10094: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10095: }
10096: }
1.1071 raeburn 10097: if ($actionurl eq '/adm/dependencies') {
10098: foreach my $path (keys(%currsubfile)) {
10099: if (ref($currsubfile{$path}) eq 'HASH') {
10100: foreach my $file (keys(%{$currsubfile{$path}})) {
10101: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10102: next if (($rem ne '') &&
10103: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10104: (ref($navmap) &&
10105: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10106: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10107: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10108: $unused{$path.'/'.$file} = 1;
10109: }
10110: }
10111: }
10112: }
10113: }
1.984 raeburn 10114: }
1.987 raeburn 10115: my %currfile;
1.1123 raeburn 10116: if (($actionurl eq '/adm/portfolio') ||
10117: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10118: my ($dirlistref,$listerror) =
10119: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10120: if (ref($dirlistref) eq 'ARRAY') {
10121: foreach my $line (@{$dirlistref}) {
10122: my ($file_name,$rest) = split(/\&/,$line,2);
10123: $currfile{$file_name} = 1;
10124: }
1.984 raeburn 10125: }
1.987 raeburn 10126: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10127: if (opendir(my $dir,$url)) {
1.987 raeburn 10128: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10129: map {$currfile{$_} = 1;} @dir_list;
10130: }
1.1084 raeburn 10131: } elsif (($actionurl eq '/adm/dependencies') ||
10132: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10133: ($args->{'context'} eq 'paste')) ||
10134: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10135: if ($env{'request.course.id'} ne '') {
10136: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10137: if ($dir ne '') {
10138: my ($dirlistref,$listerror) =
10139: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10140: if (ref($dirlistref) eq 'ARRAY') {
10141: foreach my $line (@{$dirlistref}) {
10142: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10143: $size,undef,$mtime)=split(/\&/,$line,12);
10144: unless (($testdir&$dirptr) ||
10145: ($file_name =~ /^\.\.?$/)) {
10146: $currfile{$file_name} = [$size,$mtime];
10147: }
10148: }
10149: }
10150: }
10151: }
1.984 raeburn 10152: }
10153: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10154: if (exists($currfile{$file})) {
1.987 raeburn 10155: unless ($mapping{$file} eq $file) {
10156: $pathchanges{$file} = 1;
10157: }
10158: $existing{$file} = 1;
10159: $numexisting ++;
10160: } else {
1.984 raeburn 10161: $newfiles{$file} = 1;
10162: }
10163: }
1.1071 raeburn 10164: foreach my $file (keys(%currfile)) {
10165: unless (($file eq $filename) ||
10166: ($file eq $filename.'.bak') ||
10167: ($dependencies{$file})) {
1.1085 raeburn 10168: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10169: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10170: next if (($rem ne '') &&
10171: (($env{"httpref.$rem".$file} ne '') ||
10172: (ref($navmap) &&
10173: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10174: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10175: ($navmap->getResourceByUrl($rem.$1)))))));
10176: }
1.1085 raeburn 10177: }
1.1071 raeburn 10178: $unused{$file} = 1;
10179: }
10180: }
1.1084 raeburn 10181: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10182: ($args->{'context'} eq 'paste')) {
10183: $counter = scalar(keys(%existing));
10184: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10185: return ($output,$counter,$numpathchg,\%existing);
10186: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10187: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10188: $counter = scalar(keys(%existing));
10189: $numpathchg = scalar(keys(%pathchanges));
10190: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10191: }
1.984 raeburn 10192: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10193: if ($actionurl eq '/adm/dependencies') {
10194: next if ($embed_file =~ m{^\w+://});
10195: }
1.660 raeburn 10196: $upload_output .= &start_data_table_row().
1.1123 raeburn 10197: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10198: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10199: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10200: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10201: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10202: }
1.1123 raeburn 10203: $upload_output .= '</td>';
1.1071 raeburn 10204: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10205: $upload_output.='<td align="right">'.
10206: '<span class="LC_info LC_fontsize_medium">'.
10207: &mt("URL points to web address").'</span>';
1.987 raeburn 10208: $numremref++;
1.660 raeburn 10209: } elsif ($args->{'error_on_invalid_names'}
10210: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10211: $upload_output.='<td align="right"><span class="LC_warning">'.
10212: &mt('Invalid characters').'</span>';
1.987 raeburn 10213: $numinvalid++;
1.660 raeburn 10214: } else {
1.1123 raeburn 10215: $upload_output .= '<td>'.
10216: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10217: $embed_file,\%mapping,
1.1071 raeburn 10218: $allfiles,$codebase,'upload');
10219: $counter ++;
10220: $numnew ++;
1.987 raeburn 10221: }
10222: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10223: }
10224: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10225: if ($actionurl eq '/adm/dependencies') {
10226: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10227: $modify_output .= &start_data_table_row().
10228: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10229: '<img src="'.&icon($embed_file).'" border="0" />'.
10230: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10231: '<td>'.$size.'</td>'.
10232: '<td>'.$mtime.'</td>'.
10233: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10234: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10235: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10236: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10237: &embedded_file_element('upload_embedded',$counter,
10238: $embed_file,\%mapping,
10239: $allfiles,$codebase,'modify').
10240: '</div></td>'.
10241: &end_data_table_row()."\n";
10242: $counter ++;
10243: } else {
10244: $upload_output .= &start_data_table_row().
1.1123 raeburn 10245: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10246: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10247: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10248: &Apache::loncommon::end_data_table_row()."\n";
10249: }
10250: }
10251: my $delidx = $counter;
10252: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10253: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10254: $delete_output .= &start_data_table_row().
10255: '<td><img src="'.&icon($oldfile).'" />'.
10256: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10257: '<td>'.$size.'</td>'.
10258: '<td>'.$mtime.'</td>'.
10259: '<td><label><input type="checkbox" name="del_upload_dep" '.
10260: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10261: &embedded_file_element('upload_embedded',$delidx,
10262: $oldfile,\%mapping,$allfiles,
10263: $codebase,'delete').'</td>'.
10264: &end_data_table_row()."\n";
10265: $numunused ++;
10266: $delidx ++;
1.987 raeburn 10267: }
10268: if ($upload_output) {
10269: $upload_output = &start_data_table().
10270: $upload_output.
10271: &end_data_table()."\n";
10272: }
1.1071 raeburn 10273: if ($modify_output) {
10274: $modify_output = &start_data_table().
10275: &start_data_table_header_row().
10276: '<th>'.&mt('File').'</th>'.
10277: '<th>'.&mt('Size (KB)').'</th>'.
10278: '<th>'.&mt('Modified').'</th>'.
10279: '<th>'.&mt('Upload replacement?').'</th>'.
10280: &end_data_table_header_row().
10281: $modify_output.
10282: &end_data_table()."\n";
10283: }
10284: if ($delete_output) {
10285: $delete_output = &start_data_table().
10286: &start_data_table_header_row().
10287: '<th>'.&mt('File').'</th>'.
10288: '<th>'.&mt('Size (KB)').'</th>'.
10289: '<th>'.&mt('Modified').'</th>'.
10290: '<th>'.&mt('Delete?').'</th>'.
10291: &end_data_table_header_row().
10292: $delete_output.
10293: &end_data_table()."\n";
10294: }
1.987 raeburn 10295: my $applies = 0;
10296: if ($numremref) {
10297: $applies ++;
10298: }
10299: if ($numinvalid) {
10300: $applies ++;
10301: }
10302: if ($numexisting) {
10303: $applies ++;
10304: }
1.1071 raeburn 10305: if ($counter || $numunused) {
1.987 raeburn 10306: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10307: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10308: $state.'<h3>'.$heading.'</h3>';
10309: if ($actionurl eq '/adm/dependencies') {
10310: if ($numnew) {
10311: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10312: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10313: $upload_output.'<br />'."\n";
10314: }
10315: if ($numexisting) {
10316: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10317: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10318: $modify_output.'<br />'."\n";
10319: $buttontext = &mt('Save changes');
10320: }
10321: if ($numunused) {
10322: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10323: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10324: $delete_output.'<br />'."\n";
10325: $buttontext = &mt('Save changes');
10326: }
10327: } else {
10328: $output .= $upload_output.'<br />'."\n";
10329: }
10330: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10331: $counter.'" />'."\n";
10332: if ($actionurl eq '/adm/dependencies') {
10333: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10334: $numnew.'" />'."\n";
10335: } elsif ($actionurl eq '') {
1.987 raeburn 10336: $output .= '<input type="hidden" name="phase" value="three" />';
10337: }
10338: } elsif ($applies) {
10339: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10340: if ($applies > 1) {
10341: $output .=
1.1123 raeburn 10342: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10343: if ($numremref) {
10344: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10345: }
10346: if ($numinvalid) {
10347: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10348: }
10349: if ($numexisting) {
10350: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10351: }
10352: $output .= '</ul><br />';
10353: } elsif ($numremref) {
10354: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10355: } elsif ($numinvalid) {
10356: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10357: } elsif ($numexisting) {
10358: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10359: }
10360: $output .= $upload_output.'<br />';
10361: }
10362: my ($pathchange_output,$chgcount);
1.1071 raeburn 10363: $chgcount = $counter;
1.987 raeburn 10364: if (keys(%pathchanges) > 0) {
10365: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10366: if ($counter) {
1.987 raeburn 10367: $output .= &embedded_file_element('pathchange',$chgcount,
10368: $embed_file,\%mapping,
1.1071 raeburn 10369: $allfiles,$codebase,'change');
1.987 raeburn 10370: } else {
10371: $pathchange_output .=
10372: &start_data_table_row().
10373: '<td><input type ="checkbox" name="namechange" value="'.
10374: $chgcount.'" checked="checked" /></td>'.
10375: '<td>'.$mapping{$embed_file}.'</td>'.
10376: '<td>'.$embed_file.
10377: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10378: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10379: '</td>'.&end_data_table_row();
1.660 raeburn 10380: }
1.987 raeburn 10381: $numpathchg ++;
10382: $chgcount ++;
1.660 raeburn 10383: }
10384: }
1.1127 raeburn 10385: if (($counter) || ($numunused)) {
1.987 raeburn 10386: if ($numpathchg) {
10387: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10388: $numpathchg.'" />'."\n";
10389: }
10390: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10391: ($actionurl eq '/adm/imsimport')) {
10392: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10393: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10394: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10395: } elsif ($actionurl eq '/adm/dependencies') {
10396: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10397: }
1.1123 raeburn 10398: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10399: } elsif ($numpathchg) {
10400: my %pathchange = ();
10401: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10402: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10403: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10404: }
1.987 raeburn 10405: }
1.1071 raeburn 10406: return ($output,$counter,$numpathchg);
1.987 raeburn 10407: }
10408:
1.1147 raeburn 10409: =pod
10410:
10411: =item * clean_path($name)
10412:
10413: Performs clean-up of directories, subdirectories and filename in an
10414: embedded object, referenced in an HTML file which is being uploaded
10415: to a course or portfolio, where
10416: "Upload embedded images/multimedia files if HTML file" checkbox was
10417: checked.
10418:
10419: Clean-up is similar to replacements in lonnet::clean_filename()
10420: except each / between sub-directory and next level is preserved.
10421:
10422: =cut
10423:
10424: sub clean_path {
10425: my ($embed_file) = @_;
10426: $embed_file =~s{^/+}{};
10427: my @contents;
10428: if ($embed_file =~ m{/}) {
10429: @contents = split(/\//,$embed_file);
10430: } else {
10431: @contents = ($embed_file);
10432: }
10433: my $lastidx = scalar(@contents)-1;
10434: for (my $i=0; $i<=$lastidx; $i++) {
10435: $contents[$i]=~s{\\}{/}g;
10436: $contents[$i]=~s/\s+/\_/g;
10437: $contents[$i]=~s{[^/\w\.\-]}{}g;
10438: if ($i == $lastidx) {
10439: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10440: }
10441: }
10442: if ($lastidx > 0) {
10443: return join('/',@contents);
10444: } else {
10445: return $contents[0];
10446: }
10447: }
10448:
1.987 raeburn 10449: sub embedded_file_element {
1.1071 raeburn 10450: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10451: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10452: (ref($codebase) eq 'HASH'));
10453: my $output;
1.1071 raeburn 10454: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10455: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10456: }
10457: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10458: &escape($embed_file).'" />';
10459: unless (($context eq 'upload_embedded') &&
10460: ($mapping->{$embed_file} eq $embed_file)) {
10461: $output .='
10462: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10463: }
10464: my $attrib;
10465: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10466: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10467: }
10468: $output .=
10469: "\n\t\t".
10470: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10471: $attrib.'" />';
10472: if (exists($codebase->{$mapping->{$embed_file}})) {
10473: $output .=
10474: "\n\t\t".
10475: '<input name="codebase_'.$num.'" type="hidden" value="'.
10476: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10477: }
1.987 raeburn 10478: return $output;
1.660 raeburn 10479: }
10480:
1.1071 raeburn 10481: sub get_dependency_details {
10482: my ($currfile,$currsubfile,$embed_file) = @_;
10483: my ($size,$mtime,$showsize,$showmtime);
10484: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10485: if ($embed_file =~ m{/}) {
10486: my ($path,$fname) = split(/\//,$embed_file);
10487: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10488: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10489: }
10490: } else {
10491: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10492: ($size,$mtime) = @{$currfile->{$embed_file}};
10493: }
10494: }
10495: $showsize = $size/1024.0;
10496: $showsize = sprintf("%.1f",$showsize);
10497: if ($mtime > 0) {
10498: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10499: }
10500: }
10501: return ($showsize,$showmtime);
10502: }
10503:
10504: sub ask_embedded_js {
10505: return <<"END";
10506: <script type="text/javascript"">
10507: // <![CDATA[
10508: function toggleBrowse(counter) {
10509: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10510: var fileid = document.getElementById('embedded_item_'+counter);
10511: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10512: if (chkboxid.checked == true) {
10513: uploaddivid.style.display='block';
10514: } else {
10515: uploaddivid.style.display='none';
10516: fileid.value = '';
10517: }
10518: }
10519: // ]]>
10520: </script>
10521:
10522: END
10523: }
10524:
1.661 raeburn 10525: sub upload_embedded {
10526: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10527: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10528: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10529: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10530: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10531: my $orig_uploaded_filename =
10532: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10533: foreach my $type ('orig','ref','attrib','codebase') {
10534: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10535: $env{'form.embedded_'.$type.'_'.$i} =
10536: &unescape($env{'form.embedded_'.$type.'_'.$i});
10537: }
10538: }
1.661 raeburn 10539: my ($path,$fname) =
10540: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10541: # no path, whole string is fname
10542: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10543: $fname = &Apache::lonnet::clean_filename($fname);
10544: # See if there is anything left
10545: next if ($fname eq '');
10546:
10547: # Check if file already exists as a file or directory.
10548: my ($state,$msg);
10549: if ($context eq 'portfolio') {
10550: my $port_path = $dirpath;
10551: if ($group ne '') {
10552: $port_path = "groups/$group/$port_path";
10553: }
1.987 raeburn 10554: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10555: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10556: $dir_root,$port_path,$disk_quota,
10557: $current_disk_usage,$uname,$udom);
10558: if ($state eq 'will_exceed_quota'
1.984 raeburn 10559: || $state eq 'file_locked') {
1.661 raeburn 10560: $output .= $msg;
10561: next;
10562: }
10563: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10564: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10565: if ($state eq 'exists') {
10566: $output .= $msg;
10567: next;
10568: }
10569: }
10570: # Check if extension is valid
10571: if (($fname =~ /\.(\w+)$/) &&
10572: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10573: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10574: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10575: next;
10576: } elsif (($fname =~ /\.(\w+)$/) &&
10577: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10578: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10579: next;
10580: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10581: $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 10582: next;
10583: }
10584: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10585: my $subdir = $path;
10586: $subdir =~ s{/+$}{};
1.661 raeburn 10587: if ($context eq 'portfolio') {
1.984 raeburn 10588: my $result;
10589: if ($state eq 'existingfile') {
10590: $result=
10591: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 10592: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10593: } else {
1.984 raeburn 10594: $result=
10595: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10596: $dirpath.
1.1123 raeburn 10597: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10598: if ($result !~ m|^/uploaded/|) {
10599: $output .= '<span class="LC_error">'
10600: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10601: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10602: .'</span><br />';
10603: next;
10604: } else {
1.987 raeburn 10605: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10606: $path.$fname.'</span>').'<br />';
1.984 raeburn 10607: }
1.661 raeburn 10608: }
1.1123 raeburn 10609: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 10610: my $extendedsubdir = $dirpath.'/'.$subdir;
10611: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10612: my $result =
1.1126 raeburn 10613: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10614: if ($result !~ m|^/uploaded/|) {
10615: $output .= '<span class="LC_error">'
10616: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10617: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10618: .'</span><br />';
10619: next;
10620: } else {
10621: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10622: $path.$fname.'</span>').'<br />';
1.1125 raeburn 10623: if ($context eq 'syllabus') {
10624: &Apache::lonnet::make_public_indefinitely($result);
10625: }
1.987 raeburn 10626: }
1.661 raeburn 10627: } else {
10628: # Save the file
10629: my $target = $env{'form.embedded_item_'.$i};
10630: my $fullpath = $dir_root.$dirpath.'/'.$path;
10631: my $dest = $fullpath.$fname;
10632: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10633: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10634: my $count;
10635: my $filepath = $dir_root;
1.1027 raeburn 10636: foreach my $subdir (@parts) {
10637: $filepath .= "/$subdir";
10638: if (!-e $filepath) {
1.661 raeburn 10639: mkdir($filepath,0770);
10640: }
10641: }
10642: my $fh;
10643: if (!open($fh,'>'.$dest)) {
10644: &Apache::lonnet::logthis('Failed to create '.$dest);
10645: $output .= '<span class="LC_error">'.
1.1071 raeburn 10646: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10647: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10648: '</span><br />';
10649: } else {
10650: if (!print $fh $env{'form.embedded_item_'.$i}) {
10651: &Apache::lonnet::logthis('Failed to write to '.$dest);
10652: $output .= '<span class="LC_error">'.
1.1071 raeburn 10653: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10654: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10655: '</span><br />';
10656: } else {
1.987 raeburn 10657: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10658: $url.'</span>').'<br />';
10659: unless ($context eq 'testbank') {
10660: $footer .= &mt('View embedded file: [_1]',
10661: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10662: }
10663: }
10664: close($fh);
10665: }
10666: }
10667: if ($env{'form.embedded_ref_'.$i}) {
10668: $pathchange{$i} = 1;
10669: }
10670: }
10671: if ($output) {
10672: $output = '<p>'.$output.'</p>';
10673: }
10674: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10675: $returnflag = 'ok';
1.1071 raeburn 10676: my $numpathchgs = scalar(keys(%pathchange));
10677: if ($numpathchgs > 0) {
1.987 raeburn 10678: if ($context eq 'portfolio') {
10679: $output .= '<p>'.&mt('or').'</p>';
10680: } elsif ($context eq 'testbank') {
1.1071 raeburn 10681: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10682: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10683: $returnflag = 'modify_orightml';
10684: }
10685: }
1.1071 raeburn 10686: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10687: }
10688:
10689: sub modify_html_form {
10690: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10691: my $end = 0;
10692: my $modifyform;
10693: if ($context eq 'upload_embedded') {
10694: return unless (ref($pathchange) eq 'HASH');
10695: if ($env{'form.number_embedded_items'}) {
10696: $end += $env{'form.number_embedded_items'};
10697: }
10698: if ($env{'form.number_pathchange_items'}) {
10699: $end += $env{'form.number_pathchange_items'};
10700: }
10701: if ($end) {
10702: for (my $i=0; $i<$end; $i++) {
10703: if ($i < $env{'form.number_embedded_items'}) {
10704: next unless($pathchange->{$i});
10705: }
10706: $modifyform .=
10707: &start_data_table_row().
10708: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10709: 'checked="checked" /></td>'.
10710: '<td>'.$env{'form.embedded_ref_'.$i}.
10711: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10712: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10713: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10714: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10715: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10716: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10717: '<td>'.$env{'form.embedded_orig_'.$i}.
10718: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10719: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10720: &end_data_table_row();
1.1071 raeburn 10721: }
1.987 raeburn 10722: }
10723: } else {
10724: $modifyform = $pathchgtable;
10725: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10726: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10727: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10728: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10729: }
10730: }
10731: if ($modifyform) {
1.1071 raeburn 10732: if ($actionurl eq '/adm/dependencies') {
10733: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10734: }
1.987 raeburn 10735: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10736: '<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".
10737: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10738: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10739: '</ol></p>'."\n".'<p>'.
10740: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10741: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10742: &start_data_table()."\n".
10743: &start_data_table_header_row().
10744: '<th>'.&mt('Change?').'</th>'.
10745: '<th>'.&mt('Current reference').'</th>'.
10746: '<th>'.&mt('Required reference').'</th>'.
10747: &end_data_table_header_row()."\n".
10748: $modifyform.
10749: &end_data_table().'<br />'."\n".$hiddenstate.
10750: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10751: '</form>'."\n";
10752: }
10753: return;
10754: }
10755:
10756: sub modify_html_refs {
1.1123 raeburn 10757: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10758: my $container;
10759: if ($context eq 'portfolio') {
10760: $container = $env{'form.container'};
10761: } elsif ($context eq 'coursedoc') {
10762: $container = $env{'form.primaryurl'};
1.1071 raeburn 10763: } elsif ($context eq 'manage_dependencies') {
10764: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10765: $container = "/$container";
1.1123 raeburn 10766: } elsif ($context eq 'syllabus') {
10767: $container = $url;
1.987 raeburn 10768: } else {
1.1027 raeburn 10769: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10770: }
10771: my (%allfiles,%codebase,$output,$content);
10772: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 10773: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10774: if (wantarray) {
10775: return ('',0,0);
10776: } else {
10777: return;
10778: }
10779: }
10780: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10781: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10782: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10783: if (wantarray) {
10784: return ('',0,0);
10785: } else {
10786: return;
10787: }
10788: }
1.987 raeburn 10789: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10790: if ($content eq '-1') {
10791: if (wantarray) {
10792: return ('',0,0);
10793: } else {
10794: return;
10795: }
10796: }
1.987 raeburn 10797: } else {
1.1071 raeburn 10798: unless ($container =~ /^\Q$dir_root\E/) {
10799: if (wantarray) {
10800: return ('',0,0);
10801: } else {
10802: return;
10803: }
10804: }
1.987 raeburn 10805: if (open(my $fh,"<$container")) {
10806: $content = join('', <$fh>);
10807: close($fh);
10808: } else {
1.1071 raeburn 10809: if (wantarray) {
10810: return ('',0,0);
10811: } else {
10812: return;
10813: }
1.987 raeburn 10814: }
10815: }
10816: my ($count,$codebasecount) = (0,0);
10817: my $mm = new File::MMagic;
10818: my $mime_type = $mm->checktype_contents($content);
10819: if ($mime_type eq 'text/html') {
10820: my $parse_result =
10821: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10822: \%codebase,\$content);
10823: if ($parse_result eq 'ok') {
10824: foreach my $i (@changes) {
10825: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10826: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10827: if ($allfiles{$ref}) {
10828: my $newname = $orig;
10829: my ($attrib_regexp,$codebase);
1.1006 raeburn 10830: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10831: if ($attrib_regexp =~ /:/) {
10832: $attrib_regexp =~ s/\:/|/g;
10833: }
10834: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10835: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10836: $count += $numchg;
1.1123 raeburn 10837: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 10838: delete($allfiles{$ref});
1.987 raeburn 10839: }
10840: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10841: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10842: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10843: $codebasecount ++;
10844: }
10845: }
10846: }
1.1123 raeburn 10847: my $skiprewrites;
1.987 raeburn 10848: if ($count || $codebasecount) {
10849: my $saveresult;
1.1071 raeburn 10850: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10851: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10852: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10853: if ($url eq $container) {
10854: my ($fname) = ($container =~ m{/([^/]+)$});
10855: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10856: $count,'<span class="LC_filename">'.
1.1071 raeburn 10857: $fname.'</span>').'</p>';
1.987 raeburn 10858: } else {
10859: $output = '<p class="LC_error">'.
10860: &mt('Error: update failed for: [_1].',
10861: '<span class="LC_filename">'.
10862: $container.'</span>').'</p>';
10863: }
1.1123 raeburn 10864: if ($context eq 'syllabus') {
10865: unless ($saveresult eq 'ok') {
10866: $skiprewrites = 1;
10867: }
10868: }
1.987 raeburn 10869: } else {
10870: if (open(my $fh,">$container")) {
10871: print $fh $content;
10872: close($fh);
10873: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10874: $count,'<span class="LC_filename">'.
10875: $container.'</span>').'</p>';
1.661 raeburn 10876: } else {
1.987 raeburn 10877: $output = '<p class="LC_error">'.
10878: &mt('Error: could not update [_1].',
10879: '<span class="LC_filename">'.
10880: $container.'</span>').'</p>';
1.661 raeburn 10881: }
10882: }
10883: }
1.1123 raeburn 10884: if (($context eq 'syllabus') && (!$skiprewrites)) {
10885: my ($actionurl,$state);
10886: $actionurl = "/public/$udom/$uname/syllabus";
10887: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10888: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10889: \%codebase,
10890: {'context' => 'rewrites',
10891: 'ignore_remote_references' => 1,});
10892: if (ref($mapping) eq 'HASH') {
10893: my $rewrites = 0;
10894: foreach my $key (keys(%{$mapping})) {
10895: next if ($key =~ m{^https?://});
10896: my $ref = $mapping->{$key};
10897: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10898: my $attrib;
10899: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10900: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10901: }
10902: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10903: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10904: $rewrites += $numchg;
10905: }
10906: }
10907: if ($rewrites) {
10908: my $saveresult;
10909: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10910: if ($url eq $container) {
10911: my ($fname) = ($container =~ m{/([^/]+)$});
10912: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10913: $count,'<span class="LC_filename">'.
10914: $fname.'</span>').'</p>';
10915: } else {
10916: $output .= '<p class="LC_error">'.
10917: &mt('Error: could not update links in [_1].',
10918: '<span class="LC_filename">'.
10919: $container.'</span>').'</p>';
10920:
10921: }
10922: }
10923: }
10924: }
1.987 raeburn 10925: } else {
10926: &logthis('Failed to parse '.$container.
10927: ' to modify references: '.$parse_result);
1.661 raeburn 10928: }
10929: }
1.1071 raeburn 10930: if (wantarray) {
10931: return ($output,$count,$codebasecount);
10932: } else {
10933: return $output;
10934: }
1.661 raeburn 10935: }
10936:
10937: sub check_for_existing {
10938: my ($path,$fname,$element) = @_;
10939: my ($state,$msg);
10940: if (-d $path.'/'.$fname) {
10941: $state = 'exists';
10942: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10943: } elsif (-e $path.'/'.$fname) {
10944: $state = 'exists';
10945: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10946: }
10947: if ($state eq 'exists') {
10948: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10949: }
10950: return ($state,$msg);
10951: }
10952:
10953: sub check_for_upload {
10954: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10955: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10956: my $filesize = length($env{'form.'.$element});
10957: if (!$filesize) {
10958: my $msg = '<span class="LC_error">'.
10959: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10960: '<span class="LC_filename">'.$fname.'</span>',
10961: $filesize).'<br />'.
1.1007 raeburn 10962: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10963: '</span>';
10964: return ('zero_bytes',$msg);
10965: }
10966: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10967: my $getpropath = 1;
1.1021 raeburn 10968: my ($dirlistref,$listerror) =
10969: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10970: my $found_file = 0;
10971: my $locked_file = 0;
1.991 raeburn 10972: my @lockers;
10973: my $navmap;
10974: if ($env{'request.course.id'}) {
10975: $navmap = Apache::lonnavmaps::navmap->new();
10976: }
1.1021 raeburn 10977: if (ref($dirlistref) eq 'ARRAY') {
10978: foreach my $line (@{$dirlistref}) {
10979: my ($file_name,$rest)=split(/\&/,$line,2);
10980: if ($file_name eq $fname){
10981: $file_name = $path.$file_name;
10982: if ($group ne '') {
10983: $file_name = $group.$file_name;
10984: }
10985: $found_file = 1;
10986: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10987: foreach my $lock (@lockers) {
10988: if (ref($lock) eq 'ARRAY') {
10989: my ($symb,$crsid) = @{$lock};
10990: if ($crsid eq $env{'request.course.id'}) {
10991: if (ref($navmap)) {
10992: my $res = $navmap->getBySymb($symb);
10993: foreach my $part (@{$res->parts()}) {
10994: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10995: unless (($slot_status == $res->RESERVED) ||
10996: ($slot_status == $res->RESERVED_LOCATION)) {
10997: $locked_file = 1;
10998: }
1.991 raeburn 10999: }
1.1021 raeburn 11000: } else {
11001: $locked_file = 1;
1.991 raeburn 11002: }
11003: } else {
11004: $locked_file = 1;
11005: }
11006: }
1.1021 raeburn 11007: }
11008: } else {
11009: my @info = split(/\&/,$rest);
11010: my $currsize = $info[6]/1000;
11011: if ($currsize < $filesize) {
11012: my $extra = $filesize - $currsize;
11013: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11014: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11015: &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 11016: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11017: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11018: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11019: return ('will_exceed_quota',$msg);
11020: }
1.984 raeburn 11021: }
11022: }
1.661 raeburn 11023: }
11024: }
11025: }
11026: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11027: my $msg = '<p class="LC_warning">'.
11028: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11029: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11030: return ('will_exceed_quota',$msg);
11031: } elsif ($found_file) {
11032: if ($locked_file) {
1.1179 bisitz 11033: my $msg = '<p class="LC_warning">';
1.661 raeburn 11034: $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 11035: $msg .= '</p>';
1.661 raeburn 11036: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11037: return ('file_locked',$msg);
11038: } else {
1.1179 bisitz 11039: my $msg = '<p class="LC_error">';
1.984 raeburn 11040: $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 11041: $msg .= '</p>';
1.984 raeburn 11042: return ('existingfile',$msg);
1.661 raeburn 11043: }
11044: }
11045: }
11046:
1.987 raeburn 11047: sub check_for_traversal {
11048: my ($path,$url,$toplevel) = @_;
11049: my @parts=split(/\//,$path);
11050: my $cleanpath;
11051: my $fullpath = $url;
11052: for (my $i=0;$i<@parts;$i++) {
11053: next if ($parts[$i] eq '.');
11054: if ($parts[$i] eq '..') {
11055: $fullpath =~ s{([^/]+/)$}{};
11056: } else {
11057: $fullpath .= $parts[$i].'/';
11058: }
11059: }
11060: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11061: $cleanpath = $1;
11062: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11063: my $curr_toprel = $1;
11064: my @parts = split(/\//,$curr_toprel);
11065: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11066: my @urlparts = split(/\//,$url_toprel);
11067: my $doubledots;
11068: my $startdiff = -1;
11069: for (my $i=0; $i<@urlparts; $i++) {
11070: if ($startdiff == -1) {
11071: unless ($urlparts[$i] eq $parts[$i]) {
11072: $startdiff = $i;
11073: $doubledots .= '../';
11074: }
11075: } else {
11076: $doubledots .= '../';
11077: }
11078: }
11079: if ($startdiff > -1) {
11080: $cleanpath = $doubledots;
11081: for (my $i=$startdiff; $i<@parts; $i++) {
11082: $cleanpath .= $parts[$i].'/';
11083: }
11084: }
11085: }
11086: $cleanpath =~ s{(/)$}{};
11087: return $cleanpath;
11088: }
1.31 albertel 11089:
1.1053 raeburn 11090: sub is_archive_file {
11091: my ($mimetype) = @_;
11092: if (($mimetype eq 'application/octet-stream') ||
11093: ($mimetype eq 'application/x-stuffit') ||
11094: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11095: return 1;
11096: }
11097: return;
11098: }
11099:
11100: sub decompress_form {
1.1065 raeburn 11101: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11102: my %lt = &Apache::lonlocal::texthash (
11103: this => 'This file is an archive file.',
1.1067 raeburn 11104: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11105: itsc => 'Its contents are as follows:',
1.1053 raeburn 11106: youm => 'You may wish to extract its contents.',
11107: extr => 'Extract contents',
1.1067 raeburn 11108: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11109: proa => 'Process automatically?',
1.1053 raeburn 11110: yes => 'Yes',
11111: no => 'No',
1.1067 raeburn 11112: fold => 'Title for folder containing movie',
11113: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11114: );
1.1065 raeburn 11115: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11116: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11117: my $info = &list_archive_contents($fileloc,\@paths);
11118: if (@paths) {
11119: foreach my $path (@paths) {
11120: $path =~ s{^/}{};
1.1067 raeburn 11121: if ($path =~ m{^([^/]+)/$}) {
11122: $topdir = $1;
11123: }
1.1065 raeburn 11124: if ($path =~ m{^([^/]+)/}) {
11125: $toplevel{$1} = $path;
11126: } else {
11127: $toplevel{$path} = $path;
11128: }
11129: }
11130: }
1.1067 raeburn 11131: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11132: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11133: "$topdir/media/",
11134: "$topdir/media/$topdir.mp4",
11135: "$topdir/media/FirstFrame.png",
11136: "$topdir/media/player.swf",
11137: "$topdir/media/swfobject.js",
11138: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11139: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11140: "$topdir/$topdir.mp4",
11141: "$topdir/$topdir\_config.xml",
11142: "$topdir/$topdir\_controller.swf",
11143: "$topdir/$topdir\_embed.css",
11144: "$topdir/$topdir\_First_Frame.png",
11145: "$topdir/$topdir\_player.html",
11146: "$topdir/$topdir\_Thumbnails.png",
11147: "$topdir/playerProductInstall.swf",
11148: "$topdir/scripts/",
11149: "$topdir/scripts/config_xml.js",
11150: "$topdir/scripts/handlebars.js",
11151: "$topdir/scripts/jquery-1.7.1.min.js",
11152: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11153: "$topdir/scripts/modernizr.js",
11154: "$topdir/scripts/player-min.js",
11155: "$topdir/scripts/swfobject.js",
11156: "$topdir/skins/",
11157: "$topdir/skins/configuration_express.xml",
11158: "$topdir/skins/express_show/",
11159: "$topdir/skins/express_show/player-min.css",
11160: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11161: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11162: "$topdir/$topdir.mp4",
11163: "$topdir/$topdir\_config.xml",
11164: "$topdir/$topdir\_controller.swf",
11165: "$topdir/$topdir\_embed.css",
11166: "$topdir/$topdir\_First_Frame.png",
11167: "$topdir/$topdir\_player.html",
11168: "$topdir/$topdir\_Thumbnails.png",
11169: "$topdir/playerProductInstall.swf",
11170: "$topdir/scripts/",
11171: "$topdir/scripts/config_xml.js",
11172: "$topdir/scripts/techsmith-smart-player.min.js",
11173: "$topdir/skins/",
11174: "$topdir/skins/configuration_express.xml",
11175: "$topdir/skins/express_show/",
11176: "$topdir/skins/express_show/spritesheet.min.css",
11177: "$topdir/skins/express_show/spritesheet.png",
11178: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11179: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11180: if (@diffs == 0) {
1.1164 raeburn 11181: $is_camtasia = 6;
11182: } else {
1.1197 raeburn 11183: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11184: if (@diffs == 0) {
11185: $is_camtasia = 8;
1.1197 raeburn 11186: } else {
11187: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11188: if (@diffs == 0) {
11189: $is_camtasia = 8;
11190: }
1.1164 raeburn 11191: }
1.1067 raeburn 11192: }
11193: }
11194: my $output;
11195: if ($is_camtasia) {
11196: $output = <<"ENDCAM";
11197: <script type="text/javascript" language="Javascript">
11198: // <![CDATA[
11199:
11200: function camtasiaToggle() {
11201: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11202: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11203: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11204:
11205: document.getElementById('camtasia_titles').style.display='block';
11206: } else {
11207: document.getElementById('camtasia_titles').style.display='none';
11208: }
11209: }
11210: }
11211: return;
11212: }
11213:
11214: // ]]>
11215: </script>
11216: <p>$lt{'camt'}</p>
11217: ENDCAM
1.1065 raeburn 11218: } else {
1.1067 raeburn 11219: $output = '<p>'.$lt{'this'};
11220: if ($info eq '') {
11221: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11222: } else {
11223: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11224: '<div><pre>'.$info.'</pre></div>';
11225: }
1.1065 raeburn 11226: }
1.1067 raeburn 11227: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11228: my $duplicates;
11229: my $num = 0;
11230: if (ref($dirlist) eq 'ARRAY') {
11231: foreach my $item (@{$dirlist}) {
11232: if (ref($item) eq 'ARRAY') {
11233: if (exists($toplevel{$item->[0]})) {
11234: $duplicates .=
11235: &start_data_table_row().
11236: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11237: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11238: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11239: 'value="1" />'.&mt('Yes').'</label>'.
11240: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11241: '<td>'.$item->[0].'</td>';
11242: if ($item->[2]) {
11243: $duplicates .= '<td>'.&mt('Directory').'</td>';
11244: } else {
11245: $duplicates .= '<td>'.&mt('File').'</td>';
11246: }
11247: $duplicates .= '<td>'.$item->[3].'</td>'.
11248: '<td>'.
11249: &Apache::lonlocal::locallocaltime($item->[4]).
11250: '</td>'.
11251: &end_data_table_row();
11252: $num ++;
11253: }
11254: }
11255: }
11256: }
11257: my $itemcount;
11258: if (@paths > 0) {
11259: $itemcount = scalar(@paths);
11260: } else {
11261: $itemcount = 1;
11262: }
1.1067 raeburn 11263: if ($is_camtasia) {
11264: $output .= $lt{'auto'}.'<br />'.
11265: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11266: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11267: $lt{'yes'}.'</label> <label>'.
11268: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11269: $lt{'no'}.'</label></span><br />'.
11270: '<div id="camtasia_titles" style="display:block">'.
11271: &Apache::lonhtmlcommon::start_pick_box().
11272: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11273: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11274: &Apache::lonhtmlcommon::row_closure().
11275: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11276: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11277: &Apache::lonhtmlcommon::row_closure(1).
11278: &Apache::lonhtmlcommon::end_pick_box().
11279: '</div>';
11280: }
1.1065 raeburn 11281: $output .=
11282: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11283: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11284: "\n";
1.1065 raeburn 11285: if ($duplicates ne '') {
11286: $output .= '<p><span class="LC_warning">'.
11287: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11288: &start_data_table().
11289: &start_data_table_header_row().
11290: '<th>'.&mt('Overwrite?').'</th>'.
11291: '<th>'.&mt('Name').'</th>'.
11292: '<th>'.&mt('Type').'</th>'.
11293: '<th>'.&mt('Size').'</th>'.
11294: '<th>'.&mt('Last modified').'</th>'.
11295: &end_data_table_header_row().
11296: $duplicates.
11297: &end_data_table().
11298: '</p>';
11299: }
1.1067 raeburn 11300: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11301: if (ref($hiddenelements) eq 'HASH') {
11302: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11303: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11304: }
11305: }
11306: $output .= <<"END";
1.1067 raeburn 11307: <br />
1.1053 raeburn 11308: <input type="submit" name="decompress" value="$lt{'extr'}" />
11309: </form>
11310: $noextract
11311: END
11312: return $output;
11313: }
11314:
1.1065 raeburn 11315: sub decompression_utility {
11316: my ($program) = @_;
11317: my @utilities = ('tar','gunzip','bunzip2','unzip');
11318: my $location;
11319: if (grep(/^\Q$program\E$/,@utilities)) {
11320: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11321: '/usr/sbin/') {
11322: if (-x $dir.$program) {
11323: $location = $dir.$program;
11324: last;
11325: }
11326: }
11327: }
11328: return $location;
11329: }
11330:
11331: sub list_archive_contents {
11332: my ($file,$pathsref) = @_;
11333: my (@cmd,$output);
11334: my $needsregexp;
11335: if ($file =~ /\.zip$/) {
11336: @cmd = (&decompression_utility('unzip'),"-l");
11337: $needsregexp = 1;
11338: } elsif (($file =~ m/\.tar\.gz$/) ||
11339: ($file =~ /\.tgz$/)) {
11340: @cmd = (&decompression_utility('tar'),"-ztf");
11341: } elsif ($file =~ /\.tar\.bz2$/) {
11342: @cmd = (&decompression_utility('tar'),"-jtf");
11343: } elsif ($file =~ m|\.tar$|) {
11344: @cmd = (&decompression_utility('tar'),"-tf");
11345: }
11346: if (@cmd) {
11347: undef($!);
11348: undef($@);
11349: if (open(my $fh,"-|", @cmd, $file)) {
11350: while (my $line = <$fh>) {
11351: $output .= $line;
11352: chomp($line);
11353: my $item;
11354: if ($needsregexp) {
11355: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11356: } else {
11357: $item = $line;
11358: }
11359: if ($item ne '') {
11360: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11361: push(@{$pathsref},$item);
11362: }
11363: }
11364: }
11365: close($fh);
11366: }
11367: }
11368: return $output;
11369: }
11370:
1.1053 raeburn 11371: sub decompress_uploaded_file {
11372: my ($file,$dir) = @_;
11373: &Apache::lonnet::appenv({'cgi.file' => $file});
11374: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11375: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11376: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11377: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11378: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11379: my $decompressed = $env{'cgi.decompressed'};
11380: &Apache::lonnet::delenv('cgi.file');
11381: &Apache::lonnet::delenv('cgi.dir');
11382: &Apache::lonnet::delenv('cgi.decompressed');
11383: return ($decompressed,$result);
11384: }
11385:
1.1055 raeburn 11386: sub process_decompression {
11387: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11388: my ($dir,$error,$warning,$output);
1.1180 raeburn 11389: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11390: $error = &mt('Filename not a supported archive file type.').
11391: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11392: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11393: } else {
11394: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11395: if ($docuhome eq 'no_host') {
11396: $error = &mt('Could not determine home server for course.');
11397: } else {
11398: my @ids=&Apache::lonnet::current_machine_ids();
11399: my $currdir = "$dir_root/$destination";
11400: if (grep(/^\Q$docuhome\E$/,@ids)) {
11401: $dir = &LONCAPA::propath($docudom,$docuname).
11402: "$dir_root/$destination";
11403: } else {
11404: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11405: "$dir_root/$docudom/$docuname/$destination";
11406: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11407: $error = &mt('Archive file not found.');
11408: }
11409: }
1.1065 raeburn 11410: my (@to_overwrite,@to_skip);
11411: if ($env{'form.archive_overwrite_total'} > 0) {
11412: my $total = $env{'form.archive_overwrite_total'};
11413: for (my $i=0; $i<$total; $i++) {
11414: if ($env{'form.archive_overwrite_'.$i} == 1) {
11415: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11416: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11417: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11418: }
11419: }
11420: }
11421: my $numskip = scalar(@to_skip);
11422: if (($numskip > 0) &&
11423: ($numskip == $env{'form.archive_itemcount'})) {
11424: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11425: } elsif ($dir eq '') {
1.1055 raeburn 11426: $error = &mt('Directory containing archive file unavailable.');
11427: } elsif (!$error) {
1.1065 raeburn 11428: my ($decompressed,$display);
11429: if ($numskip > 0) {
11430: my $tempdir = time.'_'.$$.int(rand(10000));
11431: mkdir("$dir/$tempdir",0755);
11432: system("mv $dir/$file $dir/$tempdir/$file");
11433: ($decompressed,$display) =
11434: &decompress_uploaded_file($file,"$dir/$tempdir");
11435: foreach my $item (@to_skip) {
11436: if (($item ne '') && ($item !~ /\.\./)) {
11437: if (-f "$dir/$tempdir/$item") {
11438: unlink("$dir/$tempdir/$item");
11439: } elsif (-d "$dir/$tempdir/$item") {
11440: system("rm -rf $dir/$tempdir/$item");
11441: }
11442: }
11443: }
11444: system("mv $dir/$tempdir/* $dir");
11445: rmdir("$dir/$tempdir");
11446: } else {
11447: ($decompressed,$display) =
11448: &decompress_uploaded_file($file,$dir);
11449: }
1.1055 raeburn 11450: if ($decompressed eq 'ok') {
1.1065 raeburn 11451: $output = '<p class="LC_info">'.
11452: &mt('Files extracted successfully from archive.').
11453: '</p>'."\n";
1.1055 raeburn 11454: my ($warning,$result,@contents);
11455: my ($newdirlistref,$newlisterror) =
11456: &Apache::lonnet::dirlist($currdir,$docudom,
11457: $docuname,1);
11458: my (%is_dir,%changes,@newitems);
11459: my $dirptr = 16384;
1.1065 raeburn 11460: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11461: foreach my $dir_line (@{$newdirlistref}) {
11462: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11463: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11464: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11465: push(@newitems,$item);
11466: if ($dirptr&$testdir) {
11467: $is_dir{$item} = 1;
11468: }
11469: $changes{$item} = 1;
11470: }
11471: }
11472: }
11473: if (keys(%changes) > 0) {
11474: foreach my $item (sort(@newitems)) {
11475: if ($changes{$item}) {
11476: push(@contents,$item);
11477: }
11478: }
11479: }
11480: if (@contents > 0) {
1.1067 raeburn 11481: my $wantform;
11482: unless ($env{'form.autoextract_camtasia'}) {
11483: $wantform = 1;
11484: }
1.1056 raeburn 11485: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11486: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11487: $currdir,\%is_dir,
11488: \%children,\%parent,
1.1056 raeburn 11489: \@contents,\%dirorder,
11490: \%titles,$wantform);
1.1055 raeburn 11491: if ($datatable ne '') {
11492: $output .= &archive_options_form('decompressed',$datatable,
11493: $count,$hiddenelem);
1.1065 raeburn 11494: my $startcount = 6;
1.1055 raeburn 11495: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11496: \%titles,\%children);
1.1055 raeburn 11497: }
1.1067 raeburn 11498: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11499: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11500: my %displayed;
11501: my $total = 1;
11502: $env{'form.archive_directory'} = [];
11503: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11504: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11505: $path =~ s{/$}{};
11506: my $item;
11507: if ($path ne '') {
11508: $item = "$path/$titles{$i}";
11509: } else {
11510: $item = $titles{$i};
11511: }
11512: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11513: if ($item eq $contents[0]) {
11514: push(@{$env{'form.archive_directory'}},$i);
11515: $env{'form.archive_'.$i} = 'display';
11516: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11517: $displayed{'folder'} = $i;
1.1164 raeburn 11518: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11519: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11520: $env{'form.archive_'.$i} = 'display';
11521: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11522: $displayed{'web'} = $i;
11523: } else {
1.1164 raeburn 11524: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11525: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11526: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11527: push(@{$env{'form.archive_directory'}},$i);
11528: }
11529: $env{'form.archive_'.$i} = 'dependency';
11530: }
11531: $total ++;
11532: }
11533: for (my $i=1; $i<$total; $i++) {
11534: next if ($i == $displayed{'web'});
11535: next if ($i == $displayed{'folder'});
11536: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11537: }
11538: $env{'form.phase'} = 'decompress_cleanup';
11539: $env{'form.archivedelete'} = 1;
11540: $env{'form.archive_count'} = $total-1;
11541: $output .=
11542: &process_extracted_files('coursedocs',$docudom,
11543: $docuname,$destination,
11544: $dir_root,$hiddenelem);
11545: }
1.1055 raeburn 11546: } else {
11547: $warning = &mt('No new items extracted from archive file.');
11548: }
11549: } else {
11550: $output = $display;
11551: $error = &mt('An error occurred during extraction from the archive file.');
11552: }
11553: }
11554: }
11555: }
11556: if ($error) {
11557: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11558: $error.'</p>'."\n";
11559: }
11560: if ($warning) {
11561: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11562: }
11563: return $output;
11564: }
11565:
11566: sub get_extracted {
1.1056 raeburn 11567: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11568: $titles,$wantform) = @_;
1.1055 raeburn 11569: my $count = 0;
11570: my $depth = 0;
11571: my $datatable;
1.1056 raeburn 11572: my @hierarchy;
1.1055 raeburn 11573: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11574: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11575: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11576: foreach my $item (@{$contents}) {
11577: $count ++;
1.1056 raeburn 11578: @{$dirorder->{$count}} = @hierarchy;
11579: $titles->{$count} = $item;
1.1055 raeburn 11580: &archive_hierarchy($depth,$count,$parent,$children);
11581: if ($wantform) {
11582: $datatable .= &archive_row($is_dir->{$item},$item,
11583: $currdir,$depth,$count);
11584: }
11585: if ($is_dir->{$item}) {
11586: $depth ++;
1.1056 raeburn 11587: push(@hierarchy,$count);
11588: $parent->{$depth} = $count;
1.1055 raeburn 11589: $datatable .=
11590: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11591: \$depth,\$count,\@hierarchy,$dirorder,
11592: $children,$parent,$titles,$wantform);
1.1055 raeburn 11593: $depth --;
1.1056 raeburn 11594: pop(@hierarchy);
1.1055 raeburn 11595: }
11596: }
11597: return ($count,$datatable);
11598: }
11599:
11600: sub recurse_extracted_archive {
1.1056 raeburn 11601: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11602: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11603: my $result='';
1.1056 raeburn 11604: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11605: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11606: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11607: return $result;
11608: }
11609: my $dirptr = 16384;
11610: my ($newdirlistref,$newlisterror) =
11611: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11612: if (ref($newdirlistref) eq 'ARRAY') {
11613: foreach my $dir_line (@{$newdirlistref}) {
11614: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11615: unless ($item =~ /^\.+$/) {
11616: $$count ++;
1.1056 raeburn 11617: @{$dirorder->{$$count}} = @{$hierarchy};
11618: $titles->{$$count} = $item;
1.1055 raeburn 11619: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11620:
1.1055 raeburn 11621: my $is_dir;
11622: if ($dirptr&$testdir) {
11623: $is_dir = 1;
11624: }
11625: if ($wantform) {
11626: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11627: }
11628: if ($is_dir) {
11629: $$depth ++;
1.1056 raeburn 11630: push(@{$hierarchy},$$count);
11631: $parent->{$$depth} = $$count;
1.1055 raeburn 11632: $result .=
11633: &recurse_extracted_archive("$currdir/$item",$docudom,
11634: $docuname,$depth,$count,
1.1056 raeburn 11635: $hierarchy,$dirorder,$children,
11636: $parent,$titles,$wantform);
1.1055 raeburn 11637: $$depth --;
1.1056 raeburn 11638: pop(@{$hierarchy});
1.1055 raeburn 11639: }
11640: }
11641: }
11642: }
11643: return $result;
11644: }
11645:
11646: sub archive_hierarchy {
11647: my ($depth,$count,$parent,$children) =@_;
11648: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11649: if (exists($parent->{$depth})) {
11650: $children->{$parent->{$depth}} .= $count.':';
11651: }
11652: }
11653: return;
11654: }
11655:
11656: sub archive_row {
11657: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11658: my ($name) = ($item =~ m{([^/]+)$});
11659: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11660: 'display' => 'Add as file',
1.1055 raeburn 11661: 'dependency' => 'Include as dependency',
11662: 'discard' => 'Discard',
11663: );
11664: if ($is_dir) {
1.1059 raeburn 11665: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11666: }
1.1056 raeburn 11667: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11668: my $offset = 0;
1.1055 raeburn 11669: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11670: $offset ++;
1.1065 raeburn 11671: if ($action ne 'display') {
11672: $offset ++;
11673: }
1.1055 raeburn 11674: $output .= '<td><span class="LC_nobreak">'.
11675: '<label><input type="radio" name="archive_'.$count.
11676: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11677: my $text = $choices{$action};
11678: if ($is_dir) {
11679: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11680: if ($action eq 'display') {
1.1059 raeburn 11681: $text = &mt('Add as folder');
1.1055 raeburn 11682: }
1.1056 raeburn 11683: } else {
11684: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11685:
11686: }
11687: $output .= ' /> '.$choices{$action}.'</label></span>';
11688: if ($action eq 'dependency') {
11689: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11690: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11691: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11692: '<option value=""></option>'."\n".
11693: '</select>'."\n".
11694: '</div>';
1.1059 raeburn 11695: } elsif ($action eq 'display') {
11696: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11697: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11698: '</div>';
1.1055 raeburn 11699: }
1.1056 raeburn 11700: $output .= '</td>';
1.1055 raeburn 11701: }
11702: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11703: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11704: for (my $i=0; $i<$depth; $i++) {
11705: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11706: }
11707: if ($is_dir) {
11708: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11709: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11710: } else {
11711: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11712: }
11713: $output .= ' '.$name.'</td>'."\n".
11714: &end_data_table_row();
11715: return $output;
11716: }
11717:
11718: sub archive_options_form {
1.1065 raeburn 11719: my ($form,$display,$count,$hiddenelem) = @_;
11720: my %lt = &Apache::lonlocal::texthash(
11721: perm => 'Permanently remove archive file?',
11722: hows => 'How should each extracted item be incorporated in the course?',
11723: cont => 'Content actions for all',
11724: addf => 'Add as folder/file',
11725: incd => 'Include as dependency for a displayed file',
11726: disc => 'Discard',
11727: no => 'No',
11728: yes => 'Yes',
11729: save => 'Save',
11730: );
11731: my $output = <<"END";
11732: <form name="$form" method="post" action="">
11733: <p><span class="LC_nobreak">$lt{'perm'}
11734: <label>
11735: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11736: </label>
11737:
11738: <label>
11739: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11740: </span>
11741: </p>
11742: <input type="hidden" name="phase" value="decompress_cleanup" />
11743: <br />$lt{'hows'}
11744: <div class="LC_columnSection">
11745: <fieldset>
11746: <legend>$lt{'cont'}</legend>
11747: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11748: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11749: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11750: </fieldset>
11751: </div>
11752: END
11753: return $output.
1.1055 raeburn 11754: &start_data_table()."\n".
1.1065 raeburn 11755: $display."\n".
1.1055 raeburn 11756: &end_data_table()."\n".
11757: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11758: $hiddenelem.
1.1065 raeburn 11759: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11760: '</form>';
11761: }
11762:
11763: sub archive_javascript {
1.1056 raeburn 11764: my ($startcount,$numitems,$titles,$children) = @_;
11765: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11766: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11767: my $scripttag = <<START;
11768: <script type="text/javascript">
11769: // <![CDATA[
11770:
11771: function checkAll(form,prefix) {
11772: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11773: for (var i=0; i < form.elements.length; i++) {
11774: var id = form.elements[i].id;
11775: if ((id != '') && (id != undefined)) {
11776: if (idstr.test(id)) {
11777: if (form.elements[i].type == 'radio') {
11778: form.elements[i].checked = true;
1.1056 raeburn 11779: var nostart = i-$startcount;
1.1059 raeburn 11780: var offset = nostart%7;
11781: var count = (nostart-offset)/7;
1.1056 raeburn 11782: dependencyCheck(form,count,offset);
1.1055 raeburn 11783: }
11784: }
11785: }
11786: }
11787: }
11788:
11789: function propagateCheck(form,count) {
11790: if (count > 0) {
1.1059 raeburn 11791: var startelement = $startcount + ((count-1) * 7);
11792: for (var j=1; j<6; j++) {
11793: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11794: var item = startelement + j;
11795: if (form.elements[item].type == 'radio') {
11796: if (form.elements[item].checked) {
11797: containerCheck(form,count,j);
11798: break;
11799: }
1.1055 raeburn 11800: }
11801: }
11802: }
11803: }
11804: }
11805:
11806: numitems = $numitems
1.1056 raeburn 11807: var titles = new Array(numitems);
11808: var parents = new Array(numitems);
1.1055 raeburn 11809: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11810: parents[i] = new Array;
1.1055 raeburn 11811: }
1.1059 raeburn 11812: var maintitle = '$maintitle';
1.1055 raeburn 11813:
11814: START
11815:
1.1056 raeburn 11816: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11817: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11818: for (my $i=0; $i<@contents; $i ++) {
11819: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11820: }
11821: }
11822:
1.1056 raeburn 11823: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11824: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11825: }
11826:
1.1055 raeburn 11827: $scripttag .= <<END;
11828:
11829: function containerCheck(form,count,offset) {
11830: if (count > 0) {
1.1056 raeburn 11831: dependencyCheck(form,count,offset);
1.1059 raeburn 11832: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11833: form.elements[item].checked = true;
11834: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11835: if (parents[count].length > 0) {
11836: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11837: containerCheck(form,parents[count][j],offset);
11838: }
11839: }
11840: }
11841: }
11842: }
11843:
11844: function dependencyCheck(form,count,offset) {
11845: if (count > 0) {
1.1059 raeburn 11846: var chosen = (offset+$startcount)+7*(count-1);
11847: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11848: var currtype = form.elements[depitem].type;
11849: if (form.elements[chosen].value == 'dependency') {
11850: document.getElementById('arc_depon_'+count).style.display='block';
11851: form.elements[depitem].options.length = 0;
11852: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11853: for (var i=1; i<=numitems; i++) {
11854: if (i == count) {
11855: continue;
11856: }
1.1059 raeburn 11857: var startelement = $startcount + (i-1) * 7;
11858: for (var j=1; j<6; j++) {
11859: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11860: var item = startelement + j;
11861: if (form.elements[item].type == 'radio') {
11862: if (form.elements[item].checked) {
11863: if (form.elements[item].value == 'display') {
11864: var n = form.elements[depitem].options.length;
11865: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11866: }
11867: }
11868: }
11869: }
11870: }
11871: }
11872: } else {
11873: document.getElementById('arc_depon_'+count).style.display='none';
11874: form.elements[depitem].options.length = 0;
11875: form.elements[depitem].options[0] = new Option('Select','',true,true);
11876: }
1.1059 raeburn 11877: titleCheck(form,count,offset);
1.1056 raeburn 11878: }
11879: }
11880:
11881: function propagateSelect(form,count,offset) {
11882: if (count > 0) {
1.1065 raeburn 11883: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11884: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11885: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11886: if (parents[count].length > 0) {
11887: for (var j=0; j<parents[count].length; j++) {
11888: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11889: }
11890: }
11891: }
11892: }
11893: }
1.1056 raeburn 11894:
11895: function containerSelect(form,count,offset,picked) {
11896: if (count > 0) {
1.1065 raeburn 11897: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11898: if (form.elements[item].type == 'radio') {
11899: if (form.elements[item].value == 'dependency') {
11900: if (form.elements[item+1].type == 'select-one') {
11901: for (var i=0; i<form.elements[item+1].options.length; i++) {
11902: if (form.elements[item+1].options[i].value == picked) {
11903: form.elements[item+1].selectedIndex = i;
11904: break;
11905: }
11906: }
11907: }
11908: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11909: if (parents[count].length > 0) {
11910: for (var j=0; j<parents[count].length; j++) {
11911: containerSelect(form,parents[count][j],offset,picked);
11912: }
11913: }
11914: }
11915: }
11916: }
11917: }
11918: }
11919:
1.1059 raeburn 11920: function titleCheck(form,count,offset) {
11921: if (count > 0) {
11922: var chosen = (offset+$startcount)+7*(count-1);
11923: var depitem = $startcount + ((count-1) * 7) + 2;
11924: var currtype = form.elements[depitem].type;
11925: if (form.elements[chosen].value == 'display') {
11926: document.getElementById('arc_title_'+count).style.display='block';
11927: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11928: document.getElementById('archive_title_'+count).value=maintitle;
11929: }
11930: } else {
11931: document.getElementById('arc_title_'+count).style.display='none';
11932: if (currtype == 'text') {
11933: document.getElementById('archive_title_'+count).value='';
11934: }
11935: }
11936: }
11937: return;
11938: }
11939:
1.1055 raeburn 11940: // ]]>
11941: </script>
11942: END
11943: return $scripttag;
11944: }
11945:
11946: sub process_extracted_files {
1.1067 raeburn 11947: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11948: my $numitems = $env{'form.archive_count'};
11949: return unless ($numitems);
11950: my @ids=&Apache::lonnet::current_machine_ids();
11951: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11952: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11953: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11954: if (grep(/^\Q$docuhome\E$/,@ids)) {
11955: $prefix = &LONCAPA::propath($docudom,$docuname);
11956: $pathtocheck = "$dir_root/$destination";
11957: $dir = $dir_root;
11958: $ishome = 1;
11959: } else {
11960: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11961: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11962: $dir = "$dir_root/$docudom/$docuname";
11963: }
11964: my $currdir = "$dir_root/$destination";
11965: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11966: if ($env{'form.folderpath'}) {
11967: my @items = split('&',$env{'form.folderpath'});
11968: $folders{'0'} = $items[-2];
1.1099 raeburn 11969: if ($env{'form.folderpath'} =~ /\:1$/) {
11970: $containers{'0'}='page';
11971: } else {
11972: $containers{'0'}='sequence';
11973: }
1.1055 raeburn 11974: }
11975: my @archdirs = &get_env_multiple('form.archive_directory');
11976: if ($numitems) {
11977: for (my $i=1; $i<=$numitems; $i++) {
11978: my $path = $env{'form.archive_content_'.$i};
11979: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11980: my $item = $1;
11981: $toplevelitems{$item} = $i;
11982: if (grep(/^\Q$i\E$/,@archdirs)) {
11983: $is_dir{$item} = 1;
11984: }
11985: }
11986: }
11987: }
1.1067 raeburn 11988: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11989: if (keys(%toplevelitems) > 0) {
11990: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11991: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11992: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11993: }
1.1066 raeburn 11994: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11995: if ($numitems) {
11996: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11997: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11998: my $path = $env{'form.archive_content_'.$i};
11999: if ($path =~ /^\Q$pathtocheck\E/) {
12000: if ($env{'form.archive_'.$i} eq 'discard') {
12001: if ($prefix ne '' && $path ne '') {
12002: if (-e $prefix.$path) {
1.1066 raeburn 12003: if ((@archdirs > 0) &&
12004: (grep(/^\Q$i\E$/,@archdirs))) {
12005: $todeletedir{$prefix.$path} = 1;
12006: } else {
12007: $todelete{$prefix.$path} = 1;
12008: }
1.1055 raeburn 12009: }
12010: }
12011: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12012: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12013: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12014: $docstitle = $env{'form.archive_title_'.$i};
12015: if ($docstitle eq '') {
12016: $docstitle = $title;
12017: }
1.1055 raeburn 12018: $outer = 0;
1.1056 raeburn 12019: if (ref($dirorder{$i}) eq 'ARRAY') {
12020: if (@{$dirorder{$i}} > 0) {
12021: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12022: if ($env{'form.archive_'.$item} eq 'display') {
12023: $outer = $item;
12024: last;
12025: }
12026: }
12027: }
12028: }
12029: my ($errtext,$fatal) =
12030: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12031: '/'.$folders{$outer}.'.'.
12032: $containers{$outer});
12033: next if ($fatal);
12034: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12035: if ($context eq 'coursedocs') {
1.1056 raeburn 12036: $mapinner{$i} = time;
1.1055 raeburn 12037: $folders{$i} = 'default_'.$mapinner{$i};
12038: $containers{$i} = 'sequence';
12039: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12040: $folders{$i}.'.'.$containers{$i};
12041: my $newidx = &LONCAPA::map::getresidx();
12042: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12043: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12044: push(@LONCAPA::map::order,$newidx);
12045: my ($outtext,$errtext) =
12046: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12047: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12048: '.'.$containers{$outer},1,1);
1.1056 raeburn 12049: $newseqid{$i} = $newidx;
1.1067 raeburn 12050: unless ($errtext) {
12051: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12052: }
1.1055 raeburn 12053: }
12054: } else {
12055: if ($context eq 'coursedocs') {
12056: my $newidx=&LONCAPA::map::getresidx();
12057: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12058: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12059: $title;
12060: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12061: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12062: }
12063: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12064: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12065: }
12066: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12067: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12068: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12069: unless ($ishome) {
12070: my $fetch = "$newdest{$i}/$title";
12071: $fetch =~ s/^\Q$prefix$dir\E//;
12072: $prompttofetch{$fetch} = 1;
12073: }
1.1055 raeburn 12074: }
12075: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12076: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12077: push(@LONCAPA::map::order, $newidx);
12078: my ($outtext,$errtext)=
12079: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12080: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12081: '.'.$containers{$outer},1,1);
1.1067 raeburn 12082: unless ($errtext) {
12083: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12084: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12085: }
12086: }
1.1055 raeburn 12087: }
12088: }
1.1086 raeburn 12089: }
12090: } else {
12091: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12092: }
12093: }
12094: for (my $i=1; $i<=$numitems; $i++) {
12095: next unless ($env{'form.archive_'.$i} eq 'dependency');
12096: my $path = $env{'form.archive_content_'.$i};
12097: if ($path =~ /^\Q$pathtocheck\E/) {
12098: my ($title) = ($path =~ m{/([^/]+)$});
12099: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12100: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12101: if (ref($dirorder{$i}) eq 'ARRAY') {
12102: my ($itemidx,$fullpath,$relpath);
12103: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12104: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12105: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12106: if ($dirorder{$i}->[$j] eq $container) {
12107: $itemidx = $j;
1.1056 raeburn 12108: }
12109: }
1.1086 raeburn 12110: }
12111: if ($itemidx eq '') {
12112: $itemidx = 0;
12113: }
12114: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12115: if ($mapinner{$referrer{$i}}) {
12116: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12117: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12118: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12119: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12120: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12121: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12122: if (!-e $fullpath) {
12123: mkdir($fullpath,0755);
1.1056 raeburn 12124: }
12125: }
1.1086 raeburn 12126: } else {
12127: last;
1.1056 raeburn 12128: }
1.1086 raeburn 12129: }
12130: }
12131: } elsif ($newdest{$referrer{$i}}) {
12132: $fullpath = $newdest{$referrer{$i}};
12133: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12134: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12135: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12136: last;
12137: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12138: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12139: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12140: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12141: if (!-e $fullpath) {
12142: mkdir($fullpath,0755);
1.1056 raeburn 12143: }
12144: }
1.1086 raeburn 12145: } else {
12146: last;
1.1056 raeburn 12147: }
1.1055 raeburn 12148: }
12149: }
1.1086 raeburn 12150: if ($fullpath ne '') {
12151: if (-e "$prefix$path") {
12152: system("mv $prefix$path $fullpath/$title");
12153: }
12154: if (-e "$fullpath/$title") {
12155: my $showpath;
12156: if ($relpath ne '') {
12157: $showpath = "$relpath/$title";
12158: } else {
12159: $showpath = "/$title";
12160: }
12161: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12162: }
12163: unless ($ishome) {
12164: my $fetch = "$fullpath/$title";
12165: $fetch =~ s/^\Q$prefix$dir\E//;
12166: $prompttofetch{$fetch} = 1;
12167: }
12168: }
1.1055 raeburn 12169: }
1.1086 raeburn 12170: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12171: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12172: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12173: }
12174: } else {
12175: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12176: }
12177: }
12178: if (keys(%todelete)) {
12179: foreach my $key (keys(%todelete)) {
12180: unlink($key);
1.1066 raeburn 12181: }
12182: }
12183: if (keys(%todeletedir)) {
12184: foreach my $key (keys(%todeletedir)) {
12185: rmdir($key);
12186: }
12187: }
12188: foreach my $dir (sort(keys(%is_dir))) {
12189: if (($pathtocheck ne '') && ($dir ne '')) {
12190: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12191: }
12192: }
1.1067 raeburn 12193: if ($result ne '') {
12194: $output .= '<ul>'."\n".
12195: $result."\n".
12196: '</ul>';
12197: }
12198: unless ($ishome) {
12199: my $replicationfail;
12200: foreach my $item (keys(%prompttofetch)) {
12201: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12202: unless ($fetchresult eq 'ok') {
12203: $replicationfail .= '<li>'.$item.'</li>'."\n";
12204: }
12205: }
12206: if ($replicationfail) {
12207: $output .= '<p class="LC_error">'.
12208: &mt('Course home server failed to retrieve:').'<ul>'.
12209: $replicationfail.
12210: '</ul></p>';
12211: }
12212: }
1.1055 raeburn 12213: } else {
12214: $warning = &mt('No items found in archive.');
12215: }
12216: if ($error) {
12217: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12218: $error.'</p>'."\n";
12219: }
12220: if ($warning) {
12221: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12222: }
12223: return $output;
12224: }
12225:
1.1066 raeburn 12226: sub cleanup_empty_dirs {
12227: my ($path) = @_;
12228: if (($path ne '') && (-d $path)) {
12229: if (opendir(my $dirh,$path)) {
12230: my @dircontents = grep(!/^\./,readdir($dirh));
12231: my $numitems = 0;
12232: foreach my $item (@dircontents) {
12233: if (-d "$path/$item") {
1.1111 raeburn 12234: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12235: if (-e "$path/$item") {
12236: $numitems ++;
12237: }
12238: } else {
12239: $numitems ++;
12240: }
12241: }
12242: if ($numitems == 0) {
12243: rmdir($path);
12244: }
12245: closedir($dirh);
12246: }
12247: }
12248: return;
12249: }
12250:
1.41 ng 12251: =pod
1.45 matthew 12252:
1.1162 raeburn 12253: =item * &get_folder_hierarchy()
1.1068 raeburn 12254:
12255: Provides hierarchy of names of folders/sub-folders containing the current
12256: item,
12257:
12258: Inputs: 3
12259: - $navmap - navmaps object
12260:
12261: - $map - url for map (either the trigger itself, or map containing
12262: the resource, which is the trigger).
12263:
12264: - $showitem - 1 => show title for map itself; 0 => do not show.
12265:
12266: Outputs: 1 @pathitems - array of folder/subfolder names.
12267:
12268: =cut
12269:
12270: sub get_folder_hierarchy {
12271: my ($navmap,$map,$showitem) = @_;
12272: my @pathitems;
12273: if (ref($navmap)) {
12274: my $mapres = $navmap->getResourceByUrl($map);
12275: if (ref($mapres)) {
12276: my $pcslist = $mapres->map_hierarchy();
12277: if ($pcslist ne '') {
12278: my @pcs = split(/,/,$pcslist);
12279: foreach my $pc (@pcs) {
12280: if ($pc == 1) {
1.1129 raeburn 12281: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12282: } else {
12283: my $res = $navmap->getByMapPc($pc);
12284: if (ref($res)) {
12285: my $title = $res->compTitle();
12286: $title =~ s/\W+/_/g;
12287: if ($title ne '') {
12288: push(@pathitems,$title);
12289: }
12290: }
12291: }
12292: }
12293: }
1.1071 raeburn 12294: if ($showitem) {
12295: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12296: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12297: } else {
12298: my $maptitle = $mapres->compTitle();
12299: $maptitle =~ s/\W+/_/g;
12300: if ($maptitle ne '') {
12301: push(@pathitems,$maptitle);
12302: }
1.1068 raeburn 12303: }
12304: }
12305: }
12306: }
12307: return @pathitems;
12308: }
12309:
12310: =pod
12311:
1.1015 raeburn 12312: =item * &get_turnedin_filepath()
12313:
12314: Determines path in a user's portfolio file for storage of files uploaded
12315: to a specific essayresponse or dropbox item.
12316:
12317: Inputs: 3 required + 1 optional.
12318: $symb is symb for resource, $uname and $udom are for current user (required).
12319: $caller is optional (can be "submission", if routine is called when storing
12320: an upoaded file when "Submit Answer" button was pressed).
12321:
12322: Returns array containing $path and $multiresp.
12323: $path is path in portfolio. $multiresp is 1 if this resource contains more
12324: than one file upload item. Callers of routine should append partid as a
12325: subdirectory to $path in cases where $multiresp is 1.
12326:
12327: Called by: homework/essayresponse.pm and homework/structuretags.pm
12328:
12329: =cut
12330:
12331: sub get_turnedin_filepath {
12332: my ($symb,$uname,$udom,$caller) = @_;
12333: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12334: my $turnindir;
12335: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12336: $turnindir = $userhash{'turnindir'};
12337: my ($path,$multiresp);
12338: if ($turnindir eq '') {
12339: if ($caller eq 'submission') {
12340: $turnindir = &mt('turned in');
12341: $turnindir =~ s/\W+/_/g;
12342: my %newhash = (
12343: 'turnindir' => $turnindir,
12344: );
12345: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12346: }
12347: }
12348: if ($turnindir ne '') {
12349: $path = '/'.$turnindir.'/';
12350: my ($multipart,$turnin,@pathitems);
12351: my $navmap = Apache::lonnavmaps::navmap->new();
12352: if (defined($navmap)) {
12353: my $mapres = $navmap->getResourceByUrl($map);
12354: if (ref($mapres)) {
12355: my $pcslist = $mapres->map_hierarchy();
12356: if ($pcslist ne '') {
12357: foreach my $pc (split(/,/,$pcslist)) {
12358: my $res = $navmap->getByMapPc($pc);
12359: if (ref($res)) {
12360: my $title = $res->compTitle();
12361: $title =~ s/\W+/_/g;
12362: if ($title ne '') {
1.1149 raeburn 12363: if (($pc > 1) && (length($title) > 12)) {
12364: $title = substr($title,0,12);
12365: }
1.1015 raeburn 12366: push(@pathitems,$title);
12367: }
12368: }
12369: }
12370: }
12371: my $maptitle = $mapres->compTitle();
12372: $maptitle =~ s/\W+/_/g;
12373: if ($maptitle ne '') {
1.1149 raeburn 12374: if (length($maptitle) > 12) {
12375: $maptitle = substr($maptitle,0,12);
12376: }
1.1015 raeburn 12377: push(@pathitems,$maptitle);
12378: }
12379: unless ($env{'request.state'} eq 'construct') {
12380: my $res = $navmap->getBySymb($symb);
12381: if (ref($res)) {
12382: my $partlist = $res->parts();
12383: my $totaluploads = 0;
12384: if (ref($partlist) eq 'ARRAY') {
12385: foreach my $part (@{$partlist}) {
12386: my @types = $res->responseType($part);
12387: my @ids = $res->responseIds($part);
12388: for (my $i=0; $i < scalar(@ids); $i++) {
12389: if ($types[$i] eq 'essay') {
12390: my $partid = $part.'_'.$ids[$i];
12391: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12392: $totaluploads ++;
12393: }
12394: }
12395: }
12396: }
12397: if ($totaluploads > 1) {
12398: $multiresp = 1;
12399: }
12400: }
12401: }
12402: }
12403: } else {
12404: return;
12405: }
12406: } else {
12407: return;
12408: }
12409: my $restitle=&Apache::lonnet::gettitle($symb);
12410: $restitle =~ s/\W+/_/g;
12411: if ($restitle eq '') {
12412: $restitle = ($resurl =~ m{/[^/]+$});
12413: if ($restitle eq '') {
12414: $restitle = time;
12415: }
12416: }
1.1149 raeburn 12417: if (length($restitle) > 12) {
12418: $restitle = substr($restitle,0,12);
12419: }
1.1015 raeburn 12420: push(@pathitems,$restitle);
12421: $path .= join('/',@pathitems);
12422: }
12423: return ($path,$multiresp);
12424: }
12425:
12426: =pod
12427:
1.464 albertel 12428: =back
1.41 ng 12429:
1.112 bowersj2 12430: =head1 CSV Upload/Handling functions
1.38 albertel 12431:
1.41 ng 12432: =over 4
12433:
1.648 raeburn 12434: =item * &upfile_store($r)
1.41 ng 12435:
12436: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12437: needs $env{'form.upfile'}
1.41 ng 12438: returns $datatoken to be put into hidden field
12439:
12440: =cut
1.31 albertel 12441:
12442: sub upfile_store {
12443: my $r=shift;
1.258 albertel 12444: $env{'form.upfile'}=~s/\r/\n/gs;
12445: $env{'form.upfile'}=~s/\f/\n/gs;
12446: $env{'form.upfile'}=~s/\n+/\n/gs;
12447: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12448:
1.258 albertel 12449: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12450: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12451: {
1.158 raeburn 12452: my $datafile = $r->dir_config('lonDaemons').
12453: '/tmp/'.$datatoken.'.tmp';
12454: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12455: print $fh $env{'form.upfile'};
1.158 raeburn 12456: close($fh);
12457: }
1.31 albertel 12458: }
12459: return $datatoken;
12460: }
12461:
1.56 matthew 12462: =pod
12463:
1.648 raeburn 12464: =item * &load_tmp_file($r)
1.41 ng 12465:
12466: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12467: needs $env{'form.datatoken'},
12468: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12469:
12470: =cut
1.31 albertel 12471:
12472: sub load_tmp_file {
12473: my $r=shift;
12474: my @studentdata=();
12475: {
1.158 raeburn 12476: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12477: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12478: if ( open(my $fh,"<$studentfile") ) {
12479: @studentdata=<$fh>;
12480: close($fh);
12481: }
1.31 albertel 12482: }
1.258 albertel 12483: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12484: }
12485:
1.56 matthew 12486: =pod
12487:
1.648 raeburn 12488: =item * &upfile_record_sep()
1.41 ng 12489:
12490: Separate uploaded file into records
12491: returns array of records,
1.258 albertel 12492: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12493:
12494: =cut
1.31 albertel 12495:
12496: sub upfile_record_sep {
1.258 albertel 12497: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12498: } else {
1.248 albertel 12499: my @records;
1.258 albertel 12500: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12501: if ($line=~/^\s*$/) { next; }
12502: push(@records,$line);
12503: }
12504: return @records;
1.31 albertel 12505: }
12506: }
12507:
1.56 matthew 12508: =pod
12509:
1.648 raeburn 12510: =item * &record_sep($record)
1.41 ng 12511:
1.258 albertel 12512: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12513:
12514: =cut
12515:
1.263 www 12516: sub takeleft {
12517: my $index=shift;
12518: return substr('0000'.$index,-4,4);
12519: }
12520:
1.31 albertel 12521: sub record_sep {
12522: my $record=shift;
12523: my %components=();
1.258 albertel 12524: if ($env{'form.upfiletype'} eq 'xml') {
12525: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12526: my $i=0;
1.356 albertel 12527: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12528: $field=~s/^(\"|\')//;
12529: $field=~s/(\"|\')$//;
1.263 www 12530: $components{&takeleft($i)}=$field;
1.31 albertel 12531: $i++;
12532: }
1.258 albertel 12533: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12534: my $i=0;
1.356 albertel 12535: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12536: $field=~s/^(\"|\')//;
12537: $field=~s/(\"|\')$//;
1.263 www 12538: $components{&takeleft($i)}=$field;
1.31 albertel 12539: $i++;
12540: }
12541: } else {
1.561 www 12542: my $separator=',';
1.480 banghart 12543: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12544: $separator=';';
1.480 banghart 12545: }
1.31 albertel 12546: my $i=0;
1.561 www 12547: # the character we are looking for to indicate the end of a quote or a record
12548: my $looking_for=$separator;
12549: # do not add the characters to the fields
12550: my $ignore=0;
12551: # we just encountered a separator (or the beginning of the record)
12552: my $just_found_separator=1;
12553: # store the field we are working on here
12554: my $field='';
12555: # work our way through all characters in record
12556: foreach my $character ($record=~/(.)/g) {
12557: if ($character eq $looking_for) {
12558: if ($character ne $separator) {
12559: # Found the end of a quote, again looking for separator
12560: $looking_for=$separator;
12561: $ignore=1;
12562: } else {
12563: # Found a separator, store away what we got
12564: $components{&takeleft($i)}=$field;
12565: $i++;
12566: $just_found_separator=1;
12567: $ignore=0;
12568: $field='';
12569: }
12570: next;
12571: }
12572: # single or double quotation marks after a separator indicate beginning of a quote
12573: # we are now looking for the end of the quote and need to ignore separators
12574: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12575: $looking_for=$character;
12576: next;
12577: }
12578: # ignore would be true after we reached the end of a quote
12579: if ($ignore) { next; }
12580: if (($just_found_separator) && ($character=~/\s/)) { next; }
12581: $field.=$character;
12582: $just_found_separator=0;
1.31 albertel 12583: }
1.561 www 12584: # catch the very last entry, since we never encountered the separator
12585: $components{&takeleft($i)}=$field;
1.31 albertel 12586: }
12587: return %components;
12588: }
12589:
1.144 matthew 12590: ######################################################
12591: ######################################################
12592:
1.56 matthew 12593: =pod
12594:
1.648 raeburn 12595: =item * &upfile_select_html()
1.41 ng 12596:
1.144 matthew 12597: Return HTML code to select a file from the users machine and specify
12598: the file type.
1.41 ng 12599:
12600: =cut
12601:
1.144 matthew 12602: ######################################################
12603: ######################################################
1.31 albertel 12604: sub upfile_select_html {
1.144 matthew 12605: my %Types = (
12606: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12607: semisv => &mt('Semicolon separated values'),
1.144 matthew 12608: space => &mt('Space separated'),
12609: tab => &mt('Tabulator separated'),
12610: # xml => &mt('HTML/XML'),
12611: );
12612: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12613: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12614: foreach my $type (sort(keys(%Types))) {
12615: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12616: }
12617: $Str .= "</select>\n";
12618: return $Str;
1.31 albertel 12619: }
12620:
1.301 albertel 12621: sub get_samples {
12622: my ($records,$toget) = @_;
12623: my @samples=({});
12624: my $got=0;
12625: foreach my $rec (@$records) {
12626: my %temp = &record_sep($rec);
12627: if (! grep(/\S/, values(%temp))) { next; }
12628: if (%temp) {
12629: $samples[$got]=\%temp;
12630: $got++;
12631: if ($got == $toget) { last; }
12632: }
12633: }
12634: return \@samples;
12635: }
12636:
1.144 matthew 12637: ######################################################
12638: ######################################################
12639:
1.56 matthew 12640: =pod
12641:
1.648 raeburn 12642: =item * &csv_print_samples($r,$records)
1.41 ng 12643:
12644: Prints a table of sample values from each column uploaded $r is an
12645: Apache Request ref, $records is an arrayref from
12646: &Apache::loncommon::upfile_record_sep
12647:
12648: =cut
12649:
1.144 matthew 12650: ######################################################
12651: ######################################################
1.31 albertel 12652: sub csv_print_samples {
12653: my ($r,$records) = @_;
1.662 bisitz 12654: my $samples = &get_samples($records,5);
1.301 albertel 12655:
1.594 raeburn 12656: $r->print(&mt('Samples').'<br />'.&start_data_table().
12657: &start_data_table_header_row());
1.356 albertel 12658: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12659: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12660: $r->print(&end_data_table_header_row());
1.301 albertel 12661: foreach my $hash (@$samples) {
1.594 raeburn 12662: $r->print(&start_data_table_row());
1.356 albertel 12663: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12664: $r->print('<td>');
1.356 albertel 12665: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12666: $r->print('</td>');
12667: }
1.594 raeburn 12668: $r->print(&end_data_table_row());
1.31 albertel 12669: }
1.594 raeburn 12670: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12671: }
12672:
1.144 matthew 12673: ######################################################
12674: ######################################################
12675:
1.56 matthew 12676: =pod
12677:
1.648 raeburn 12678: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12679:
12680: Prints a table to create associations between values and table columns.
1.144 matthew 12681:
1.41 ng 12682: $r is an Apache Request ref,
12683: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12684: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12685:
12686: =cut
12687:
1.144 matthew 12688: ######################################################
12689: ######################################################
1.31 albertel 12690: sub csv_print_select_table {
12691: my ($r,$records,$d) = @_;
1.301 albertel 12692: my $i=0;
12693: my $samples = &get_samples($records,1);
1.144 matthew 12694: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12695: &start_data_table().&start_data_table_header_row().
1.144 matthew 12696: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12697: '<th>'.&mt('Column').'</th>'.
12698: &end_data_table_header_row()."\n");
1.356 albertel 12699: foreach my $array_ref (@$d) {
12700: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12701: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12702:
1.875 bisitz 12703: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12704: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12705: $r->print('<option value="none"></option>');
1.356 albertel 12706: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12707: $r->print('<option value="'.$sample.'"'.
12708: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12709: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12710: }
1.594 raeburn 12711: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12712: $i++;
12713: }
1.594 raeburn 12714: $r->print(&end_data_table());
1.31 albertel 12715: $i--;
12716: return $i;
12717: }
1.56 matthew 12718:
1.144 matthew 12719: ######################################################
12720: ######################################################
12721:
1.56 matthew 12722: =pod
1.31 albertel 12723:
1.648 raeburn 12724: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12725:
12726: Prints a table of sample values from the upload and can make associate samples to internal names.
12727:
12728: $r is an Apache Request ref,
12729: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12730: $d is an array of 2 element arrays (internal name, displayed name)
12731:
12732: =cut
12733:
1.144 matthew 12734: ######################################################
12735: ######################################################
1.31 albertel 12736: sub csv_samples_select_table {
12737: my ($r,$records,$d) = @_;
12738: my $i=0;
1.144 matthew 12739: #
1.662 bisitz 12740: my $max_samples = 5;
12741: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12742: $r->print(&start_data_table().
12743: &start_data_table_header_row().'<th>'.
12744: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12745: &end_data_table_header_row());
1.301 albertel 12746:
12747: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12748: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12749: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12750: foreach my $option (@$d) {
12751: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12752: $r->print('<option value="'.$value.'"'.
1.253 albertel 12753: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12754: $display.'</option>');
1.31 albertel 12755: }
12756: $r->print('</select></td><td>');
1.662 bisitz 12757: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12758: if (defined($samples->[$line]{$key})) {
12759: $r->print($samples->[$line]{$key}."<br />\n");
12760: }
12761: }
1.594 raeburn 12762: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12763: $i++;
12764: }
1.594 raeburn 12765: $r->print(&end_data_table());
1.31 albertel 12766: $i--;
12767: return($i);
1.115 matthew 12768: }
12769:
1.144 matthew 12770: ######################################################
12771: ######################################################
12772:
1.115 matthew 12773: =pod
12774:
1.648 raeburn 12775: =item * &clean_excel_name($name)
1.115 matthew 12776:
12777: Returns a replacement for $name which does not contain any illegal characters.
12778:
12779: =cut
12780:
1.144 matthew 12781: ######################################################
12782: ######################################################
1.115 matthew 12783: sub clean_excel_name {
12784: my ($name) = @_;
12785: $name =~ s/[:\*\?\/\\]//g;
12786: if (length($name) > 31) {
12787: $name = substr($name,0,31);
12788: }
12789: return $name;
1.25 albertel 12790: }
1.84 albertel 12791:
1.85 albertel 12792: =pod
12793:
1.648 raeburn 12794: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12795:
12796: Returns either 1 or undef
12797:
12798: 1 if the part is to be hidden, undef if it is to be shown
12799:
12800: Arguments are:
12801:
12802: $id the id of the part to be checked
12803: $symb, optional the symb of the resource to check
12804: $udom, optional the domain of the user to check for
12805: $uname, optional the username of the user to check for
12806:
12807: =cut
1.84 albertel 12808:
12809: sub check_if_partid_hidden {
12810: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12811: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12812: $symb,$udom,$uname);
1.141 albertel 12813: my $truth=1;
12814: #if the string starts with !, then the list is the list to show not hide
12815: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12816: my @hiddenlist=split(/,/,$hiddenparts);
12817: foreach my $checkid (@hiddenlist) {
1.141 albertel 12818: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12819: }
1.141 albertel 12820: return !$truth;
1.84 albertel 12821: }
1.127 matthew 12822:
1.138 matthew 12823:
12824: ############################################################
12825: ############################################################
12826:
12827: =pod
12828:
1.157 matthew 12829: =back
12830:
1.138 matthew 12831: =head1 cgi-bin script and graphing routines
12832:
1.157 matthew 12833: =over 4
12834:
1.648 raeburn 12835: =item * &get_cgi_id()
1.138 matthew 12836:
12837: Inputs: none
12838:
12839: Returns an id which can be used to pass environment variables
12840: to various cgi-bin scripts. These environment variables will
12841: be removed from the users environment after a given time by
12842: the routine &Apache::lonnet::transfer_profile_to_env.
12843:
12844: =cut
12845:
12846: ############################################################
12847: ############################################################
1.152 albertel 12848: my $uniq=0;
1.136 matthew 12849: sub get_cgi_id {
1.154 albertel 12850: $uniq=($uniq+1)%100000;
1.280 albertel 12851: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12852: }
12853:
1.127 matthew 12854: ############################################################
12855: ############################################################
12856:
12857: =pod
12858:
1.648 raeburn 12859: =item * &DrawBarGraph()
1.127 matthew 12860:
1.138 matthew 12861: Facilitates the plotting of data in a (stacked) bar graph.
12862: Puts plot definition data into the users environment in order for
12863: graph.png to plot it. Returns an <img> tag for the plot.
12864: The bars on the plot are labeled '1','2',...,'n'.
12865:
12866: Inputs:
12867:
12868: =over 4
12869:
12870: =item $Title: string, the title of the plot
12871:
12872: =item $xlabel: string, text describing the X-axis of the plot
12873:
12874: =item $ylabel: string, text describing the Y-axis of the plot
12875:
12876: =item $Max: scalar, the maximum Y value to use in the plot
12877: If $Max is < any data point, the graph will not be rendered.
12878:
1.140 matthew 12879: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12880: they are plotted. If undefined, default values will be used.
12881:
1.178 matthew 12882: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12883:
1.138 matthew 12884: =item @Values: An array of array references. Each array reference holds data
12885: to be plotted in a stacked bar chart.
12886:
1.239 matthew 12887: =item If the final element of @Values is a hash reference the key/value
12888: pairs will be added to the graph definition.
12889:
1.138 matthew 12890: =back
12891:
12892: Returns:
12893:
12894: An <img> tag which references graph.png and the appropriate identifying
12895: information for the plot.
12896:
1.127 matthew 12897: =cut
12898:
12899: ############################################################
12900: ############################################################
1.134 matthew 12901: sub DrawBarGraph {
1.178 matthew 12902: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12903: #
12904: if (! defined($colors)) {
12905: $colors = ['#33ff00',
12906: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12907: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12908: ];
12909: }
1.228 matthew 12910: my $extra_settings = {};
12911: if (ref($Values[-1]) eq 'HASH') {
12912: $extra_settings = pop(@Values);
12913: }
1.127 matthew 12914: #
1.136 matthew 12915: my $identifier = &get_cgi_id();
12916: my $id = 'cgi.'.$identifier;
1.129 matthew 12917: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12918: return '';
12919: }
1.225 matthew 12920: #
12921: my @Labels;
12922: if (defined($labels)) {
12923: @Labels = @$labels;
12924: } else {
12925: for (my $i=0;$i<@{$Values[0]};$i++) {
12926: push (@Labels,$i+1);
12927: }
12928: }
12929: #
1.129 matthew 12930: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12931: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12932: my %ValuesHash;
12933: my $NumSets=1;
12934: foreach my $array (@Values) {
12935: next if (! ref($array));
1.136 matthew 12936: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12937: join(',',@$array);
1.129 matthew 12938: }
1.127 matthew 12939: #
1.136 matthew 12940: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12941: if ($NumBars < 3) {
12942: $width = 120+$NumBars*32;
1.220 matthew 12943: $xskip = 1;
1.225 matthew 12944: $bar_width = 30;
12945: } elsif ($NumBars < 5) {
12946: $width = 120+$NumBars*20;
12947: $xskip = 1;
12948: $bar_width = 20;
1.220 matthew 12949: } elsif ($NumBars < 10) {
1.136 matthew 12950: $width = 120+$NumBars*15;
12951: $xskip = 1;
12952: $bar_width = 15;
12953: } elsif ($NumBars <= 25) {
12954: $width = 120+$NumBars*11;
12955: $xskip = 5;
12956: $bar_width = 8;
12957: } elsif ($NumBars <= 50) {
12958: $width = 120+$NumBars*8;
12959: $xskip = 5;
12960: $bar_width = 4;
12961: } else {
12962: $width = 120+$NumBars*8;
12963: $xskip = 5;
12964: $bar_width = 4;
12965: }
12966: #
1.137 matthew 12967: $Max = 1 if ($Max < 1);
12968: if ( int($Max) < $Max ) {
12969: $Max++;
12970: $Max = int($Max);
12971: }
1.127 matthew 12972: $Title = '' if (! defined($Title));
12973: $xlabel = '' if (! defined($xlabel));
12974: $ylabel = '' if (! defined($ylabel));
1.369 www 12975: $ValuesHash{$id.'.title'} = &escape($Title);
12976: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12977: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12978: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12979: $ValuesHash{$id.'.NumBars'} = $NumBars;
12980: $ValuesHash{$id.'.NumSets'} = $NumSets;
12981: $ValuesHash{$id.'.PlotType'} = 'bar';
12982: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12983: $ValuesHash{$id.'.height'} = $height;
12984: $ValuesHash{$id.'.width'} = $width;
12985: $ValuesHash{$id.'.xskip'} = $xskip;
12986: $ValuesHash{$id.'.bar_width'} = $bar_width;
12987: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12988: #
1.228 matthew 12989: # Deal with other parameters
12990: while (my ($key,$value) = each(%$extra_settings)) {
12991: $ValuesHash{$id.'.'.$key} = $value;
12992: }
12993: #
1.646 raeburn 12994: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12995: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12996: }
12997:
12998: ############################################################
12999: ############################################################
13000:
13001: =pod
13002:
1.648 raeburn 13003: =item * &DrawXYGraph()
1.137 matthew 13004:
1.138 matthew 13005: Facilitates the plotting of data in an XY graph.
13006: Puts plot definition data into the users environment in order for
13007: graph.png to plot it. Returns an <img> tag for the plot.
13008:
13009: Inputs:
13010:
13011: =over 4
13012:
13013: =item $Title: string, the title of the plot
13014:
13015: =item $xlabel: string, text describing the X-axis of the plot
13016:
13017: =item $ylabel: string, text describing the Y-axis of the plot
13018:
13019: =item $Max: scalar, the maximum Y value to use in the plot
13020: If $Max is < any data point, the graph will not be rendered.
13021:
13022: =item $colors: Array ref containing the hex color codes for the data to be
13023: plotted in. If undefined, default values will be used.
13024:
13025: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13026:
13027: =item $Ydata: Array ref containing Array refs.
1.185 www 13028: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13029:
13030: =item %Values: hash indicating or overriding any default values which are
13031: passed to graph.png.
13032: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13033:
13034: =back
13035:
13036: Returns:
13037:
13038: An <img> tag which references graph.png and the appropriate identifying
13039: information for the plot.
13040:
1.137 matthew 13041: =cut
13042:
13043: ############################################################
13044: ############################################################
13045: sub DrawXYGraph {
13046: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13047: #
13048: # Create the identifier for the graph
13049: my $identifier = &get_cgi_id();
13050: my $id = 'cgi.'.$identifier;
13051: #
13052: $Title = '' if (! defined($Title));
13053: $xlabel = '' if (! defined($xlabel));
13054: $ylabel = '' if (! defined($ylabel));
13055: my %ValuesHash =
13056: (
1.369 www 13057: $id.'.title' => &escape($Title),
13058: $id.'.xlabel' => &escape($xlabel),
13059: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13060: $id.'.y_max_value'=> $Max,
13061: $id.'.labels' => join(',',@$Xlabels),
13062: $id.'.PlotType' => 'XY',
13063: );
13064: #
13065: if (defined($colors) && ref($colors) eq 'ARRAY') {
13066: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13067: }
13068: #
13069: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13070: return '';
13071: }
13072: my $NumSets=1;
1.138 matthew 13073: foreach my $array (@{$Ydata}){
1.137 matthew 13074: next if (! ref($array));
13075: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13076: }
1.138 matthew 13077: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13078: #
13079: # Deal with other parameters
13080: while (my ($key,$value) = each(%Values)) {
13081: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13082: }
13083: #
1.646 raeburn 13084: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13085: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13086: }
13087:
13088: ############################################################
13089: ############################################################
13090:
13091: =pod
13092:
1.648 raeburn 13093: =item * &DrawXYYGraph()
1.138 matthew 13094:
13095: Facilitates the plotting of data in an XY graph with two Y axes.
13096: Puts plot definition data into the users environment in order for
13097: graph.png to plot it. Returns an <img> tag for the plot.
13098:
13099: Inputs:
13100:
13101: =over 4
13102:
13103: =item $Title: string, the title of the plot
13104:
13105: =item $xlabel: string, text describing the X-axis of the plot
13106:
13107: =item $ylabel: string, text describing the Y-axis of the plot
13108:
13109: =item $colors: Array ref containing the hex color codes for the data to be
13110: plotted in. If undefined, default values will be used.
13111:
13112: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13113:
13114: =item $Ydata1: The first data set
13115:
13116: =item $Min1: The minimum value of the left Y-axis
13117:
13118: =item $Max1: The maximum value of the left Y-axis
13119:
13120: =item $Ydata2: The second data set
13121:
13122: =item $Min2: The minimum value of the right Y-axis
13123:
13124: =item $Max2: The maximum value of the left Y-axis
13125:
13126: =item %Values: hash indicating or overriding any default values which are
13127: passed to graph.png.
13128: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13129:
13130: =back
13131:
13132: Returns:
13133:
13134: An <img> tag which references graph.png and the appropriate identifying
13135: information for the plot.
1.136 matthew 13136:
13137: =cut
13138:
13139: ############################################################
13140: ############################################################
1.137 matthew 13141: sub DrawXYYGraph {
13142: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13143: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13144: #
13145: # Create the identifier for the graph
13146: my $identifier = &get_cgi_id();
13147: my $id = 'cgi.'.$identifier;
13148: #
13149: $Title = '' if (! defined($Title));
13150: $xlabel = '' if (! defined($xlabel));
13151: $ylabel = '' if (! defined($ylabel));
13152: my %ValuesHash =
13153: (
1.369 www 13154: $id.'.title' => &escape($Title),
13155: $id.'.xlabel' => &escape($xlabel),
13156: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13157: $id.'.labels' => join(',',@$Xlabels),
13158: $id.'.PlotType' => 'XY',
13159: $id.'.NumSets' => 2,
1.137 matthew 13160: $id.'.two_axes' => 1,
13161: $id.'.y1_max_value' => $Max1,
13162: $id.'.y1_min_value' => $Min1,
13163: $id.'.y2_max_value' => $Max2,
13164: $id.'.y2_min_value' => $Min2,
1.136 matthew 13165: );
13166: #
1.137 matthew 13167: if (defined($colors) && ref($colors) eq 'ARRAY') {
13168: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13169: }
13170: #
13171: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13172: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13173: return '';
13174: }
13175: my $NumSets=1;
1.137 matthew 13176: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13177: next if (! ref($array));
13178: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13179: }
13180: #
13181: # Deal with other parameters
13182: while (my ($key,$value) = each(%Values)) {
13183: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13184: }
13185: #
1.646 raeburn 13186: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13187: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13188: }
13189:
13190: ############################################################
13191: ############################################################
13192:
13193: =pod
13194:
1.157 matthew 13195: =back
13196:
1.139 matthew 13197: =head1 Statistics helper routines?
13198:
13199: Bad place for them but what the hell.
13200:
1.157 matthew 13201: =over 4
13202:
1.648 raeburn 13203: =item * &chartlink()
1.139 matthew 13204:
13205: Returns a link to the chart for a specific student.
13206:
13207: Inputs:
13208:
13209: =over 4
13210:
13211: =item $linktext: The text of the link
13212:
13213: =item $sname: The students username
13214:
13215: =item $sdomain: The students domain
13216:
13217: =back
13218:
1.157 matthew 13219: =back
13220:
1.139 matthew 13221: =cut
13222:
13223: ############################################################
13224: ############################################################
13225: sub chartlink {
13226: my ($linktext, $sname, $sdomain) = @_;
13227: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13228: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13229: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13230: '">'.$linktext.'</a>';
1.153 matthew 13231: }
13232:
13233: #######################################################
13234: #######################################################
13235:
13236: =pod
13237:
13238: =head1 Course Environment Routines
1.157 matthew 13239:
13240: =over 4
1.153 matthew 13241:
1.648 raeburn 13242: =item * &restore_course_settings()
1.153 matthew 13243:
1.648 raeburn 13244: =item * &store_course_settings()
1.153 matthew 13245:
13246: Restores/Store indicated form parameters from the course environment.
13247: Will not overwrite existing values of the form parameters.
13248:
13249: Inputs:
13250: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13251:
13252: a hash ref describing the data to be stored. For example:
13253:
13254: %Save_Parameters = ('Status' => 'scalar',
13255: 'chartoutputmode' => 'scalar',
13256: 'chartoutputdata' => 'scalar',
13257: 'Section' => 'array',
1.373 raeburn 13258: 'Group' => 'array',
1.153 matthew 13259: 'StudentData' => 'array',
13260: 'Maps' => 'array');
13261:
13262: Returns: both routines return nothing
13263:
1.631 raeburn 13264: =back
13265:
1.153 matthew 13266: =cut
13267:
13268: #######################################################
13269: #######################################################
13270: sub store_course_settings {
1.496 albertel 13271: return &store_settings($env{'request.course.id'},@_);
13272: }
13273:
13274: sub store_settings {
1.153 matthew 13275: # save to the environment
13276: # appenv the same items, just to be safe
1.300 albertel 13277: my $udom = $env{'user.domain'};
13278: my $uname = $env{'user.name'};
1.496 albertel 13279: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13280: my %SaveHash;
13281: my %AppHash;
13282: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13283: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13284: my $envname = 'environment.'.$basename;
1.258 albertel 13285: if (exists($env{'form.'.$setting})) {
1.153 matthew 13286: # Save this value away
13287: if ($type eq 'scalar' &&
1.258 albertel 13288: (! exists($env{$envname}) ||
13289: $env{$envname} ne $env{'form.'.$setting})) {
13290: $SaveHash{$basename} = $env{'form.'.$setting};
13291: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13292: } elsif ($type eq 'array') {
13293: my $stored_form;
1.258 albertel 13294: if (ref($env{'form.'.$setting})) {
1.153 matthew 13295: $stored_form = join(',',
13296: map {
1.369 www 13297: &escape($_);
1.258 albertel 13298: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13299: } else {
13300: $stored_form =
1.369 www 13301: &escape($env{'form.'.$setting});
1.153 matthew 13302: }
13303: # Determine if the array contents are the same.
1.258 albertel 13304: if ($stored_form ne $env{$envname}) {
1.153 matthew 13305: $SaveHash{$basename} = $stored_form;
13306: $AppHash{$envname} = $stored_form;
13307: }
13308: }
13309: }
13310: }
13311: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13312: $udom,$uname);
1.153 matthew 13313: if ($put_result !~ /^(ok|delayed)/) {
13314: &Apache::lonnet::logthis('unable to save form parameters, '.
13315: 'got error:'.$put_result);
13316: }
13317: # Make sure these settings stick around in this session, too
1.646 raeburn 13318: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13319: return;
13320: }
13321:
13322: sub restore_course_settings {
1.499 albertel 13323: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13324: }
13325:
13326: sub restore_settings {
13327: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13328: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13329: next if (exists($env{'form.'.$setting}));
1.496 albertel 13330: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13331: '.'.$setting;
1.258 albertel 13332: if (exists($env{$envname})) {
1.153 matthew 13333: if ($type eq 'scalar') {
1.258 albertel 13334: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13335: } elsif ($type eq 'array') {
1.258 albertel 13336: $env{'form.'.$setting} = [
1.153 matthew 13337: map {
1.369 www 13338: &unescape($_);
1.258 albertel 13339: } split(',',$env{$envname})
1.153 matthew 13340: ];
13341: }
13342: }
13343: }
1.127 matthew 13344: }
13345:
1.618 raeburn 13346: #######################################################
13347: #######################################################
13348:
13349: =pod
13350:
13351: =head1 Domain E-mail Routines
13352:
13353: =over 4
13354:
1.648 raeburn 13355: =item * &build_recipient_list()
1.618 raeburn 13356:
1.1144 raeburn 13357: Build recipient lists for following types of e-mail:
1.766 raeburn 13358: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13359: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13360: module change checking, student/employee ID conflict checks, as
13361: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13362: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13363:
13364: Inputs:
1.619 raeburn 13365: defmail (scalar - email address of default recipient),
1.1144 raeburn 13366: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13367: requestsmail, updatesmail, or idconflictsmail).
13368:
1.619 raeburn 13369: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13370:
1.619 raeburn 13371: origmail (scalar - email address of recipient from loncapa.conf,
13372: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13373:
1.655 raeburn 13374: Returns: comma separated list of addresses to which to send e-mail.
13375:
13376: =back
1.618 raeburn 13377:
13378: =cut
13379:
13380: ############################################################
13381: ############################################################
13382: sub build_recipient_list {
1.619 raeburn 13383: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13384: my @recipients;
13385: my $otheremails;
13386: my %domconfig =
13387: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13388: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13389: if (exists($domconfig{'contacts'}{$mailing})) {
13390: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13391: my @contacts = ('adminemail','supportemail');
13392: foreach my $item (@contacts) {
13393: if ($domconfig{'contacts'}{$mailing}{$item}) {
13394: my $addr = $domconfig{'contacts'}{$item};
13395: if (!grep(/^\Q$addr\E$/,@recipients)) {
13396: push(@recipients,$addr);
13397: }
1.619 raeburn 13398: }
1.766 raeburn 13399: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13400: }
13401: }
1.766 raeburn 13402: } elsif ($origmail ne '') {
13403: push(@recipients,$origmail);
1.618 raeburn 13404: }
1.619 raeburn 13405: } elsif ($origmail ne '') {
13406: push(@recipients,$origmail);
1.618 raeburn 13407: }
1.688 raeburn 13408: if (defined($defmail)) {
13409: if ($defmail ne '') {
13410: push(@recipients,$defmail);
13411: }
1.618 raeburn 13412: }
13413: if ($otheremails) {
1.619 raeburn 13414: my @others;
13415: if ($otheremails =~ /,/) {
13416: @others = split(/,/,$otheremails);
1.618 raeburn 13417: } else {
1.619 raeburn 13418: push(@others,$otheremails);
13419: }
13420: foreach my $addr (@others) {
13421: if (!grep(/^\Q$addr\E$/,@recipients)) {
13422: push(@recipients,$addr);
13423: }
1.618 raeburn 13424: }
13425: }
1.619 raeburn 13426: my $recipientlist = join(',',@recipients);
1.618 raeburn 13427: return $recipientlist;
13428: }
13429:
1.127 matthew 13430: ############################################################
13431: ############################################################
1.154 albertel 13432:
1.655 raeburn 13433: =pod
13434:
13435: =head1 Course Catalog Routines
13436:
13437: =over 4
13438:
13439: =item * &gather_categories()
13440:
13441: Converts category definitions - keys of categories hash stored in
13442: coursecategories in configuration.db on the primary library server in a
13443: domain - to an array. Also generates javascript and idx hash used to
13444: generate Domain Coordinator interface for editing Course Categories.
13445:
13446: Inputs:
1.663 raeburn 13447:
1.655 raeburn 13448: categories (reference to hash of category definitions).
1.663 raeburn 13449:
1.655 raeburn 13450: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13451: categories and subcategories).
1.663 raeburn 13452:
1.655 raeburn 13453: idx (reference to hash of counters used in Domain Coordinator interface for
13454: editing Course Categories).
1.663 raeburn 13455:
1.655 raeburn 13456: jsarray (reference to array of categories used to create Javascript arrays for
13457: Domain Coordinator interface for editing Course Categories).
13458:
13459: Returns: nothing
13460:
13461: Side effects: populates cats, idx and jsarray.
13462:
13463: =cut
13464:
13465: sub gather_categories {
13466: my ($categories,$cats,$idx,$jsarray) = @_;
13467: my %counters;
13468: my $num = 0;
13469: foreach my $item (keys(%{$categories})) {
13470: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13471: if ($container eq '' && $depth == 0) {
13472: $cats->[$depth][$categories->{$item}] = $cat;
13473: } else {
13474: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13475: }
13476: my ($escitem,$tail) = split(/:/,$item,2);
13477: if ($counters{$tail} eq '') {
13478: $counters{$tail} = $num;
13479: $num ++;
13480: }
13481: if (ref($idx) eq 'HASH') {
13482: $idx->{$item} = $counters{$tail};
13483: }
13484: if (ref($jsarray) eq 'ARRAY') {
13485: push(@{$jsarray->[$counters{$tail}]},$item);
13486: }
13487: }
13488: return;
13489: }
13490:
13491: =pod
13492:
13493: =item * &extract_categories()
13494:
13495: Used to generate breadcrumb trails for course categories.
13496:
13497: Inputs:
1.663 raeburn 13498:
1.655 raeburn 13499: categories (reference to hash of category definitions).
1.663 raeburn 13500:
1.655 raeburn 13501: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13502: categories and subcategories).
1.663 raeburn 13503:
1.655 raeburn 13504: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13505:
1.655 raeburn 13506: allitems (reference to hash - key is category key
13507: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13508:
1.655 raeburn 13509: idx (reference to hash of counters used in Domain Coordinator interface for
13510: editing Course Categories).
1.663 raeburn 13511:
1.655 raeburn 13512: jsarray (reference to array of categories used to create Javascript arrays for
13513: Domain Coordinator interface for editing Course Categories).
13514:
1.665 raeburn 13515: subcats (reference to hash of arrays containing all subcategories within each
13516: category, -recursive)
13517:
1.655 raeburn 13518: Returns: nothing
13519:
13520: Side effects: populates trails and allitems hash references.
13521:
13522: =cut
13523:
13524: sub extract_categories {
1.665 raeburn 13525: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13526: if (ref($categories) eq 'HASH') {
13527: &gather_categories($categories,$cats,$idx,$jsarray);
13528: if (ref($cats->[0]) eq 'ARRAY') {
13529: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13530: my $name = $cats->[0][$i];
13531: my $item = &escape($name).'::0';
13532: my $trailstr;
13533: if ($name eq 'instcode') {
13534: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13535: } elsif ($name eq 'communities') {
13536: $trailstr = &mt('Communities');
1.655 raeburn 13537: } else {
13538: $trailstr = $name;
13539: }
13540: if ($allitems->{$item} eq '') {
13541: push(@{$trails},$trailstr);
13542: $allitems->{$item} = scalar(@{$trails})-1;
13543: }
13544: my @parents = ($name);
13545: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13546: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13547: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13548: if (ref($subcats) eq 'HASH') {
13549: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13550: }
13551: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13552: }
13553: } else {
13554: if (ref($subcats) eq 'HASH') {
13555: $subcats->{$item} = [];
1.655 raeburn 13556: }
13557: }
13558: }
13559: }
13560: }
13561: return;
13562: }
13563:
13564: =pod
13565:
1.1162 raeburn 13566: =item * &recurse_categories()
1.655 raeburn 13567:
13568: Recursively used to generate breadcrumb trails for course categories.
13569:
13570: Inputs:
1.663 raeburn 13571:
1.655 raeburn 13572: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13573: categories and subcategories).
1.663 raeburn 13574:
1.655 raeburn 13575: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13576:
13577: category (current course category, for which breadcrumb trail is being generated).
13578:
13579: trails (reference to array of breadcrumb trails for each category).
13580:
1.655 raeburn 13581: allitems (reference to hash - key is category key
13582: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13583:
1.655 raeburn 13584: parents (array containing containers directories for current category,
13585: back to top level).
13586:
13587: Returns: nothing
13588:
13589: Side effects: populates trails and allitems hash references
13590:
13591: =cut
13592:
13593: sub recurse_categories {
1.665 raeburn 13594: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13595: my $shallower = $depth - 1;
13596: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13597: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13598: my $name = $cats->[$depth]{$category}[$k];
13599: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13600: my $trailstr = join(' -> ',(@{$parents},$category));
13601: if ($allitems->{$item} eq '') {
13602: push(@{$trails},$trailstr);
13603: $allitems->{$item} = scalar(@{$trails})-1;
13604: }
13605: my $deeper = $depth+1;
13606: push(@{$parents},$category);
1.665 raeburn 13607: if (ref($subcats) eq 'HASH') {
13608: my $subcat = &escape($name).':'.$category.':'.$depth;
13609: for (my $j=@{$parents}; $j>=0; $j--) {
13610: my $higher;
13611: if ($j > 0) {
13612: $higher = &escape($parents->[$j]).':'.
13613: &escape($parents->[$j-1]).':'.$j;
13614: } else {
13615: $higher = &escape($parents->[$j]).'::'.$j;
13616: }
13617: push(@{$subcats->{$higher}},$subcat);
13618: }
13619: }
13620: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13621: $subcats);
1.655 raeburn 13622: pop(@{$parents});
13623: }
13624: } else {
13625: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13626: my $trailstr = join(' -> ',(@{$parents},$category));
13627: if ($allitems->{$item} eq '') {
13628: push(@{$trails},$trailstr);
13629: $allitems->{$item} = scalar(@{$trails})-1;
13630: }
13631: }
13632: return;
13633: }
13634:
1.663 raeburn 13635: =pod
13636:
1.1162 raeburn 13637: =item * &assign_categories_table()
1.663 raeburn 13638:
13639: Create a datatable for display of hierarchical categories in a domain,
13640: with checkboxes to allow a course to be categorized.
13641:
13642: Inputs:
13643:
13644: cathash - reference to hash of categories defined for the domain (from
13645: configuration.db)
13646:
13647: currcat - scalar with an & separated list of categories assigned to a course.
13648:
1.919 raeburn 13649: type - scalar contains course type (Course or Community).
13650:
1.663 raeburn 13651: Returns: $output (markup to be displayed)
13652:
13653: =cut
13654:
13655: sub assign_categories_table {
1.919 raeburn 13656: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13657: my $output;
13658: if (ref($cathash) eq 'HASH') {
13659: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13660: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13661: $maxdepth = scalar(@cats);
13662: if (@cats > 0) {
13663: my $itemcount = 0;
13664: if (ref($cats[0]) eq 'ARRAY') {
13665: my @currcategories;
13666: if ($currcat ne '') {
13667: @currcategories = split('&',$currcat);
13668: }
1.919 raeburn 13669: my $table;
1.663 raeburn 13670: for (my $i=0; $i<@{$cats[0]}; $i++) {
13671: my $parent = $cats[0][$i];
1.919 raeburn 13672: next if ($parent eq 'instcode');
13673: if ($type eq 'Community') {
13674: next unless ($parent eq 'communities');
13675: } else {
13676: next if ($parent eq 'communities');
13677: }
1.663 raeburn 13678: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13679: my $item = &escape($parent).'::0';
13680: my $checked = '';
13681: if (@currcategories > 0) {
13682: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13683: $checked = ' checked="checked"';
1.663 raeburn 13684: }
13685: }
1.919 raeburn 13686: my $parent_title = $parent;
13687: if ($parent eq 'communities') {
13688: $parent_title = &mt('Communities');
13689: }
13690: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13691: '<input type="checkbox" name="usecategory" value="'.
13692: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13693: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13694: my $depth = 1;
13695: push(@path,$parent);
1.919 raeburn 13696: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13697: pop(@path);
1.919 raeburn 13698: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13699: $itemcount ++;
13700: }
1.919 raeburn 13701: if ($itemcount) {
13702: $output = &Apache::loncommon::start_data_table().
13703: $table.
13704: &Apache::loncommon::end_data_table();
13705: }
1.663 raeburn 13706: }
13707: }
13708: }
13709: return $output;
13710: }
13711:
13712: =pod
13713:
1.1162 raeburn 13714: =item * &assign_category_rows()
1.663 raeburn 13715:
13716: Create a datatable row for display of nested categories in a domain,
13717: with checkboxes to allow a course to be categorized,called recursively.
13718:
13719: Inputs:
13720:
13721: itemcount - track row number for alternating colors
13722:
13723: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13724: categories and subcategories.
13725:
13726: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13727:
13728: parent - parent of current category item
13729:
13730: path - Array containing all categories back up through the hierarchy from the
13731: current category to the top level.
13732:
13733: currcategories - reference to array of current categories assigned to the course
13734:
13735: Returns: $output (markup to be displayed).
13736:
13737: =cut
13738:
13739: sub assign_category_rows {
13740: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13741: my ($text,$name,$item,$chgstr);
13742: if (ref($cats) eq 'ARRAY') {
13743: my $maxdepth = scalar(@{$cats});
13744: if (ref($cats->[$depth]) eq 'HASH') {
13745: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13746: my $numchildren = @{$cats->[$depth]{$parent}};
13747: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 13748: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13749: for (my $j=0; $j<$numchildren; $j++) {
13750: $name = $cats->[$depth]{$parent}[$j];
13751: $item = &escape($name).':'.&escape($parent).':'.$depth;
13752: my $deeper = $depth+1;
13753: my $checked = '';
13754: if (ref($currcategories) eq 'ARRAY') {
13755: if (@{$currcategories} > 0) {
13756: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13757: $checked = ' checked="checked"';
1.663 raeburn 13758: }
13759: }
13760: }
1.664 raeburn 13761: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13762: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13763: $item.'"'.$checked.' />'.$name.'</label></span>'.
13764: '<input type="hidden" name="catname" value="'.$name.'" />'.
13765: '</td><td>';
1.663 raeburn 13766: if (ref($path) eq 'ARRAY') {
13767: push(@{$path},$name);
13768: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13769: pop(@{$path});
13770: }
13771: $text .= '</td></tr>';
13772: }
13773: $text .= '</table></td>';
13774: }
13775: }
13776: }
13777: return $text;
13778: }
13779:
1.1181 raeburn 13780: =pod
13781:
13782: =back
13783:
13784: =cut
13785:
1.655 raeburn 13786: ############################################################
13787: ############################################################
13788:
13789:
1.443 albertel 13790: sub commit_customrole {
1.664 raeburn 13791: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13792: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13793: ($start?', '.&mt('starting').' '.localtime($start):'').
13794: ($end?', ending '.localtime($end):'').': <b>'.
13795: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13796: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13797: '</b><br />';
13798: return $output;
13799: }
13800:
13801: sub commit_standardrole {
1.1116 raeburn 13802: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13803: my ($output,$logmsg,$linefeed);
13804: if ($context eq 'auto') {
13805: $linefeed = "\n";
13806: } else {
13807: $linefeed = "<br />\n";
13808: }
1.443 albertel 13809: if ($three eq 'st') {
1.541 raeburn 13810: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 13811: $one,$two,$sec,$context,$credits);
1.541 raeburn 13812: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13813: ($result eq 'unknown_course') || ($result eq 'refused')) {
13814: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13815: } else {
1.541 raeburn 13816: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13817: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13818: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13819: if ($context eq 'auto') {
13820: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13821: } else {
13822: $output .= '<b>'.$result.'</b>'.$linefeed.
13823: &mt('Add to classlist').': <b>ok</b>';
13824: }
13825: $output .= $linefeed;
1.443 albertel 13826: }
13827: } else {
13828: $output = &mt('Assigning').' '.$three.' in '.$url.
13829: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13830: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13831: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13832: if ($context eq 'auto') {
13833: $output .= $result.$linefeed;
13834: } else {
13835: $output .= '<b>'.$result.'</b>'.$linefeed;
13836: }
1.443 albertel 13837: }
13838: return $output;
13839: }
13840:
13841: sub commit_studentrole {
1.1116 raeburn 13842: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13843: $credits) = @_;
1.626 raeburn 13844: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13845: if ($context eq 'auto') {
13846: $linefeed = "\n";
13847: } else {
13848: $linefeed = '<br />'."\n";
13849: }
1.443 albertel 13850: if (defined($one) && defined($two)) {
13851: my $cid=$one.'_'.$two;
13852: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13853: my $secchange = 0;
13854: my $expire_role_result;
13855: my $modify_section_result;
1.628 raeburn 13856: if ($oldsec ne '-1') {
13857: if ($oldsec ne $sec) {
1.443 albertel 13858: $secchange = 1;
1.628 raeburn 13859: my $now = time;
1.443 albertel 13860: my $uurl='/'.$cid;
13861: $uurl=~s/\_/\//g;
13862: if ($oldsec) {
13863: $uurl.='/'.$oldsec;
13864: }
1.626 raeburn 13865: $oldsecurl = $uurl;
1.628 raeburn 13866: $expire_role_result =
1.652 raeburn 13867: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13868: if ($env{'request.course.sec'} ne '') {
13869: if ($expire_role_result eq 'refused') {
13870: my @roles = ('st');
13871: my @statuses = ('previous');
13872: my @roledoms = ($one);
13873: my $withsec = 1;
13874: my %roleshash =
13875: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13876: \@statuses,\@roles,\@roledoms,$withsec);
13877: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13878: my ($oldstart,$oldend) =
13879: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13880: if ($oldend > 0 && $oldend <= $now) {
13881: $expire_role_result = 'ok';
13882: }
13883: }
13884: }
13885: }
1.443 albertel 13886: $result = $expire_role_result;
13887: }
13888: }
13889: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 13890: $modify_section_result =
13891: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13892: undef,undef,undef,$sec,
13893: $end,$start,'','',$cid,
13894: '',$context,$credits);
1.443 albertel 13895: if ($modify_section_result =~ /^ok/) {
13896: if ($secchange == 1) {
1.628 raeburn 13897: if ($sec eq '') {
13898: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13899: } else {
13900: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13901: }
1.443 albertel 13902: } elsif ($oldsec eq '-1') {
1.628 raeburn 13903: if ($sec eq '') {
13904: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13905: } else {
13906: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13907: }
1.443 albertel 13908: } else {
1.628 raeburn 13909: if ($sec eq '') {
13910: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13911: } else {
13912: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13913: }
1.443 albertel 13914: }
13915: } else {
1.1115 raeburn 13916: if ($secchange) {
1.628 raeburn 13917: $$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;
13918: } else {
13919: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13920: }
1.443 albertel 13921: }
13922: $result = $modify_section_result;
13923: } elsif ($secchange == 1) {
1.628 raeburn 13924: if ($oldsec eq '') {
1.1103 raeburn 13925: $$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 13926: } else {
13927: $$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;
13928: }
1.626 raeburn 13929: if ($expire_role_result eq 'refused') {
13930: my $newsecurl = '/'.$cid;
13931: $newsecurl =~ s/\_/\//g;
13932: if ($sec ne '') {
13933: $newsecurl.='/'.$sec;
13934: }
13935: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13936: if ($sec eq '') {
13937: $$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;
13938: } else {
13939: $$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;
13940: }
13941: }
13942: }
1.443 albertel 13943: }
13944: } else {
1.626 raeburn 13945: $$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 13946: $result = "error: incomplete course id\n";
13947: }
13948: return $result;
13949: }
13950:
1.1108 raeburn 13951: sub show_role_extent {
13952: my ($scope,$context,$role) = @_;
13953: $scope =~ s{^/}{};
13954: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13955: push(@courseroles,'co');
13956: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13957: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13958: $scope =~ s{/}{_};
13959: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13960: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13961: my ($audom,$auname) = split(/\//,$scope);
13962: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13963: &Apache::loncommon::plainname($auname,$audom).'</span>');
13964: } else {
13965: $scope =~ s{/$}{};
13966: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13967: &Apache::lonnet::domain($scope,'description').'</span>');
13968: }
13969: }
13970:
1.443 albertel 13971: ############################################################
13972: ############################################################
13973:
1.566 albertel 13974: sub check_clone {
1.578 raeburn 13975: my ($args,$linefeed) = @_;
1.566 albertel 13976: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13977: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13978: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13979: my $clonemsg;
13980: my $can_clone = 0;
1.944 raeburn 13981: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13982: if ($lctype ne 'community') {
13983: $lctype = 'course';
13984: }
1.566 albertel 13985: if ($clonehome eq 'no_host') {
1.944 raeburn 13986: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13987: $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'});
13988: } else {
13989: $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'});
13990: }
1.566 albertel 13991: } else {
13992: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13993: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13994: if ($clonedesc{'type'} ne 'Community') {
13995: $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'});
13996: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13997: }
13998: }
1.882 raeburn 13999: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14000: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14001: $can_clone = 1;
14002: } else {
14003: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14004: $args->{'clonedomain'},$args->{'clonecourse'});
14005: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14006: if (grep(/^\*$/,@cloners)) {
14007: $can_clone = 1;
14008: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14009: $can_clone = 1;
14010: } else {
1.908 raeburn 14011: my $ccrole = 'cc';
1.944 raeburn 14012: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14013: $ccrole = 'co';
14014: }
1.578 raeburn 14015: my %roleshash =
14016: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14017: $args->{'ccdomain'},
1.908 raeburn 14018: 'userroles',['active'],[$ccrole],
1.578 raeburn 14019: [$args->{'clonedomain'}]);
1.908 raeburn 14020: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14021: $can_clone = 1;
14022: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14023: $can_clone = 1;
14024: } else {
1.944 raeburn 14025: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14026: $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'});
14027: } else {
14028: $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'});
14029: }
1.578 raeburn 14030: }
1.566 albertel 14031: }
1.578 raeburn 14032: }
1.566 albertel 14033: }
14034: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14035: }
14036:
1.444 albertel 14037: sub construct_course {
1.1166 raeburn 14038: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14039: my $outcome;
1.541 raeburn 14040: my $linefeed = '<br />'."\n";
14041: if ($context eq 'auto') {
14042: $linefeed = "\n";
14043: }
1.566 albertel 14044:
14045: #
14046: # Are we cloning?
14047: #
14048: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14049: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14050: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14051: if ($context ne 'auto') {
1.578 raeburn 14052: if ($clonemsg ne '') {
14053: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14054: }
1.566 albertel 14055: }
14056: $outcome .= $clonemsg.$linefeed;
14057:
14058: if (!$can_clone) {
14059: return (0,$outcome);
14060: }
14061: }
14062:
1.444 albertel 14063: #
14064: # Open course
14065: #
14066: my $crstype = lc($args->{'crstype'});
14067: my %cenv=();
14068: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14069: $args->{'cdescr'},
14070: $args->{'curl'},
14071: $args->{'course_home'},
14072: $args->{'nonstandard'},
14073: $args->{'crscode'},
14074: $args->{'ccuname'}.':'.
14075: $args->{'ccdomain'},
1.882 raeburn 14076: $args->{'crstype'},
1.885 raeburn 14077: $cnum,$context,$category);
1.444 albertel 14078:
14079: # Note: The testing routines depend on this being output; see
14080: # Utils::Course. This needs to at least be output as a comment
14081: # if anyone ever decides to not show this, and Utils::Course::new
14082: # will need to be suitably modified.
1.541 raeburn 14083: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14084: if ($$courseid =~ /^error:/) {
14085: return (0,$outcome);
14086: }
14087:
1.444 albertel 14088: #
14089: # Check if created correctly
14090: #
1.479 albertel 14091: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14092: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14093: if ($crsuhome eq 'no_host') {
14094: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14095: return (0,$outcome);
14096: }
1.541 raeburn 14097: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14098:
1.444 albertel 14099: #
1.566 albertel 14100: # Do the cloning
14101: #
14102: if ($can_clone && $cloneid) {
14103: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14104: if ($context ne 'auto') {
14105: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14106: }
14107: $outcome .= $clonemsg.$linefeed;
14108: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14109: # Copy all files
1.637 www 14110: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14111: # Restore URL
1.566 albertel 14112: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14113: # Restore title
1.566 albertel 14114: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14115: # Restore creation date, creator and creation context.
14116: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14117: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14118: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14119: # Mark as cloned
1.566 albertel 14120: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14121: # Need to clone grading mode
14122: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14123: $cenv{'grading'}=$newenv{'grading'};
14124: # Do not clone these environment entries
14125: &Apache::lonnet::del('environment',
14126: ['default_enrollment_start_date',
14127: 'default_enrollment_end_date',
14128: 'question.email',
14129: 'policy.email',
14130: 'comment.email',
14131: 'pch.users.denied',
1.725 raeburn 14132: 'plc.users.denied',
14133: 'hidefromcat',
1.1121 raeburn 14134: 'checkforpriv',
1.1166 raeburn 14135: 'categories',
14136: 'internal.uniquecode'],
1.638 www 14137: $$crsudom,$$crsunum);
1.1170 raeburn 14138: if ($args->{'textbook'}) {
14139: $cenv{'internal.textbook'} = $args->{'textbook'};
14140: }
1.444 albertel 14141: }
1.566 albertel 14142:
1.444 albertel 14143: #
14144: # Set environment (will override cloned, if existing)
14145: #
14146: my @sections = ();
14147: my @xlists = ();
14148: if ($args->{'crstype'}) {
14149: $cenv{'type'}=$args->{'crstype'};
14150: }
14151: if ($args->{'crsid'}) {
14152: $cenv{'courseid'}=$args->{'crsid'};
14153: }
14154: if ($args->{'crscode'}) {
14155: $cenv{'internal.coursecode'}=$args->{'crscode'};
14156: }
14157: if ($args->{'crsquota'} ne '') {
14158: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14159: } else {
14160: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14161: }
14162: if ($args->{'ccuname'}) {
14163: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14164: ':'.$args->{'ccdomain'};
14165: } else {
14166: $cenv{'internal.courseowner'} = $args->{'curruser'};
14167: }
1.1116 raeburn 14168: if ($args->{'defaultcredits'}) {
14169: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14170: }
1.444 albertel 14171: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14172: if ($args->{'crssections'}) {
14173: $cenv{'internal.sectionnums'} = '';
14174: if ($args->{'crssections'} =~ m/,/) {
14175: @sections = split/,/,$args->{'crssections'};
14176: } else {
14177: $sections[0] = $args->{'crssections'};
14178: }
14179: if (@sections > 0) {
14180: foreach my $item (@sections) {
14181: my ($sec,$gp) = split/:/,$item;
14182: my $class = $args->{'crscode'}.$sec;
14183: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14184: $cenv{'internal.sectionnums'} .= $item.',';
14185: unless ($addcheck eq 'ok') {
14186: push @badclasses, $class;
14187: }
14188: }
14189: $cenv{'internal.sectionnums'} =~ s/,$//;
14190: }
14191: }
14192: # do not hide course coordinator from staff listing,
14193: # even if privileged
14194: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14195: # add course coordinator's domain to domains to check for privileged users
14196: # if different to course domain
14197: if ($$crsudom ne $args->{'ccdomain'}) {
14198: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14199: }
1.444 albertel 14200: # add crosslistings
14201: if ($args->{'crsxlist'}) {
14202: $cenv{'internal.crosslistings'}='';
14203: if ($args->{'crsxlist'} =~ m/,/) {
14204: @xlists = split/,/,$args->{'crsxlist'};
14205: } else {
14206: $xlists[0] = $args->{'crsxlist'};
14207: }
14208: if (@xlists > 0) {
14209: foreach my $item (@xlists) {
14210: my ($xl,$gp) = split/:/,$item;
14211: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14212: $cenv{'internal.crosslistings'} .= $item.',';
14213: unless ($addcheck eq 'ok') {
14214: push @badclasses, $xl;
14215: }
14216: }
14217: $cenv{'internal.crosslistings'} =~ s/,$//;
14218: }
14219: }
14220: if ($args->{'autoadds'}) {
14221: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14222: }
14223: if ($args->{'autodrops'}) {
14224: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14225: }
14226: # check for notification of enrollment changes
14227: my @notified = ();
14228: if ($args->{'notify_owner'}) {
14229: if ($args->{'ccuname'} ne '') {
14230: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14231: }
14232: }
14233: if ($args->{'notify_dc'}) {
14234: if ($uname ne '') {
1.630 raeburn 14235: push(@notified,$uname.':'.$udom);
1.444 albertel 14236: }
14237: }
14238: if (@notified > 0) {
14239: my $notifylist;
14240: if (@notified > 1) {
14241: $notifylist = join(',',@notified);
14242: } else {
14243: $notifylist = $notified[0];
14244: }
14245: $cenv{'internal.notifylist'} = $notifylist;
14246: }
14247: if (@badclasses > 0) {
14248: my %lt=&Apache::lonlocal::texthash(
14249: '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',
14250: 'dnhr' => 'does not have rights to access enrollment in these classes',
14251: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14252: );
1.541 raeburn 14253: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14254: ' ('.$lt{'adby'}.')';
14255: if ($context eq 'auto') {
14256: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14257: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14258: foreach my $item (@badclasses) {
14259: if ($context eq 'auto') {
14260: $outcome .= " - $item\n";
14261: } else {
14262: $outcome .= "<li>$item</li>\n";
14263: }
14264: }
14265: if ($context eq 'auto') {
14266: $outcome .= $linefeed;
14267: } else {
1.566 albertel 14268: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14269: }
14270: }
1.444 albertel 14271: }
14272: if ($args->{'no_end_date'}) {
14273: $args->{'endaccess'} = 0;
14274: }
14275: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14276: $cenv{'internal.autoend'}=$args->{'enrollend'};
14277: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14278: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14279: if ($args->{'showphotos'}) {
14280: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14281: }
14282: $cenv{'internal.authtype'} = $args->{'authtype'};
14283: $cenv{'internal.autharg'} = $args->{'autharg'};
14284: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14285: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14286: 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');
14287: if ($context eq 'auto') {
14288: $outcome .= $krb_msg;
14289: } else {
1.566 albertel 14290: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14291: }
14292: $outcome .= $linefeed;
1.444 albertel 14293: }
14294: }
14295: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14296: if ($args->{'setpolicy'}) {
14297: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14298: }
14299: if ($args->{'setcontent'}) {
14300: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14301: }
14302: }
14303: if ($args->{'reshome'}) {
14304: $cenv{'reshome'}=$args->{'reshome'}.'/';
14305: $cenv{'reshome'}=~s/\/+$/\//;
14306: }
14307: #
14308: # course has keyed access
14309: #
14310: if ($args->{'setkeys'}) {
14311: $cenv{'keyaccess'}='yes';
14312: }
14313: # if specified, key authority is not course, but user
14314: # only active if keyaccess is yes
14315: if ($args->{'keyauth'}) {
1.487 albertel 14316: my ($user,$domain) = split(':',$args->{'keyauth'});
14317: $user = &LONCAPA::clean_username($user);
14318: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14319: if ($user ne '' && $domain ne '') {
1.487 albertel 14320: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14321: }
14322: }
14323:
1.1166 raeburn 14324: #
1.1167 raeburn 14325: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14326: #
14327: if ($args->{'uniquecode'}) {
14328: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14329: if ($code) {
14330: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14331: my %crsinfo =
14332: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14333: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14334: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14335: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14336: }
1.1166 raeburn 14337: if (ref($coderef)) {
14338: $$coderef = $code;
14339: }
14340: }
14341: }
14342:
1.444 albertel 14343: if ($args->{'disresdis'}) {
14344: $cenv{'pch.roles.denied'}='st';
14345: }
14346: if ($args->{'disablechat'}) {
14347: $cenv{'plc.roles.denied'}='st';
14348: }
14349:
14350: # Record we've not yet viewed the Course Initialization Helper for this
14351: # course
14352: $cenv{'course.helper.not.run'} = 1;
14353: #
14354: # Use new Randomseed
14355: #
14356: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14357: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14358: #
14359: # The encryption code and receipt prefix for this course
14360: #
14361: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14362: $cenv{'internal.encpref'}=100+int(9*rand(99));
14363: #
14364: # By default, use standard grading
14365: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14366:
1.541 raeburn 14367: $outcome .= $linefeed.&mt('Setting environment').': '.
14368: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14369: #
14370: # Open all assignments
14371: #
14372: if ($args->{'openall'}) {
14373: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14374: my %storecontent = ($storeunder => time,
14375: $storeunder.'.type' => 'date_start');
14376:
14377: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14378: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14379: }
14380: #
14381: # Set first page
14382: #
14383: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14384: || ($cloneid)) {
1.445 albertel 14385: use LONCAPA::map;
1.444 albertel 14386: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14387:
14388: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14389: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14390:
1.444 albertel 14391: $outcome .= ($fatal?$errtext:'read ok').' - ';
14392: my $title; my $url;
14393: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14394: $title=&mt('Syllabus');
1.444 albertel 14395: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14396: } else {
1.963 raeburn 14397: $title=&mt('Table of Contents');
1.444 albertel 14398: $url='/adm/navmaps';
14399: }
1.445 albertel 14400:
14401: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14402: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14403:
14404: if ($errtext) { $fatal=2; }
1.541 raeburn 14405: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14406: }
1.566 albertel 14407:
14408: return (1,$outcome);
1.444 albertel 14409: }
14410:
1.1166 raeburn 14411: sub make_unique_code {
14412: my ($cdom,$cnum) = @_;
14413: # get lock on uniquecodes db
14414: my $lockhash = {
14415: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14416: ':'.$env{'user.domain'},
14417: };
14418: my $tries = 0;
14419: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14420: my ($code,$error);
14421:
14422: while (($gotlock ne 'ok') && ($tries<3)) {
14423: $tries ++;
14424: sleep 1;
14425: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14426: }
14427: if ($gotlock eq 'ok') {
14428: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14429: my $gotcode;
14430: my $attempts = 0;
14431: while ((!$gotcode) && ($attempts < 100)) {
14432: $code = &generate_code();
14433: if (!exists($currcodes{$code})) {
14434: $gotcode = 1;
14435: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14436: $error = 'nostore';
14437: }
14438: }
14439: $attempts ++;
14440: }
14441: my @del_lock = ($cnum."\0".'uniquecodes');
14442: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14443: } else {
14444: $error = 'nolock';
14445: }
14446: return ($code,$error);
14447: }
14448:
14449: sub generate_code {
14450: my $code;
14451: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14452: for (my $i=0; $i<6; $i++) {
14453: my $lettnum = int (rand 2);
14454: my $item = '';
14455: if ($lettnum) {
14456: $item = $letts[int( rand(18) )];
14457: } else {
14458: $item = 1+int( rand(8) );
14459: }
14460: $code .= $item;
14461: }
14462: return $code;
14463: }
14464:
1.444 albertel 14465: ############################################################
14466: ############################################################
14467:
1.953 droeschl 14468: #SD
14469: # only Community and Course, or anything else?
1.378 raeburn 14470: sub course_type {
14471: my ($cid) = @_;
14472: if (!defined($cid)) {
14473: $cid = $env{'request.course.id'};
14474: }
1.404 albertel 14475: if (defined($env{'course.'.$cid.'.type'})) {
14476: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14477: } else {
14478: return 'Course';
1.377 raeburn 14479: }
14480: }
1.156 albertel 14481:
1.406 raeburn 14482: sub group_term {
14483: my $crstype = &course_type();
14484: my %names = (
14485: 'Course' => 'group',
1.865 raeburn 14486: 'Community' => 'group',
1.406 raeburn 14487: );
14488: return $names{$crstype};
14489: }
14490:
1.902 raeburn 14491: sub course_types {
1.1165 raeburn 14492: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14493: my %typename = (
14494: official => 'Official course',
14495: unofficial => 'Unofficial course',
14496: community => 'Community',
1.1165 raeburn 14497: textbook => 'Textbook course',
1.902 raeburn 14498: );
14499: return (\@types,\%typename);
14500: }
14501:
1.156 albertel 14502: sub icon {
14503: my ($file)=@_;
1.505 albertel 14504: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14505: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14506: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14507: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14508: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14509: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14510: $curfext.".gif") {
14511: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14512: $curfext.".gif";
14513: }
14514: }
1.249 albertel 14515: return &lonhttpdurl($iconname);
1.154 albertel 14516: }
1.84 albertel 14517:
1.575 albertel 14518: sub lonhttpdurl {
1.692 www 14519: #
14520: # Had been used for "small fry" static images on separate port 8080.
14521: # Modify here if lightweight http functionality desired again.
14522: # Currently eliminated due to increasing firewall issues.
14523: #
1.575 albertel 14524: my ($url)=@_;
1.692 www 14525: return $url;
1.215 albertel 14526: }
14527:
1.213 albertel 14528: sub connection_aborted {
14529: my ($r)=@_;
14530: $r->print(" ");$r->rflush();
14531: my $c = $r->connection;
14532: return $c->aborted();
14533: }
14534:
1.221 foxr 14535: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14536: # strings as 'strings'.
14537: sub escape_single {
1.221 foxr 14538: my ($input) = @_;
1.223 albertel 14539: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14540: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14541: return $input;
14542: }
1.223 albertel 14543:
1.222 foxr 14544: # Same as escape_single, but escape's "'s This
14545: # can be used for "strings"
14546: sub escape_double {
14547: my ($input) = @_;
14548: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14549: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14550: return $input;
14551: }
1.223 albertel 14552:
1.222 foxr 14553: # Escapes the last element of a full URL.
14554: sub escape_url {
14555: my ($url) = @_;
1.238 raeburn 14556: my @urlslices = split(/\//, $url,-1);
1.369 www 14557: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 14558: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14559: }
1.462 albertel 14560:
1.820 raeburn 14561: sub compare_arrays {
14562: my ($arrayref1,$arrayref2) = @_;
14563: my (@difference,%count);
14564: @difference = ();
14565: %count = ();
14566: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14567: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14568: foreach my $element (keys(%count)) {
14569: if ($count{$element} == 1) {
14570: push(@difference,$element);
14571: }
14572: }
14573: }
14574: return @difference;
14575: }
14576:
1.817 bisitz 14577: # -------------------------------------------------------- Initialize user login
1.462 albertel 14578: sub init_user_environment {
1.463 albertel 14579: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14580: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14581:
14582: my $public=($username eq 'public' && $domain eq 'public');
14583:
14584: # See if old ID present, if so, remove
14585:
1.1062 raeburn 14586: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14587: my $now=time;
14588:
14589: if ($public) {
14590: my $max_public=100;
14591: my $oldest;
14592: my $oldest_time=0;
14593: for(my $next=1;$next<=$max_public;$next++) {
14594: if (-e $lonids."/publicuser_$next.id") {
14595: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14596: if ($mtime<$oldest_time || !$oldest_time) {
14597: $oldest_time=$mtime;
14598: $oldest=$next;
14599: }
14600: } else {
14601: $cookie="publicuser_$next";
14602: last;
14603: }
14604: }
14605: if (!$cookie) { $cookie="publicuser_$oldest"; }
14606: } else {
1.463 albertel 14607: # if this isn't a robot, kill any existing non-robot sessions
14608: if (!$args->{'robot'}) {
14609: opendir(DIR,$lonids);
14610: while ($filename=readdir(DIR)) {
14611: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14612: unlink($lonids.'/'.$filename);
14613: }
1.462 albertel 14614: }
1.463 albertel 14615: closedir(DIR);
1.1204 ! raeburn 14616: # If there is a undeleted lockfile for the user's paste buffer remove it.
! 14617: my $namespace = 'nohist_courseeditor';
! 14618: my $lockingkey = 'paste'."\0".'locked_num';
! 14619: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
! 14620: $domain,$username);
! 14621: if (exists($lockhash{$lockingkey})) {
! 14622: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
! 14623: unless ($delresult eq 'ok') {
! 14624: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
! 14625: }
! 14626: }
1.462 albertel 14627: }
14628: # Give them a new cookie
1.463 albertel 14629: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14630: : $now.$$.int(rand(10000)));
1.463 albertel 14631: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14632:
14633: # Initialize roles
14634:
1.1062 raeburn 14635: ($userroles,$firstaccenv,$timerintenv) =
14636: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14637: }
14638: # ------------------------------------ Check browser type and MathML capability
14639:
1.1194 raeburn 14640: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14641: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14642:
14643: # ------------------------------------------------------------- Get environment
14644:
14645: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14646: my ($tmp) = keys(%userenv);
14647: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14648: } else {
14649: undef(%userenv);
14650: }
14651: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14652: $form->{'interface'}=$userenv{'interface'};
14653: }
14654: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14655:
14656: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14657: foreach my $option ('interface','localpath','localres') {
14658: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14659: }
14660: # --------------------------------------------------------- Write first profile
14661:
14662: {
14663: my %initial_env =
14664: ("user.name" => $username,
14665: "user.domain" => $domain,
14666: "user.home" => $authhost,
14667: "browser.type" => $clientbrowser,
14668: "browser.version" => $clientversion,
14669: "browser.mathml" => $clientmathml,
14670: "browser.unicode" => $clientunicode,
14671: "browser.os" => $clientos,
1.1137 raeburn 14672: "browser.mobile" => $clientmobile,
1.1141 raeburn 14673: "browser.info" => $clientinfo,
1.1194 raeburn 14674: "browser.osversion" => $clientosversion,
1.462 albertel 14675: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14676: "request.course.fn" => '',
14677: "request.course.uri" => '',
14678: "request.course.sec" => '',
14679: "request.role" => 'cm',
14680: "request.role.adv" => $env{'user.adv'},
14681: "request.host" => $ENV{'REMOTE_ADDR'},);
14682:
14683: if ($form->{'localpath'}) {
14684: $initial_env{"browser.localpath"} = $form->{'localpath'};
14685: $initial_env{"browser.localres"} = $form->{'localres'};
14686: }
14687:
14688: if ($form->{'interface'}) {
14689: $form->{'interface'}=~s/\W//gs;
14690: $initial_env{"browser.interface"} = $form->{'interface'};
14691: $env{'browser.interface'}=$form->{'interface'};
14692: }
14693:
1.1157 raeburn 14694: if ($form->{'iptoken'}) {
14695: my $lonhost = $r->dir_config('lonHostID');
14696: $initial_env{"user.noloadbalance"} = $lonhost;
14697: $env{'user.noloadbalance'} = $lonhost;
14698: }
14699:
1.981 raeburn 14700: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14701: my %domdef;
14702: unless ($domain eq 'public') {
14703: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14704: }
1.980 raeburn 14705:
1.1081 raeburn 14706: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14707: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14708: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14709: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14710: }
14711:
1.1165 raeburn 14712: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14713: $userenv{'canrequest.'.$crstype} =
14714: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14715: 'reload','requestcourses',
14716: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14717: }
14718:
1.1092 raeburn 14719: $userenv{'canrequest.author'} =
14720: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14721: 'reload','requestauthor',
14722: \%userenv,\%domdef,\%is_adv);
14723: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14724: $domain,$username);
14725: my $reqstatus = $reqauthor{'author_status'};
14726: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14727: if (ref($reqauthor{'author'}) eq 'HASH') {
14728: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14729: $reqauthor{'author'}{'timestamp'};
14730: }
14731: }
14732:
1.462 albertel 14733: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14734:
1.462 albertel 14735: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14736: &GDBM_WRCREAT(),0640)) {
14737: &_add_to_env(\%disk_env,\%initial_env);
14738: &_add_to_env(\%disk_env,\%userenv,'environment.');
14739: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14740: if (ref($firstaccenv) eq 'HASH') {
14741: &_add_to_env(\%disk_env,$firstaccenv);
14742: }
14743: if (ref($timerintenv) eq 'HASH') {
14744: &_add_to_env(\%disk_env,$timerintenv);
14745: }
1.463 albertel 14746: if (ref($args->{'extra_env'})) {
14747: &_add_to_env(\%disk_env,$args->{'extra_env'});
14748: }
1.462 albertel 14749: untie(%disk_env);
14750: } else {
1.705 tempelho 14751: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14752: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14753: return 'error: '.$!;
14754: }
14755: }
14756: $env{'request.role'}='cm';
14757: $env{'request.role.adv'}=$env{'user.adv'};
14758: $env{'browser.type'}=$clientbrowser;
14759:
14760: return $cookie;
14761:
14762: }
14763:
14764: sub _add_to_env {
14765: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14766: if (ref($env_data) eq 'HASH') {
14767: while (my ($key,$value) = each(%$env_data)) {
14768: $idf->{$prefix.$key} = $value;
14769: $env{$prefix.$key} = $value;
14770: }
1.462 albertel 14771: }
14772: }
14773:
1.685 tempelho 14774: # --- Get the symbolic name of a problem and the url
14775: sub get_symb {
14776: my ($request,$silent) = @_;
1.726 raeburn 14777: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14778: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14779: if ($symb eq '') {
14780: if (!$silent) {
1.1071 raeburn 14781: if (ref($request)) {
14782: $request->print("Unable to handle ambiguous references:$url:.");
14783: }
1.685 tempelho 14784: return ();
14785: }
14786: }
14787: &Apache::lonenc::check_decrypt(\$symb);
14788: return ($symb);
14789: }
14790:
14791: # --------------------------------------------------------------Get annotation
14792:
14793: sub get_annotation {
14794: my ($symb,$enc) = @_;
14795:
14796: my $key = $symb;
14797: if (!$enc) {
14798: $key =
14799: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14800: }
14801: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14802: return $annotation{$key};
14803: }
14804:
14805: sub clean_symb {
1.731 raeburn 14806: my ($symb,$delete_enc) = @_;
1.685 tempelho 14807:
14808: &Apache::lonenc::check_decrypt(\$symb);
14809: my $enc = $env{'request.enc'};
1.731 raeburn 14810: if ($delete_enc) {
1.730 raeburn 14811: delete($env{'request.enc'});
14812: }
1.685 tempelho 14813:
14814: return ($symb,$enc);
14815: }
1.462 albertel 14816:
1.1181 raeburn 14817: ############################################################
14818: ############################################################
14819:
14820: =pod
14821:
14822: =head1 Routines for building display used to search for courses
14823:
14824:
14825: =over 4
14826:
14827: =item * &build_filters()
14828:
14829: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 14830: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14831: and quotacheck.pl
14832:
1.1181 raeburn 14833:
14834: Inputs:
14835:
14836: filterlist - anonymous array of fields to include as potential filters
14837:
14838: crstype - course type
14839:
14840: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14841: to pop-open a course selector (will contain "extra element").
14842:
14843: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14844:
14845: filter - anonymous hash of criteria and their values
14846:
14847: action - form action
14848:
14849: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14850:
1.1182 raeburn 14851: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 14852:
14853: cloneruname - username of owner of new course who wants to clone
14854:
14855: clonerudom - domain of owner of new course who wants to clone
14856:
14857: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14858:
14859: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14860:
14861: codedom - domain
14862:
14863: formname - value of form element named "form".
14864:
14865: fixeddom - domain, if fixed.
14866:
14867: prevphase - value to assign to form element named "phase" when going back to the previous screen
14868:
14869: cnameelement - name of form element in form on opener page which will receive title of selected course
14870:
14871: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14872:
14873: cdomelement - name of form element in form on opener page which will receive domain of selected course
14874:
14875: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14876:
14877: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14878:
14879: clonewarning - warning message about missing information for intended course owner when DC creates a course
14880:
1.1182 raeburn 14881:
1.1181 raeburn 14882: Returns: $output - HTML for display of search criteria, and hidden form elements.
14883:
1.1182 raeburn 14884:
1.1181 raeburn 14885: Side Effects: None
14886:
14887: =cut
14888:
14889: # ---------------------------------------------- search for courses based on last activity etc.
14890:
14891: sub build_filters {
14892: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14893: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14894: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14895: $cnameelement,$cnumelement,$cdomelement,$setroles,
14896: $clonetext,$clonewarning) = @_;
1.1182 raeburn 14897: my ($list,$jscript);
1.1181 raeburn 14898: my $onchange = 'javascript:updateFilters(this)';
14899: my ($domainselectform,$sincefilterform,$createdfilterform,
14900: $ownerdomselectform,$persondomselectform,$instcodeform,
14901: $typeselectform,$instcodetitle);
14902: if ($formname eq '') {
14903: $formname = $caller;
14904: }
14905: foreach my $item (@{$filterlist}) {
14906: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
14907: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
14908: if ($item eq 'domainfilter') {
14909: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
14910: } elsif ($item eq 'coursefilter') {
14911: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
14912: } elsif ($item eq 'ownerfilter') {
14913: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14914: } elsif ($item eq 'ownerdomfilter') {
14915: $filter->{'ownerdomfilter'} =
14916: &LONCAPA::clean_domain($filter->{$item});
14917: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
14918: 'ownerdomfilter',1);
14919: } elsif ($item eq 'personfilter') {
14920: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14921: } elsif ($item eq 'persondomfilter') {
14922: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
14923: 'persondomfilter',1);
14924: } else {
14925: $filter->{$item} =~ s/\W//g;
14926: }
14927: if (!$filter->{$item}) {
14928: $filter->{$item} = '';
14929: }
14930: }
14931: if ($item eq 'domainfilter') {
14932: my $allow_blank = 1;
14933: if ($formname eq 'portform') {
14934: $allow_blank=0;
14935: } elsif ($formname eq 'studentform') {
14936: $allow_blank=0;
14937: }
14938: if ($fixeddom) {
14939: $domainselectform = '<input type="hidden" name="domainfilter"'.
14940: ' value="'.$codedom.'" />'.
14941: &Apache::lonnet::domain($codedom,'description');
14942: } else {
14943: $domainselectform = &select_dom_form($filter->{$item},
14944: 'domainfilter',
14945: $allow_blank,'',$onchange);
14946: }
14947: } else {
14948: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
14949: }
14950: }
14951:
14952: # last course activity filter and selection
14953: $sincefilterform = &timebased_select_form('sincefilter',$filter);
14954:
14955: # course created filter and selection
14956: if (exists($filter->{'createdfilter'})) {
14957: $createdfilterform = &timebased_select_form('createdfilter',$filter);
14958: }
14959:
14960: my %lt = &Apache::lonlocal::texthash(
14961: 'cac' => "$crstype Activity",
14962: 'ccr' => "$crstype Created",
14963: 'cde' => "$crstype Title",
14964: 'cdo' => "$crstype Domain",
14965: 'ins' => 'Institutional Code',
14966: 'inc' => 'Institutional Categorization',
14967: 'cow' => "$crstype Owner/Co-owner",
14968: 'cop' => "$crstype Personnel Includes",
14969: 'cog' => 'Type',
14970: );
14971:
14972: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
14973: my $typeval = 'Course';
14974: if ($crstype eq 'Community') {
14975: $typeval = 'Community';
14976: }
14977: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
14978: } else {
14979: $typeselectform = '<select name="type" size="1"';
14980: if ($onchange) {
14981: $typeselectform .= ' onchange="'.$onchange.'"';
14982: }
14983: $typeselectform .= '>'."\n";
14984: foreach my $posstype ('Course','Community') {
14985: $typeselectform.='<option value="'.$posstype.'"'.
14986: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
14987: }
14988: $typeselectform.="</select>";
14989: }
14990:
14991: my ($cloneableonlyform,$cloneabletitle);
14992: if (exists($filter->{'cloneableonly'})) {
14993: my $cloneableon = '';
14994: my $cloneableoff = ' checked="checked"';
14995: if ($filter->{'cloneableonly'}) {
14996: $cloneableon = $cloneableoff;
14997: $cloneableoff = '';
14998: }
14999: $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>';
15000: if ($formname eq 'ccrs') {
1.1187 bisitz 15001: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 15002: } else {
15003: $cloneabletitle = &mt('Cloneable by you');
15004: }
15005: }
15006: my $officialjs;
15007: if ($crstype eq 'Course') {
15008: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 15009: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15010: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15011: if ($codedom) {
1.1181 raeburn 15012: $officialjs = 1;
15013: ($instcodeform,$jscript,$$numtitlesref) =
15014: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15015: $officialjs,$codetitlesref);
15016: if ($jscript) {
1.1182 raeburn 15017: $jscript = '<script type="text/javascript">'."\n".
15018: '// <![CDATA['."\n".
15019: $jscript."\n".
15020: '// ]]>'."\n".
15021: '</script>'."\n";
1.1181 raeburn 15022: }
15023: }
15024: if ($instcodeform eq '') {
15025: $instcodeform =
15026: '<input type="text" name="instcodefilter" size="10" value="'.
15027: $list->{'instcodefilter'}.'" />';
15028: $instcodetitle = $lt{'ins'};
15029: } else {
15030: $instcodetitle = $lt{'inc'};
15031: }
15032: if ($fixeddom) {
15033: $instcodetitle .= '<br />('.$codedom.')';
15034: }
15035: }
15036: }
15037: my $output = qq|
15038: <form method="post" name="filterpicker" action="$action">
15039: <input type="hidden" name="form" value="$formname" />
15040: |;
15041: if ($formname eq 'modifycourse') {
15042: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15043: '<input type="hidden" name="prevphase" value="'.
15044: $prevphase.'" />'."\n";
1.1198 musolffc 15045: } elsif ($formname eq 'quotacheck') {
15046: $output .= qq|
15047: <input type="hidden" name="sortby" value="" />
15048: <input type="hidden" name="sortorder" value="" />
15049: |;
15050: } else {
1.1181 raeburn 15051: my $name_input;
15052: if ($cnameelement ne '') {
15053: $name_input = '<input type="hidden" name="cnameelement" value="'.
15054: $cnameelement.'" />';
15055: }
15056: $output .= qq|
1.1182 raeburn 15057: <input type="hidden" name="cnumelement" value="$cnumelement" />
15058: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15059: $name_input
15060: $roleelement
15061: $multelement
15062: $typeelement
15063: |;
15064: if ($formname eq 'portform') {
15065: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15066: }
15067: }
15068: if ($fixeddom) {
15069: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15070: }
15071: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15072: if ($sincefilterform) {
15073: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15074: .$sincefilterform
15075: .&Apache::lonhtmlcommon::row_closure();
15076: }
15077: if ($createdfilterform) {
15078: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15079: .$createdfilterform
15080: .&Apache::lonhtmlcommon::row_closure();
15081: }
15082: if ($domainselectform) {
15083: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15084: .$domainselectform
15085: .&Apache::lonhtmlcommon::row_closure();
15086: }
15087: if ($typeselectform) {
15088: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15089: $output .= $typeselectform;
15090: } else {
15091: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15092: .$typeselectform
15093: .&Apache::lonhtmlcommon::row_closure();
15094: }
15095: }
15096: if ($instcodeform) {
15097: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15098: .$instcodeform
15099: .&Apache::lonhtmlcommon::row_closure();
15100: }
15101: if (exists($filter->{'ownerfilter'})) {
15102: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15103: '<table><tr><td>'.&mt('Username').'<br />'.
15104: '<input type="text" name="ownerfilter" size="20" value="'.
15105: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15106: $ownerdomselectform.'</td></tr></table>'.
15107: &Apache::lonhtmlcommon::row_closure();
15108: }
15109: if (exists($filter->{'personfilter'})) {
15110: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15111: '<table><tr><td>'.&mt('Username').'<br />'.
15112: '<input type="text" name="personfilter" size="20" value="'.
15113: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15114: $persondomselectform.'</td></tr></table>'.
15115: &Apache::lonhtmlcommon::row_closure();
15116: }
15117: if (exists($filter->{'coursefilter'})) {
15118: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15119: .'<input type="text" name="coursefilter" size="25" value="'
15120: .$list->{'coursefilter'}.'" />'
15121: .&Apache::lonhtmlcommon::row_closure();
15122: }
15123: if ($cloneableonlyform) {
15124: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15125: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15126: }
15127: if (exists($filter->{'descriptfilter'})) {
15128: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15129: .'<input type="text" name="descriptfilter" size="40" value="'
15130: .$list->{'descriptfilter'}.'" />'
15131: .&Apache::lonhtmlcommon::row_closure(1);
15132: }
15133: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15134: '<input type="hidden" name="updater" value="" />'."\n".
15135: '<input type="submit" name="gosearch" value="'.
15136: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15137: return $jscript.$clonewarning.$output;
15138: }
15139:
15140: =pod
15141:
15142: =item * &timebased_select_form()
15143:
1.1182 raeburn 15144: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15145: filter e.g., Course Activity, Course Created, when searching for courses
15146: or communities
15147:
15148: Inputs:
15149:
15150: item - name of form element (sincefilter or createdfilter)
15151:
15152: filter - anonymous hash of criteria and their values
15153:
15154: Returns: HTML for a select box contained a blank, then six time selections,
15155: with value set in incoming form variables currently selected.
15156:
15157: Side Effects: None
15158:
15159: =cut
15160:
15161: sub timebased_select_form {
15162: my ($item,$filter) = @_;
15163: if (ref($filter) eq 'HASH') {
15164: $filter->{$item} =~ s/[^\d-]//g;
15165: if (!$filter->{$item}) { $filter->{$item}=-1; }
15166: return &select_form(
15167: $filter->{$item},
15168: $item,
15169: { '-1' => '',
15170: '86400' => &mt('today'),
15171: '604800' => &mt('last week'),
15172: '2592000' => &mt('last month'),
15173: '7776000' => &mt('last three months'),
15174: '15552000' => &mt('last six months'),
15175: '31104000' => &mt('last year'),
15176: 'select_form_order' =>
15177: ['-1','86400','604800','2592000','7776000',
15178: '15552000','31104000']});
15179: }
15180: }
15181:
15182: =pod
15183:
15184: =item * &js_changer()
15185:
15186: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15187: when course type or domain is changed, and also to hide 'Searching ...' on
15188: page load completion for page showing search result.
1.1181 raeburn 15189:
15190: Inputs: None
15191:
1.1183 raeburn 15192: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15193:
15194: Side Effects: None
15195:
15196: =cut
15197:
15198: sub js_changer {
15199: return <<ENDJS;
15200: <script type="text/javascript">
15201: // <![CDATA[
15202: function updateFilters(caller) {
15203: if (typeof(caller) != "undefined") {
15204: document.filterpicker.updater.value = caller.name;
15205: }
15206: document.filterpicker.submit();
15207: }
1.1183 raeburn 15208:
15209: function hideSearching() {
15210: if (document.getElementById('searching')) {
15211: document.getElementById('searching').style.display = 'none';
15212: }
15213: return;
15214: }
15215:
1.1181 raeburn 15216: // ]]>
15217: </script>
15218:
15219: ENDJS
15220: }
15221:
15222: =pod
15223:
1.1182 raeburn 15224: =item * &search_courses()
15225:
15226: Process selected filters form course search form and pass to lonnet::courseiddump
15227: to retrieve a hash for which keys are courseIDs which match the selected filters.
15228:
15229: Inputs:
15230:
15231: dom - domain being searched
15232:
15233: type - course type ('Course' or 'Community' or '.' if any).
15234:
15235: filter - anonymous hash of criteria and their values
15236:
15237: numtitles - for institutional codes - number of categories
15238:
15239: cloneruname - optional username of new course owner
15240:
15241: clonerudom - optional domain of new course owner
15242:
15243: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15244: (used when DC is using course creation form)
15245:
15246: codetitles - reference to array of titles of components in institutional codes (official courses).
15247:
15248:
15249: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15250:
15251:
15252: Side Effects: None
15253:
15254: =cut
15255:
15256:
15257: sub search_courses {
15258: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15259: my (%courses,%showcourses,$cloner);
15260: if (($filter->{'ownerfilter'} ne '') ||
15261: ($filter->{'ownerdomfilter'} ne '')) {
15262: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15263: $filter->{'ownerdomfilter'};
15264: }
15265: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15266: if (!$filter->{$item}) {
15267: $filter->{$item}='.';
15268: }
15269: }
15270: my $now = time;
15271: my $timefilter =
15272: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15273: my ($createdbefore,$createdafter);
15274: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15275: $createdbefore = $now;
15276: $createdafter = $now-$filter->{'createdfilter'};
15277: }
15278: my ($instcodefilter,$regexpok);
15279: if ($numtitles) {
15280: if ($env{'form.official'} eq 'on') {
15281: $instcodefilter =
15282: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15283: $regexpok = 1;
15284: } elsif ($env{'form.official'} eq 'off') {
15285: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15286: unless ($instcodefilter eq '') {
15287: $regexpok = -1;
15288: }
15289: }
15290: } else {
15291: $instcodefilter = $filter->{'instcodefilter'};
15292: }
15293: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15294: if ($type eq '') { $type = '.'; }
15295:
15296: if (($clonerudom ne '') && ($cloneruname ne '')) {
15297: $cloner = $cloneruname.':'.$clonerudom;
15298: }
15299: %courses = &Apache::lonnet::courseiddump($dom,
15300: $filter->{'descriptfilter'},
15301: $timefilter,
15302: $instcodefilter,
15303: $filter->{'combownerfilter'},
15304: $filter->{'coursefilter'},
15305: undef,undef,$type,$regexpok,undef,undef,
15306: undef,undef,$cloner,$env{'form.cc_clone'},
15307: $filter->{'cloneableonly'},
15308: $createdbefore,$createdafter,undef,
15309: $domcloner);
15310: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15311: my $ccrole;
15312: if ($type eq 'Community') {
15313: $ccrole = 'co';
15314: } else {
15315: $ccrole = 'cc';
15316: }
15317: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15318: $filter->{'persondomfilter'},
15319: 'userroles',undef,
15320: [$ccrole,'in','ad','ep','ta','cr'],
15321: $dom);
15322: foreach my $role (keys(%rolehash)) {
15323: my ($cnum,$cdom,$courserole) = split(':',$role);
15324: my $cid = $cdom.'_'.$cnum;
15325: if (exists($courses{$cid})) {
15326: if (ref($courses{$cid}) eq 'HASH') {
15327: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15328: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15329: push (@{$courses{$cid}{roles}},$courserole);
15330: }
15331: } else {
15332: $courses{$cid}{roles} = [$courserole];
15333: }
15334: $showcourses{$cid} = $courses{$cid};
15335: }
15336: }
15337: }
15338: %courses = %showcourses;
15339: }
15340: return %courses;
15341: }
15342:
15343: =pod
15344:
1.1181 raeburn 15345: =back
15346:
15347: =cut
15348:
15349:
1.1083 raeburn 15350: sub update_content_constraints {
15351: my ($cdom,$cnum,$chome,$cid) = @_;
15352: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15353: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15354: my %checkresponsetypes;
15355: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15356: my ($item,$name,$value) = split(/:/,$key);
15357: if ($item eq 'resourcetag') {
15358: if ($name eq 'responsetype') {
15359: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15360: }
15361: }
15362: }
15363: my $navmap = Apache::lonnavmaps::navmap->new();
15364: if (defined($navmap)) {
15365: my %allresponses;
15366: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15367: my %responses = $res->responseTypes();
15368: foreach my $key (keys(%responses)) {
15369: next unless(exists($checkresponsetypes{$key}));
15370: $allresponses{$key} += $responses{$key};
15371: }
15372: }
15373: foreach my $key (keys(%allresponses)) {
15374: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15375: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15376: ($reqdmajor,$reqdminor) = ($major,$minor);
15377: }
15378: }
15379: undef($navmap);
15380: }
15381: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15382: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15383: }
15384: return;
15385: }
15386:
1.1110 raeburn 15387: sub allmaps_incourse {
15388: my ($cdom,$cnum,$chome,$cid) = @_;
15389: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15390: $cid = $env{'request.course.id'};
15391: $cdom = $env{'course.'.$cid.'.domain'};
15392: $cnum = $env{'course.'.$cid.'.num'};
15393: $chome = $env{'course.'.$cid.'.home'};
15394: }
15395: my %allmaps = ();
15396: my $lastchange =
15397: &Apache::lonnet::get_coursechange($cdom,$cnum);
15398: if ($lastchange > $env{'request.course.tied'}) {
15399: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15400: unless ($ferr) {
15401: &update_content_constraints($cdom,$cnum,$chome,$cid);
15402: }
15403: }
15404: my $navmap = Apache::lonnavmaps::navmap->new();
15405: if (defined($navmap)) {
15406: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15407: $allmaps{$res->src()} = 1;
15408: }
15409: }
15410: return \%allmaps;
15411: }
15412:
1.1083 raeburn 15413: sub parse_supplemental_title {
15414: my ($title) = @_;
15415:
15416: my ($foldertitle,$renametitle);
15417: if ($title =~ /&&&/) {
15418: $title = &HTML::Entites::decode($title);
15419: }
15420: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15421: $renametitle=$4;
15422: my ($time,$uname,$udom) = ($1,$2,$3);
15423: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15424: my $name = &plainname($uname,$udom);
15425: $name = &HTML::Entities::encode($name,'"<>&\'');
15426: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15427: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15428: $name.': <br />'.$foldertitle;
15429: }
15430: if (wantarray) {
15431: return ($title,$foldertitle,$renametitle);
15432: }
15433: return $title;
15434: }
15435:
1.1143 raeburn 15436: sub recurse_supplemental {
15437: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15438: if ($suppmap) {
15439: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15440: if ($fatal) {
15441: $errors ++;
15442: } else {
15443: if ($#LONCAPA::map::resources > 0) {
15444: foreach my $res (@LONCAPA::map::resources) {
15445: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15446: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 15447: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15448: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 15449: } else {
15450: $numfiles ++;
15451: }
15452: }
15453: }
15454: }
15455: }
15456: }
15457: return ($numfiles,$errors);
15458: }
15459:
1.1101 raeburn 15460: sub symb_to_docspath {
15461: my ($symb) = @_;
15462: return unless ($symb);
15463: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15464: if ($resurl=~/\.(sequence|page)$/) {
15465: $mapurl=$resurl;
15466: } elsif ($resurl eq 'adm/navmaps') {
15467: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15468: }
15469: my $mapresobj;
15470: my $navmap = Apache::lonnavmaps::navmap->new();
15471: if (ref($navmap)) {
15472: $mapresobj = $navmap->getResourceByUrl($mapurl);
15473: }
15474: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15475: my $type=$2;
15476: my $path;
15477: if (ref($mapresobj)) {
15478: my $pcslist = $mapresobj->map_hierarchy();
15479: if ($pcslist ne '') {
15480: foreach my $pc (split(/,/,$pcslist)) {
15481: next if ($pc <= 1);
15482: my $res = $navmap->getByMapPc($pc);
15483: if (ref($res)) {
15484: my $thisurl = $res->src();
15485: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15486: my $thistitle = $res->title();
15487: $path .= '&'.
15488: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 15489: &escape($thistitle).
1.1101 raeburn 15490: ':'.$res->randompick().
15491: ':'.$res->randomout().
15492: ':'.$res->encrypted().
15493: ':'.$res->randomorder().
15494: ':'.$res->is_page();
15495: }
15496: }
15497: }
15498: $path =~ s/^\&//;
15499: my $maptitle = $mapresobj->title();
15500: if ($mapurl eq 'default') {
1.1129 raeburn 15501: $maptitle = 'Main Content';
1.1101 raeburn 15502: }
15503: $path .= (($path ne '')? '&' : '').
15504: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15505: &escape($maptitle).
1.1101 raeburn 15506: ':'.$mapresobj->randompick().
15507: ':'.$mapresobj->randomout().
15508: ':'.$mapresobj->encrypted().
15509: ':'.$mapresobj->randomorder().
15510: ':'.$mapresobj->is_page();
15511: } else {
15512: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15513: my $ispage = (($type eq 'page')? 1 : '');
15514: if ($mapurl eq 'default') {
1.1129 raeburn 15515: $maptitle = 'Main Content';
1.1101 raeburn 15516: }
15517: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15518: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 15519: }
15520: unless ($mapurl eq 'default') {
15521: $path = 'default&'.
1.1146 raeburn 15522: &escape('Main Content').
1.1101 raeburn 15523: ':::::&'.$path;
15524: }
15525: return $path;
15526: }
15527:
1.1094 raeburn 15528: sub captcha_display {
15529: my ($context,$lonhost) = @_;
15530: my ($output,$error);
15531: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15532: if ($captcha eq 'original') {
1.1094 raeburn 15533: $output = &create_captcha();
15534: unless ($output) {
1.1172 raeburn 15535: $error = 'captcha';
1.1094 raeburn 15536: }
15537: } elsif ($captcha eq 'recaptcha') {
15538: $output = &create_recaptcha($pubkey);
15539: unless ($output) {
1.1172 raeburn 15540: $error = 'recaptcha';
1.1094 raeburn 15541: }
15542: }
1.1176 raeburn 15543: return ($output,$error,$captcha);
1.1094 raeburn 15544: }
15545:
15546: sub captcha_response {
15547: my ($context,$lonhost) = @_;
15548: my ($captcha_chk,$captcha_error);
15549: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15550: if ($captcha eq 'original') {
1.1094 raeburn 15551: ($captcha_chk,$captcha_error) = &check_captcha();
15552: } elsif ($captcha eq 'recaptcha') {
15553: $captcha_chk = &check_recaptcha($privkey);
15554: } else {
15555: $captcha_chk = 1;
15556: }
15557: return ($captcha_chk,$captcha_error);
15558: }
15559:
15560: sub get_captcha_config {
15561: my ($context,$lonhost) = @_;
1.1095 raeburn 15562: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 15563: my $hostname = &Apache::lonnet::hostname($lonhost);
15564: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15565: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 15566: if ($context eq 'usercreation') {
15567: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15568: if (ref($domconfig{$context}) eq 'HASH') {
15569: $hashtocheck = $domconfig{$context}{'cancreate'};
15570: if (ref($hashtocheck) eq 'HASH') {
15571: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15572: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15573: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15574: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15575: }
15576: if ($privkey && $pubkey) {
15577: $captcha = 'recaptcha';
15578: } else {
15579: $captcha = 'original';
15580: }
15581: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15582: $captcha = 'original';
15583: }
1.1094 raeburn 15584: }
1.1095 raeburn 15585: } else {
15586: $captcha = 'captcha';
15587: }
15588: } elsif ($context eq 'login') {
15589: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15590: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15591: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15592: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 15593: if ($privkey && $pubkey) {
15594: $captcha = 'recaptcha';
1.1095 raeburn 15595: } else {
15596: $captcha = 'original';
1.1094 raeburn 15597: }
1.1095 raeburn 15598: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15599: $captcha = 'original';
1.1094 raeburn 15600: }
15601: }
15602: return ($captcha,$pubkey,$privkey);
15603: }
15604:
15605: sub create_captcha {
15606: my %captcha_params = &captcha_settings();
15607: my ($output,$maxtries,$tries) = ('',10,0);
15608: while ($tries < $maxtries) {
15609: $tries ++;
15610: my $captcha = Authen::Captcha->new (
15611: output_folder => $captcha_params{'output_dir'},
15612: data_folder => $captcha_params{'db_dir'},
15613: );
15614: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15615:
15616: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15617: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15618: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 15619: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15620: '<br />'.
15621: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 15622: last;
15623: }
15624: }
15625: return $output;
15626: }
15627:
15628: sub captcha_settings {
15629: my %captcha_params = (
15630: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15631: www_output_dir => "/captchaspool",
15632: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15633: numchars => '5',
15634: );
15635: return %captcha_params;
15636: }
15637:
15638: sub check_captcha {
15639: my ($captcha_chk,$captcha_error);
15640: my $code = $env{'form.code'};
15641: my $md5sum = $env{'form.crypt'};
15642: my %captcha_params = &captcha_settings();
15643: my $captcha = Authen::Captcha->new(
15644: output_folder => $captcha_params{'output_dir'},
15645: data_folder => $captcha_params{'db_dir'},
15646: );
1.1109 raeburn 15647: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 15648: my %captcha_hash = (
15649: 0 => 'Code not checked (file error)',
15650: -1 => 'Failed: code expired',
15651: -2 => 'Failed: invalid code (not in database)',
15652: -3 => 'Failed: invalid code (code does not match crypt)',
15653: );
15654: if ($captcha_chk != 1) {
15655: $captcha_error = $captcha_hash{$captcha_chk}
15656: }
15657: return ($captcha_chk,$captcha_error);
15658: }
15659:
15660: sub create_recaptcha {
15661: my ($pubkey) = @_;
1.1153 raeburn 15662: my $use_ssl;
15663: if ($ENV{'SERVER_PORT'} == 443) {
15664: $use_ssl = 1;
15665: }
1.1094 raeburn 15666: my $captcha = Captcha::reCAPTCHA->new;
15667: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 15668: $captcha->get_html($pubkey,undef,$use_ssl).
1.1094 raeburn 15669: &mt('If either word is hard to read, [_1] will replace them.',
1.1133 raeburn 15670: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 15671: '<br /><br />';
15672: }
15673:
15674: sub check_recaptcha {
15675: my ($privkey) = @_;
15676: my $captcha_chk;
15677: my $captcha = Captcha::reCAPTCHA->new;
15678: my $captcha_result =
15679: $captcha->check_answer(
15680: $privkey,
15681: $ENV{'REMOTE_ADDR'},
15682: $env{'form.recaptcha_challenge_field'},
15683: $env{'form.recaptcha_response_field'},
15684: );
15685: if ($captcha_result->{is_valid}) {
15686: $captcha_chk = 1;
15687: }
15688: return $captcha_chk;
15689: }
15690:
1.1174 raeburn 15691: sub emailusername_info {
1.1177 raeburn 15692: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 15693: my %titles = &Apache::lonlocal::texthash (
15694: lastname => 'Last Name',
15695: firstname => 'First Name',
15696: institution => 'School/college/university',
15697: location => "School's city, state/province, country",
15698: web => "School's web address",
15699: officialemail => 'E-mail address at institution (if different)',
15700: );
15701: return (\@fields,\%titles);
15702: }
15703:
1.1161 raeburn 15704: sub cleanup_html {
15705: my ($incoming) = @_;
15706: my $outgoing;
15707: if ($incoming ne '') {
15708: $outgoing = $incoming;
15709: $outgoing =~ s/;/;/g;
15710: $outgoing =~ s/\#/#/g;
15711: $outgoing =~ s/\&/&/g;
15712: $outgoing =~ s/</</g;
15713: $outgoing =~ s/>/>/g;
15714: $outgoing =~ s/\(/(/g;
15715: $outgoing =~ s/\)/)/g;
15716: $outgoing =~ s/"/"/g;
15717: $outgoing =~ s/'/'/g;
15718: $outgoing =~ s/\$/$/g;
15719: $outgoing =~ s{/}{/}g;
15720: $outgoing =~ s/=/=/g;
15721: $outgoing =~ s/\\/\/g
15722: }
15723: return $outgoing;
15724: }
15725:
1.1190 musolffc 15726: # Checks for critical messages and returns a redirect url if one exists.
15727: # $interval indicates how often to check for messages.
15728: sub critical_redirect {
15729: my ($interval) = @_;
15730: if ((time-$env{'user.criticalcheck.time'})>$interval) {
15731: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
15732: $env{'user.name'});
15733: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 15734: my $redirecturl;
1.1190 musolffc 15735: if ($what[0]) {
15736: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
15737: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 15738: my $url=&Apache::lonnet::absolute_url().$redirecturl;
15739: return (1, $url);
1.1190 musolffc 15740: }
1.1191 raeburn 15741: }
15742: }
15743: return ();
1.1190 musolffc 15744: }
15745:
1.1174 raeburn 15746: # Use:
15747: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
15748: #
15749: ##################################################
15750: # password associated functions #
15751: ##################################################
15752: sub des_keys {
15753: # Make a new key for DES encryption.
15754: # Each key has two parts which are returned separately.
15755: # Please note: Each key must be passed through the &hex function
15756: # before it is output to the web browser. The hex versions cannot
15757: # be used to decrypt.
15758: my @hexstr=('0','1','2','3','4','5','6','7',
15759: '8','9','a','b','c','d','e','f');
15760: my $lkey='';
15761: for (0..7) {
15762: $lkey.=$hexstr[rand(15)];
15763: }
15764: my $ukey='';
15765: for (0..7) {
15766: $ukey.=$hexstr[rand(15)];
15767: }
15768: return ($lkey,$ukey);
15769: }
15770:
15771: sub des_decrypt {
15772: my ($key,$cyphertext) = @_;
15773: my $keybin=pack("H16",$key);
15774: my $cypher;
15775: if ($Crypt::DES::VERSION>=2.03) {
15776: $cypher=new Crypt::DES $keybin;
15777: } else {
15778: $cypher=new DES $keybin;
15779: }
15780: my $plaintext=
15781: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
15782: $plaintext.=
15783: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
15784: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
15785: return $plaintext;
15786: }
15787:
1.112 bowersj2 15788: 1;
15789: __END__;
1.41 ng 15790:
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