Annotation of loncom/interface/loncommon.pm, revision 1.1289
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1289 ! raeburn 4: # $Id: loncommon.pm,v 1.1288 2017/08/11 00:24:52 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.1280 raeburn 74: use LONCAPA::LWPReq;
1.657 raeburn 75: use DateTime::TimeZone;
1.1241 raeburn 76: use DateTime::Locale;
1.1220 raeburn 77: use Encode();
1.1091 foxr 78: use Text::Aspell;
1.1094 raeburn 79: use Authen::Captcha;
80: use Captcha::reCAPTCHA;
1.1234 raeburn 81: use JSON::DWIW;
82: use LWP::UserAgent;
1.1174 raeburn 83: use Crypt::DES;
84: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 85: use MIME::Lite;
86: use MIME::Types;
1.117 www 87:
1.517 raeburn 88: # ---------------------------------------------- Designs
89: use vars qw(%defaultdesign);
90:
1.22 www 91: my $readit;
92:
1.517 raeburn 93:
1.157 matthew 94: ##
95: ## Global Variables
96: ##
1.46 matthew 97:
1.643 foxr 98:
99: # ----------------------------------------------- SSI with retries:
100: #
101:
102: =pod
103:
1.648 raeburn 104: =head1 Server Side include with retries:
1.643 foxr 105:
106: =over 4
107:
1.648 raeburn 108: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 109:
110: Performs an ssi with some number of retries. Retries continue either
111: until the result is ok or until the retry count supplied by the
112: caller is exhausted.
113:
114: Inputs:
1.648 raeburn 115:
116: =over 4
117:
1.643 foxr 118: resource - Identifies the resource to insert.
1.648 raeburn 119:
1.643 foxr 120: retries - Count of the number of retries allowed.
1.648 raeburn 121:
1.643 foxr 122: form - Hash that identifies the rendering options.
123:
1.648 raeburn 124: =back
125:
126: Returns:
127:
128: =over 4
129:
1.643 foxr 130: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 131:
1.643 foxr 132: response - The response from the last attempt (which may or may not have been successful.
133:
1.648 raeburn 134: =back
135:
136: =back
137:
1.643 foxr 138: =cut
139:
140: sub ssi_with_retries {
141: my ($resource, $retries, %form) = @_;
142:
143:
144: my $ok = 0; # True if we got a good response.
145: my $content;
146: my $response;
147:
148: # Try to get the ssi done. within the retries count:
149:
150: do {
151: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
152: $ok = $response->is_success;
1.650 www 153: if (!$ok) {
154: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
155: }
1.643 foxr 156: $retries--;
157: } while (!$ok && ($retries > 0));
158:
159: if (!$ok) {
160: $content = ''; # On error return an empty content.
161: }
162: return ($content, $response);
163:
164: }
165:
166:
167:
1.20 www 168: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 169: my %language;
1.124 www 170: my %supported_language;
1.1088 foxr 171: my %supported_codes;
1.1048 foxr 172: my %latex_language; # For choosing hyphenation in <transl..>
173: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 174: my %cprtag;
1.192 taceyjo1 175: my %scprtag;
1.351 www 176: my %fe; my %fd; my %fm;
1.41 ng 177: my %category_extensions;
1.12 harris41 178:
1.46 matthew 179: # ---------------------------------------------- Thesaurus variables
1.144 matthew 180: #
181: # %Keywords:
182: # A hash used by &keyword to determine if a word is considered a keyword.
183: # $thesaurus_db_file
184: # Scalar containing the full path to the thesaurus database.
1.46 matthew 185:
186: my %Keywords;
187: my $thesaurus_db_file;
188:
1.144 matthew 189: #
190: # Initialize values from language.tab, copyright.tab, filetypes.tab,
191: # thesaurus.tab, and filecategories.tab.
192: #
1.18 www 193: BEGIN {
1.46 matthew 194: # Variable initialization
195: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
196: #
1.22 www 197: unless ($readit) {
1.12 harris41 198: # ------------------------------------------------------------------- languages
199: {
1.158 raeburn 200: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
201: '/language.tab';
202: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 203: while (my $line = <$fh>) {
204: next if ($line=~/^\#/);
205: chomp($line);
1.1088 foxr 206: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 207: $language{$key}=$val.' - '.$enc;
208: if ($sup) {
209: $supported_language{$key}=$sup;
1.1088 foxr 210: $supported_codes{$key} = $code;
1.158 raeburn 211: }
1.1048 foxr 212: if ($latex) {
213: $latex_language_bykey{$key} = $latex;
1.1088 foxr 214: $latex_language{$code} = $latex;
1.1048 foxr 215: }
1.158 raeburn 216: }
217: close($fh);
218: }
1.12 harris41 219: }
220: # ------------------------------------------------------------------ copyrights
221: {
1.158 raeburn 222: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
223: '/copyright.tab';
224: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 225: while (my $line = <$fh>) {
226: next if ($line=~/^\#/);
227: chomp($line);
228: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 229: $cprtag{$key}=$val;
230: }
231: close($fh);
232: }
1.12 harris41 233: }
1.351 www 234: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 235: {
236: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
237: '/source_copyright.tab';
238: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 239: while (my $line = <$fh>) {
240: next if ($line =~ /^\#/);
241: chomp($line);
242: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 243: $scprtag{$key}=$val;
244: }
245: close($fh);
246: }
247: }
1.63 www 248:
1.517 raeburn 249: # -------------------------------------------------------------- default domain designs
1.63 www 250: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 251: my $designfile = $designdir.'/default.tab';
252: if ( open (my $fh,"<$designfile") ) {
253: while (my $line = <$fh>) {
254: next if ($line =~ /^\#/);
255: chomp($line);
256: my ($key,$val)=(split(/\=/,$line));
257: if ($val) { $defaultdesign{$key}=$val; }
258: }
259: close($fh);
1.63 www 260: }
261:
1.15 harris41 262: # ------------------------------------------------------------- file categories
263: {
1.158 raeburn 264: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
265: '/filecategories.tab';
266: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 267: while (my $line = <$fh>) {
268: next if ($line =~ /^\#/);
269: chomp($line);
270: my ($extension,$category)=(split(/\s+/,$line,2));
1.1263 raeburn 271: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 272: }
273: close($fh);
274: }
275:
1.15 harris41 276: }
1.12 harris41 277: # ------------------------------------------------------------------ file types
278: {
1.158 raeburn 279: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
280: '/filetypes.tab';
281: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 282: while (my $line = <$fh>) {
283: next if ($line =~ /^\#/);
284: chomp($line);
285: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 286: if ($descr ne '') {
287: $fe{$ending}=lc($emb);
288: $fd{$ending}=$descr;
1.351 www 289: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 290: }
291: }
292: close($fh);
293: }
1.12 harris41 294: }
1.22 www 295: &Apache::lonnet::logthis(
1.705 tempelho 296: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 297: $readit=1;
1.46 matthew 298: } # end of unless($readit)
1.32 matthew 299:
300: }
1.112 bowersj2 301:
1.42 matthew 302: ###############################################################
303: ## HTML and Javascript Helper Functions ##
304: ###############################################################
305:
306: =pod
307:
1.112 bowersj2 308: =head1 HTML and Javascript Functions
1.42 matthew 309:
1.112 bowersj2 310: =over 4
311:
1.648 raeburn 312: =item * &browser_and_searcher_javascript()
1.112 bowersj2 313:
314: X<browsing, javascript>X<searching, javascript>Returns a string
315: containing javascript with two functions, C<openbrowser> and
316: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
317: tags.
1.42 matthew 318:
1.648 raeburn 319: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 320:
321: inputs: formname, elementname, only, omit
322:
323: formname and elementname indicate the name of the html form and name of
324: the element that the results of the browsing selection are to be placed in.
325:
326: Specifying 'only' will restrict the browser to displaying only files
1.185 www 327: with the given extension. Can be a comma separated list.
1.42 matthew 328:
329: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 330: with the given extension. Can be a comma separated list.
1.42 matthew 331:
1.648 raeburn 332: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 333:
334: Inputs: formname, elementname
335:
336: formname and elementname specify the name of the html form and the name
337: of the element the selection from the search results will be placed in.
1.542 raeburn 338:
1.42 matthew 339: =cut
340:
341: sub browser_and_searcher_javascript {
1.199 albertel 342: my ($mode)=@_;
343: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 344: my $resurl=&escape_single(&lastresurl());
1.42 matthew 345: return <<END;
1.219 albertel 346: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 347: var editbrowser = null;
1.135 albertel 348: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 349: var url = '$resurl/?';
1.42 matthew 350: if (editbrowser == null) {
351: url += 'launch=1&';
352: }
353: url += 'catalogmode=interactive&';
1.199 albertel 354: url += 'mode=$mode&';
1.611 albertel 355: url += 'inhibitmenu=yes&';
1.42 matthew 356: url += 'form=' + formname + '&';
357: if (only != null) {
358: url += 'only=' + only + '&';
1.217 albertel 359: } else {
360: url += 'only=&';
361: }
1.42 matthew 362: if (omit != null) {
363: url += 'omit=' + omit + '&';
1.217 albertel 364: } else {
365: url += 'omit=&';
366: }
1.135 albertel 367: if (titleelement != null) {
368: url += 'titleelement=' + titleelement + '&';
1.217 albertel 369: } else {
370: url += 'titleelement=&';
371: }
1.42 matthew 372: url += 'element=' + elementname + '';
373: var title = 'Browser';
1.435 albertel 374: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 375: options += ',width=700,height=600';
376: editbrowser = open(url,title,options,'1');
377: editbrowser.focus();
378: }
379: var editsearcher;
1.135 albertel 380: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 381: var url = '/adm/searchcat?';
382: if (editsearcher == null) {
383: url += 'launch=1&';
384: }
385: url += 'catalogmode=interactive&';
1.199 albertel 386: url += 'mode=$mode&';
1.42 matthew 387: url += 'form=' + formname + '&';
1.135 albertel 388: if (titleelement != null) {
389: url += 'titleelement=' + titleelement + '&';
1.217 albertel 390: } else {
391: url += 'titleelement=&';
392: }
1.42 matthew 393: url += 'element=' + elementname + '';
394: var title = 'Search';
1.435 albertel 395: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 396: options += ',width=700,height=600';
397: editsearcher = open(url,title,options,'1');
398: editsearcher.focus();
399: }
1.219 albertel 400: // END LON-CAPA Internal -->
1.42 matthew 401: END
1.170 www 402: }
403:
404: sub lastresurl {
1.258 albertel 405: if ($env{'environment.lastresurl'}) {
406: return $env{'environment.lastresurl'}
1.170 www 407: } else {
408: return '/res';
409: }
410: }
411:
412: sub storeresurl {
413: my $resurl=&Apache::lonnet::clutter(shift);
414: unless ($resurl=~/^\/res/) { return 0; }
415: $resurl=~s/\/$//;
416: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 417: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 418: return 1;
1.42 matthew 419: }
420:
1.74 www 421: sub studentbrowser_javascript {
1.111 www 422: unless (
1.258 albertel 423: (($env{'request.course.id'}) &&
1.302 albertel 424: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
425: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
426: '/'.$env{'request.course.sec'})
427: ))
1.258 albertel 428: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 429: ) { return ''; }
1.74 www 430: return (<<'ENDSTDBRW');
1.776 bisitz 431: <script type="text/javascript" language="Javascript">
1.824 bisitz 432: // <![CDATA[
1.74 www 433: var stdeditbrowser;
1.999 www 434: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 435: var url = '/adm/pickstudent?';
436: var filter;
1.558 albertel 437: if (!ignorefilter) {
438: eval('filter=document.'+formname+'.'+uname+'.value;');
439: }
1.74 www 440: if (filter != null) {
441: if (filter != '') {
442: url += 'filter='+filter+'&';
443: }
444: }
445: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 446: '&udomelement='+udom+
447: '&clicker='+clicker;
1.111 www 448: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 449: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 450: var title = 'Student_Browser';
1.74 www 451: var options = 'scrollbars=1,resizable=1,menubar=0';
452: options += ',width=700,height=600';
453: stdeditbrowser = open(url,title,options,'1');
454: stdeditbrowser.focus();
455: }
1.824 bisitz 456: // ]]>
1.74 www 457: </script>
458: ENDSTDBRW
459: }
1.42 matthew 460:
1.1003 www 461: sub resourcebrowser_javascript {
462: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 463: return (<<'ENDRESBRW');
1.1003 www 464: <script type="text/javascript" language="Javascript">
465: // <![CDATA[
466: var reseditbrowser;
1.1004 www 467: function openresbrowser(formname,reslink) {
1.1005 www 468: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 469: var title = 'Resource_Browser';
470: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 471: options += ',width=700,height=500';
1.1004 www 472: reseditbrowser = open(url,title,options,'1');
473: reseditbrowser.focus();
1.1003 www 474: }
475: // ]]>
476: </script>
1.1004 www 477: ENDRESBRW
1.1003 www 478: }
479:
1.74 www 480: sub selectstudent_link {
1.999 www 481: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
482: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
483: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
484: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 485: if ($env{'request.course.id'}) {
1.302 albertel 486: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
487: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
488: '/'.$env{'request.course.sec'})) {
1.111 www 489: return '';
490: }
1.999 www 491: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 492: if ($courseadvonly) {
493: $callargs .= ",'',1,1";
494: }
495: return '<span class="LC_nobreak">'.
496: '<a href="javascript:openstdbrowser('.$callargs.');">'.
497: &mt('Select User').'</a></span>';
1.74 www 498: }
1.258 albertel 499: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 500: $callargs .= ",'',1";
1.793 raeburn 501: return '<span class="LC_nobreak">'.
502: '<a href="javascript:openstdbrowser('.$callargs.');">'.
503: &mt('Select User').'</a></span>';
1.111 www 504: }
505: return '';
1.91 www 506: }
507:
1.1004 www 508: sub selectresource_link {
509: my ($form,$reslink,$arg)=@_;
510:
511: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
512: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
513: unless ($env{'request.course.id'}) { return $arg; }
514: return '<span class="LC_nobreak">'.
515: '<a href="javascript:openresbrowser('.$callargs.');">'.
516: $arg.'</a></span>';
517: }
518:
519:
520:
1.653 raeburn 521: sub authorbrowser_javascript {
522: return <<"ENDAUTHORBRW";
1.776 bisitz 523: <script type="text/javascript" language="JavaScript">
1.824 bisitz 524: // <![CDATA[
1.653 raeburn 525: var stdeditbrowser;
526:
527: function openauthorbrowser(formname,udom) {
528: var url = '/adm/pickauthor?';
529: url += 'form='+formname+'&roledom='+udom;
530: var title = 'Author_Browser';
531: var options = 'scrollbars=1,resizable=1,menubar=0';
532: options += ',width=700,height=600';
533: stdeditbrowser = open(url,title,options,'1');
534: stdeditbrowser.focus();
535: }
536:
1.824 bisitz 537: // ]]>
1.653 raeburn 538: </script>
539: ENDAUTHORBRW
540: }
541:
1.91 www 542: sub coursebrowser_javascript {
1.1116 raeburn 543: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 544: $credits_element,$instcode) = @_;
1.932 raeburn 545: my $wintitle = 'Course_Browser';
1.931 raeburn 546: if ($crstype eq 'Community') {
1.932 raeburn 547: $wintitle = 'Community_Browser';
1.909 raeburn 548: }
1.876 raeburn 549: my $id_functions = &javascript_index_functions();
550: my $output = '
1.776 bisitz 551: <script type="text/javascript" language="JavaScript">
1.824 bisitz 552: // <![CDATA[
1.468 raeburn 553: var stdeditbrowser;'."\n";
1.876 raeburn 554:
555: $output .= <<"ENDSTDBRW";
1.909 raeburn 556: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 557: var url = '/adm/pickcourse?';
1.895 raeburn 558: var formid = getFormIdByName(formname);
1.876 raeburn 559: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 560: if (domainfilter != null) {
561: if (domainfilter != '') {
562: url += 'domainfilter='+domainfilter+'&';
563: }
564: }
1.91 www 565: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 566: '&cdomelement='+udom+
567: '&cnameelement='+desc;
1.468 raeburn 568: if (extra_element !=null && extra_element != '') {
1.594 raeburn 569: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 570: url += '&roleelement='+extra_element;
571: if (domainfilter == null || domainfilter == '') {
572: url += '&domainfilter='+extra_element;
573: }
1.234 raeburn 574: }
1.468 raeburn 575: else {
576: if (formname == 'portform') {
577: url += '&setroles='+extra_element;
1.800 raeburn 578: } else {
579: if (formname == 'rules') {
580: url += '&fixeddom='+extra_element;
581: }
1.468 raeburn 582: }
583: }
1.230 raeburn 584: }
1.909 raeburn 585: if (type != null && type != '') {
586: url += '&type='+type;
587: }
588: if (type_elem != null && type_elem != '') {
589: url += '&typeelement='+type_elem;
590: }
1.872 raeburn 591: if (formname == 'ccrs') {
592: var ownername = document.forms[formid].ccuname.value;
593: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 594: url += '&cloner='+ownername+':'+ownerdom;
595: if (type == 'Course') {
596: url += '&crscode='+document.forms[formid].crscode.value;
597: }
1.1221 raeburn 598: }
599: if (formname == 'requestcrs') {
600: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 601: }
1.293 raeburn 602: if (multflag !=null && multflag != '') {
603: url += '&multiple='+multflag;
604: }
1.909 raeburn 605: var title = '$wintitle';
1.91 www 606: var options = 'scrollbars=1,resizable=1,menubar=0';
607: options += ',width=700,height=600';
608: stdeditbrowser = open(url,title,options,'1');
609: stdeditbrowser.focus();
610: }
1.876 raeburn 611: $id_functions
612: ENDSTDBRW
1.1116 raeburn 613: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
614: $output .= &setsec_javascript($sec_element,$formname,$role_element,
615: $credits_element);
1.876 raeburn 616: }
617: $output .= '
618: // ]]>
619: </script>';
620: return $output;
621: }
622:
623: sub javascript_index_functions {
624: return <<"ENDJS";
625:
626: function getFormIdByName(formname) {
627: for (var i=0;i<document.forms.length;i++) {
628: if (document.forms[i].name == formname) {
629: return i;
630: }
631: }
632: return -1;
633: }
634:
635: function getIndexByName(formid,item) {
636: for (var i=0;i<document.forms[formid].elements.length;i++) {
637: if (document.forms[formid].elements[i].name == item) {
638: return i;
639: }
640: }
641: return -1;
642: }
1.468 raeburn 643:
1.876 raeburn 644: function getDomainFromSelectbox(formname,udom) {
645: var userdom;
646: var formid = getFormIdByName(formname);
647: if (formid > -1) {
648: var domid = getIndexByName(formid,udom);
649: if (domid > -1) {
650: if (document.forms[formid].elements[domid].type == 'select-one') {
651: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
652: }
653: if (document.forms[formid].elements[domid].type == 'hidden') {
654: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 655: }
656: }
657: }
1.876 raeburn 658: return userdom;
659: }
660:
661: ENDJS
1.468 raeburn 662:
1.876 raeburn 663: }
664:
1.1017 raeburn 665: sub javascript_array_indexof {
1.1018 raeburn 666: return <<ENDJS;
1.1017 raeburn 667: <script type="text/javascript" language="JavaScript">
668: // <![CDATA[
669:
670: if (!Array.prototype.indexOf) {
671: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
672: "use strict";
673: if (this === void 0 || this === null) {
674: throw new TypeError();
675: }
676: var t = Object(this);
677: var len = t.length >>> 0;
678: if (len === 0) {
679: return -1;
680: }
681: var n = 0;
682: if (arguments.length > 0) {
683: n = Number(arguments[1]);
1.1088 foxr 684: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 685: n = 0;
686: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
687: n = (n > 0 || -1) * Math.floor(Math.abs(n));
688: }
689: }
690: if (n >= len) {
691: return -1;
692: }
693: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
694: for (; k < len; k++) {
695: if (k in t && t[k] === searchElement) {
696: return k;
697: }
698: }
699: return -1;
700: }
701: }
702:
703: // ]]>
704: </script>
705:
706: ENDJS
707:
708: }
709:
1.876 raeburn 710: sub userbrowser_javascript {
711: my $id_functions = &javascript_index_functions();
712: return <<"ENDUSERBRW";
713:
1.888 raeburn 714: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 715: var url = '/adm/pickuser?';
716: var userdom = getDomainFromSelectbox(formname,udom);
717: if (userdom != null) {
718: if (userdom != '') {
719: url += 'srchdom='+userdom+'&';
720: }
721: }
722: url += 'form=' + formname + '&unameelement='+uname+
723: '&udomelement='+udom+
724: '&ulastelement='+ulast+
725: '&ufirstelement='+ufirst+
726: '&uemailelement='+uemail+
1.881 raeburn 727: '&hideudomelement='+hideudom+
728: '&coursedom='+crsdom;
1.888 raeburn 729: if ((caller != null) && (caller != undefined)) {
730: url += '&caller='+caller;
731: }
1.876 raeburn 732: var title = 'User_Browser';
733: var options = 'scrollbars=1,resizable=1,menubar=0';
734: options += ',width=700,height=600';
735: var stdeditbrowser = open(url,title,options,'1');
736: stdeditbrowser.focus();
737: }
738:
1.888 raeburn 739: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 740: var formid = getFormIdByName(formname);
741: if (formid > -1) {
1.888 raeburn 742: var unameid = getIndexByName(formid,uname);
1.876 raeburn 743: var domid = getIndexByName(formid,udom);
744: var hidedomid = getIndexByName(formid,origdom);
745: if (hidedomid > -1) {
746: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 747: var unameval = document.forms[formid].elements[unameid].value;
748: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
749: if (domid > -1) {
750: var slct = document.forms[formid].elements[domid];
751: if (slct.type == 'select-one') {
752: var i;
753: for (i=0;i<slct.length;i++) {
754: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
755: }
756: }
757: if (slct.type == 'hidden') {
758: slct.value = fixeddom;
1.876 raeburn 759: }
760: }
1.468 raeburn 761: }
762: }
763: }
1.876 raeburn 764: return;
765: }
766:
767: $id_functions
768: ENDUSERBRW
1.468 raeburn 769: }
770:
771: sub setsec_javascript {
1.1116 raeburn 772: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 773: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
774: $communityrolestr);
775: if ($role_element ne '') {
776: my @allroles = ('st','ta','ep','in','ad');
777: foreach my $crstype ('Course','Community') {
778: if ($crstype eq 'Community') {
779: foreach my $role (@allroles) {
780: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
781: }
782: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
783: } else {
784: foreach my $role (@allroles) {
785: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
786: }
787: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
788: }
789: }
790: $rolestr = '"'.join('","',@allroles).'"';
791: $courserolestr = '"'.join('","',@courserolenames).'"';
792: $communityrolestr = '"'.join('","',@communityrolenames).'"';
793: }
1.468 raeburn 794: my $setsections = qq|
795: function setSect(sectionlist) {
1.629 raeburn 796: var sectionsArray = new Array();
797: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
798: sectionsArray = sectionlist.split(",");
799: }
1.468 raeburn 800: var numSections = sectionsArray.length;
801: document.$formname.$sec_element.length = 0;
802: if (numSections == 0) {
803: document.$formname.$sec_element.multiple=false;
804: document.$formname.$sec_element.size=1;
805: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
806: } else {
807: if (numSections == 1) {
808: document.$formname.$sec_element.multiple=false;
809: document.$formname.$sec_element.size=1;
810: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
811: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
812: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
813: } else {
814: for (var i=0; i<numSections; i++) {
815: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
816: }
817: document.$formname.$sec_element.multiple=true
818: if (numSections < 3) {
819: document.$formname.$sec_element.size=numSections;
820: } else {
821: document.$formname.$sec_element.size=3;
822: }
823: document.$formname.$sec_element.options[0].selected = false
824: }
825: }
1.91 www 826: }
1.905 raeburn 827:
828: function setRole(crstype) {
1.468 raeburn 829: |;
1.905 raeburn 830: if ($role_element eq '') {
831: $setsections .= ' return;
832: }
833: ';
834: } else {
835: $setsections .= qq|
836: var elementLength = document.$formname.$role_element.length;
837: var allroles = Array($rolestr);
838: var courserolenames = Array($courserolestr);
839: var communityrolenames = Array($communityrolestr);
840: if (elementLength != undefined) {
841: if (document.$formname.$role_element.options[5].value == 'cc') {
842: if (crstype == 'Course') {
843: return;
844: } else {
845: allroles[5] = 'co';
846: for (var i=0; i<6; i++) {
847: document.$formname.$role_element.options[i].value = allroles[i];
848: document.$formname.$role_element.options[i].text = communityrolenames[i];
849: }
850: }
851: } else {
852: if (crstype == 'Community') {
853: return;
854: } else {
855: allroles[5] = 'cc';
856: for (var i=0; i<6; i++) {
857: document.$formname.$role_element.options[i].value = allroles[i];
858: document.$formname.$role_element.options[i].text = courserolenames[i];
859: }
860: }
861: }
862: }
863: return;
864: }
865: |;
866: }
1.1116 raeburn 867: if ($credits_element) {
868: $setsections .= qq|
869: function setCredits(defaultcredits) {
870: document.$formname.$credits_element.value = defaultcredits;
871: return;
872: }
873: |;
874: }
1.468 raeburn 875: return $setsections;
876: }
877:
1.91 www 878: sub selectcourse_link {
1.909 raeburn 879: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
880: $typeelement) = @_;
881: my $type = $selecttype;
1.871 raeburn 882: my $linktext = &mt('Select Course');
883: if ($selecttype eq 'Community') {
1.909 raeburn 884: $linktext = &mt('Select Community');
1.1239 raeburn 885: } elsif ($selecttype eq 'Placement') {
886: $linktext = &mt('Select Placement Test');
1.906 raeburn 887: } elsif ($selecttype eq 'Course/Community') {
888: $linktext = &mt('Select Course/Community');
1.909 raeburn 889: $type = '';
1.1019 raeburn 890: } elsif ($selecttype eq 'Select') {
891: $linktext = &mt('Select');
892: $type = '';
1.871 raeburn 893: }
1.787 bisitz 894: return '<span class="LC_nobreak">'
895: ."<a href='"
896: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
897: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 898: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 899: ."'>".$linktext.'</a>'
1.787 bisitz 900: .'</span>';
1.74 www 901: }
1.42 matthew 902:
1.653 raeburn 903: sub selectauthor_link {
904: my ($form,$udom)=@_;
905: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
906: &mt('Select Author').'</a>';
907: }
908:
1.876 raeburn 909: sub selectuser_link {
1.881 raeburn 910: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 911: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 912: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 913: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 914: ');">'.$linktext.'</a>';
1.876 raeburn 915: }
916:
1.273 raeburn 917: sub check_uncheck_jscript {
918: my $jscript = <<"ENDSCRT";
919: function checkAll(field) {
920: if (field.length > 0) {
921: for (i = 0; i < field.length; i++) {
1.1093 raeburn 922: if (!field[i].disabled) {
923: field[i].checked = true;
924: }
1.273 raeburn 925: }
926: } else {
1.1093 raeburn 927: if (!field.disabled) {
928: field.checked = true;
929: }
1.273 raeburn 930: }
931: }
932:
933: function uncheckAll(field) {
934: if (field.length > 0) {
935: for (i = 0; i < field.length; i++) {
936: field[i].checked = false ;
1.543 albertel 937: }
938: } else {
1.273 raeburn 939: field.checked = false ;
940: }
941: }
942: ENDSCRT
943: return $jscript;
944: }
945:
1.656 www 946: sub select_timezone {
1.1256 raeburn 947: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
948: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 949: if ($includeempty) {
950: $output .= '<option value=""';
951: if (($selected eq '') || ($selected eq 'local')) {
952: $output .= ' selected="selected" ';
953: }
954: $output .= '> </option>';
955: }
1.657 raeburn 956: my @timezones = DateTime::TimeZone->all_names;
957: foreach my $tzone (@timezones) {
958: $output.= '<option value="'.$tzone.'"';
959: if ($tzone eq $selected) {
960: $output.=' selected="selected"';
961: }
962: $output.=">$tzone</option>\n";
1.656 www 963: }
964: $output.="</select>";
965: return $output;
966: }
1.273 raeburn 967:
1.687 raeburn 968: sub select_datelocale {
1.1256 raeburn 969: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
970: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 971: if ($includeempty) {
972: $output .= '<option value=""';
973: if ($selected eq '') {
974: $output .= ' selected="selected" ';
975: }
976: $output .= '> </option>';
977: }
1.1241 raeburn 978: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 979: my (@possibles,%locale_names);
1.1241 raeburn 980: my @locales = DateTime::Locale->ids();
981: foreach my $id (@locales) {
982: if ($id ne '') {
983: my ($en_terr,$native_terr);
984: my $loc = DateTime::Locale->load($id);
985: if (ref($loc)) {
986: $en_terr = $loc->name();
987: $native_terr = $loc->native_name();
1.687 raeburn 988: if (grep(/^en$/,@languages) || !@languages) {
989: if ($en_terr ne '') {
990: $locale_names{$id} = '('.$en_terr.')';
991: } elsif ($native_terr ne '') {
992: $locale_names{$id} = $native_terr;
993: }
994: } else {
995: if ($native_terr ne '') {
996: $locale_names{$id} = $native_terr.' ';
997: } elsif ($en_terr ne '') {
998: $locale_names{$id} = '('.$en_terr.')';
999: }
1000: }
1.1220 raeburn 1001: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1002: push(@possibles,$id);
1003: }
1.687 raeburn 1004: }
1005: }
1006: foreach my $item (sort(@possibles)) {
1007: $output.= '<option value="'.$item.'"';
1008: if ($item eq $selected) {
1009: $output.=' selected="selected"';
1010: }
1011: $output.=">$item";
1012: if ($locale_names{$item} ne '') {
1.1220 raeburn 1013: $output.=' '.$locale_names{$item};
1.687 raeburn 1014: }
1015: $output.="</option>\n";
1016: }
1017: $output.="</select>";
1018: return $output;
1019: }
1020:
1.792 raeburn 1021: sub select_language {
1.1256 raeburn 1022: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1023: my %langchoices;
1024: if ($includeempty) {
1.1117 raeburn 1025: %langchoices = ('' => 'No language preference');
1.792 raeburn 1026: }
1027: foreach my $id (&languageids()) {
1028: my $code = &supportedlanguagecode($id);
1029: if ($code) {
1030: $langchoices{$code} = &plainlanguagedescription($id);
1031: }
1032: }
1.1117 raeburn 1033: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256 raeburn 1034: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1035: }
1036:
1.42 matthew 1037: =pod
1.36 matthew 1038:
1.1088 foxr 1039:
1040: =item * &list_languages()
1041:
1042: Returns an array reference that is suitable for use in language prompters.
1043: Each array element is itself a two element array. The first element
1044: is the language code. The second element a descsriptiuon of the
1045: language itself. This is suitable for use in e.g.
1046: &Apache::edit::select_arg (once dereferenced that is).
1047:
1048: =cut
1049:
1050: sub list_languages {
1051: my @lang_choices;
1052:
1053: foreach my $id (&languageids()) {
1054: my $code = &supportedlanguagecode($id);
1055: if ($code) {
1056: my $selector = $supported_codes{$id};
1057: my $description = &plainlanguagedescription($id);
1.1263 raeburn 1058: push(@lang_choices, [$selector, $description]);
1.1088 foxr 1059: }
1060: }
1061: return \@lang_choices;
1062: }
1063:
1064: =pod
1065:
1.648 raeburn 1066: =item * &linked_select_forms(...)
1.36 matthew 1067:
1068: linked_select_forms returns a string containing a <script></script> block
1069: and html for two <select> menus. The select menus will be linked in that
1070: changing the value of the first menu will result in new values being placed
1071: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1072: order unless a defined order is provided.
1.36 matthew 1073:
1074: linked_select_forms takes the following ordered inputs:
1075:
1076: =over 4
1077:
1.112 bowersj2 1078: =item * $formname, the name of the <form> tag
1.36 matthew 1079:
1.112 bowersj2 1080: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1081:
1.112 bowersj2 1082: =item * $firstdefault, the default value for the first menu
1.36 matthew 1083:
1.112 bowersj2 1084: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1085:
1.112 bowersj2 1086: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1087:
1.112 bowersj2 1088: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1089:
1.609 raeburn 1090: =item * $menuorder, the order of values in the first menu
1091:
1.1115 raeburn 1092: =item * $onchangefirst, additional javascript call to execute for an onchange
1093: event for the first <select> tag
1094:
1095: =item * $onchangesecond, additional javascript call to execute for an onchange
1096: event for the second <select> tag
1097:
1.1245 raeburn 1098: =item * $suffix, to differentiate separate uses of select2data javascript
1099: objects in a page.
1100:
1.41 ng 1101: =back
1102:
1.36 matthew 1103: Below is an example of such a hash. Only the 'text', 'default', and
1104: 'select2' keys must appear as stated. keys(%menu) are the possible
1105: values for the first select menu. The text that coincides with the
1.41 ng 1106: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1107: and text for the second menu are given in the hash pointed to by
1108: $menu{$choice1}->{'select2'}.
1109:
1.112 bowersj2 1110: my %menu = ( A1 => { text =>"Choice A1" ,
1111: default => "B3",
1112: select2 => {
1113: B1 => "Choice B1",
1114: B2 => "Choice B2",
1115: B3 => "Choice B3",
1116: B4 => "Choice B4"
1.609 raeburn 1117: },
1118: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1119: },
1120: A2 => { text =>"Choice A2" ,
1121: default => "C2",
1122: select2 => {
1123: C1 => "Choice C1",
1124: C2 => "Choice C2",
1125: C3 => "Choice C3"
1.609 raeburn 1126: },
1127: order => ['C2','C1','C3'],
1.112 bowersj2 1128: },
1129: A3 => { text =>"Choice A3" ,
1130: default => "D6",
1131: select2 => {
1132: D1 => "Choice D1",
1133: D2 => "Choice D2",
1134: D3 => "Choice D3",
1135: D4 => "Choice D4",
1136: D5 => "Choice D5",
1137: D6 => "Choice D6",
1138: D7 => "Choice D7"
1.609 raeburn 1139: },
1140: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1141: }
1142: );
1.36 matthew 1143:
1144: =cut
1145:
1146: sub linked_select_forms {
1147: my ($formname,
1148: $middletext,
1149: $firstdefault,
1150: $firstselectname,
1151: $secondselectname,
1.609 raeburn 1152: $hashref,
1153: $menuorder,
1.1115 raeburn 1154: $onchangefirst,
1.1245 raeburn 1155: $onchangesecond,
1156: $suffix
1.36 matthew 1157: ) = @_;
1158: my $second = "document.$formname.$secondselectname";
1159: my $first = "document.$formname.$firstselectname";
1160: # output the javascript to do the changing
1161: my $result = '';
1.776 bisitz 1162: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1163: $result.="// <![CDATA[\n";
1.1245 raeburn 1164: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1165: $" = '","';
1166: my $debug = '';
1167: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1168: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1169: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1170: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1171: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1172: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1173: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1174: @s2values = @{$hashref->{$s1}->{'order'}};
1175: }
1.36 matthew 1176: $result.="\"@s2values\");\n";
1.1245 raeburn 1177: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1178: my @s2texts;
1179: foreach my $value (@s2values) {
1.1263 raeburn 1180: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1181: }
1182: $result.="\"@s2texts\");\n";
1183: }
1184: $"=' ';
1185: $result.= <<"END";
1186:
1.1245 raeburn 1187: function select1${suffix}_changed() {
1.36 matthew 1188: // Determine new choice
1.1245 raeburn 1189: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1190: // update select2
1.1245 raeburn 1191: var values = select2data${suffix}[newvalue].values;
1192: var texts = select2data${suffix}[newvalue].texts;
1193: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1194: var i;
1195: // out with the old
1.1245 raeburn 1196: $second.options.length = 0;
1197: // in with the new
1.36 matthew 1198: for (i=0;i<values.length; i++) {
1199: $second.options[i] = new Option(values[i]);
1.143 matthew 1200: $second.options[i].value = values[i];
1.36 matthew 1201: $second.options[i].text = texts[i];
1202: if (values[i] == select2def) {
1203: $second.options[i].selected = true;
1204: }
1205: }
1206: }
1.824 bisitz 1207: // ]]>
1.36 matthew 1208: </script>
1209: END
1210: # output the initial values for the selection lists
1.1245 raeburn 1211: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1212: my @order = sort(keys(%{$hashref}));
1213: if (ref($menuorder) eq 'ARRAY') {
1214: @order = @{$menuorder};
1215: }
1216: foreach my $value (@order) {
1.36 matthew 1217: $result.=" <option value=\"$value\" ";
1.253 albertel 1218: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1219: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1220: }
1221: $result .= "</select>\n";
1222: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1223: $result .= $middletext;
1.1115 raeburn 1224: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1225: if ($onchangesecond) {
1226: $result .= ' onchange="'.$onchangesecond.'"';
1227: }
1228: $result .= ">\n";
1.36 matthew 1229: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1230:
1231: my @secondorder = sort(keys(%select2));
1232: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1233: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1234: }
1235: foreach my $value (@secondorder) {
1.36 matthew 1236: $result.=" <option value=\"$value\" ";
1.253 albertel 1237: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1238: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1239: }
1240: $result .= "</select>\n";
1241: # return $debug;
1242: return $result;
1243: } # end of sub linked_select_forms {
1244:
1.45 matthew 1245: =pod
1.44 bowersj2 1246:
1.973 raeburn 1247: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1248:
1.112 bowersj2 1249: Returns a string corresponding to an HTML link to the given help
1250: $topic, where $topic corresponds to the name of a .tex file in
1251: /home/httpd/html/adm/help/tex, with underscores replaced by
1252: spaces.
1253:
1254: $text will optionally be linked to the same topic, allowing you to
1255: link text in addition to the graphic. If you do not want to link
1256: text, but wish to specify one of the later parameters, pass an
1257: empty string.
1258:
1259: $stayOnPage is a value that will be interpreted as a boolean. If true,
1260: the link will not open a new window. If false, the link will open
1261: a new window using Javascript. (Default is false.)
1262:
1263: $width and $height are optional numerical parameters that will
1264: override the width and height of the popped up window, which may
1.973 raeburn 1265: be useful for certain help topics with big pictures included.
1266:
1267: $imgid is the id of the img tag used for the help icon. This may be
1268: used in a javascript call to switch the image src. See
1269: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1270:
1271: =cut
1272:
1273: sub help_open_topic {
1.973 raeburn 1274: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1275: $text = "" if (not defined $text);
1.44 bowersj2 1276: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1277: $width = 500 if (not defined $width);
1.44 bowersj2 1278: $height = 400 if (not defined $height);
1279: my $filename = $topic;
1280: $filename =~ s/ /_/g;
1281:
1.48 bowersj2 1282: my $template = "";
1283: my $link;
1.572 banghart 1284:
1.159 www 1285: $topic=~s/\W/\_/g;
1.44 bowersj2 1286:
1.572 banghart 1287: if (!$stayOnPage) {
1.1033 www 1288: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1289: } elsif ($stayOnPage eq 'popup') {
1290: $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 1291: } else {
1.48 bowersj2 1292: $link = "/adm/help/${filename}.hlp";
1293: }
1294:
1295: # Add the text
1.755 neumanie 1296: if ($text ne "") {
1.763 bisitz 1297: $template.='<span class="LC_help_open_topic">'
1298: .'<a target="_top" href="'.$link.'">'
1299: .$text.'</a>';
1.48 bowersj2 1300: }
1301:
1.763 bisitz 1302: # (Always) Add the graphic
1.179 matthew 1303: my $title = &mt('Online Help');
1.667 raeburn 1304: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1305: if ($imgid ne '') {
1306: $imgid = ' id="'.$imgid.'"';
1307: }
1.763 bisitz 1308: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1309: .'<img src="'.$helpicon.'" border="0"'
1310: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1311: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1312: .' /></a>';
1313: if ($text ne "") {
1314: $template.='</span>';
1315: }
1.44 bowersj2 1316: return $template;
1317:
1.106 bowersj2 1318: }
1319:
1320: # This is a quicky function for Latex cheatsheet editing, since it
1321: # appears in at least four places
1322: sub helpLatexCheatsheet {
1.1037 www 1323: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1324: my $out;
1.106 bowersj2 1325: my $addOther = '';
1.732 raeburn 1326: if ($topic) {
1.1037 www 1327: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1328: }
1329: $out = '<span>' # Start cheatsheet
1330: .$addOther
1331: .'<span>'
1.1037 www 1332: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1333: .'</span> <span>'
1.1037 www 1334: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1335: .'</span>';
1.732 raeburn 1336: unless ($not_author) {
1.1186 kruse 1337: $out .= '<span>'
1338: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1339: .'</span> <span>'
1340: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1341: .'</span>';
1.732 raeburn 1342: }
1.763 bisitz 1343: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1344: return $out;
1.172 www 1345: }
1346:
1.430 albertel 1347: sub general_help {
1348: my $helptopic='Student_Intro';
1349: if ($env{'request.role'}=~/^(ca|au)/) {
1350: $helptopic='Authoring_Intro';
1.907 raeburn 1351: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1352: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1353: } elsif ($env{'request.role'}=~/^dc/) {
1354: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1355: }
1356: return $helptopic;
1357: }
1358:
1359: sub update_help_link {
1360: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1361: my $origurl = $ENV{'REQUEST_URI'};
1362: $origurl=~s|^/~|/priv/|;
1363: my $timestamp = time;
1364: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1365: $$datum = &escape($$datum);
1366: }
1367:
1368: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1369: my $output .= <<"ENDOUTPUT";
1370: <script type="text/javascript">
1.824 bisitz 1371: // <![CDATA[
1.430 albertel 1372: banner_link = '$banner_link';
1.824 bisitz 1373: // ]]>
1.430 albertel 1374: </script>
1375: ENDOUTPUT
1376: return $output;
1377: }
1378:
1379: # now just updates the help link and generates a blue icon
1.193 raeburn 1380: sub help_open_menu {
1.430 albertel 1381: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1382: = @_;
1.949 droeschl 1383: $stayOnPage = 1;
1.430 albertel 1384: my $output;
1385: if ($component_help) {
1386: if (!$text) {
1387: $output=&help_open_topic($component_help,undef,$stayOnPage,
1388: $width,$height);
1389: } else {
1390: my $help_text;
1391: $help_text=&unescape($topic);
1392: $output='<table><tr><td>'.
1393: &help_open_topic($component_help,$help_text,$stayOnPage,
1394: $width,$height).'</td></tr></table>';
1395: }
1396: }
1397: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1398: return $output.$banner_link;
1399: }
1400:
1401: sub top_nav_help {
1402: my ($text) = @_;
1.436 albertel 1403: $text = &mt($text);
1.949 droeschl 1404: my $stay_on_page = 1;
1405:
1.1168 raeburn 1406: my ($link,$banner_link);
1407: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1408: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1409: : "javascript:helpMenu('open')";
1410: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1411: }
1.201 raeburn 1412: my $title = &mt('Get help');
1.1168 raeburn 1413: if ($link) {
1414: return <<"END";
1.436 albertel 1415: $banner_link
1.1159 raeburn 1416: <a href="$link" title="$title">$text</a>
1.436 albertel 1417: END
1.1168 raeburn 1418: } else {
1419: return ' '.$text.' ';
1420: }
1.436 albertel 1421: }
1422:
1423: sub help_menu_js {
1.1154 raeburn 1424: my ($httphost) = @_;
1.949 droeschl 1425: my $stayOnPage = 1;
1.436 albertel 1426: my $width = 620;
1427: my $height = 600;
1.430 albertel 1428: my $helptopic=&general_help();
1.1154 raeburn 1429: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1430: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1431: my $start_page =
1432: &Apache::loncommon::start_page('Help Menu', undef,
1433: {'frameset' => 1,
1434: 'js_ready' => 1,
1.1154 raeburn 1435: 'use_absolute' => $httphost,
1.331 albertel 1436: 'add_entries' => {
1.1168 raeburn 1437: 'border' => '0',
1.579 raeburn 1438: 'rows' => "110,*",},});
1.331 albertel 1439: my $end_page =
1440: &Apache::loncommon::end_page({'frameset' => 1,
1441: 'js_ready' => 1,});
1442:
1.436 albertel 1443: my $template .= <<"ENDTEMPLATE";
1444: <script type="text/javascript">
1.877 bisitz 1445: // <![CDATA[
1.253 albertel 1446: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1447: var banner_link = '';
1.243 raeburn 1448: function helpMenu(target) {
1449: var caller = this;
1450: if (target == 'open') {
1451: var newWindow = null;
1452: try {
1.262 albertel 1453: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1454: }
1455: catch(error) {
1456: writeHelp(caller);
1457: return;
1458: }
1459: if (newWindow) {
1460: caller = newWindow;
1461: }
1.193 raeburn 1462: }
1.243 raeburn 1463: writeHelp(caller);
1464: return;
1465: }
1466: function writeHelp(caller) {
1.1168 raeburn 1467: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1468: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1469: caller.document.close();
1470: caller.focus();
1.193 raeburn 1471: }
1.877 bisitz 1472: // END LON-CAPA Internal -->
1.253 albertel 1473: // ]]>
1.436 albertel 1474: </script>
1.193 raeburn 1475: ENDTEMPLATE
1476: return $template;
1477: }
1478:
1.172 www 1479: sub help_open_bug {
1480: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1481: unless ($env{'user.adv'}) { return ''; }
1.172 www 1482: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1483: $text = "" if (not defined $text);
1484: $stayOnPage=1;
1.184 albertel 1485: $width = 600 if (not defined $width);
1486: $height = 600 if (not defined $height);
1.172 www 1487:
1488: $topic=~s/\W+/\+/g;
1489: my $link='';
1490: my $template='';
1.379 albertel 1491: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1492: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1493: if (!$stayOnPage)
1494: {
1495: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1496: }
1497: else
1498: {
1499: $link = $url;
1500: }
1501: # Add the text
1502: if ($text ne "")
1503: {
1504: $template .=
1505: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1506: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1507: }
1508:
1509: # Add the graphic
1.179 matthew 1510: my $title = &mt('Report a Bug');
1.215 albertel 1511: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1512: $template .= <<"ENDTEMPLATE";
1.436 albertel 1513: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1514: ENDTEMPLATE
1515: if ($text ne '') { $template.='</td></tr></table>' };
1516: return $template;
1517:
1518: }
1519:
1520: sub help_open_faq {
1521: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1522: unless ($env{'user.adv'}) { return ''; }
1.172 www 1523: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1524: $text = "" if (not defined $text);
1525: $stayOnPage=1;
1526: $width = 350 if (not defined $width);
1527: $height = 400 if (not defined $height);
1528:
1529: $topic=~s/\W+/\+/g;
1530: my $link='';
1531: my $template='';
1532: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1533: if (!$stayOnPage)
1534: {
1535: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1536: }
1537: else
1538: {
1539: $link = $url;
1540: }
1541:
1542: # Add the text
1543: if ($text ne "")
1544: {
1545: $template .=
1.173 www 1546: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1547: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1548: }
1549:
1550: # Add the graphic
1.179 matthew 1551: my $title = &mt('View the FAQ');
1.215 albertel 1552: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1553: $template .= <<"ENDTEMPLATE";
1.436 albertel 1554: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1555: ENDTEMPLATE
1556: if ($text ne '') { $template.='</td></tr></table>' };
1557: return $template;
1558:
1.44 bowersj2 1559: }
1.37 matthew 1560:
1.180 matthew 1561: ###############################################################
1562: ###############################################################
1563:
1.45 matthew 1564: =pod
1565:
1.648 raeburn 1566: =item * &change_content_javascript():
1.256 matthew 1567:
1568: This and the next function allow you to create small sections of an
1569: otherwise static HTML page that you can update on the fly with
1570: Javascript, even in Netscape 4.
1571:
1572: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1573: must be written to the HTML page once. It will prove the Javascript
1574: function "change(name, content)". Calling the change function with the
1575: name of the section
1576: you want to update, matching the name passed to C<changable_area>, and
1577: the new content you want to put in there, will put the content into
1578: that area.
1579:
1580: B<Note>: Netscape 4 only reserves enough space for the changable area
1581: to contain room for the original contents. You need to "make space"
1582: for whatever changes you wish to make, and be B<sure> to check your
1583: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1584: it's adequate for updating a one-line status display, but little more.
1585: This script will set the space to 100% width, so you only need to
1586: worry about height in Netscape 4.
1587:
1588: Modern browsers are much less limiting, and if you can commit to the
1589: user not using Netscape 4, this feature may be used freely with
1590: pretty much any HTML.
1591:
1592: =cut
1593:
1594: sub change_content_javascript {
1595: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1596: if ($env{'browser.type'} eq 'netscape' &&
1597: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1598: return (<<NETSCAPE4);
1599: function change(name, content) {
1600: doc = document.layers[name+"___escape"].layers[0].document;
1601: doc.open();
1602: doc.write(content);
1603: doc.close();
1604: }
1605: NETSCAPE4
1606: } else {
1607: # Otherwise, we need to use semi-standards-compliant code
1608: # (technically, "innerHTML" isn't standard but the equivalent
1609: # is really scary, and every useful browser supports it
1610: return (<<DOMBASED);
1611: function change(name, content) {
1612: element = document.getElementById(name);
1613: element.innerHTML = content;
1614: }
1615: DOMBASED
1616: }
1617: }
1618:
1619: =pod
1620:
1.648 raeburn 1621: =item * &changable_area($name,$origContent):
1.256 matthew 1622:
1623: This provides a "changable area" that can be modified on the fly via
1624: the Javascript code provided in C<change_content_javascript>. $name is
1625: the name you will use to reference the area later; do not repeat the
1626: same name on a given HTML page more then once. $origContent is what
1627: the area will originally contain, which can be left blank.
1628:
1629: =cut
1630:
1631: sub changable_area {
1632: my ($name, $origContent) = @_;
1633:
1.258 albertel 1634: if ($env{'browser.type'} eq 'netscape' &&
1635: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1636: # If this is netscape 4, we need to use the Layer tag
1637: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1638: } else {
1639: return "<span id='$name'>$origContent</span>";
1640: }
1641: }
1642:
1643: =pod
1644:
1.648 raeburn 1645: =item * &viewport_geometry_js
1.590 raeburn 1646:
1647: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1648:
1649: =cut
1650:
1651:
1652: sub viewport_geometry_js {
1653: return <<"GEOMETRY";
1654: var Geometry = {};
1655: function init_geometry() {
1656: if (Geometry.init) { return };
1657: Geometry.init=1;
1658: if (window.innerHeight) {
1659: Geometry.getViewportHeight = function() { return window.innerHeight; };
1660: Geometry.getViewportWidth = function() { return window.innerWidth; };
1661: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1662: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1663: }
1664: else if (document.documentElement && document.documentElement.clientHeight) {
1665: Geometry.getViewportHeight =
1666: function() { return document.documentElement.clientHeight; };
1667: Geometry.getViewportWidth =
1668: function() { return document.documentElement.clientWidth; };
1669:
1670: Geometry.getHorizontalScroll =
1671: function() { return document.documentElement.scrollLeft; };
1672: Geometry.getVerticalScroll =
1673: function() { return document.documentElement.scrollTop; };
1674: }
1675: else if (document.body.clientHeight) {
1676: Geometry.getViewportHeight =
1677: function() { return document.body.clientHeight; };
1678: Geometry.getViewportWidth =
1679: function() { return document.body.clientWidth; };
1680: Geometry.getHorizontalScroll =
1681: function() { return document.body.scrollLeft; };
1682: Geometry.getVerticalScroll =
1683: function() { return document.body.scrollTop; };
1684: }
1685: }
1686:
1687: GEOMETRY
1688: }
1689:
1690: =pod
1691:
1.648 raeburn 1692: =item * &viewport_size_js()
1.590 raeburn 1693:
1694: 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.
1695:
1696: =cut
1697:
1698: sub viewport_size_js {
1699: my $geometry = &viewport_geometry_js();
1700: return <<"DIMS";
1701:
1702: $geometry
1703:
1704: function getViewportDims(width,height) {
1705: init_geometry();
1706: width.value = Geometry.getViewportWidth();
1707: height.value = Geometry.getViewportHeight();
1708: return;
1709: }
1710:
1711: DIMS
1712: }
1713:
1714: =pod
1715:
1.648 raeburn 1716: =item * &resize_textarea_js()
1.565 albertel 1717:
1718: emits the needed javascript to resize a textarea to be as big as possible
1719:
1720: creates a function resize_textrea that takes two IDs first should be
1721: the id of the element to resize, second should be the id of a div that
1722: surrounds everything that comes after the textarea, this routine needs
1723: to be attached to the <body> for the onload and onresize events.
1724:
1.648 raeburn 1725: =back
1.565 albertel 1726:
1727: =cut
1728:
1729: sub resize_textarea_js {
1.590 raeburn 1730: my $geometry = &viewport_geometry_js();
1.565 albertel 1731: return <<"RESIZE";
1732: <script type="text/javascript">
1.824 bisitz 1733: // <![CDATA[
1.590 raeburn 1734: $geometry
1.565 albertel 1735:
1.588 albertel 1736: function getX(element) {
1737: var x = 0;
1738: while (element) {
1739: x += element.offsetLeft;
1740: element = element.offsetParent;
1741: }
1742: return x;
1743: }
1744: function getY(element) {
1745: var y = 0;
1746: while (element) {
1747: y += element.offsetTop;
1748: element = element.offsetParent;
1749: }
1750: return y;
1751: }
1752:
1753:
1.565 albertel 1754: function resize_textarea(textarea_id,bottom_id) {
1755: init_geometry();
1756: var textarea = document.getElementById(textarea_id);
1757: //alert(textarea);
1758:
1.588 albertel 1759: var textarea_top = getY(textarea);
1.565 albertel 1760: var textarea_height = textarea.offsetHeight;
1761: var bottom = document.getElementById(bottom_id);
1.588 albertel 1762: var bottom_top = getY(bottom);
1.565 albertel 1763: var bottom_height = bottom.offsetHeight;
1764: var window_height = Geometry.getViewportHeight();
1.588 albertel 1765: var fudge = 23;
1.565 albertel 1766: var new_height = window_height-fudge-textarea_top-bottom_height;
1767: if (new_height < 300) {
1768: new_height = 300;
1769: }
1770: textarea.style.height=new_height+'px';
1771: }
1.824 bisitz 1772: // ]]>
1.565 albertel 1773: </script>
1774: RESIZE
1775:
1776: }
1777:
1.1205 golterma 1778: sub colorfuleditor_js {
1.1248 raeburn 1779: my $browse_or_search;
1780: my $respath;
1781: my ($cnum,$cdom) = &crsauthor_url();
1782: if ($cnum) {
1783: $respath = "/res/$cdom/$cnum/";
1784: my %js_lt = &Apache::lonlocal::texthash(
1785: sunm => 'Sub-directory name',
1786: save => 'Save page to make this permanent',
1787: );
1788: &js_escape(\%js_lt);
1789: $browse_or_search = <<"END";
1790:
1791: function toggleChooser(form,element,titleid,only,search) {
1792: var disp = 'none';
1793: if (document.getElementById('chooser_'+element)) {
1794: var curr = document.getElementById('chooser_'+element).style.display;
1795: if (curr == 'none') {
1796: disp='inline';
1797: if (form.elements['chooser_'+element].length) {
1798: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1799: form.elements['chooser_'+element][i].checked = false;
1800: }
1801: }
1802: toggleResImport(form,element);
1803: }
1804: document.getElementById('chooser_'+element).style.display = disp;
1805: }
1806: }
1807:
1808: function toggleCrsFile(form,element,numdirs) {
1809: if (document.getElementById('chooser_'+element+'_crsres')) {
1810: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1811: if (curr == 'none') {
1812: if (numdirs) {
1813: form.elements['coursepath_'+element].selectedIndex = 0;
1814: if (numdirs > 1) {
1815: window['select1'+element+'_changed']();
1816: }
1817: }
1818: }
1819: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1820:
1821: }
1822: if (document.getElementById('chooser_'+element+'_upload')) {
1823: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1824: if (document.getElementById('uploadcrsres_'+element)) {
1825: document.getElementById('uploadcrsres_'+element).value = '';
1826: }
1827: }
1828: return;
1829: }
1830:
1831: function toggleCrsUpload(form,element,numcrsdirs) {
1832: if (document.getElementById('chooser_'+element+'_crsres')) {
1833: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1834: }
1835: if (document.getElementById('chooser_'+element+'_upload')) {
1836: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1837: if (curr == 'none') {
1838: if (numcrsdirs) {
1839: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1840: form.elements['newsubdir_'+element][0].checked = true;
1841: toggleNewsubdir(form,element);
1842: }
1843: }
1844: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1845: }
1846: return;
1847: }
1848:
1849: function toggleResImport(form,element) {
1850: var choices = new Array('crsres','upload');
1851: for (var i=0; i<choices.length; i++) {
1852: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1853: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1854: }
1855: }
1856: }
1857:
1858: function toggleNewsubdir(form,element) {
1859: var newsub = form.elements['newsubdir_'+element];
1860: if (newsub) {
1861: if (newsub.length) {
1862: for (var j=0; j<newsub.length; j++) {
1863: if (newsub[j].checked) {
1864: if (document.getElementById('newsubdirname_'+element)) {
1865: if (newsub[j].value == '1') {
1866: document.getElementById('newsubdirname_'+element).type = "text";
1867: if (document.getElementById('newsubdir_'+element)) {
1868: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1869: }
1870: } else {
1871: document.getElementById('newsubdirname_'+element).type = "hidden";
1872: document.getElementById('newsubdirname_'+element).value = "";
1873: document.getElementById('newsubdir_'+element).innerHTML = "";
1874: }
1875: }
1876: break;
1877: }
1878: }
1879: }
1880: }
1881: }
1882:
1883: function updateCrsFile(form,element) {
1884: var directory = form.elements['coursepath_'+element];
1885: var filename = form.elements['coursefile_'+element];
1886: var path = directory.options[directory.selectedIndex].value;
1887: var file = filename.options[filename.selectedIndex].value;
1888: form.elements[element].value = '$respath';
1889: if (path == '/') {
1890: form.elements[element].value += file;
1891: } else {
1892: form.elements[element].value += path+'/'+file;
1893: }
1894: unClean();
1895: if (document.getElementById('previewimg_'+element)) {
1896: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1897: var newsrc = document.getElementById('previewimg_'+element).src;
1898: }
1899: if (document.getElementById('showimg_'+element)) {
1900: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1901: }
1902: toggleChooser(form,element);
1903: return;
1904: }
1905:
1906: function uploadDone(suffix,name) {
1907: if (name) {
1908: document.forms["lonhomework"].elements[suffix].value = name;
1909: unClean();
1910: toggleChooser(document.forms["lonhomework"],suffix);
1911: }
1912: }
1913:
1914: \$(document).ready(function(){
1915:
1916: \$(document).delegate('form :submit', 'click', function( event ) {
1917: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1918: var buttonId = this.id;
1919: var suffix = buttonId.toString();
1920: suffix = suffix.replace(/^crsupload_/,'');
1921: event.preventDefault();
1922: document.lonhomework.target = 'crsupload_target_'+suffix;
1923: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1924: \$(this.form).submit();
1925: document.lonhomework.target = '';
1926: if (document.getElementById('crsuploadto_'+suffix)) {
1927: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1928: }
1929: return false;
1930: }
1931: });
1932: });
1933: END
1934: }
1.1205 golterma 1935: return <<"COLORFULEDIT"
1936: <script type="text/javascript">
1937: // <![CDATA[>
1938: function fold_box(curDepth, lastresource){
1939:
1940: // we need a list because there can be several blocks you need to fold in one tag
1941: var block = document.getElementsByName('foldblock_'+curDepth);
1942: // but there is only one folding button per tag
1943: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1944:
1945: if(block.item(0).style.display == 'none'){
1946:
1947: foldbutton.value = '@{[&mt("Hide")]}';
1948: for (i = 0; i < block.length; i++){
1949: block.item(i).style.display = '';
1950: }
1951: }else{
1952:
1953: foldbutton.value = '@{[&mt("Show")]}';
1954: for (i = 0; i < block.length; i++){
1955: // block.item(i).style.visibility = 'collapse';
1956: block.item(i).style.display = 'none';
1957: }
1958: };
1959: saveState(lastresource);
1960: }
1961:
1962: function saveState (lastresource) {
1963:
1964: var tag_list = getTagList();
1965: if(tag_list != null){
1966: var timestamp = new Date().getTime();
1967: var key = lastresource;
1968:
1969: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1970: // starting with timestamp
1971: var value = timestamp+';';
1972:
1973: // building the list of key-value pairs
1974: for(var i = 0; i < tag_list.length; i++){
1975: value += tag_list[i]+',';
1976: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1977: }
1978:
1979: // only iterate whole storage if nothing to override
1980: if(localStorage.getItem(key) == null){
1981:
1982: // prevent storage from growing large
1983: if(localStorage.length > 50){
1984: var regex_getTimestamp = /^(?:\d)+;/;
1985: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1986: var oldest_key;
1987:
1988: for(var i = 1; i < localStorage.length; i++){
1989: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1990: oldest_key = localStorage.key(i);
1991: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1992: }
1993: }
1994: localStorage.removeItem(oldest_key);
1995: }
1996: }
1997: localStorage.setItem(key,value);
1998: }
1999: }
2000:
2001: // restore folding status of blocks (on page load)
2002: function restoreState (lastresource) {
2003: if(localStorage.getItem(lastresource) != null){
2004: var key = lastresource;
2005: var value = localStorage.getItem(key);
2006: var regex_delTimestamp = /^\d+;/;
2007:
2008: value.replace(regex_delTimestamp, '');
2009:
2010: var valueArr = value.split(';');
2011: var pairs;
2012: var elements;
2013: for (var i = 0; i < valueArr.length; i++){
2014: pairs = valueArr[i].split(',');
2015: elements = document.getElementsByName(pairs[0]);
2016:
2017: for (var j = 0; j < elements.length; j++){
2018: elements[j].style.display = pairs[1];
2019: if (pairs[1] == "none"){
2020: var regex_id = /([_\\d]+)\$/;
2021: regex_id.exec(pairs[0]);
2022: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2023: }
2024: }
2025: }
2026: }
2027: }
2028:
2029: function getTagList () {
2030:
2031: var stringToSearch = document.lonhomework.innerHTML;
2032:
2033: var ret = new Array();
2034: var regex_findBlock = /(foldblock_.*?)"/g;
2035: var tag_list = stringToSearch.match(regex_findBlock);
2036:
2037: if(tag_list != null){
2038: for(var i = 0; i < tag_list.length; i++){
2039: ret.push(tag_list[i].replace(/"/, ''));
2040: }
2041: }
2042: return ret;
2043: }
2044:
2045: function saveScrollPosition (resource) {
2046: var tag_list = getTagList();
2047:
2048: // we dont always want to jump to the first block
2049: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2050: if(\$(window).scrollTop() > 170){
2051: if(tag_list != null){
2052: var result;
2053: for(var i = 0; i < tag_list.length; i++){
2054: if(isElementInViewport(tag_list[i])){
2055: result += tag_list[i]+';';
2056: }
2057: }
2058: sessionStorage.setItem('anchor_'+resource, result);
2059: }
2060: } else {
2061: // we dont need to save zero, just delete the item to leave everything tidy
2062: sessionStorage.removeItem('anchor_'+resource);
2063: }
2064: }
2065:
2066: function restoreScrollPosition(resource){
2067:
2068: var elem = sessionStorage.getItem('anchor_'+resource);
2069: if(elem != null){
2070: var tag_list = elem.split(';');
2071: var elem_list;
2072:
2073: for(var i = 0; i < tag_list.length; i++){
2074: elem_list = document.getElementsByName(tag_list[i]);
2075:
2076: if(elem_list.length > 0){
2077: elem = elem_list[0];
2078: break;
2079: }
2080: }
2081: elem.scrollIntoView();
2082: }
2083: }
2084:
2085: function isElementInViewport(el) {
2086:
2087: // change to last element instead of first
2088: var elem = document.getElementsByName(el);
2089: var rect = elem[0].getBoundingClientRect();
2090:
2091: return (
2092: rect.top >= 0 &&
2093: rect.left >= 0 &&
2094: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2095: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2096: );
2097: }
2098:
2099: function autosize(depth){
2100: var cmInst = window['cm'+depth];
2101: var fitsizeButton = document.getElementById('fitsize'+depth);
2102:
2103: // is fixed size, switching to dynamic
2104: if (sessionStorage.getItem("autosized_"+depth) == null) {
2105: cmInst.setSize("","auto");
2106: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2107: sessionStorage.setItem("autosized_"+depth, "yes");
2108:
2109: // is dynamic size, switching to fixed
2110: } else {
2111: cmInst.setSize("","300px");
2112: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2113: sessionStorage.removeItem("autosized_"+depth);
2114: }
2115: }
2116:
1.1248 raeburn 2117: $browse_or_search
1.1205 golterma 2118:
2119: // ]]>
2120: </script>
2121: COLORFULEDIT
2122: }
2123:
2124: sub xmleditor_js {
2125: return <<XMLEDIT
2126: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2127: <script type="text/javascript">
2128: // <![CDATA[>
2129:
2130: function saveScrollPosition (resource) {
2131:
2132: var scrollPos = \$(window).scrollTop();
2133: sessionStorage.setItem(resource,scrollPos);
2134: }
2135:
2136: function restoreScrollPosition(resource){
2137:
2138: var scrollPos = sessionStorage.getItem(resource);
2139: \$(window).scrollTop(scrollPos);
2140: }
2141:
2142: // unless internet explorer
2143: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2144:
2145: \$(document).ready(function() {
2146: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2147: });
2148: }
2149:
2150: // inserts text at cursor position into codemirror (xml editor only)
2151: function insertText(text){
2152: cm.focus();
2153: var curPos = cm.getCursor();
2154: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2155: }
2156: // ]]>
2157: </script>
2158: XMLEDIT
2159: }
2160:
2161: sub insert_folding_button {
2162: my $curDepth = $Apache::lonxml::curdepth;
2163: my $lastresource = $env{'request.ambiguous'};
2164:
2165: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2166: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2167: }
2168:
1.1248 raeburn 2169: sub crsauthor_url {
2170: my ($url) = @_;
2171: if ($url eq '') {
2172: $url = $ENV{'REQUEST_URI'};
2173: }
2174: my ($cnum,$cdom);
2175: if ($env{'request.course.id'}) {
2176: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2177: if ($audom ne '' && $auname ne '') {
2178: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2179: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2180: $cnum = $auname;
2181: $cdom = $audom;
2182: }
2183: }
2184: }
2185: return ($cnum,$cdom);
2186: }
2187:
2188: sub import_crsauthor_form {
1.1265 raeburn 2189: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2190: return (0) unless ($env{'request.course.id'});
2191: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2192: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2193: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2194: return (0) unless (($cnum ne '') && ($cdom ne ''));
2195: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2196: my @ids=&Apache::lonnet::current_machine_ids();
2197: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2198:
2199: if (grep(/^\Q$crshome\E$/,@ids)) {
2200: $is_home = 1;
2201: }
2202: $relpath = "/priv/$cdom/$cnum";
2203: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2204: my %lt = &Apache::lonlocal::texthash (
2205: fnam => 'Filename',
2206: dire => 'Directory',
2207: );
2208: my $numdirs = scalar(keys(%files));
2209: my (%possexts,$singledir,@singledirfiles);
2210: if ($only) {
2211: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2212: }
2213: my (%nonemptydirs,$possdirs);
2214: if ($numdirs > 1) {
2215: my @order;
2216: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2217: if (ref($files{$key}) eq 'HASH') {
2218: my $shown = $key;
2219: if ($key eq '') {
2220: $shown = '/';
2221: }
2222: my @ordered = ();
2223: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
2224: if ($only) {
2225: my ($ext) = ($file =~ /\.([^.]+)$/);
2226: unless ($possexts{lc($ext)}) {
2227: next;
2228: }
2229: }
2230: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2231: push(@ordered,$file);
2232: }
2233: if (@ordered) {
2234: push(@order,$key);
2235: $nonemptydirs{$key} = 1;
2236: $selimport_menus{$key}->{'text'} = $shown;
2237: $selimport_menus{$key}->{'default'} = '';
2238: $selimport_menus{$key}->{'select2'}->{''} = '';
2239: $selimport_menus{$key}->{'order'} = \@ordered;
2240: }
2241: }
2242: }
2243: $possdirs = scalar(keys(%nonemptydirs));
2244: if ($possdirs > 1) {
2245: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2246: $output = $lt{'dire'}.
2247: &linked_select_forms($form,'<br />'.
2248: $lt{'fnam'},'',
2249: $firstselectname,$secondselectname,
2250: \%selimport_menus,\@order,
2251: $onchangefirst,'',$suffix).'<br />';
2252: } elsif ($possdirs == 1) {
2253: $singledir = (keys(%nonemptydirs))[0];
2254: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2255: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2256: }
2257: delete($selimport_menus{$singledir});
2258: }
2259: } elsif ($numdirs == 1) {
2260: $singledir = (keys(%files))[0];
2261: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2262: if ($only) {
2263: my ($ext) = ($file =~ /\.([^.]+)$/);
2264: unless ($possexts{lc($ext)}) {
2265: next;
2266: }
2267: }
2268: push(@singledirfiles,$file);
2269: }
2270: if (@singledirfiles) {
2271: $possdirs == 1;
2272: }
2273: }
2274: if (($possdirs == 1) && (@singledirfiles)) {
2275: my $showdir = $singledir;
2276: if ($singledir eq '') {
2277: $showdir = '/';
2278: }
2279: $output = $lt{'dire'}.
2280: '<select name="'.$firstselectname.'">'.
2281: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2282: '</select><br />'.
2283: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2284: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2285: foreach my $file (@singledirfiles) {
2286: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2287: }
2288: $output .= '</select><br />'."\n";
2289: }
2290: return ($possdirs,$output);
2291: }
2292:
1.565 albertel 2293: =pod
2294:
1.256 matthew 2295: =head1 Excel and CSV file utility routines
2296:
2297: =cut
2298:
2299: ###############################################################
2300: ###############################################################
2301:
2302: =pod
2303:
1.1162 raeburn 2304: =over 4
2305:
1.648 raeburn 2306: =item * &csv_translate($text)
1.37 matthew 2307:
1.185 www 2308: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2309: format.
2310:
2311: =cut
2312:
1.180 matthew 2313: ###############################################################
2314: ###############################################################
1.37 matthew 2315: sub csv_translate {
2316: my $text = shift;
2317: $text =~ s/\"/\"\"/g;
1.209 albertel 2318: $text =~ s/\n/ /g;
1.37 matthew 2319: return $text;
2320: }
1.180 matthew 2321:
2322: ###############################################################
2323: ###############################################################
2324:
2325: =pod
2326:
1.648 raeburn 2327: =item * &define_excel_formats()
1.180 matthew 2328:
2329: Define some commonly used Excel cell formats.
2330:
2331: Currently supported formats:
2332:
2333: =over 4
2334:
2335: =item header
2336:
2337: =item bold
2338:
2339: =item h1
2340:
2341: =item h2
2342:
2343: =item h3
2344:
1.256 matthew 2345: =item h4
2346:
2347: =item i
2348:
1.180 matthew 2349: =item date
2350:
2351: =back
2352:
2353: Inputs: $workbook
2354:
2355: Returns: $format, a hash reference.
2356:
1.1057 foxr 2357:
1.180 matthew 2358: =cut
2359:
2360: ###############################################################
2361: ###############################################################
2362: sub define_excel_formats {
2363: my ($workbook) = @_;
2364: my $format;
2365: $format->{'header'} = $workbook->add_format(bold => 1,
2366: bottom => 1,
2367: align => 'center');
2368: $format->{'bold'} = $workbook->add_format(bold=>1);
2369: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2370: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2371: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2372: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2373: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2374: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2375: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2376: return $format;
2377: }
2378:
2379: ###############################################################
2380: ###############################################################
1.113 bowersj2 2381:
2382: =pod
2383:
1.648 raeburn 2384: =item * &create_workbook()
1.255 matthew 2385:
2386: Create an Excel worksheet. If it fails, output message on the
2387: request object and return undefs.
2388:
2389: Inputs: Apache request object
2390:
2391: Returns (undef) on failure,
2392: Excel worksheet object, scalar with filename, and formats
2393: from &Apache::loncommon::define_excel_formats on success
2394:
2395: =cut
2396:
2397: ###############################################################
2398: ###############################################################
2399: sub create_workbook {
2400: my ($r) = @_;
2401: #
2402: # Create the excel spreadsheet
2403: my $filename = '/prtspool/'.
1.258 albertel 2404: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2405: time.'_'.rand(1000000000).'.xls';
2406: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2407: if (! defined($workbook)) {
2408: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2409: $r->print(
2410: '<p class="LC_error">'
2411: .&mt('Problems occurred in creating the new Excel file.')
2412: .' '.&mt('This error has been logged.')
2413: .' '.&mt('Please alert your LON-CAPA administrator.')
2414: .'</p>'
2415: );
1.255 matthew 2416: return (undef);
2417: }
2418: #
1.1014 foxr 2419: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2420: #
2421: my $format = &Apache::loncommon::define_excel_formats($workbook);
2422: return ($workbook,$filename,$format);
2423: }
2424:
2425: ###############################################################
2426: ###############################################################
2427:
2428: =pod
2429:
1.648 raeburn 2430: =item * &create_text_file()
1.113 bowersj2 2431:
1.542 raeburn 2432: Create a file to write to and eventually make available to the user.
1.256 matthew 2433: If file creation fails, outputs an error message on the request object and
2434: return undefs.
1.113 bowersj2 2435:
1.256 matthew 2436: Inputs: Apache request object, and file suffix
1.113 bowersj2 2437:
1.256 matthew 2438: Returns (undef) on failure,
2439: Filehandle and filename on success.
1.113 bowersj2 2440:
2441: =cut
2442:
1.256 matthew 2443: ###############################################################
2444: ###############################################################
2445: sub create_text_file {
2446: my ($r,$suffix) = @_;
2447: if (! defined($suffix)) { $suffix = 'txt'; };
2448: my $fh;
2449: my $filename = '/prtspool/'.
1.258 albertel 2450: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2451: time.'_'.rand(1000000000).'.'.$suffix;
2452: $fh = Apache::File->new('>/home/httpd'.$filename);
2453: if (! defined($fh)) {
2454: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2455: $r->print(
2456: '<p class="LC_error">'
2457: .&mt('Problems occurred in creating the output file.')
2458: .' '.&mt('This error has been logged.')
2459: .' '.&mt('Please alert your LON-CAPA administrator.')
2460: .'</p>'
2461: );
1.113 bowersj2 2462: }
1.256 matthew 2463: return ($fh,$filename)
1.113 bowersj2 2464: }
2465:
2466:
1.256 matthew 2467: =pod
1.113 bowersj2 2468:
2469: =back
2470:
2471: =cut
1.37 matthew 2472:
2473: ###############################################################
1.33 matthew 2474: ## Home server <option> list generating code ##
2475: ###############################################################
1.35 matthew 2476:
1.169 www 2477: # ------------------------------------------
2478:
2479: sub domain_select {
1.1289 ! raeburn 2480: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
! 2481: my @possdoms;
! 2482: if (ref($incdoms) eq 'ARRAY') {
! 2483: @possdoms = @{$incdoms};
! 2484: } else {
! 2485: @possdoms = &Apache::lonnet::all_domains();
! 2486: }
! 2487:
1.169 www 2488: my %domains=map {
1.514 albertel 2489: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 ! raeburn 2490: } @possdoms;
! 2491:
! 2492: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
! 2493: foreach my $dom (@{$excdoms}) {
! 2494: delete($domains{$dom});
! 2495: }
! 2496: }
! 2497:
1.169 www 2498: if ($multiple) {
2499: $domains{''}=&mt('Any domain');
1.550 albertel 2500: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2501: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2502: } else {
1.550 albertel 2503: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2504: return &select_form($name,$value,\%domains);
1.169 www 2505: }
2506: }
2507:
1.282 albertel 2508: #-------------------------------------------
2509:
2510: =pod
2511:
1.519 raeburn 2512: =head1 Routines for form select boxes
2513:
2514: =over 4
2515:
1.648 raeburn 2516: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2517:
2518: Returns a string containing a <select> element int multiple mode
2519:
2520:
2521: Args:
2522: $name - name of the <select> element
1.506 raeburn 2523: $value - scalar or array ref of values that should already be selected
1.282 albertel 2524: $size - number of rows long the select element is
1.283 albertel 2525: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2526: (shown text should already have been &mt())
1.506 raeburn 2527: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2528:
1.282 albertel 2529: =cut
2530:
2531: #-------------------------------------------
1.169 www 2532: sub multiple_select_form {
1.284 albertel 2533: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2534: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2535: my $output='';
1.191 matthew 2536: if (! defined($size)) {
2537: $size = 4;
1.283 albertel 2538: if (scalar(keys(%$hash))<4) {
2539: $size = scalar(keys(%$hash));
1.191 matthew 2540: }
2541: }
1.734 bisitz 2542: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2543: my @order;
1.506 raeburn 2544: if (ref($order) eq 'ARRAY') {
2545: @order = @{$order};
2546: } else {
2547: @order = sort(keys(%$hash));
1.501 banghart 2548: }
2549: if (exists($$hash{'select_form_order'})) {
2550: @order = @{$$hash{'select_form_order'}};
2551: }
2552:
1.284 albertel 2553: foreach my $key (@order) {
1.356 albertel 2554: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2555: $output.='selected="selected" ' if ($selected{$key});
2556: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2557: }
2558: $output.="</select>\n";
2559: return $output;
2560: }
2561:
1.88 www 2562: #-------------------------------------------
2563:
2564: =pod
2565:
1.1254 raeburn 2566: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2567:
2568: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2569: allow a user to select options from a ref to a hash containing:
2570: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2571: a javascript onchange item, e.g., onchange="this.form.submit();".
2572: An optional arg -- $readonly -- if true will cause the select form
2573: to be disabled, e.g., for the case where an instructor has a section-
2574: specific role, and is viewing/modifying parameters.
1.970 raeburn 2575:
1.88 www 2576: See lonrights.pm for an example invocation and use.
2577:
2578: =cut
2579:
2580: #-------------------------------------------
2581: sub select_form {
1.1228 raeburn 2582: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2583: return unless (ref($hashref) eq 'HASH');
2584: if ($onchange) {
2585: $onchange = ' onchange="'.$onchange.'"';
2586: }
1.1228 raeburn 2587: my $disabled;
2588: if ($readonly) {
2589: $disabled = ' disabled="disabled"';
2590: }
2591: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2592: my @keys;
1.970 raeburn 2593: if (exists($hashref->{'select_form_order'})) {
2594: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2595: } else {
1.970 raeburn 2596: @keys=sort(keys(%{$hashref}));
1.128 albertel 2597: }
1.356 albertel 2598: foreach my $key (@keys) {
2599: $selectform.=
2600: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2601: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2602: ">".$hashref->{$key}."</option>\n";
1.88 www 2603: }
2604: $selectform.="</select>";
2605: return $selectform;
2606: }
2607:
1.475 www 2608: # For display filters
2609:
2610: sub display_filter {
1.1074 raeburn 2611: my ($context) = @_;
1.475 www 2612: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2613: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2614: my $phraseinput = 'hidden';
2615: my $includeinput = 'hidden';
2616: my ($checked,$includetypestext);
2617: if ($env{'form.displayfilter'} eq 'containing') {
2618: $phraseinput = 'text';
2619: if ($context eq 'parmslog') {
2620: $includeinput = 'checkbox';
2621: if ($env{'form.includetypes'}) {
2622: $checked = ' checked="checked"';
2623: }
2624: $includetypestext = &mt('Include parameter types');
2625: }
2626: } else {
2627: $includetypestext = ' ';
2628: }
2629: my ($additional,$secondid,$thirdid);
2630: if ($context eq 'parmslog') {
2631: $additional =
2632: '<label><input type="'.$includeinput.'" name="includetypes"'.
2633: $checked.' name="includetypes" value="1" id="includetypes" />'.
2634: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2635: '</label>';
2636: $secondid = 'includetypes';
2637: $thirdid = 'includetypestext';
2638: }
2639: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2640: '$secondid','$thirdid')";
2641: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2642: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2643: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2644: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2645: &mt('Filter: [_1]',
1.477 www 2646: &select_form($env{'form.displayfilter'},
2647: 'displayfilter',
1.970 raeburn 2648: {'currentfolder' => 'Current folder/page',
1.477 www 2649: 'containing' => 'Containing phrase',
1.1074 raeburn 2650: 'none' => 'None'},$onchange)).' '.
2651: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2652: &HTML::Entities::encode($env{'form.containingphrase'}).
2653: '" />'.$additional;
2654: }
2655:
2656: sub display_filter_js {
2657: my $includetext = &mt('Include parameter types');
2658: return <<"ENDJS";
2659:
2660: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2661: var firstType = 'hidden';
2662: if (setter.options[setter.selectedIndex].value == 'containing') {
2663: firstType = 'text';
2664: }
2665: firstObject = document.getElementById(firstid);
2666: if (typeof(firstObject) == 'object') {
2667: if (firstObject.type != firstType) {
2668: changeInputType(firstObject,firstType);
2669: }
2670: }
2671: if (context == 'parmslog') {
2672: var secondType = 'hidden';
2673: if (firstType == 'text') {
2674: secondType = 'checkbox';
2675: }
2676: secondObject = document.getElementById(secondid);
2677: if (typeof(secondObject) == 'object') {
2678: if (secondObject.type != secondType) {
2679: changeInputType(secondObject,secondType);
2680: }
2681: }
2682: var textItem = document.getElementById(thirdid);
2683: var currtext = textItem.innerHTML;
2684: var newtext;
2685: if (firstType == 'text') {
2686: newtext = '$includetext';
2687: } else {
2688: newtext = ' ';
2689: }
2690: if (currtext != newtext) {
2691: textItem.innerHTML = newtext;
2692: }
2693: }
2694: return;
2695: }
2696:
2697: function changeInputType(oldObject,newType) {
2698: var newObject = document.createElement('input');
2699: newObject.type = newType;
2700: if (oldObject.size) {
2701: newObject.size = oldObject.size;
2702: }
2703: if (oldObject.value) {
2704: newObject.value = oldObject.value;
2705: }
2706: if (oldObject.name) {
2707: newObject.name = oldObject.name;
2708: }
2709: if (oldObject.id) {
2710: newObject.id = oldObject.id;
2711: }
2712: oldObject.parentNode.replaceChild(newObject,oldObject);
2713: return;
2714: }
2715:
2716: ENDJS
1.475 www 2717: }
2718:
1.167 www 2719: sub gradeleveldescription {
2720: my $gradelevel=shift;
2721: my %gradelevels=(0 => 'Not specified',
2722: 1 => 'Grade 1',
2723: 2 => 'Grade 2',
2724: 3 => 'Grade 3',
2725: 4 => 'Grade 4',
2726: 5 => 'Grade 5',
2727: 6 => 'Grade 6',
2728: 7 => 'Grade 7',
2729: 8 => 'Grade 8',
2730: 9 => 'Grade 9',
2731: 10 => 'Grade 10',
2732: 11 => 'Grade 11',
2733: 12 => 'Grade 12',
2734: 13 => 'Grade 13',
2735: 14 => '100 Level',
2736: 15 => '200 Level',
2737: 16 => '300 Level',
2738: 17 => '400 Level',
2739: 18 => 'Graduate Level');
2740: return &mt($gradelevels{$gradelevel});
2741: }
2742:
1.163 www 2743: sub select_level_form {
2744: my ($deflevel,$name)=@_;
2745: unless ($deflevel) { $deflevel=0; }
1.167 www 2746: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2747: for (my $i=0; $i<=18; $i++) {
2748: $selectform.="<option value=\"$i\" ".
1.253 albertel 2749: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2750: ">".&gradeleveldescription($i)."</option>\n";
2751: }
2752: $selectform.="</select>";
2753: return $selectform;
1.163 www 2754: }
1.167 www 2755:
1.35 matthew 2756: #-------------------------------------------
2757:
1.45 matthew 2758: =pod
2759:
1.1256 raeburn 2760: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2761:
2762: Returns a string containing a <select name='$name' size='1'> form to
2763: allow a user to select the domain to preform an operation in.
2764: See loncreateuser.pm for an example invocation and use.
2765:
1.90 www 2766: If the $includeempty flag is set, it also includes an empty choice ("no domain
2767: selected");
2768:
1.743 raeburn 2769: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2770:
1.910 raeburn 2771: 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.
2772:
1.1121 raeburn 2773: The optional $incdoms is a reference to an array of domains which will be the only available options.
2774:
2775: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2776:
1.1256 raeburn 2777: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2778:
1.35 matthew 2779: =cut
2780:
2781: #-------------------------------------------
1.34 matthew 2782: sub select_dom_form {
1.1256 raeburn 2783: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2784: if ($onchange) {
1.874 raeburn 2785: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2786: }
1.1256 raeburn 2787: if ($disabled) {
2788: $disabled = ' disabled="disabled"';
2789: }
1.1121 raeburn 2790: my (@domains,%exclude);
1.910 raeburn 2791: if (ref($incdoms) eq 'ARRAY') {
2792: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2793: } else {
2794: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2795: }
1.90 www 2796: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2797: if (ref($excdoms) eq 'ARRAY') {
2798: map { $exclude{$_} = 1; } @{$excdoms};
2799: }
1.1256 raeburn 2800: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2801: foreach my $dom (@domains) {
1.1121 raeburn 2802: next if ($exclude{$dom});
1.356 albertel 2803: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2804: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2805: if ($showdomdesc) {
2806: if ($dom ne '') {
2807: my $domdesc = &Apache::lonnet::domain($dom,'description');
2808: if ($domdesc ne '') {
2809: $selectdomain .= ' ('.$domdesc.')';
2810: }
2811: }
2812: }
2813: $selectdomain .= "</option>\n";
1.34 matthew 2814: }
2815: $selectdomain.="</select>";
2816: return $selectdomain;
2817: }
2818:
1.35 matthew 2819: #-------------------------------------------
2820:
1.45 matthew 2821: =pod
2822:
1.648 raeburn 2823: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2824:
1.586 raeburn 2825: input: 4 arguments (two required, two optional) -
2826: $domain - domain of new user
2827: $name - name of form element
2828: $default - Value of 'default' causes a default item to be first
2829: option, and selected by default.
2830: $hide - Value of 'hide' causes hiding of the name of the server,
2831: if 1 server found, or default, if 0 found.
1.594 raeburn 2832: output: returns 2 items:
1.586 raeburn 2833: (a) form element which contains either:
2834: (i) <select name="$name">
2835: <option value="$hostid1">$hostid $servers{$hostid}</option>
2836: <option value="$hostid2">$hostid $servers{$hostid}</option>
2837: </select>
2838: form item if there are multiple library servers in $domain, or
2839: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2840: if there is only one library server in $domain.
2841:
2842: (b) number of library servers found.
2843:
2844: See loncreateuser.pm for example of use.
1.35 matthew 2845:
2846: =cut
2847:
2848: #-------------------------------------------
1.586 raeburn 2849: sub home_server_form_item {
2850: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2851: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2852: my $result;
2853: my $numlib = keys(%servers);
2854: if ($numlib > 1) {
2855: $result .= '<select name="'.$name.'" />'."\n";
2856: if ($default) {
1.804 bisitz 2857: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2858: '</option>'."\n";
2859: }
2860: foreach my $hostid (sort(keys(%servers))) {
2861: $result.= '<option value="'.$hostid.'">'.
2862: $hostid.' '.$servers{$hostid}."</option>\n";
2863: }
2864: $result .= '</select>'."\n";
2865: } elsif ($numlib == 1) {
2866: my $hostid;
2867: foreach my $item (keys(%servers)) {
2868: $hostid = $item;
2869: }
2870: $result .= '<input type="hidden" name="'.$name.'" value="'.
2871: $hostid.'" />';
2872: if (!$hide) {
2873: $result .= $hostid.' '.$servers{$hostid};
2874: }
2875: $result .= "\n";
2876: } elsif ($default) {
2877: $result .= '<input type="hidden" name="'.$name.
2878: '" value="default" />';
2879: if (!$hide) {
2880: $result .= &mt('default');
2881: }
2882: $result .= "\n";
1.33 matthew 2883: }
1.586 raeburn 2884: return ($result,$numlib);
1.33 matthew 2885: }
1.112 bowersj2 2886:
2887: =pod
2888:
1.534 albertel 2889: =back
2890:
1.112 bowersj2 2891: =cut
1.87 matthew 2892:
2893: ###############################################################
1.112 bowersj2 2894: ## Decoding User Agent ##
1.87 matthew 2895: ###############################################################
2896:
2897: =pod
2898:
1.112 bowersj2 2899: =head1 Decoding the User Agent
2900:
2901: =over 4
2902:
2903: =item * &decode_user_agent()
1.87 matthew 2904:
2905: Inputs: $r
2906:
2907: Outputs:
2908:
2909: =over 4
2910:
1.112 bowersj2 2911: =item * $httpbrowser
1.87 matthew 2912:
1.112 bowersj2 2913: =item * $clientbrowser
1.87 matthew 2914:
1.112 bowersj2 2915: =item * $clientversion
1.87 matthew 2916:
1.112 bowersj2 2917: =item * $clientmathml
1.87 matthew 2918:
1.112 bowersj2 2919: =item * $clientunicode
1.87 matthew 2920:
1.112 bowersj2 2921: =item * $clientos
1.87 matthew 2922:
1.1137 raeburn 2923: =item * $clientmobile
2924:
1.1141 raeburn 2925: =item * $clientinfo
2926:
1.1194 raeburn 2927: =item * $clientosversion
2928:
1.87 matthew 2929: =back
2930:
1.157 matthew 2931: =back
2932:
1.87 matthew 2933: =cut
2934:
2935: ###############################################################
2936: ###############################################################
2937: sub decode_user_agent {
1.247 albertel 2938: my ($r)=@_;
1.87 matthew 2939: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2940: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2941: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2942: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2943: my $clientbrowser='unknown';
2944: my $clientversion='0';
2945: my $clientmathml='';
2946: my $clientunicode='0';
1.1137 raeburn 2947: my $clientmobile=0;
1.1194 raeburn 2948: my $clientosversion='';
1.87 matthew 2949: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2950: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2951: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2952: $clientbrowser=$bname;
2953: $httpbrowser=~/$vreg/i;
2954: $clientversion=$1;
2955: $clientmathml=($clientversion>=$minv);
2956: $clientunicode=($clientversion>=$univ);
2957: }
2958: }
2959: my $clientos='unknown';
1.1141 raeburn 2960: my $clientinfo;
1.87 matthew 2961: if (($httpbrowser=~/linux/i) ||
2962: ($httpbrowser=~/unix/i) ||
2963: ($httpbrowser=~/ux/i) ||
2964: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2965: if (($httpbrowser=~/vax/i) ||
2966: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2967: if ($httpbrowser=~/next/i) { $clientos='next'; }
2968: if (($httpbrowser=~/mac/i) ||
2969: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2970: if ($httpbrowser=~/win/i) {
2971: $clientos='win';
2972: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2973: $clientosversion = $1;
2974: }
2975: }
1.87 matthew 2976: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2977: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2978: $clientmobile=lc($1);
2979: }
1.1141 raeburn 2980: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2981: $clientinfo = 'firefox-'.$1;
2982: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2983: $clientinfo = 'chromeframe-'.$1;
2984: }
1.87 matthew 2985: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2986: $clientunicode,$clientos,$clientmobile,$clientinfo,
2987: $clientosversion);
1.87 matthew 2988: }
2989:
1.32 matthew 2990: ###############################################################
2991: ## Authentication changing form generation subroutines ##
2992: ###############################################################
2993: ##
2994: ## All of the authform_xxxxxxx subroutines take their inputs in a
2995: ## hash, and have reasonable default values.
2996: ##
2997: ## formname = the name given in the <form> tag.
1.35 matthew 2998: #-------------------------------------------
2999:
1.45 matthew 3000: =pod
3001:
1.112 bowersj2 3002: =head1 Authentication Routines
3003:
3004: =over 4
3005:
1.648 raeburn 3006: =item * &authform_xxxxxx()
1.35 matthew 3007:
3008: The authform_xxxxxx subroutines provide javascript and html forms which
3009: handle some of the conveniences required for authentication forms.
3010: This is not an optimal method, but it works.
3011:
3012: =over 4
3013:
1.112 bowersj2 3014: =item * authform_header
1.35 matthew 3015:
1.112 bowersj2 3016: =item * authform_authorwarning
1.35 matthew 3017:
1.112 bowersj2 3018: =item * authform_nochange
1.35 matthew 3019:
1.112 bowersj2 3020: =item * authform_kerberos
1.35 matthew 3021:
1.112 bowersj2 3022: =item * authform_internal
1.35 matthew 3023:
1.112 bowersj2 3024: =item * authform_filesystem
1.35 matthew 3025:
3026: =back
3027:
1.648 raeburn 3028: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3029:
1.35 matthew 3030: =cut
3031:
3032: #-------------------------------------------
1.32 matthew 3033: sub authform_header{
3034: my %in = (
3035: formname => 'cu',
1.80 albertel 3036: kerb_def_dom => '',
1.32 matthew 3037: @_,
3038: );
3039: $in{'formname'} = 'document.' . $in{'formname'};
3040: my $result='';
1.80 albertel 3041:
3042: #---------------------------------------------- Code for upper case translation
3043: my $Javascript_toUpperCase;
3044: unless ($in{kerb_def_dom}) {
3045: $Javascript_toUpperCase =<<"END";
3046: switch (choice) {
3047: case 'krb': currentform.elements[choicearg].value =
3048: currentform.elements[choicearg].value.toUpperCase();
3049: break;
3050: default:
3051: }
3052: END
3053: } else {
3054: $Javascript_toUpperCase = "";
3055: }
3056:
1.165 raeburn 3057: my $radioval = "'nochange'";
1.591 raeburn 3058: if (defined($in{'curr_authtype'})) {
3059: if ($in{'curr_authtype'} ne '') {
3060: $radioval = "'".$in{'curr_authtype'}."arg'";
3061: }
1.174 matthew 3062: }
1.165 raeburn 3063: my $argfield = 'null';
1.591 raeburn 3064: if (defined($in{'mode'})) {
1.165 raeburn 3065: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3066: if (defined($in{'curr_autharg'})) {
3067: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3068: $argfield = "'$in{'curr_autharg'}'";
3069: }
3070: }
3071: }
3072: }
3073:
1.32 matthew 3074: $result.=<<"END";
3075: var current = new Object();
1.165 raeburn 3076: current.radiovalue = $radioval;
3077: current.argfield = $argfield;
1.32 matthew 3078:
3079: function changed_radio(choice,currentform) {
3080: var choicearg = choice + 'arg';
3081: // If a radio button in changed, we need to change the argfield
3082: if (current.radiovalue != choice) {
3083: current.radiovalue = choice;
3084: if (current.argfield != null) {
3085: currentform.elements[current.argfield].value = '';
3086: }
3087: if (choice == 'nochange') {
3088: current.argfield = null;
3089: } else {
3090: current.argfield = choicearg;
3091: switch(choice) {
3092: case 'krb':
3093: currentform.elements[current.argfield].value =
3094: "$in{'kerb_def_dom'}";
3095: break;
3096: default:
3097: break;
3098: }
3099: }
3100: }
3101: return;
3102: }
1.22 www 3103:
1.32 matthew 3104: function changed_text(choice,currentform) {
3105: var choicearg = choice + 'arg';
3106: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3107: $Javascript_toUpperCase
1.32 matthew 3108: // clear old field
3109: if ((current.argfield != choicearg) && (current.argfield != null)) {
3110: currentform.elements[current.argfield].value = '';
3111: }
3112: current.argfield = choicearg;
3113: }
3114: set_auth_radio_buttons(choice,currentform);
3115: return;
1.20 www 3116: }
1.32 matthew 3117:
3118: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3119: var numauthchoices = currentform.login.length;
3120: if (typeof numauthchoices == "undefined") {
3121: return;
3122: }
1.32 matthew 3123: var i=0;
1.986 raeburn 3124: while (i < numauthchoices) {
1.32 matthew 3125: if (currentform.login[i].value == newvalue) { break; }
3126: i++;
3127: }
1.986 raeburn 3128: if (i == numauthchoices) {
1.32 matthew 3129: return;
3130: }
3131: current.radiovalue = newvalue;
3132: currentform.login[i].checked = true;
3133: return;
3134: }
3135: END
3136: return $result;
3137: }
3138:
1.1106 raeburn 3139: sub authform_authorwarning {
1.32 matthew 3140: my $result='';
1.144 matthew 3141: $result='<i>'.
3142: &mt('As a general rule, only authors or co-authors should be '.
3143: 'filesystem authenticated '.
3144: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3145: return $result;
3146: }
3147:
1.1106 raeburn 3148: sub authform_nochange {
1.32 matthew 3149: my %in = (
3150: formname => 'document.cu',
3151: kerb_def_dom => 'MSU.EDU',
3152: @_,
3153: );
1.1106 raeburn 3154: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3155: my $result;
1.1104 raeburn 3156: if (!$authnum) {
1.1105 raeburn 3157: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3158: } else {
3159: $result = '<label>'.&mt('[_1] Do not change login data',
3160: '<input type="radio" name="login" value="nochange" '.
3161: 'checked="checked" onclick="'.
1.281 albertel 3162: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3163: '</label>';
1.586 raeburn 3164: }
1.32 matthew 3165: return $result;
3166: }
3167:
1.591 raeburn 3168: sub authform_kerberos {
1.32 matthew 3169: my %in = (
3170: formname => 'document.cu',
3171: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3172: kerb_def_auth => 'krb4',
1.32 matthew 3173: @_,
3174: );
1.586 raeburn 3175: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3176: $autharg,$jscall,$disabled);
1.1106 raeburn 3177: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3178: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3179: $check5 = ' checked="checked"';
1.80 albertel 3180: } else {
1.772 bisitz 3181: $check4 = ' checked="checked"';
1.80 albertel 3182: }
1.1259 raeburn 3183: if ($in{'readonly'}) {
3184: $disabled = ' disabled="disabled"';
3185: }
1.165 raeburn 3186: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3187: if (defined($in{'curr_authtype'})) {
3188: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3189: $krbcheck = ' checked="checked"';
1.623 raeburn 3190: if (defined($in{'mode'})) {
3191: if ($in{'mode'} eq 'modifyuser') {
3192: $krbcheck = '';
3193: }
3194: }
1.591 raeburn 3195: if (defined($in{'curr_kerb_ver'})) {
3196: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3197: $check5 = ' checked="checked"';
1.591 raeburn 3198: $check4 = '';
3199: } else {
1.772 bisitz 3200: $check4 = ' checked="checked"';
1.591 raeburn 3201: $check5 = '';
3202: }
1.586 raeburn 3203: }
1.591 raeburn 3204: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3205: $krbarg = $in{'curr_autharg'};
3206: }
1.586 raeburn 3207: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3208: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3209: $result =
3210: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3211: $in{'curr_autharg'},$krbver);
3212: } else {
3213: $result =
3214: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3215: }
3216: return $result;
3217: }
3218: }
3219: } else {
3220: if ($authnum == 1) {
1.784 bisitz 3221: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3222: }
3223: }
1.586 raeburn 3224: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3225: return;
1.587 raeburn 3226: } elsif ($authtype eq '') {
1.591 raeburn 3227: if (defined($in{'mode'})) {
1.587 raeburn 3228: if ($in{'mode'} eq 'modifycourse') {
3229: if ($authnum == 1) {
1.1259 raeburn 3230: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3231: }
3232: }
3233: }
1.586 raeburn 3234: }
3235: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3236: if ($authtype eq '') {
3237: $authtype = '<input type="radio" name="login" value="krb" '.
3238: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3239: $krbcheck.$disabled.' />';
1.586 raeburn 3240: }
3241: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3242: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3243: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3244: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3245: $in{'curr_authtype'} eq 'krb4')) {
3246: $result .= &mt
1.144 matthew 3247: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3248: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3249: '<label>'.$authtype,
1.281 albertel 3250: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3251: 'value="'.$krbarg.'" '.
1.1259 raeburn 3252: 'onchange="'.$jscall.'"'.$disabled.' />',
3253: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3254: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3255: '</label>');
1.586 raeburn 3256: } elsif ($can_assign{'krb4'}) {
3257: $result .= &mt
3258: ('[_1] Kerberos authenticated with domain [_2] '.
3259: '[_3] Version 4 [_4]',
3260: '<label>'.$authtype,
3261: '</label><input type="text" size="10" name="krbarg" '.
3262: 'value="'.$krbarg.'" '.
1.1259 raeburn 3263: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3264: '<label><input type="hidden" name="krbver" value="4" />',
3265: '</label>');
3266: } elsif ($can_assign{'krb5'}) {
3267: $result .= &mt
3268: ('[_1] Kerberos authenticated with domain [_2] '.
3269: '[_3] Version 5 [_4]',
3270: '<label>'.$authtype,
3271: '</label><input type="text" size="10" name="krbarg" '.
3272: 'value="'.$krbarg.'" '.
1.1259 raeburn 3273: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3274: '<label><input type="hidden" name="krbver" value="5" />',
3275: '</label>');
3276: }
1.32 matthew 3277: return $result;
3278: }
3279:
1.1106 raeburn 3280: sub authform_internal {
1.586 raeburn 3281: my %in = (
1.32 matthew 3282: formname => 'document.cu',
3283: kerb_def_dom => 'MSU.EDU',
3284: @_,
3285: );
1.1259 raeburn 3286: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3287: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3288: if ($in{'readonly'}) {
3289: $disabled = ' disabled="disabled"';
3290: }
1.591 raeburn 3291: if (defined($in{'curr_authtype'})) {
3292: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3293: if ($can_assign{'int'}) {
1.772 bisitz 3294: $intcheck = 'checked="checked" ';
1.623 raeburn 3295: if (defined($in{'mode'})) {
3296: if ($in{'mode'} eq 'modifyuser') {
3297: $intcheck = '';
3298: }
3299: }
1.591 raeburn 3300: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3301: $intarg = $in{'curr_autharg'};
3302: }
3303: } else {
3304: $result = &mt('Currently internally authenticated.');
3305: return $result;
1.165 raeburn 3306: }
3307: }
1.586 raeburn 3308: } else {
3309: if ($authnum == 1) {
1.784 bisitz 3310: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3311: }
3312: }
3313: if (!$can_assign{'int'}) {
3314: return;
1.587 raeburn 3315: } elsif ($authtype eq '') {
1.591 raeburn 3316: if (defined($in{'mode'})) {
1.587 raeburn 3317: if ($in{'mode'} eq 'modifycourse') {
3318: if ($authnum == 1) {
1.1259 raeburn 3319: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3320: }
3321: }
3322: }
1.165 raeburn 3323: }
1.586 raeburn 3324: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3325: if ($authtype eq '') {
3326: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3327: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3328: }
1.605 bisitz 3329: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3330: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3331: $result = &mt
1.144 matthew 3332: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3333: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3334: $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
1.32 matthew 3335: return $result;
3336: }
3337:
1.1104 raeburn 3338: sub authform_local {
1.32 matthew 3339: my %in = (
3340: formname => 'document.cu',
3341: kerb_def_dom => 'MSU.EDU',
3342: @_,
3343: );
1.1259 raeburn 3344: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3345: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3346: if ($in{'readonly'}) {
3347: $disabled = ' disabled="disabled"';
3348: }
1.591 raeburn 3349: if (defined($in{'curr_authtype'})) {
3350: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3351: if ($can_assign{'loc'}) {
1.772 bisitz 3352: $loccheck = 'checked="checked" ';
1.623 raeburn 3353: if (defined($in{'mode'})) {
3354: if ($in{'mode'} eq 'modifyuser') {
3355: $loccheck = '';
3356: }
3357: }
1.591 raeburn 3358: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3359: $locarg = $in{'curr_autharg'};
3360: }
3361: } else {
3362: $result = &mt('Currently using local (institutional) authentication.');
3363: return $result;
1.165 raeburn 3364: }
3365: }
1.586 raeburn 3366: } else {
3367: if ($authnum == 1) {
1.784 bisitz 3368: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3369: }
3370: }
3371: if (!$can_assign{'loc'}) {
3372: return;
1.587 raeburn 3373: } elsif ($authtype eq '') {
1.591 raeburn 3374: if (defined($in{'mode'})) {
1.587 raeburn 3375: if ($in{'mode'} eq 'modifycourse') {
3376: if ($authnum == 1) {
1.1259 raeburn 3377: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3378: }
3379: }
3380: }
1.165 raeburn 3381: }
1.586 raeburn 3382: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3383: if ($authtype eq '') {
3384: $authtype = '<input type="radio" name="login" value="loc" '.
3385: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3386: $jscall.'"'.$disabled.' />';
1.586 raeburn 3387: }
3388: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3389: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3390: $result = &mt('[_1] Local Authentication with argument [_2]',
3391: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3392: return $result;
3393: }
3394:
1.1106 raeburn 3395: sub authform_filesystem {
1.32 matthew 3396: my %in = (
3397: formname => 'document.cu',
3398: kerb_def_dom => 'MSU.EDU',
3399: @_,
3400: );
1.1259 raeburn 3401: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3402: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3403: if ($in{'readonly'}) {
3404: $disabled = ' disabled="disabled"';
3405: }
1.591 raeburn 3406: if (defined($in{'curr_authtype'})) {
3407: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3408: if ($can_assign{'fsys'}) {
1.772 bisitz 3409: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3410: if (defined($in{'mode'})) {
3411: if ($in{'mode'} eq 'modifyuser') {
3412: $fsyscheck = '';
3413: }
3414: }
1.586 raeburn 3415: } else {
3416: $result = &mt('Currently Filesystem Authenticated.');
3417: return $result;
1.1259 raeburn 3418: }
1.586 raeburn 3419: }
3420: } else {
3421: if ($authnum == 1) {
1.784 bisitz 3422: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3423: }
3424: }
3425: if (!$can_assign{'fsys'}) {
3426: return;
1.587 raeburn 3427: } elsif ($authtype eq '') {
1.591 raeburn 3428: if (defined($in{'mode'})) {
1.587 raeburn 3429: if ($in{'mode'} eq 'modifycourse') {
3430: if ($authnum == 1) {
1.1259 raeburn 3431: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3432: }
3433: }
3434: }
1.586 raeburn 3435: }
3436: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3437: if ($authtype eq '') {
3438: $authtype = '<input type="radio" name="login" value="fsys" '.
3439: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3440: $jscall.'"'.$disabled.' />';
1.586 raeburn 3441: }
3442: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3443: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3444: $result = &mt
1.144 matthew 3445: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3446: '<label><input type="radio" name="login" value="fsys" '.
1.1259 raeburn 3447: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
1.605 bisitz 3448: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.1259 raeburn 3449: 'onchange="'.$jscall.'"'.$disabled.' />');
1.32 matthew 3450: return $result;
3451: }
3452:
1.586 raeburn 3453: sub get_assignable_auth {
3454: my ($dom) = @_;
3455: if ($dom eq '') {
3456: $dom = $env{'request.role.domain'};
3457: }
3458: my %can_assign = (
3459: krb4 => 1,
3460: krb5 => 1,
3461: int => 1,
3462: loc => 1,
3463: );
3464: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3465: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3466: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3467: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3468: my $context;
3469: if ($env{'request.role'} =~ /^au/) {
3470: $context = 'author';
1.1259 raeburn 3471: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3472: $context = 'domain';
3473: } elsif ($env{'request.course.id'}) {
3474: $context = 'course';
3475: }
3476: if ($context) {
3477: if (ref($authhash->{$context}) eq 'HASH') {
3478: %can_assign = %{$authhash->{$context}};
3479: }
3480: }
3481: }
3482: }
3483: my $authnum = 0;
3484: foreach my $key (keys(%can_assign)) {
3485: if ($can_assign{$key}) {
3486: $authnum ++;
3487: }
3488: }
3489: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3490: $authnum --;
3491: }
3492: return ($authnum,%can_assign);
3493: }
3494:
1.80 albertel 3495: ###############################################################
3496: ## Get Kerberos Defaults for Domain ##
3497: ###############################################################
3498: ##
3499: ## Returns default kerberos version and an associated argument
3500: ## as listed in file domain.tab. If not listed, provides
3501: ## appropriate default domain and kerberos version.
3502: ##
3503: #-------------------------------------------
3504:
3505: =pod
3506:
1.648 raeburn 3507: =item * &get_kerberos_defaults()
1.80 albertel 3508:
3509: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3510: version and domain. If not found, it defaults to version 4 and the
3511: domain of the server.
1.80 albertel 3512:
1.648 raeburn 3513: =over 4
3514:
1.80 albertel 3515: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3516:
1.648 raeburn 3517: =back
3518:
3519: =back
3520:
1.80 albertel 3521: =cut
3522:
3523: #-------------------------------------------
3524: sub get_kerberos_defaults {
3525: my $domain=shift;
1.641 raeburn 3526: my ($krbdef,$krbdefdom);
3527: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3528: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3529: $krbdef = $domdefaults{'auth_def'};
3530: $krbdefdom = $domdefaults{'auth_arg_def'};
3531: } else {
1.80 albertel 3532: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3533: my $krbdefdom=$1;
3534: $krbdefdom=~tr/a-z/A-Z/;
3535: $krbdef = "krb4";
3536: }
3537: return ($krbdef,$krbdefdom);
3538: }
1.112 bowersj2 3539:
1.32 matthew 3540:
1.46 matthew 3541: ###############################################################
3542: ## Thesaurus Functions ##
3543: ###############################################################
1.20 www 3544:
1.46 matthew 3545: =pod
1.20 www 3546:
1.112 bowersj2 3547: =head1 Thesaurus Functions
3548:
3549: =over 4
3550:
1.648 raeburn 3551: =item * &initialize_keywords()
1.46 matthew 3552:
3553: Initializes the package variable %Keywords if it is empty. Uses the
3554: package variable $thesaurus_db_file.
3555:
3556: =cut
3557:
3558: ###################################################
3559:
3560: sub initialize_keywords {
3561: return 1 if (scalar keys(%Keywords));
3562: # If we are here, %Keywords is empty, so fill it up
3563: # Make sure the file we need exists...
3564: if (! -e $thesaurus_db_file) {
3565: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3566: " failed because it does not exist");
3567: return 0;
3568: }
3569: # Set up the hash as a database
3570: my %thesaurus_db;
3571: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3572: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3573: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3574: $thesaurus_db_file);
3575: return 0;
3576: }
3577: # Get the average number of appearances of a word.
3578: my $avecount = $thesaurus_db{'average.count'};
3579: # Put keywords (those that appear > average) into %Keywords
3580: while (my ($word,$data)=each (%thesaurus_db)) {
3581: my ($count,undef) = split /:/,$data;
3582: $Keywords{$word}++ if ($count > $avecount);
3583: }
3584: untie %thesaurus_db;
3585: # Remove special values from %Keywords.
1.356 albertel 3586: foreach my $value ('total.count','average.count') {
3587: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3588: }
1.46 matthew 3589: return 1;
3590: }
3591:
3592: ###################################################
3593:
3594: =pod
3595:
1.648 raeburn 3596: =item * &keyword($word)
1.46 matthew 3597:
3598: Returns true if $word is a keyword. A keyword is a word that appears more
3599: than the average number of times in the thesaurus database. Calls
3600: &initialize_keywords
3601:
3602: =cut
3603:
3604: ###################################################
1.20 www 3605:
3606: sub keyword {
1.46 matthew 3607: return if (!&initialize_keywords());
3608: my $word=lc(shift());
3609: $word=~s/\W//g;
3610: return exists($Keywords{$word});
1.20 www 3611: }
1.46 matthew 3612:
3613: ###############################################################
3614:
3615: =pod
1.20 www 3616:
1.648 raeburn 3617: =item * &get_related_words()
1.46 matthew 3618:
1.160 matthew 3619: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3620: an array of words. If the keyword is not in the thesaurus, an empty array
3621: will be returned. The order of the words returned is determined by the
3622: database which holds them.
3623:
3624: Uses global $thesaurus_db_file.
3625:
1.1057 foxr 3626:
1.46 matthew 3627: =cut
3628:
3629: ###############################################################
3630: sub get_related_words {
3631: my $keyword = shift;
3632: my %thesaurus_db;
3633: if (! -e $thesaurus_db_file) {
3634: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3635: "failed because the file does not exist");
3636: return ();
3637: }
3638: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3639: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3640: return ();
3641: }
3642: my @Words=();
1.429 www 3643: my $count=0;
1.46 matthew 3644: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3645: # The first element is the number of times
3646: # the word appears. We do not need it now.
1.429 www 3647: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3648: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3649: my $threshold=$mostfrequentcount/10;
3650: foreach my $possibleword (@RelatedWords) {
3651: my ($word,$wordcount)=split(/\,/,$possibleword);
3652: if ($wordcount>$threshold) {
3653: push(@Words,$word);
3654: $count++;
3655: if ($count>10) { last; }
3656: }
1.20 www 3657: }
3658: }
1.46 matthew 3659: untie %thesaurus_db;
3660: return @Words;
1.14 harris41 3661: }
1.1090 foxr 3662: ###############################################################
3663: #
3664: # Spell checking
3665: #
3666:
3667: =pod
3668:
1.1142 raeburn 3669: =back
3670:
1.1090 foxr 3671: =head1 Spell checking
3672:
3673: =over 4
3674:
3675: =item * &check_spelling($wordlist $language)
3676:
3677: Takes a string containing words and feeds it to an external
3678: spellcheck program via a pipeline. Returns a string containing
3679: them mis-spelled words.
3680:
3681: Parameters:
3682:
3683: =over 4
3684:
3685: =item - $wordlist
3686:
3687: String that will be fed into the spellcheck program.
3688:
3689: =item - $language
3690:
3691: Language string that specifies the language for which the spell
3692: check will be performed.
3693:
3694: =back
3695:
3696: =back
3697:
3698: Note: This sub assumes that aspell is installed.
3699:
3700:
3701: =cut
3702:
1.46 matthew 3703:
1.1090 foxr 3704: sub check_spelling {
3705: my ($wordlist, $language) = @_;
1.1091 foxr 3706: my @misspellings;
3707:
3708: # Generate the speller and set the langauge.
3709: # if explicitly selected:
1.1090 foxr 3710:
1.1091 foxr 3711: my $speller = Text::Aspell->new;
1.1090 foxr 3712: if ($language) {
1.1091 foxr 3713: $speller->set_option('lang', $language);
1.1090 foxr 3714: }
3715:
1.1091 foxr 3716: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3717:
1.1091 foxr 3718: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3719:
1.1091 foxr 3720: foreach my $word (@words) {
3721: if(! $speller->check($word)) {
3722: push(@misspellings, $word);
1.1090 foxr 3723: }
3724: }
1.1091 foxr 3725: return join(' ', @misspellings);
3726:
1.1090 foxr 3727: }
3728:
1.61 www 3729: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3730: =pod
3731:
1.112 bowersj2 3732: =head1 User Name Functions
3733:
3734: =over 4
3735:
1.648 raeburn 3736: =item * &plainname($uname,$udom,$first)
1.81 albertel 3737:
1.112 bowersj2 3738: Takes a users logon name and returns it as a string in
1.226 albertel 3739: "first middle last generation" form
3740: if $first is set to 'lastname' then it returns it as
3741: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3742:
3743: =cut
1.61 www 3744:
1.295 www 3745:
1.81 albertel 3746: ###############################################################
1.61 www 3747: sub plainname {
1.226 albertel 3748: my ($uname,$udom,$first)=@_;
1.537 albertel 3749: return if (!defined($uname) || !defined($udom));
1.295 www 3750: my %names=&getnames($uname,$udom);
1.226 albertel 3751: my $name=&Apache::lonnet::format_name($names{'firstname'},
3752: $names{'middlename'},
3753: $names{'lastname'},
3754: $names{'generation'},$first);
3755: $name=~s/^\s+//;
1.62 www 3756: $name=~s/\s+$//;
3757: $name=~s/\s+/ /g;
1.353 albertel 3758: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3759: return $name;
1.61 www 3760: }
1.66 www 3761:
3762: # -------------------------------------------------------------------- Nickname
1.81 albertel 3763: =pod
3764:
1.648 raeburn 3765: =item * &nickname($uname,$udom)
1.81 albertel 3766:
3767: Gets a users name and returns it as a string as
3768:
3769: ""nickname""
1.66 www 3770:
1.81 albertel 3771: if the user has a nickname or
3772:
3773: "first middle last generation"
3774:
3775: if the user does not
3776:
3777: =cut
1.66 www 3778:
3779: sub nickname {
3780: my ($uname,$udom)=@_;
1.537 albertel 3781: return if (!defined($uname) || !defined($udom));
1.295 www 3782: my %names=&getnames($uname,$udom);
1.68 albertel 3783: my $name=$names{'nickname'};
1.66 www 3784: if ($name) {
3785: $name='"'.$name.'"';
3786: } else {
3787: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3788: $names{'lastname'}.' '.$names{'generation'};
3789: $name=~s/\s+$//;
3790: $name=~s/\s+/ /g;
3791: }
3792: return $name;
3793: }
3794:
1.295 www 3795: sub getnames {
3796: my ($uname,$udom)=@_;
1.537 albertel 3797: return if (!defined($uname) || !defined($udom));
1.433 albertel 3798: if ($udom eq 'public' && $uname eq 'public') {
3799: return ('lastname' => &mt('Public'));
3800: }
1.295 www 3801: my $id=$uname.':'.$udom;
3802: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3803: if ($cached) {
3804: return %{$names};
3805: } else {
3806: my %loadnames=&Apache::lonnet::get('environment',
3807: ['firstname','middlename','lastname','generation','nickname'],
3808: $udom,$uname);
3809: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3810: return %loadnames;
3811: }
3812: }
1.61 www 3813:
1.542 raeburn 3814: # -------------------------------------------------------------------- getemails
1.648 raeburn 3815:
1.542 raeburn 3816: =pod
3817:
1.648 raeburn 3818: =item * &getemails($uname,$udom)
1.542 raeburn 3819:
3820: Gets a user's email information and returns it as a hash with keys:
3821: notification, critnotification, permanentemail
3822:
3823: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3824: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3825:
1.648 raeburn 3826:
1.542 raeburn 3827: =cut
3828:
1.648 raeburn 3829:
1.466 albertel 3830: sub getemails {
3831: my ($uname,$udom)=@_;
3832: if ($udom eq 'public' && $uname eq 'public') {
3833: return;
3834: }
1.467 www 3835: if (!$udom) { $udom=$env{'user.domain'}; }
3836: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3837: my $id=$uname.':'.$udom;
3838: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3839: if ($cached) {
3840: return %{$names};
3841: } else {
3842: my %loadnames=&Apache::lonnet::get('environment',
3843: ['notification','critnotification',
3844: 'permanentemail'],
3845: $udom,$uname);
3846: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3847: return %loadnames;
3848: }
3849: }
3850:
1.551 albertel 3851: sub flush_email_cache {
3852: my ($uname,$udom)=@_;
3853: if (!$udom) { $udom =$env{'user.domain'}; }
3854: if (!$uname) { $uname=$env{'user.name'}; }
3855: return if ($udom eq 'public' && $uname eq 'public');
3856: my $id=$uname.':'.$udom;
3857: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3858: }
3859:
1.728 raeburn 3860: # -------------------------------------------------------------------- getlangs
3861:
3862: =pod
3863:
3864: =item * &getlangs($uname,$udom)
3865:
3866: Gets a user's language preference and returns it as a hash with key:
3867: language.
3868:
3869: =cut
3870:
3871:
3872: sub getlangs {
3873: my ($uname,$udom) = @_;
3874: if (!$udom) { $udom =$env{'user.domain'}; }
3875: if (!$uname) { $uname=$env{'user.name'}; }
3876: my $id=$uname.':'.$udom;
3877: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3878: if ($cached) {
3879: return %{$langs};
3880: } else {
3881: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3882: $udom,$uname);
3883: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3884: return %loadlangs;
3885: }
3886: }
3887:
3888: sub flush_langs_cache {
3889: my ($uname,$udom)=@_;
3890: if (!$udom) { $udom =$env{'user.domain'}; }
3891: if (!$uname) { $uname=$env{'user.name'}; }
3892: return if ($udom eq 'public' && $uname eq 'public');
3893: my $id=$uname.':'.$udom;
3894: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3895: }
3896:
1.61 www 3897: # ------------------------------------------------------------------ Screenname
1.81 albertel 3898:
3899: =pod
3900:
1.648 raeburn 3901: =item * &screenname($uname,$udom)
1.81 albertel 3902:
3903: Gets a users screenname and returns it as a string
3904:
3905: =cut
1.61 www 3906:
3907: sub screenname {
3908: my ($uname,$udom)=@_;
1.258 albertel 3909: if ($uname eq $env{'user.name'} &&
3910: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3911: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3912: return $names{'screenname'};
1.62 www 3913: }
3914:
1.212 albertel 3915:
1.802 bisitz 3916: # ------------------------------------------------------------- Confirm Wrapper
3917: =pod
3918:
1.1142 raeburn 3919: =item * &confirmwrapper($message)
1.802 bisitz 3920:
3921: Wrap messages about completion of operation in box
3922:
3923: =cut
3924:
3925: sub confirmwrapper {
3926: my ($message)=@_;
3927: if ($message) {
3928: return "\n".'<div class="LC_confirm_box">'."\n"
3929: .$message."\n"
3930: .'</div>'."\n";
3931: } else {
3932: return $message;
3933: }
3934: }
3935:
1.62 www 3936: # ------------------------------------------------------------- Message Wrapper
3937:
3938: sub messagewrapper {
1.369 www 3939: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3940: return
1.441 albertel 3941: '<a href="/adm/email?compose=individual&'.
3942: 'recname='.$username.'&recdom='.$domain.
3943: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3944: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3945: }
1.802 bisitz 3946:
1.74 www 3947: # --------------------------------------------------------------- Notes Wrapper
3948:
3949: sub noteswrapper {
3950: my ($link,$un,$do)=@_;
3951: return
1.896 amueller 3952: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3953: }
1.802 bisitz 3954:
1.62 www 3955: # ------------------------------------------------------------- Aboutme Wrapper
3956:
3957: sub aboutmewrapper {
1.1070 raeburn 3958: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3959: if (!defined($username) && !defined($domain)) {
3960: return;
3961: }
1.1096 raeburn 3962: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3963: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3964: }
3965:
3966: # ------------------------------------------------------------ Syllabus Wrapper
3967:
3968: sub syllabuswrapper {
1.707 bisitz 3969: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3970: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3971: }
1.14 harris41 3972:
1.802 bisitz 3973: # -----------------------------------------------------------------------------
3974:
1.208 matthew 3975: sub track_student_link {
1.887 raeburn 3976: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3977: my $link ="/adm/trackstudent?";
1.208 matthew 3978: my $title = 'View recent activity';
3979: if (defined($sname) && $sname !~ /^\s*$/ &&
3980: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3981: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3982: $title .= ' of this student';
1.268 albertel 3983: }
1.208 matthew 3984: if (defined($target) && $target !~ /^\s*$/) {
3985: $target = qq{target="$target"};
3986: } else {
3987: $target = '';
3988: }
1.268 albertel 3989: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3990: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3991: $title = &mt($title);
3992: $linktext = &mt($linktext);
1.448 albertel 3993: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3994: &help_open_topic('View_recent_activity');
1.208 matthew 3995: }
3996:
1.781 raeburn 3997: sub slot_reservations_link {
3998: my ($linktext,$sname,$sdom,$target) = @_;
3999: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4000: my $title = 'View slot reservation history';
4001: if (defined($sname) && $sname !~ /^\s*$/ &&
4002: defined($sdom) && $sdom !~ /^\s*$/) {
4003: $link .= "&uname=$sname&udom=$sdom";
4004: $title .= ' of this student';
4005: }
4006: if (defined($target) && $target !~ /^\s*$/) {
4007: $target = qq{target="$target"};
4008: } else {
4009: $target = '';
4010: }
4011: $title = &mt($title);
4012: $linktext = &mt($linktext);
4013: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4014: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4015:
4016: }
4017:
1.508 www 4018: # ===================================================== Display a student photo
4019:
4020:
1.509 albertel 4021: sub student_image_tag {
1.508 www 4022: my ($domain,$user)=@_;
4023: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4024: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4025: return '<img src="'.$imgsrc.'" align="right" />';
4026: } else {
4027: return '';
4028: }
4029: }
4030:
1.112 bowersj2 4031: =pod
4032:
4033: =back
4034:
4035: =head1 Access .tab File Data
4036:
4037: =over 4
4038:
1.648 raeburn 4039: =item * &languageids()
1.112 bowersj2 4040:
4041: returns list of all language ids
4042:
4043: =cut
4044:
1.14 harris41 4045: sub languageids {
1.16 harris41 4046: return sort(keys(%language));
1.14 harris41 4047: }
4048:
1.112 bowersj2 4049: =pod
4050:
1.648 raeburn 4051: =item * &languagedescription()
1.112 bowersj2 4052:
4053: returns description of a specified language id
4054:
4055: =cut
4056:
1.14 harris41 4057: sub languagedescription {
1.125 www 4058: my $code=shift;
4059: return ($supported_language{$code}?'* ':'').
4060: $language{$code}.
1.126 www 4061: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4062: }
4063:
1.1048 foxr 4064: =pod
4065:
4066: =item * &plainlanguagedescription
4067:
4068: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4069: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4070:
4071: =cut
4072:
1.145 www 4073: sub plainlanguagedescription {
4074: my $code=shift;
4075: return $language{$code};
4076: }
4077:
1.1048 foxr 4078: =pod
4079:
4080: =item * &supportedlanguagecode
4081:
4082: Returns the supported language code (e.g. sptutf maps to pt) given a language
4083: code.
4084:
4085: =cut
4086:
1.145 www 4087: sub supportedlanguagecode {
4088: my $code=shift;
4089: return $supported_language{$code};
1.97 www 4090: }
4091:
1.112 bowersj2 4092: =pod
4093:
1.1048 foxr 4094: =item * &latexlanguage()
4095:
4096: Given a language key code returns the correspondnig language to use
4097: to select the correct hyphenation on LaTeX printouts. This is undef if there
4098: is no supported hyphenation for the language code.
4099:
4100: =cut
4101:
4102: sub latexlanguage {
4103: my $code = shift;
4104: return $latex_language{$code};
4105: }
4106:
4107: =pod
4108:
4109: =item * &latexhyphenation()
4110:
4111: Same as above but what's supplied is the language as it might be stored
4112: in the metadata.
4113:
4114: =cut
4115:
4116: sub latexhyphenation {
4117: my $key = shift;
4118: return $latex_language_bykey{$key};
4119: }
4120:
4121: =pod
4122:
1.648 raeburn 4123: =item * ©rightids()
1.112 bowersj2 4124:
4125: returns list of all copyrights
4126:
4127: =cut
4128:
4129: sub copyrightids {
4130: return sort(keys(%cprtag));
4131: }
4132:
4133: =pod
4134:
1.648 raeburn 4135: =item * ©rightdescription()
1.112 bowersj2 4136:
4137: returns description of a specified copyright id
4138:
4139: =cut
4140:
4141: sub copyrightdescription {
1.166 www 4142: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4143: }
1.197 matthew 4144:
4145: =pod
4146:
1.648 raeburn 4147: =item * &source_copyrightids()
1.192 taceyjo1 4148:
4149: returns list of all source copyrights
4150:
4151: =cut
4152:
4153: sub source_copyrightids {
4154: return sort(keys(%scprtag));
4155: }
4156:
4157: =pod
4158:
1.648 raeburn 4159: =item * &source_copyrightdescription()
1.192 taceyjo1 4160:
4161: returns description of a specified source copyright id
4162:
4163: =cut
4164:
4165: sub source_copyrightdescription {
4166: return &mt($scprtag{shift(@_)});
4167: }
1.112 bowersj2 4168:
4169: =pod
4170:
1.648 raeburn 4171: =item * &filecategories()
1.112 bowersj2 4172:
4173: returns list of all file categories
4174:
4175: =cut
4176:
4177: sub filecategories {
4178: return sort(keys(%category_extensions));
4179: }
4180:
4181: =pod
4182:
1.648 raeburn 4183: =item * &filecategorytypes()
1.112 bowersj2 4184:
4185: returns list of file types belonging to a given file
4186: category
4187:
4188: =cut
4189:
4190: sub filecategorytypes {
1.356 albertel 4191: my ($cat) = @_;
1.1248 raeburn 4192: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4193: return @{$category_extensions{lc($cat)}};
4194: } else {
4195: return ();
4196: }
1.112 bowersj2 4197: }
4198:
4199: =pod
4200:
1.648 raeburn 4201: =item * &fileembstyle()
1.112 bowersj2 4202:
4203: returns embedding style for a specified file type
4204:
4205: =cut
4206:
4207: sub fileembstyle {
4208: return $fe{lc(shift(@_))};
1.169 www 4209: }
4210:
1.351 www 4211: sub filemimetype {
4212: return $fm{lc(shift(@_))};
4213: }
4214:
1.169 www 4215:
4216: sub filecategoryselect {
4217: my ($name,$value)=@_;
1.189 matthew 4218: return &select_form($value,$name,
1.970 raeburn 4219: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4220: }
4221:
4222: =pod
4223:
1.648 raeburn 4224: =item * &filedescription()
1.112 bowersj2 4225:
4226: returns description for a specified file type
4227:
4228: =cut
4229:
4230: sub filedescription {
1.188 matthew 4231: my $file_description = $fd{lc(shift())};
4232: $file_description =~ s:([\[\]]):~$1:g;
4233: return &mt($file_description);
1.112 bowersj2 4234: }
4235:
4236: =pod
4237:
1.648 raeburn 4238: =item * &filedescriptionex()
1.112 bowersj2 4239:
4240: returns description for a specified file type with
4241: extra formatting
4242:
4243: =cut
4244:
4245: sub filedescriptionex {
4246: my $ex=shift;
1.188 matthew 4247: my $file_description = $fd{lc($ex)};
4248: $file_description =~ s:([\[\]]):~$1:g;
4249: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4250: }
4251:
4252: # End of .tab access
4253: =pod
4254:
4255: =back
4256:
4257: =cut
4258:
4259: # ------------------------------------------------------------------ File Types
4260: sub fileextensions {
4261: return sort(keys(%fe));
4262: }
4263:
1.97 www 4264: # ----------------------------------------------------------- Display Languages
4265: # returns a hash with all desired display languages
4266: #
4267:
4268: sub display_languages {
4269: my %languages=();
1.695 raeburn 4270: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4271: $languages{$lang}=1;
1.97 www 4272: }
4273: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4274: if ($env{'form.displaylanguage'}) {
1.356 albertel 4275: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4276: $languages{$lang}=1;
1.97 www 4277: }
4278: }
4279: return %languages;
1.14 harris41 4280: }
4281:
1.582 albertel 4282: sub languages {
4283: my ($possible_langs) = @_;
1.695 raeburn 4284: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4285: if (!ref($possible_langs)) {
4286: if( wantarray ) {
4287: return @preferred_langs;
4288: } else {
4289: return $preferred_langs[0];
4290: }
4291: }
4292: my %possibilities = map { $_ => 1 } (@$possible_langs);
4293: my @preferred_possibilities;
4294: foreach my $preferred_lang (@preferred_langs) {
4295: if (exists($possibilities{$preferred_lang})) {
4296: push(@preferred_possibilities, $preferred_lang);
4297: }
4298: }
4299: if( wantarray ) {
4300: return @preferred_possibilities;
4301: }
4302: return $preferred_possibilities[0];
4303: }
4304:
1.742 raeburn 4305: sub user_lang {
4306: my ($touname,$toudom,$fromcid) = @_;
4307: my @userlangs;
4308: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4309: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4310: $env{'course.'.$fromcid.'.languages'}));
4311: } else {
4312: my %langhash = &getlangs($touname,$toudom);
4313: if ($langhash{'languages'} ne '') {
4314: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4315: } else {
4316: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4317: if ($domdefs{'lang_def'} ne '') {
4318: @userlangs = ($domdefs{'lang_def'});
4319: }
4320: }
4321: }
4322: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4323: my $user_lh = Apache::localize->get_handle(@languages);
4324: return $user_lh;
4325: }
4326:
4327:
1.112 bowersj2 4328: ###############################################################
4329: ## Student Answer Attempts ##
4330: ###############################################################
4331:
4332: =pod
4333:
4334: =head1 Alternate Problem Views
4335:
4336: =over 4
4337:
1.648 raeburn 4338: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4339: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4340:
4341: Return string with previous attempt on problem. Arguments:
4342:
4343: =over 4
4344:
4345: =item * $symb: Problem, including path
4346:
4347: =item * $username: username of the desired student
4348:
4349: =item * $domain: domain of the desired student
1.14 harris41 4350:
1.112 bowersj2 4351: =item * $course: Course ID
1.14 harris41 4352:
1.112 bowersj2 4353: =item * $getattempt: Leave blank for all attempts, otherwise put
4354: something
1.14 harris41 4355:
1.112 bowersj2 4356: =item * $regexp: if string matches this regexp, the string will be
4357: sent to $gradesub
1.14 harris41 4358:
1.112 bowersj2 4359: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4360:
1.1199 raeburn 4361: =item * $usec: section of the desired student
4362:
4363: =item * $identifier: counter for student (multiple students one problem) or
4364: problem (one student; whole sequence).
4365:
1.112 bowersj2 4366: =back
1.14 harris41 4367:
1.112 bowersj2 4368: The output string is a table containing all desired attempts, if any.
1.16 harris41 4369:
1.112 bowersj2 4370: =cut
1.1 albertel 4371:
4372: sub get_previous_attempt {
1.1199 raeburn 4373: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4374: my $prevattempts='';
1.43 ng 4375: no strict 'refs';
1.1 albertel 4376: if ($symb) {
1.3 albertel 4377: my (%returnhash)=
4378: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4379: if ($returnhash{'version'}) {
4380: my %lasthash=();
4381: my $version;
4382: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4383: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4384: if ($key =~ /\.rawrndseed$/) {
4385: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4386: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4387: } else {
4388: $lasthash{$key}=$returnhash{$version.':'.$key};
4389: }
1.19 harris41 4390: }
1.1 albertel 4391: }
1.596 albertel 4392: $prevattempts=&start_data_table().&start_data_table_header_row();
4393: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4394: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4395: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4396: foreach my $key (sort(keys(%lasthash))) {
4397: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4398: if ($#parts > 0) {
1.31 albertel 4399: my $data=$parts[-1];
1.989 raeburn 4400: next if ($data eq 'foilorder');
1.31 albertel 4401: pop(@parts);
1.1010 www 4402: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4403: if ($data eq 'type') {
4404: unless ($showsurv) {
4405: my $id = join(',',@parts);
4406: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4407: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4408: $lasthidden{$ign.'.'.$id} = 1;
4409: }
1.945 raeburn 4410: }
1.1199 raeburn 4411: if ($identifier ne '') {
4412: my $id = join(',',@parts);
4413: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4414: $domain,$username,$usec,undef,$course) =~ /^no/) {
4415: $hidestatus{$ign.'.'.$id} = 1;
4416: }
4417: }
4418: } elsif ($data eq 'regrader') {
4419: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4420: my $id = join(',',@parts);
4421: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4422: }
1.1010 www 4423: }
1.31 albertel 4424: } else {
1.41 ng 4425: if ($#parts == 0) {
4426: $prevattempts.='<th>'.$parts[0].'</th>';
4427: } else {
4428: $prevattempts.='<th>'.$ign.'</th>';
4429: }
1.31 albertel 4430: }
1.16 harris41 4431: }
1.596 albertel 4432: $prevattempts.=&end_data_table_header_row();
1.40 ng 4433: if ($getattempt eq '') {
1.1199 raeburn 4434: my (%solved,%resets,%probstatus);
1.1200 raeburn 4435: if (($identifier ne '') && (keys(%regraded) > 0)) {
4436: for ($version=1;$version<=$returnhash{'version'};$version++) {
4437: foreach my $id (keys(%regraded)) {
4438: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4439: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4440: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4441: push(@{$resets{$id}},$version);
1.1199 raeburn 4442: }
4443: }
4444: }
1.1200 raeburn 4445: }
4446: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4447: my (@hidden,@unsolved);
1.945 raeburn 4448: if (%typeparts) {
4449: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4450: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4451: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4452: push(@hidden,$id);
1.1199 raeburn 4453: } elsif ($identifier ne '') {
4454: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4455: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4456: ($hidestatus{$id})) {
1.1200 raeburn 4457: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4458: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4459: push(@{$solved{$id}},$version);
4460: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4461: (ref($solved{$id}) eq 'ARRAY')) {
4462: my $skip;
4463: if (ref($resets{$id}) eq 'ARRAY') {
4464: foreach my $reset (@{$resets{$id}}) {
4465: if ($reset > $solved{$id}[-1]) {
4466: $skip=1;
4467: last;
4468: }
4469: }
4470: }
4471: unless ($skip) {
4472: my ($ign,$partslist) = split(/\./,$id,2);
4473: push(@unsolved,$partslist);
4474: }
4475: }
4476: }
1.945 raeburn 4477: }
4478: }
4479: }
4480: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4481: '<td>'.&mt('Transaction [_1]',$version);
4482: if (@unsolved) {
4483: $prevattempts .= '<span class="LC_nobreak"><label>'.
4484: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4485: &mt('Hide').'</label></span>';
4486: }
4487: $prevattempts .= '</td>';
1.945 raeburn 4488: if (@hidden) {
4489: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4490: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4491: my $hide;
4492: foreach my $id (@hidden) {
4493: if ($key =~ /^\Q$id\E/) {
4494: $hide = 1;
4495: last;
4496: }
4497: }
4498: if ($hide) {
4499: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4500: if (($data eq 'award') || ($data eq 'awarddetail')) {
4501: my $value = &format_previous_attempt_value($key,
4502: $returnhash{$version.':'.$key});
1.1173 kruse 4503: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4504: } else {
4505: $prevattempts.='<td> </td>';
4506: }
4507: } else {
4508: if ($key =~ /\./) {
1.1212 raeburn 4509: my $value = $returnhash{$version.':'.$key};
4510: if ($key =~ /\.rndseed$/) {
4511: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4512: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4513: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4514: }
4515: }
4516: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4517: ' </td>';
1.945 raeburn 4518: } else {
4519: $prevattempts.='<td> </td>';
4520: }
4521: }
4522: }
4523: } else {
4524: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4525: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4526: my $value = $returnhash{$version.':'.$key};
4527: if ($key =~ /\.rndseed$/) {
4528: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4529: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4530: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4531: }
4532: }
4533: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4534: ' </td>';
1.945 raeburn 4535: }
4536: }
4537: $prevattempts.=&end_data_table_row();
1.40 ng 4538: }
1.1 albertel 4539: }
1.945 raeburn 4540: my @currhidden = keys(%lasthidden);
1.596 albertel 4541: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4542: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4543: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4544: if (%typeparts) {
4545: my $hidden;
4546: foreach my $id (@currhidden) {
4547: if ($key =~ /^\Q$id\E/) {
4548: $hidden = 1;
4549: last;
4550: }
4551: }
4552: if ($hidden) {
4553: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4554: if (($data eq 'award') || ($data eq 'awarddetail')) {
4555: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4556: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4557: $value = &$gradesub($value);
4558: }
1.1173 kruse 4559: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4560: } else {
4561: $prevattempts.='<td> </td>';
4562: }
4563: } else {
4564: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4565: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4566: $value = &$gradesub($value);
4567: }
1.1173 kruse 4568: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4569: }
4570: } else {
4571: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4572: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4573: $value = &$gradesub($value);
4574: }
1.1173 kruse 4575: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4576: }
1.16 harris41 4577: }
1.596 albertel 4578: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4579: } else {
1.596 albertel 4580: $prevattempts=
4581: &start_data_table().&start_data_table_row().
4582: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4583: &end_data_table_row().&end_data_table();
1.1 albertel 4584: }
4585: } else {
1.596 albertel 4586: $prevattempts=
4587: &start_data_table().&start_data_table_row().
4588: '<td>'.&mt('No data.').'</td>'.
4589: &end_data_table_row().&end_data_table();
1.1 albertel 4590: }
1.10 albertel 4591: }
4592:
1.581 albertel 4593: sub format_previous_attempt_value {
4594: my ($key,$value) = @_;
1.1011 www 4595: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4596: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4597: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4598: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4599: } elsif ($key =~ /answerstring$/) {
4600: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4601: my @answer = %answers;
4602: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4603: my @anskeys = sort(keys(%answers));
4604: if (@anskeys == 1) {
4605: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4606: if ($answer =~ m{\0}) {
4607: $answer =~ s{\0}{,}g;
1.988 raeburn 4608: }
4609: my $tag_internal_answer_name = 'INTERNAL';
4610: if ($anskeys[0] eq $tag_internal_answer_name) {
4611: $value = $answer;
4612: } else {
4613: $value = $anskeys[0].'='.$answer;
4614: }
4615: } else {
4616: foreach my $ans (@anskeys) {
4617: my $answer = $answers{$ans};
1.1001 raeburn 4618: if ($answer =~ m{\0}) {
4619: $answer =~ s{\0}{,}g;
1.988 raeburn 4620: }
4621: $value .= $ans.'='.$answer.'<br />';;
4622: }
4623: }
1.581 albertel 4624: } else {
1.1173 kruse 4625: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4626: }
4627: return $value;
4628: }
4629:
4630:
1.107 albertel 4631: sub relative_to_absolute {
4632: my ($url,$output)=@_;
4633: my $parser=HTML::TokeParser->new(\$output);
4634: my $token;
4635: my $thisdir=$url;
4636: my @rlinks=();
4637: while ($token=$parser->get_token) {
4638: if ($token->[0] eq 'S') {
4639: if ($token->[1] eq 'a') {
4640: if ($token->[2]->{'href'}) {
4641: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4642: }
4643: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4644: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4645: } elsif ($token->[1] eq 'base') {
4646: $thisdir=$token->[2]->{'href'};
4647: }
4648: }
4649: }
4650: $thisdir=~s-/[^/]*$--;
1.356 albertel 4651: foreach my $link (@rlinks) {
1.726 raeburn 4652: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4653: ($link=~/^\//) ||
4654: ($link=~/^javascript:/i) ||
4655: ($link=~/^mailto:/i) ||
4656: ($link=~/^\#/)) {
4657: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4658: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4659: }
4660: }
4661: # -------------------------------------------------- Deal with Applet codebases
4662: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4663: return $output;
4664: }
4665:
1.112 bowersj2 4666: =pod
4667:
1.648 raeburn 4668: =item * &get_student_view()
1.112 bowersj2 4669:
4670: show a snapshot of what student was looking at
4671:
4672: =cut
4673:
1.10 albertel 4674: sub get_student_view {
1.186 albertel 4675: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4676: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4677: my (%form);
1.10 albertel 4678: my @elements=('symb','courseid','domain','username');
4679: foreach my $element (@elements) {
1.186 albertel 4680: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4681: }
1.186 albertel 4682: if (defined($moreenv)) {
4683: %form=(%form,%{$moreenv});
4684: }
1.236 albertel 4685: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4686: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4687: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4688: $userview=~s/\<body[^\>]*\>//gi;
4689: $userview=~s/\<\/body\>//gi;
4690: $userview=~s/\<html\>//gi;
4691: $userview=~s/\<\/html\>//gi;
4692: $userview=~s/\<head\>//gi;
4693: $userview=~s/\<\/head\>//gi;
4694: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4695: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4696: if (wantarray) {
4697: return ($userview,$response);
4698: } else {
4699: return $userview;
4700: }
4701: }
4702:
4703: sub get_student_view_with_retries {
4704: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4705:
4706: my $ok = 0; # True if we got a good response.
4707: my $content;
4708: my $response;
4709:
4710: # Try to get the student_view done. within the retries count:
4711:
4712: do {
4713: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4714: $ok = $response->is_success;
4715: if (!$ok) {
4716: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4717: }
4718: $retries--;
4719: } while (!$ok && ($retries > 0));
4720:
4721: if (!$ok) {
4722: $content = ''; # On error return an empty content.
4723: }
1.651 www 4724: if (wantarray) {
4725: return ($content, $response);
4726: } else {
4727: return $content;
4728: }
1.11 albertel 4729: }
4730:
1.112 bowersj2 4731: =pod
4732:
1.648 raeburn 4733: =item * &get_student_answers()
1.112 bowersj2 4734:
4735: show a snapshot of how student was answering problem
4736:
4737: =cut
4738:
1.11 albertel 4739: sub get_student_answers {
1.100 sakharuk 4740: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4741: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4742: my (%moreenv);
1.11 albertel 4743: my @elements=('symb','courseid','domain','username');
4744: foreach my $element (@elements) {
1.186 albertel 4745: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4746: }
1.186 albertel 4747: $moreenv{'grade_target'}='answer';
4748: %moreenv=(%form,%moreenv);
1.497 raeburn 4749: $feedurl = &Apache::lonnet::clutter($feedurl);
4750: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4751: return $userview;
1.1 albertel 4752: }
1.116 albertel 4753:
4754: =pod
4755:
4756: =item * &submlink()
4757:
1.242 albertel 4758: Inputs: $text $uname $udom $symb $target
1.116 albertel 4759:
4760: Returns: A link to grades.pm such as to see the SUBM view of a student
4761:
4762: =cut
4763:
4764: ###############################################
4765: sub submlink {
1.242 albertel 4766: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4767: if (!($uname && $udom)) {
4768: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4769: &Apache::lonnet::whichuser($symb);
1.116 albertel 4770: if (!$symb) { $symb=$cursymb; }
4771: }
1.254 matthew 4772: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4773: $symb=&escape($symb);
1.960 bisitz 4774: if ($target) { $target=" target=\"$target\""; }
4775: return
4776: '<a href="/adm/grades?command=submission'.
4777: '&symb='.$symb.
4778: '&student='.$uname.
4779: '&userdom='.$udom.'"'.
4780: $target.'>'.$text.'</a>';
1.242 albertel 4781: }
4782: ##############################################
4783:
4784: =pod
4785:
4786: =item * &pgrdlink()
4787:
4788: Inputs: $text $uname $udom $symb $target
4789:
4790: Returns: A link to grades.pm such as to see the PGRD view of a student
4791:
4792: =cut
4793:
4794: ###############################################
4795: sub pgrdlink {
4796: my $link=&submlink(@_);
4797: $link=~s/(&command=submission)/$1&showgrading=yes/;
4798: return $link;
4799: }
4800: ##############################################
4801:
4802: =pod
4803:
4804: =item * &pprmlink()
4805:
4806: Inputs: $text $uname $udom $symb $target
4807:
4808: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4809: student and a specific resource
1.242 albertel 4810:
4811: =cut
4812:
4813: ###############################################
4814: sub pprmlink {
4815: my ($text,$uname,$udom,$symb,$target)=@_;
4816: if (!($uname && $udom)) {
4817: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4818: &Apache::lonnet::whichuser($symb);
1.242 albertel 4819: if (!$symb) { $symb=$cursymb; }
4820: }
1.254 matthew 4821: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4822: $symb=&escape($symb);
1.242 albertel 4823: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4824: return '<a href="/adm/parmset?command=set&'.
4825: 'symb='.$symb.'&uname='.$uname.
4826: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4827: }
4828: ##############################################
1.37 matthew 4829:
1.112 bowersj2 4830: =pod
4831:
4832: =back
4833:
4834: =cut
4835:
1.37 matthew 4836: ###############################################
1.51 www 4837:
4838:
4839: sub timehash {
1.687 raeburn 4840: my ($thistime) = @_;
4841: my $timezone = &Apache::lonlocal::gettimezone();
4842: my $dt = DateTime->from_epoch(epoch => $thistime)
4843: ->set_time_zone($timezone);
4844: my $wday = $dt->day_of_week();
4845: if ($wday == 7) { $wday = 0; }
4846: return ( 'second' => $dt->second(),
4847: 'minute' => $dt->minute(),
4848: 'hour' => $dt->hour(),
4849: 'day' => $dt->day_of_month(),
4850: 'month' => $dt->month(),
4851: 'year' => $dt->year(),
4852: 'weekday' => $wday,
4853: 'dayyear' => $dt->day_of_year(),
4854: 'dlsav' => $dt->is_dst() );
1.51 www 4855: }
4856:
1.370 www 4857: sub utc_string {
4858: my ($date)=@_;
1.371 www 4859: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4860: }
4861:
1.51 www 4862: sub maketime {
4863: my %th=@_;
1.687 raeburn 4864: my ($epoch_time,$timezone,$dt);
4865: $timezone = &Apache::lonlocal::gettimezone();
4866: eval {
4867: $dt = DateTime->new( year => $th{'year'},
4868: month => $th{'month'},
4869: day => $th{'day'},
4870: hour => $th{'hour'},
4871: minute => $th{'minute'},
4872: second => $th{'second'},
4873: time_zone => $timezone,
4874: );
4875: };
4876: if (!$@) {
4877: $epoch_time = $dt->epoch;
4878: if ($epoch_time) {
4879: return $epoch_time;
4880: }
4881: }
1.51 www 4882: return POSIX::mktime(
4883: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4884: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4885: }
4886:
4887: #########################################
1.51 www 4888:
4889: sub findallcourses {
1.482 raeburn 4890: my ($roles,$uname,$udom) = @_;
1.355 albertel 4891: my %roles;
4892: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4893: my %courses;
1.51 www 4894: my $now=time;
1.482 raeburn 4895: if (!defined($uname)) {
4896: $uname = $env{'user.name'};
4897: }
4898: if (!defined($udom)) {
4899: $udom = $env{'user.domain'};
4900: }
4901: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4902: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4903: if (!%roles) {
4904: %roles = (
4905: cc => 1,
1.907 raeburn 4906: co => 1,
1.482 raeburn 4907: in => 1,
4908: ep => 1,
4909: ta => 1,
4910: cr => 1,
4911: st => 1,
4912: );
4913: }
4914: foreach my $entry (keys(%roleshash)) {
4915: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4916: if ($trole =~ /^cr/) {
4917: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4918: } else {
4919: next if (!exists($roles{$trole}));
4920: }
4921: if ($tend) {
4922: next if ($tend < $now);
4923: }
4924: if ($tstart) {
4925: next if ($tstart > $now);
4926: }
1.1058 raeburn 4927: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4928: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4929: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4930: if ($secpart eq '') {
4931: ($cnum,$role) = split(/_/,$cnumpart);
4932: $sec = 'none';
1.1058 raeburn 4933: $value .= $cnum.'/';
1.482 raeburn 4934: } else {
4935: $cnum = $cnumpart;
4936: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4937: $value .= $cnum.'/'.$sec;
4938: }
4939: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4940: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4941: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4942: }
4943: } else {
4944: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4945: }
1.482 raeburn 4946: }
4947: } else {
4948: foreach my $key (keys(%env)) {
1.483 albertel 4949: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4950: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4951: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4952: next if ($role eq 'ca' || $role eq 'aa');
4953: next if (%roles && !exists($roles{$role}));
4954: my ($starttime,$endtime)=split(/\./,$env{$key});
4955: my $active=1;
4956: if ($starttime) {
4957: if ($now<$starttime) { $active=0; }
4958: }
4959: if ($endtime) {
4960: if ($now>$endtime) { $active=0; }
4961: }
4962: if ($active) {
1.1058 raeburn 4963: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4964: if ($sec eq '') {
4965: $sec = 'none';
1.1058 raeburn 4966: } else {
4967: $value .= $sec;
4968: }
4969: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4970: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4971: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4972: }
4973: } else {
4974: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4975: }
1.474 raeburn 4976: }
4977: }
1.51 www 4978: }
4979: }
1.474 raeburn 4980: return %courses;
1.51 www 4981: }
1.37 matthew 4982:
1.54 www 4983: ###############################################
1.474 raeburn 4984:
4985: sub blockcheck {
1.1189 raeburn 4986: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4987:
1.1189 raeburn 4988: if (defined($udom) && defined($uname)) {
4989: # If uname and udom are for a course, check for blocks in the course.
4990: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4991: my ($startblock,$endblock,$triggerblock) =
4992: &get_blocks($setters,$activity,$udom,$uname,$url);
4993: return ($startblock,$endblock,$triggerblock);
4994: }
4995: } else {
1.490 raeburn 4996: $udom = $env{'user.domain'};
4997: $uname = $env{'user.name'};
4998: }
4999:
1.502 raeburn 5000: my $startblock = 0;
5001: my $endblock = 0;
1.1062 raeburn 5002: my $triggerblock = '';
1.482 raeburn 5003: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 5004:
1.490 raeburn 5005: # If uname is for a user, and activity is course-specific, i.e.,
5006: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5007:
1.490 raeburn 5008: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5009: $activity eq 'groups' || $activity eq 'printout' ||
5010: $activity eq 'reinit' || $activity eq 'alert') &&
1.1189 raeburn 5011: ($env{'request.course.id'})) {
1.490 raeburn 5012: foreach my $key (keys(%live_courses)) {
5013: if ($key ne $env{'request.course.id'}) {
5014: delete($live_courses{$key});
5015: }
5016: }
5017: }
5018:
5019: my $otheruser = 0;
5020: my %own_courses;
5021: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5022: # Resource belongs to user other than current user.
5023: $otheruser = 1;
5024: # Gather courses for current user
5025: %own_courses =
5026: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5027: }
5028:
5029: # Gather active course roles - course coordinator, instructor,
5030: # exam proctor, ta, student, or custom role.
1.474 raeburn 5031:
5032: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5033: my ($cdom,$cnum);
5034: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5035: $cdom = $env{'course.'.$course.'.domain'};
5036: $cnum = $env{'course.'.$course.'.num'};
5037: } else {
1.490 raeburn 5038: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5039: }
5040: my $no_ownblock = 0;
5041: my $no_userblock = 0;
1.533 raeburn 5042: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5043: # Check if current user has 'evb' priv for this
5044: if (defined($own_courses{$course})) {
5045: foreach my $sec (keys(%{$own_courses{$course}})) {
5046: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5047: if ($sec ne 'none') {
5048: $checkrole .= '/'.$sec;
5049: }
5050: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5051: $no_ownblock = 1;
5052: last;
5053: }
5054: }
5055: }
5056: # if they have 'evb' priv and are currently not playing student
5057: next if (($no_ownblock) &&
5058: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5059: }
1.474 raeburn 5060: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5061: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5062: if ($sec ne 'none') {
1.482 raeburn 5063: $checkrole .= '/'.$sec;
1.474 raeburn 5064: }
1.490 raeburn 5065: if ($otheruser) {
5066: # Resource belongs to user other than current user.
5067: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5068: my (%allroles,%userroles);
5069: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5070: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5071: my ($trole,$tdom,$tnum,$tsec);
5072: if ($entry =~ /^cr/) {
5073: ($trole,$tdom,$tnum,$tsec) =
5074: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5075: } else {
5076: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5077: }
5078: my ($spec,$area,$trest);
5079: $area = '/'.$tdom.'/'.$tnum;
5080: $trest = $tnum;
5081: if ($tsec ne '') {
5082: $area .= '/'.$tsec;
5083: $trest .= '/'.$tsec;
5084: }
5085: $spec = $trole.'.'.$area;
5086: if ($trole =~ /^cr/) {
5087: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5088: $tdom,$spec,$trest,$area);
5089: } else {
5090: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5091: $tdom,$spec,$trest,$area);
5092: }
5093: }
1.1276 raeburn 5094: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5095: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5096: if ($1) {
5097: $no_userblock = 1;
5098: last;
5099: }
1.486 raeburn 5100: }
5101: }
1.490 raeburn 5102: } else {
5103: # Resource belongs to current user
5104: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5105: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5106: $no_ownblock = 1;
5107: last;
5108: }
1.474 raeburn 5109: }
5110: }
5111: # if they have the evb priv and are currently not playing student
1.482 raeburn 5112: next if (($no_ownblock) &&
1.491 albertel 5113: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5114: next if ($no_userblock);
1.474 raeburn 5115:
1.866 kalberla 5116: # Retrieve blocking times and identity of locker for course
1.490 raeburn 5117: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5118:
1.1062 raeburn 5119: my ($start,$end,$trigger) =
5120: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5121: if (($start != 0) &&
5122: (($startblock == 0) || ($startblock > $start))) {
5123: $startblock = $start;
1.1062 raeburn 5124: if ($trigger ne '') {
5125: $triggerblock = $trigger;
5126: }
1.502 raeburn 5127: }
5128: if (($end != 0) &&
5129: (($endblock == 0) || ($endblock < $end))) {
5130: $endblock = $end;
1.1062 raeburn 5131: if ($trigger ne '') {
5132: $triggerblock = $trigger;
5133: }
1.502 raeburn 5134: }
1.490 raeburn 5135: }
1.1062 raeburn 5136: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5137: }
5138:
5139: sub get_blocks {
1.1062 raeburn 5140: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5141: my $startblock = 0;
5142: my $endblock = 0;
1.1062 raeburn 5143: my $triggerblock = '';
1.490 raeburn 5144: my $course = $cdom.'_'.$cnum;
5145: $setters->{$course} = {};
5146: $setters->{$course}{'staff'} = [];
5147: $setters->{$course}{'times'} = [];
1.1062 raeburn 5148: $setters->{$course}{'triggers'} = [];
5149: my (@blockers,%triggered);
5150: my $now = time;
5151: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5152: if ($activity eq 'docs') {
5153: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5154: foreach my $block (@blockers) {
5155: if ($block =~ /^firstaccess____(.+)$/) {
5156: my $item = $1;
5157: my $type = 'map';
5158: my $timersymb = $item;
5159: if ($item eq 'course') {
5160: $type = 'course';
5161: } elsif ($item =~ /___\d+___/) {
5162: $type = 'resource';
5163: } else {
5164: $timersymb = &Apache::lonnet::symbread($item);
5165: }
5166: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5167: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5168: $triggered{$block} = {
5169: start => $start,
5170: end => $end,
5171: type => $type,
5172: };
5173: }
5174: }
5175: } else {
5176: foreach my $block (keys(%commblocks)) {
5177: if ($block =~ m/^(\d+)____(\d+)$/) {
5178: my ($start,$end) = ($1,$2);
5179: if ($start <= time && $end >= time) {
5180: if (ref($commblocks{$block}) eq 'HASH') {
5181: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5182: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5183: unless(grep(/^\Q$block\E$/,@blockers)) {
5184: push(@blockers,$block);
5185: }
5186: }
5187: }
5188: }
5189: }
5190: } elsif ($block =~ /^firstaccess____(.+)$/) {
5191: my $item = $1;
5192: my $timersymb = $item;
5193: my $type = 'map';
5194: if ($item eq 'course') {
5195: $type = 'course';
5196: } elsif ($item =~ /___\d+___/) {
5197: $type = 'resource';
5198: } else {
5199: $timersymb = &Apache::lonnet::symbread($item);
5200: }
5201: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5202: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5203: if ($start && $end) {
5204: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5205: if (ref($commblocks{$block}) eq 'HASH') {
5206: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5207: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5208: unless(grep(/^\Q$block\E$/,@blockers)) {
5209: push(@blockers,$block);
5210: $triggered{$block} = {
5211: start => $start,
5212: end => $end,
5213: type => $type,
5214: };
5215: }
5216: }
5217: }
1.1062 raeburn 5218: }
5219: }
1.490 raeburn 5220: }
1.1062 raeburn 5221: }
5222: }
5223: }
5224: foreach my $blocker (@blockers) {
5225: my ($staff_name,$staff_dom,$title,$blocks) =
5226: &parse_block_record($commblocks{$blocker});
5227: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5228: my ($start,$end,$triggertype);
5229: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5230: ($start,$end) = ($1,$2);
5231: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5232: $start = $triggered{$blocker}{'start'};
5233: $end = $triggered{$blocker}{'end'};
5234: $triggertype = $triggered{$blocker}{'type'};
5235: }
5236: if ($start) {
5237: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5238: if ($triggertype) {
5239: push(@{$$setters{$course}{'triggers'}},$triggertype);
5240: } else {
5241: push(@{$$setters{$course}{'triggers'}},0);
5242: }
5243: if ( ($startblock == 0) || ($startblock > $start) ) {
5244: $startblock = $start;
5245: if ($triggertype) {
5246: $triggerblock = $blocker;
1.474 raeburn 5247: }
5248: }
1.1062 raeburn 5249: if ( ($endblock == 0) || ($endblock < $end) ) {
5250: $endblock = $end;
5251: if ($triggertype) {
5252: $triggerblock = $blocker;
5253: }
5254: }
1.474 raeburn 5255: }
5256: }
1.1062 raeburn 5257: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5258: }
5259:
5260: sub parse_block_record {
5261: my ($record) = @_;
5262: my ($setuname,$setudom,$title,$blocks);
5263: if (ref($record) eq 'HASH') {
5264: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5265: $title = &unescape($record->{'event'});
5266: $blocks = $record->{'blocks'};
5267: } else {
5268: my @data = split(/:/,$record,3);
5269: if (scalar(@data) eq 2) {
5270: $title = $data[1];
5271: ($setuname,$setudom) = split(/@/,$data[0]);
5272: } else {
5273: ($setuname,$setudom,$title) = @data;
5274: }
5275: $blocks = { 'com' => 'on' };
5276: }
5277: return ($setuname,$setudom,$title,$blocks);
5278: }
5279:
1.854 kalberla 5280: sub blocking_status {
1.1189 raeburn 5281: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5282: my %setters;
1.890 droeschl 5283:
1.1061 raeburn 5284: # check for active blocking
1.1062 raeburn 5285: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5286: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5287: my $blocked = 0;
5288: if ($startblock && $endblock) {
5289: $blocked = 1;
5290: }
1.890 droeschl 5291:
1.1061 raeburn 5292: # caller just wants to know whether a block is active
5293: if (!wantarray) { return $blocked; }
5294:
5295: # build a link to a popup window containing the details
5296: my $querystring = "?activity=$activity";
5297: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5298: if (($activity eq 'port') || ($activity eq 'passwd')) {
5299: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5300: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5301: } elsif ($activity eq 'docs') {
5302: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5303: }
1.1061 raeburn 5304:
5305: my $output .= <<'END_MYBLOCK';
5306: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5307: var options = "width=" + w + ",height=" + h + ",";
5308: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5309: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5310: var newWin = window.open(url, wdwName, options);
5311: newWin.focus();
5312: }
1.890 droeschl 5313: END_MYBLOCK
1.854 kalberla 5314:
1.1061 raeburn 5315: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5316:
1.1061 raeburn 5317: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5318: my $text = &mt('Communication Blocked');
1.1217 raeburn 5319: my $class = 'LC_comblock';
1.1062 raeburn 5320: if ($activity eq 'docs') {
5321: $text = &mt('Content Access Blocked');
1.1217 raeburn 5322: $class = '';
1.1063 raeburn 5323: } elsif ($activity eq 'printout') {
5324: $text = &mt('Printing Blocked');
1.1232 raeburn 5325: } elsif ($activity eq 'passwd') {
5326: $text = &mt('Password Changing Blocked');
1.1282 raeburn 5327: } elsif ($activity eq 'alert') {
5328: $text = &mt('Checking Critical Messages Blocked');
5329: } elsif ($activity eq 'reinit') {
5330: $text = &mt('Checking Course Update Blocked');
1.1062 raeburn 5331: }
1.1061 raeburn 5332: $output .= <<"END_BLOCK";
1.1217 raeburn 5333: <div class='$class'>
1.869 kalberla 5334: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5335: title='$text'>
5336: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5337: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5338: title='$text'>$text</a>
1.867 kalberla 5339: </div>
5340:
5341: END_BLOCK
1.474 raeburn 5342:
1.1061 raeburn 5343: return ($blocked, $output);
1.854 kalberla 5344: }
1.490 raeburn 5345:
1.60 matthew 5346: ###############################################
5347:
1.682 raeburn 5348: sub check_ip_acc {
1.1201 raeburn 5349: my ($acc,$clientip)=@_;
1.682 raeburn 5350: &Apache::lonxml::debug("acc is $acc");
5351: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5352: return 1;
5353: }
1.1219 raeburn 5354: my $allowed;
1.1252 raeburn 5355: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5356:
5357: my $name;
1.1219 raeburn 5358: my %access = (
5359: allowfrom => 1,
5360: denyfrom => 0,
5361: );
5362: my @allows;
5363: my @denies;
5364: foreach my $item (split(',',$acc)) {
5365: $item =~ s/^\s*//;
5366: $item =~ s/\s*$//;
5367: my $pattern;
5368: if ($item =~ /^\!(.+)$/) {
5369: push(@denies,$1);
5370: } else {
5371: push(@allows,$item);
5372: }
5373: }
5374: my $numdenies = scalar(@denies);
5375: my $numallows = scalar(@allows);
5376: my $count = 0;
5377: foreach my $pattern (@denies,@allows) {
5378: $count ++;
5379: my $acctype = 'allowfrom';
5380: if ($count <= $numdenies) {
5381: $acctype = 'denyfrom';
5382: }
1.682 raeburn 5383: if ($pattern =~ /\*$/) {
5384: #35.8.*
5385: $pattern=~s/\*//;
1.1219 raeburn 5386: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5387: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5388: #35.8.3.[34-56]
5389: my $low=$2;
5390: my $high=$3;
5391: $pattern=$1;
5392: if ($ip =~ /^\Q$pattern\E/) {
5393: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5394: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5395: }
5396: } elsif ($pattern =~ /^\*/) {
5397: #*.msu.edu
5398: $pattern=~s/\*//;
5399: if (!defined($name)) {
5400: use Socket;
5401: my $netaddr=inet_aton($ip);
5402: ($name)=gethostbyaddr($netaddr,AF_INET);
5403: }
1.1219 raeburn 5404: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5405: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5406: #127.0.0.1
1.1219 raeburn 5407: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5408: } else {
5409: #some.name.com
5410: if (!defined($name)) {
5411: use Socket;
5412: my $netaddr=inet_aton($ip);
5413: ($name)=gethostbyaddr($netaddr,AF_INET);
5414: }
1.1219 raeburn 5415: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5416: }
5417: if ($allowed =~ /^(0|1)$/) { last; }
5418: }
5419: if ($allowed eq '') {
5420: if ($numdenies && !$numallows) {
5421: $allowed = 1;
5422: } else {
5423: $allowed = 0;
1.682 raeburn 5424: }
5425: }
5426: return $allowed;
5427: }
5428:
5429: ###############################################
5430:
1.60 matthew 5431: =pod
5432:
1.112 bowersj2 5433: =head1 Domain Template Functions
5434:
5435: =over 4
5436:
5437: =item * &determinedomain()
1.60 matthew 5438:
5439: Inputs: $domain (usually will be undef)
5440:
1.63 www 5441: Returns: Determines which domain should be used for designs
1.60 matthew 5442:
5443: =cut
1.54 www 5444:
1.60 matthew 5445: ###############################################
1.63 www 5446: sub determinedomain {
5447: my $domain=shift;
1.531 albertel 5448: if (! $domain) {
1.60 matthew 5449: # Determine domain if we have not been given one
1.893 raeburn 5450: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5451: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5452: if ($env{'request.role.domain'}) {
5453: $domain=$env{'request.role.domain'};
1.60 matthew 5454: }
5455: }
1.63 www 5456: return $domain;
5457: }
5458: ###############################################
1.517 raeburn 5459:
1.518 albertel 5460: sub devalidate_domconfig_cache {
5461: my ($udom)=@_;
5462: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5463: }
5464:
5465: # ---------------------- Get domain configuration for a domain
5466: sub get_domainconf {
5467: my ($udom) = @_;
5468: my $cachetime=1800;
5469: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5470: if (defined($cached)) { return %{$result}; }
5471:
5472: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5473: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5474: my (%designhash,%legacy);
1.518 albertel 5475: if (keys(%domconfig) > 0) {
5476: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5477: if (keys(%{$domconfig{'login'}})) {
5478: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5479: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5480: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5481: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5482: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5483: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5484: if ($key eq 'loginvia') {
5485: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5486: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5487: $designhash{$udom.'.login.loginvia'} = $server;
5488: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5489:
5490: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5491: } else {
5492: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5493: }
1.948 raeburn 5494: }
1.1208 raeburn 5495: } elsif ($key eq 'headtag') {
5496: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5497: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5498: }
1.946 raeburn 5499: }
1.1208 raeburn 5500: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5501: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5502: }
1.946 raeburn 5503: }
5504: }
5505: }
5506: } else {
5507: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5508: $designhash{$udom.'.login.'.$key.'_'.$img} =
5509: $domconfig{'login'}{$key}{$img};
5510: }
1.699 raeburn 5511: }
5512: } else {
5513: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5514: }
1.632 raeburn 5515: }
5516: } else {
5517: $legacy{'login'} = 1;
1.518 albertel 5518: }
1.632 raeburn 5519: } else {
5520: $legacy{'login'} = 1;
1.518 albertel 5521: }
5522: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5523: if (keys(%{$domconfig{'rolecolors'}})) {
5524: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5525: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5526: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5527: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5528: }
1.518 albertel 5529: }
5530: }
1.632 raeburn 5531: } else {
5532: $legacy{'rolecolors'} = 1;
1.518 albertel 5533: }
1.632 raeburn 5534: } else {
5535: $legacy{'rolecolors'} = 1;
1.518 albertel 5536: }
1.948 raeburn 5537: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5538: if ($domconfig{'autoenroll'}{'co-owners'}) {
5539: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5540: }
5541: }
1.632 raeburn 5542: if (keys(%legacy) > 0) {
5543: my %legacyhash = &get_legacy_domconf($udom);
5544: foreach my $item (keys(%legacyhash)) {
5545: if ($item =~ /^\Q$udom\E\.login/) {
5546: if ($legacy{'login'}) {
5547: $designhash{$item} = $legacyhash{$item};
5548: }
5549: } else {
5550: if ($legacy{'rolecolors'}) {
5551: $designhash{$item} = $legacyhash{$item};
5552: }
1.518 albertel 5553: }
5554: }
5555: }
1.632 raeburn 5556: } else {
5557: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5558: }
5559: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5560: $cachetime);
5561: return %designhash;
5562: }
5563:
1.632 raeburn 5564: sub get_legacy_domconf {
5565: my ($udom) = @_;
5566: my %legacyhash;
5567: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5568: my $designfile = $designdir.'/'.$udom.'.tab';
5569: if (-e $designfile) {
5570: if ( open (my $fh,"<$designfile") ) {
5571: while (my $line = <$fh>) {
5572: next if ($line =~ /^\#/);
5573: chomp($line);
5574: my ($key,$val)=(split(/\=/,$line));
5575: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5576: }
5577: close($fh);
5578: }
5579: }
1.1026 raeburn 5580: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5581: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5582: }
5583: return %legacyhash;
5584: }
5585:
1.63 www 5586: =pod
5587:
1.112 bowersj2 5588: =item * &domainlogo()
1.63 www 5589:
5590: Inputs: $domain (usually will be undef)
5591:
5592: Returns: A link to a domain logo, if the domain logo exists.
5593: If the domain logo does not exist, a description of the domain.
5594:
5595: =cut
1.112 bowersj2 5596:
1.63 www 5597: ###############################################
5598: sub domainlogo {
1.517 raeburn 5599: my $domain = &determinedomain(shift);
1.518 albertel 5600: my %designhash = &get_domainconf($domain);
1.517 raeburn 5601: # See if there is a logo
5602: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5603: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5604: if ($imgsrc =~ m{^/(adm|res)/}) {
5605: if ($imgsrc =~ m{^/res/}) {
5606: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5607: &Apache::lonnet::repcopy($local_name);
5608: }
5609: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5610: }
5611: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5612: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5613: return &Apache::lonnet::domain($domain,'description');
1.59 www 5614: } else {
1.60 matthew 5615: return '';
1.59 www 5616: }
5617: }
1.63 www 5618: ##############################################
5619:
5620: =pod
5621:
1.112 bowersj2 5622: =item * &designparm()
1.63 www 5623:
5624: Inputs: $which parameter; $domain (usually will be undef)
5625:
5626: Returns: value of designparamter $which
5627:
5628: =cut
1.112 bowersj2 5629:
1.397 albertel 5630:
1.400 albertel 5631: ##############################################
1.397 albertel 5632: sub designparm {
5633: my ($which,$domain)=@_;
5634: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5635: return $env{'environment.color.'.$which};
1.96 www 5636: }
1.63 www 5637: $domain=&determinedomain($domain);
1.1016 raeburn 5638: my %domdesign;
5639: unless ($domain eq 'public') {
5640: %domdesign = &get_domainconf($domain);
5641: }
1.520 raeburn 5642: my $output;
1.517 raeburn 5643: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5644: $output = $domdesign{$domain.'.'.$which};
1.63 www 5645: } else {
1.520 raeburn 5646: $output = $defaultdesign{$which};
5647: }
5648: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5649: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5650: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5651: if ($output =~ m{^/res/}) {
5652: my $local_name = &Apache::lonnet::filelocation('',$output);
5653: &Apache::lonnet::repcopy($local_name);
5654: }
1.520 raeburn 5655: $output = &lonhttpdurl($output);
5656: }
1.63 www 5657: }
1.520 raeburn 5658: return $output;
1.63 www 5659: }
1.59 www 5660:
1.822 bisitz 5661: ##############################################
5662: =pod
5663:
1.832 bisitz 5664: =item * &authorspace()
5665:
1.1028 raeburn 5666: Inputs: $url (usually will be undef).
1.832 bisitz 5667:
1.1132 raeburn 5668: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5669: directory being viewed (or for which action is being taken).
5670: If $url is provided, and begins /priv/<domain>/<uname>
5671: the path will be that portion of the $context argument.
5672: Otherwise the path will be for the author space of the current
5673: user when the current role is author, or for that of the
5674: co-author/assistant co-author space when the current role
5675: is co-author or assistant co-author.
1.832 bisitz 5676:
5677: =cut
5678:
5679: sub authorspace {
1.1028 raeburn 5680: my ($url) = @_;
5681: if ($url ne '') {
5682: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5683: return $1;
5684: }
5685: }
1.832 bisitz 5686: my $caname = '';
1.1024 www 5687: my $cadom = '';
1.1028 raeburn 5688: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5689: ($cadom,$caname) =
1.832 bisitz 5690: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5691: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5692: $caname = $env{'user.name'};
1.1024 www 5693: $cadom = $env{'user.domain'};
1.832 bisitz 5694: }
1.1028 raeburn 5695: if (($caname ne '') && ($cadom ne '')) {
5696: return "/priv/$cadom/$caname/";
5697: }
5698: return;
1.832 bisitz 5699: }
5700:
5701: ##############################################
5702: =pod
5703:
1.822 bisitz 5704: =item * &head_subbox()
5705:
5706: Inputs: $content (contains HTML code with page functions, etc.)
5707:
5708: Returns: HTML div with $content
5709: To be included in page header
5710:
5711: =cut
5712:
5713: sub head_subbox {
5714: my ($content)=@_;
5715: my $output =
1.993 raeburn 5716: '<div class="LC_head_subbox">'
1.822 bisitz 5717: .$content
5718: .'</div>'
5719: }
5720:
5721: ##############################################
5722: =pod
5723:
5724: =item * &CSTR_pageheader()
5725:
1.1026 raeburn 5726: Input: (optional) filename from which breadcrumb trail is built.
5727: In most cases no input as needed, as $env{'request.filename'}
5728: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5729:
5730: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5731: To be included on Authoring Space pages
1.822 bisitz 5732:
5733: =cut
5734:
5735: sub CSTR_pageheader {
1.1026 raeburn 5736: my ($trailfile) = @_;
5737: if ($trailfile eq '') {
5738: $trailfile = $env{'request.filename'};
5739: }
5740:
5741: # this is for resources; directories have customtitle, and crumbs
5742: # and select recent are created in lonpubdir.pm
5743:
5744: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5745: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5746: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5747: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5748: $formaction =~ s{/+}{/}g;
1.822 bisitz 5749:
5750: my $parentpath = '';
5751: my $lastitem = '';
5752: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5753: $parentpath = $1;
5754: $lastitem = $2;
5755: } else {
5756: $lastitem = $thisdisfn;
5757: }
1.921 bisitz 5758:
1.1246 raeburn 5759: my ($crsauthor,$title);
5760: if (($env{'request.course.id'}) &&
5761: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5762: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5763: $crsauthor = 1;
5764: $title = &mt('Course Authoring Space');
5765: } else {
5766: $title = &mt('Authoring Space');
5767: }
5768:
1.921 bisitz 5769: my $output =
1.822 bisitz 5770: '<div>'
5771: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5772: .'<b>'.$title.'</b> '
1.822 bisitz 5773: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5774: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5775: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5776:
5777: if ($lastitem) {
5778: $output .=
5779: '<span class="LC_filename">'
5780: .$lastitem
5781: .'</span>';
5782: }
1.1245 raeburn 5783:
1.1246 raeburn 5784: if ($crsauthor) {
5785: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5786: } else {
5787: $output .=
5788: '<br />'
5789: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5790: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5791: .'</form>'
5792: .&Apache::lonmenu::constspaceform();
5793: }
5794: $output .= '</div>';
1.921 bisitz 5795:
5796: return $output;
1.822 bisitz 5797: }
5798:
1.60 matthew 5799: ###############################################
5800: ###############################################
5801:
5802: =pod
5803:
1.112 bowersj2 5804: =back
5805:
1.549 albertel 5806: =head1 HTML Helpers
1.112 bowersj2 5807:
5808: =over 4
5809:
5810: =item * &bodytag()
1.60 matthew 5811:
5812: Returns a uniform header for LON-CAPA web pages.
5813:
5814: Inputs:
5815:
1.112 bowersj2 5816: =over 4
5817:
5818: =item * $title, A title to be displayed on the page.
5819:
5820: =item * $function, the current role (can be undef).
5821:
5822: =item * $addentries, extra parameters for the <body> tag.
5823:
5824: =item * $bodyonly, if defined, only return the <body> tag.
5825:
5826: =item * $domain, if defined, force a given domain.
5827:
5828: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5829: text interface only)
1.60 matthew 5830:
1.814 bisitz 5831: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5832: navigational links
1.317 albertel 5833:
1.338 albertel 5834: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5835:
1.460 albertel 5836: =item * $args, optional argument valid values are
5837: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 5838: use_absolute -> for external resource or syllabus, this will
5839: contain https://<hostname> if server uses
5840: https (as per hosts.tab), but request is for http
5841: hostname -> hostname, from $r->hostname().
1.460 albertel 5842:
1.1096 raeburn 5843: =item * $advtoolsref, optional argument, ref to an array containing
5844: inlineremote items to be added in "Functions" menu below
5845: breadcrumbs.
5846:
1.112 bowersj2 5847: =back
5848:
1.60 matthew 5849: Returns: A uniform header for LON-CAPA web pages.
5850: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5851: If $bodyonly is undef or zero, an html string containing a <body> tag and
5852: other decorations will be returned.
5853:
5854: =cut
5855:
1.54 www 5856: sub bodytag {
1.831 bisitz 5857: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5858: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5859:
1.954 raeburn 5860: my $public;
5861: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5862: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5863: $public = 1;
5864: }
1.460 albertel 5865: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5866: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 5867: my $hostname = $args->{'hostname'};
1.339 albertel 5868:
1.183 matthew 5869: $function = &get_users_function() if (!$function);
1.339 albertel 5870: my $img = &designparm($function.'.img',$domain);
5871: my $font = &designparm($function.'.font',$domain);
5872: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5873:
1.803 bisitz 5874: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5875: 'bgcolor' => $pgbg,
1.339 albertel 5876: 'text' => $font,
5877: 'alink' => &designparm($function.'.alink',$domain),
5878: 'vlink' => &designparm($function.'.vlink',$domain),
5879: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5880: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5881:
1.63 www 5882: # role and realm
1.1178 raeburn 5883: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5884: if ($realm) {
5885: $realm = '/'.$realm;
5886: }
1.378 raeburn 5887: if ($role eq 'ca') {
1.479 albertel 5888: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5889: $realm = &plainname($rname,$rdom);
1.378 raeburn 5890: }
1.55 www 5891: # realm
1.258 albertel 5892: if ($env{'request.course.id'}) {
1.378 raeburn 5893: if ($env{'request.role'} !~ /^cr/) {
5894: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 5895: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 5896: if ($env{'request.role.desc'}) {
5897: $role = $env{'request.role.desc'};
5898: } else {
5899: $role = &mt('Helpdesk[_1]',' '.$2);
5900: }
1.1257 raeburn 5901: } else {
5902: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5903: }
1.898 raeburn 5904: if ($env{'request.course.sec'}) {
5905: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5906: }
1.359 albertel 5907: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5908: } else {
5909: $role = &Apache::lonnet::plaintext($role);
1.54 www 5910: }
1.433 albertel 5911:
1.359 albertel 5912: if (!$realm) { $realm=' '; }
1.330 albertel 5913:
1.438 albertel 5914: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5915:
1.101 www 5916: # construct main body tag
1.359 albertel 5917: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5918: &Apache::lontexconvert::init_math_support();
1.252 albertel 5919:
1.1131 raeburn 5920: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5921:
1.1130 raeburn 5922: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5923: return $bodytag;
1.1130 raeburn 5924: }
1.359 albertel 5925:
1.954 raeburn 5926: if ($public) {
1.433 albertel 5927: undef($role);
5928: }
1.359 albertel 5929:
1.762 bisitz 5930: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5931: #
5932: # Extra info if you are the DC
5933: my $dc_info = '';
5934: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5935: $env{'course.'.$env{'request.course.id'}.
5936: '.domain'}.'/'})) {
5937: my $cid = $env{'request.course.id'};
1.917 raeburn 5938: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5939: $dc_info =~ s/\s+$//;
1.359 albertel 5940: }
5941:
1.1237 raeburn 5942: my $crstype;
5943: if ($env{'request.course.id'}) {
5944: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5945: } elsif ($args->{'crstype'}) {
5946: $crstype = $args->{'crstype'};
5947: }
5948: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5949: undef($role);
5950: } else {
1.1242 raeburn 5951: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 5952: }
1.853 droeschl 5953:
1.903 droeschl 5954: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5955:
5956: # if ($env{'request.state'} eq 'construct') {
5957: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5958: # }
5959:
1.1130 raeburn 5960: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5961: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5962:
1.1237 raeburn 5963: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5964:
1.916 droeschl 5965: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5966: if ($dc_info) {
5967: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5968: }
1.1130 raeburn 5969: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5970: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5971: return $bodytag;
5972: }
1.894 droeschl 5973:
1.927 raeburn 5974: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5975: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5976: }
1.916 droeschl 5977:
1.1130 raeburn 5978: $bodytag .= $right;
1.852 droeschl 5979:
1.917 raeburn 5980: if ($dc_info) {
5981: $dc_info = &dc_courseid_toggle($dc_info);
5982: }
5983: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5984:
1.1169 raeburn 5985: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5986: if ($args->{'no_secondary_menu'}) {
5987: return $bodytag;
5988: }
1.1169 raeburn 5989: #don't show menus for public users
1.954 raeburn 5990: if (!$public){
1.1154 raeburn 5991: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5992: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5993: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5994: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5995: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1274 raeburn 5996: $args->{'bread_crumbs'},'','',$hostname);
1.1096 raeburn 5997: } elsif ($forcereg) {
5998: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 5999: $args->{'group'},
1.1274 raeburn 6000: $args->{'hide_buttons'},
6001: $hostname);
1.1096 raeburn 6002: } else {
6003: $bodytag .=
6004: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6005: $forcereg,$args->{'group'},
6006: $args->{'bread_crumbs'},
1.1274 raeburn 6007: $advtoolsref,'',$hostname);
1.920 raeburn 6008: }
1.903 droeschl 6009: }else{
6010: # this is to seperate menu from content when there's no secondary
6011: # menu. Especially needed for public accessible ressources.
6012: $bodytag .= '<hr style="clear:both" />';
6013: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6014: }
1.903 droeschl 6015:
1.235 raeburn 6016: return $bodytag;
1.182 matthew 6017: }
6018:
1.917 raeburn 6019: sub dc_courseid_toggle {
6020: my ($dc_info) = @_;
1.980 raeburn 6021: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6022: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6023: &mt('(More ...)').'</a></span>'.
6024: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6025: }
6026:
1.330 albertel 6027: sub make_attr_string {
6028: my ($register,$attr_ref) = @_;
6029:
6030: if ($attr_ref && !ref($attr_ref)) {
6031: die("addentries Must be a hash ref ".
6032: join(':',caller(1))." ".
6033: join(':',caller(0))." ");
6034: }
6035:
6036: if ($register) {
1.339 albertel 6037: my ($on_load,$on_unload);
6038: foreach my $key (keys(%{$attr_ref})) {
6039: if (lc($key) eq 'onload') {
6040: $on_load.=$attr_ref->{$key}.';';
6041: delete($attr_ref->{$key});
6042:
6043: } elsif (lc($key) eq 'onunload') {
6044: $on_unload.=$attr_ref->{$key}.';';
6045: delete($attr_ref->{$key});
6046: }
6047: }
1.953 droeschl 6048: $attr_ref->{'onload'} = $on_load;
6049: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6050: }
1.339 albertel 6051:
1.330 albertel 6052: my $attr_string;
1.1159 raeburn 6053: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6054: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6055: }
6056: return $attr_string;
6057: }
6058:
6059:
1.182 matthew 6060: ###############################################
1.251 albertel 6061: ###############################################
6062:
6063: =pod
6064:
6065: =item * &endbodytag()
6066:
6067: Returns a uniform footer for LON-CAPA web pages.
6068:
1.635 raeburn 6069: Inputs: 1 - optional reference to an args hash
6070: If in the hash, key for noredirectlink has a value which evaluates to true,
6071: a 'Continue' link is not displayed if the page contains an
6072: internal redirect in the <head></head> section,
6073: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6074:
6075: =cut
6076:
6077: sub endbodytag {
1.635 raeburn 6078: my ($args) = @_;
1.1080 raeburn 6079: my $endbodytag;
6080: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6081: $endbodytag='</body>';
6082: }
1.315 albertel 6083: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6084: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6085: $endbodytag=
6086: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6087: &mt('Continue').'</a>'.
6088: $endbodytag;
6089: }
1.315 albertel 6090: }
1.251 albertel 6091: return $endbodytag;
6092: }
6093:
1.352 albertel 6094: =pod
6095:
6096: =item * &standard_css()
6097:
6098: Returns a style sheet
6099:
6100: Inputs: (all optional)
6101: domain -> force to color decorate a page for a specific
6102: domain
6103: function -> force usage of a specific rolish color scheme
6104: bgcolor -> override the default page bgcolor
6105:
6106: =cut
6107:
1.343 albertel 6108: sub standard_css {
1.345 albertel 6109: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6110: $function = &get_users_function() if (!$function);
6111: my $img = &designparm($function.'.img', $domain);
6112: my $tabbg = &designparm($function.'.tabbg', $domain);
6113: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6114: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6115: #second colour for later usage
1.345 albertel 6116: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6117: my $pgbg_or_bgcolor =
6118: $bgcolor ||
1.352 albertel 6119: &designparm($function.'.pgbg', $domain);
1.382 albertel 6120: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6121: my $alink = &designparm($function.'.alink', $domain);
6122: my $vlink = &designparm($function.'.vlink', $domain);
6123: my $link = &designparm($function.'.link', $domain);
6124:
1.602 albertel 6125: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6126: my $mono = 'monospace';
1.850 bisitz 6127: my $data_table_head = $sidebg;
6128: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6129: my $data_table_dark = '#E0E0E0';
1.470 banghart 6130: my $data_table_darker = '#CCCCCC';
1.349 albertel 6131: my $data_table_highlight = '#FFFF00';
1.352 albertel 6132: my $mail_new = '#FFBB77';
6133: my $mail_new_hover = '#DD9955';
6134: my $mail_read = '#BBBB77';
6135: my $mail_read_hover = '#999944';
6136: my $mail_replied = '#AAAA88';
6137: my $mail_replied_hover = '#888855';
6138: my $mail_other = '#99BBBB';
6139: my $mail_other_hover = '#669999';
1.391 albertel 6140: my $table_header = '#DDDDDD';
1.489 raeburn 6141: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6142: my $lg_border_color = '#C8C8C8';
1.952 onken 6143: my $button_hover = '#BF2317';
1.392 albertel 6144:
1.608 albertel 6145: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6146: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6147: : '0 3px 0 4px';
1.448 albertel 6148:
1.523 albertel 6149:
1.343 albertel 6150: return <<END;
1.947 droeschl 6151:
6152: /* needed for iframe to allow 100% height in FF */
6153: body, html {
6154: margin: 0;
6155: padding: 0 0.5%;
6156: height: 99%; /* to avoid scrollbars */
6157: }
6158:
1.795 www 6159: body {
1.911 bisitz 6160: font-family: $sans;
6161: line-height:130%;
6162: font-size:0.83em;
6163: color:$font;
1.795 www 6164: }
6165:
1.959 onken 6166: a:focus,
6167: a:focus img {
1.795 www 6168: color: red;
6169: }
1.698 harmsja 6170:
1.911 bisitz 6171: form, .inline {
6172: display: inline;
1.795 www 6173: }
1.721 harmsja 6174:
1.795 www 6175: .LC_right {
1.911 bisitz 6176: text-align:right;
1.795 www 6177: }
6178:
6179: .LC_middle {
1.911 bisitz 6180: vertical-align:middle;
1.795 www 6181: }
1.721 harmsja 6182:
1.1130 raeburn 6183: .LC_floatleft {
6184: float: left;
6185: }
6186:
6187: .LC_floatright {
6188: float: right;
6189: }
6190:
1.911 bisitz 6191: .LC_400Box {
6192: width:400px;
6193: }
1.721 harmsja 6194:
1.947 droeschl 6195: .LC_iframecontainer {
6196: width: 98%;
6197: margin: 0;
6198: position: fixed;
6199: top: 8.5em;
6200: bottom: 0;
6201: }
6202:
6203: .LC_iframecontainer iframe{
6204: border: none;
6205: width: 100%;
6206: height: 100%;
6207: }
6208:
1.778 bisitz 6209: .LC_filename {
6210: font-family: $mono;
6211: white-space:pre;
1.921 bisitz 6212: font-size: 120%;
1.778 bisitz 6213: }
6214:
6215: .LC_fileicon {
6216: border: none;
6217: height: 1.3em;
6218: vertical-align: text-bottom;
6219: margin-right: 0.3em;
6220: text-decoration:none;
6221: }
6222:
1.1008 www 6223: .LC_setting {
6224: text-decoration:underline;
6225: }
6226:
1.350 albertel 6227: .LC_error {
6228: color: red;
6229: }
1.795 www 6230:
1.1097 bisitz 6231: .LC_warning {
6232: color: darkorange;
6233: }
6234:
1.457 albertel 6235: .LC_diff_removed {
1.733 bisitz 6236: color: red;
1.394 albertel 6237: }
1.532 albertel 6238:
6239: .LC_info,
1.457 albertel 6240: .LC_success,
6241: .LC_diff_added {
1.350 albertel 6242: color: green;
6243: }
1.795 www 6244:
1.802 bisitz 6245: div.LC_confirm_box {
6246: background-color: #FAFAFA;
6247: border: 1px solid $lg_border_color;
6248: margin-right: 0;
6249: padding: 5px;
6250: }
6251:
6252: div.LC_confirm_box .LC_error img,
6253: div.LC_confirm_box .LC_success img {
6254: vertical-align: middle;
6255: }
6256:
1.1242 raeburn 6257: .LC_maxwidth {
6258: max-width: 100%;
6259: height: auto;
6260: }
6261:
1.1243 raeburn 6262: .LC_textsize_mobile {
6263: \@media only screen and (max-device-width: 480px) {
6264: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6265: }
6266: }
6267:
1.440 albertel 6268: .LC_icon {
1.771 droeschl 6269: border: none;
1.790 droeschl 6270: vertical-align: middle;
1.771 droeschl 6271: }
6272:
1.543 albertel 6273: .LC_docs_spacer {
6274: width: 25px;
6275: height: 1px;
1.771 droeschl 6276: border: none;
1.543 albertel 6277: }
1.346 albertel 6278:
1.532 albertel 6279: .LC_internal_info {
1.735 bisitz 6280: color: #999999;
1.532 albertel 6281: }
6282:
1.794 www 6283: .LC_discussion {
1.1050 www 6284: background: $data_table_dark;
1.911 bisitz 6285: border: 1px solid black;
6286: margin: 2px;
1.794 www 6287: }
6288:
6289: .LC_disc_action_left {
1.1050 www 6290: background: $sidebg;
1.911 bisitz 6291: text-align: left;
1.1050 www 6292: padding: 4px;
6293: margin: 2px;
1.794 www 6294: }
6295:
6296: .LC_disc_action_right {
1.1050 www 6297: background: $sidebg;
1.911 bisitz 6298: text-align: right;
1.1050 www 6299: padding: 4px;
6300: margin: 2px;
1.794 www 6301: }
6302:
6303: .LC_disc_new_item {
1.911 bisitz 6304: background: white;
6305: border: 2px solid red;
1.1050 www 6306: margin: 4px;
6307: padding: 4px;
1.794 www 6308: }
6309:
6310: .LC_disc_old_item {
1.911 bisitz 6311: background: white;
1.1050 www 6312: margin: 4px;
6313: padding: 4px;
1.794 www 6314: }
6315:
1.458 albertel 6316: table.LC_pastsubmission {
6317: border: 1px solid black;
6318: margin: 2px;
6319: }
6320:
1.924 bisitz 6321: table#LC_menubuttons {
1.345 albertel 6322: width: 100%;
6323: background: $pgbg;
1.392 albertel 6324: border: 2px;
1.402 albertel 6325: border-collapse: separate;
1.803 bisitz 6326: padding: 0;
1.345 albertel 6327: }
1.392 albertel 6328:
1.801 tempelho 6329: table#LC_title_bar a {
6330: color: $fontmenu;
6331: }
1.836 bisitz 6332:
1.807 droeschl 6333: table#LC_title_bar {
1.819 tempelho 6334: clear: both;
1.836 bisitz 6335: display: none;
1.807 droeschl 6336: }
6337:
1.795 www 6338: table#LC_title_bar,
1.933 droeschl 6339: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6340: table#LC_title_bar.LC_with_remote {
1.359 albertel 6341: width: 100%;
1.392 albertel 6342: border-color: $pgbg;
6343: border-style: solid;
6344: border-width: $border;
1.379 albertel 6345: background: $pgbg;
1.801 tempelho 6346: color: $fontmenu;
1.392 albertel 6347: border-collapse: collapse;
1.803 bisitz 6348: padding: 0;
1.819 tempelho 6349: margin: 0;
1.359 albertel 6350: }
1.795 www 6351:
1.933 droeschl 6352: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6353: margin: 0;
6354: padding: 0;
1.933 droeschl 6355: position: relative;
6356: list-style: none;
1.913 droeschl 6357: }
1.933 droeschl 6358: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6359: display: inline;
6360: }
1.933 droeschl 6361:
6362: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6363: padding: 0;
1.933 droeschl 6364: margin: 0;
6365: float: left;
1.913 droeschl 6366: }
1.933 droeschl 6367: .LC_breadcrumb_tools_tools {
6368: padding: 0;
6369: margin: 0;
1.913 droeschl 6370: float: right;
6371: }
6372:
1.1240 raeburn 6373: .LC_placement_prog {
6374: padding-right: 20px;
6375: font-weight: bold;
6376: font-size: 90%;
6377: }
6378:
1.359 albertel 6379: table#LC_title_bar td {
6380: background: $tabbg;
6381: }
1.795 www 6382:
1.911 bisitz 6383: table#LC_menubuttons img {
1.803 bisitz 6384: border: none;
1.346 albertel 6385: }
1.795 www 6386:
1.842 droeschl 6387: .LC_breadcrumbs_component {
1.911 bisitz 6388: float: right;
6389: margin: 0 1em;
1.357 albertel 6390: }
1.842 droeschl 6391: .LC_breadcrumbs_component img {
1.911 bisitz 6392: vertical-align: middle;
1.777 tempelho 6393: }
1.795 www 6394:
1.1243 raeburn 6395: .LC_breadcrumbs_hoverable {
6396: background: $sidebg;
6397: }
6398:
1.383 albertel 6399: td.LC_table_cell_checkbox {
6400: text-align: center;
6401: }
1.795 www 6402:
6403: .LC_fontsize_small {
1.911 bisitz 6404: font-size: 70%;
1.705 tempelho 6405: }
6406:
1.844 bisitz 6407: #LC_breadcrumbs {
1.911 bisitz 6408: clear:both;
6409: background: $sidebg;
6410: border-bottom: 1px solid $lg_border_color;
6411: line-height: 2.5em;
1.933 droeschl 6412: overflow: hidden;
1.911 bisitz 6413: margin: 0;
6414: padding: 0;
1.995 raeburn 6415: text-align: left;
1.819 tempelho 6416: }
1.862 bisitz 6417:
1.1098 bisitz 6418: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6419: clear:both;
6420: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6421: border: 1px solid $sidebg;
1.1098 bisitz 6422: margin: 0 0 10px 0;
1.966 bisitz 6423: padding: 3px;
1.995 raeburn 6424: text-align: left;
1.822 bisitz 6425: }
6426:
1.795 www 6427: .LC_fontsize_medium {
1.911 bisitz 6428: font-size: 85%;
1.705 tempelho 6429: }
6430:
1.795 www 6431: .LC_fontsize_large {
1.911 bisitz 6432: font-size: 120%;
1.705 tempelho 6433: }
6434:
1.346 albertel 6435: .LC_menubuttons_inline_text {
6436: color: $font;
1.698 harmsja 6437: font-size: 90%;
1.701 harmsja 6438: padding-left:3px;
1.346 albertel 6439: }
6440:
1.934 droeschl 6441: .LC_menubuttons_inline_text img{
6442: vertical-align: middle;
6443: }
6444:
1.1051 www 6445: li.LC_menubuttons_inline_text img {
1.951 onken 6446: cursor:pointer;
1.1002 droeschl 6447: text-decoration: none;
1.951 onken 6448: }
6449:
1.526 www 6450: .LC_menubuttons_link {
6451: text-decoration: none;
6452: }
1.795 www 6453:
1.522 albertel 6454: .LC_menubuttons_category {
1.521 www 6455: color: $font;
1.526 www 6456: background: $pgbg;
1.521 www 6457: font-size: larger;
6458: font-weight: bold;
6459: }
6460:
1.346 albertel 6461: td.LC_menubuttons_text {
1.911 bisitz 6462: color: $font;
1.346 albertel 6463: }
1.706 harmsja 6464:
1.346 albertel 6465: .LC_current_location {
6466: background: $tabbg;
6467: }
1.795 www 6468:
1.1286 raeburn 6469: td.LC_zero_height {
6470: line-height: 0;
6471: cellpadding: 0;
6472: }
6473:
1.938 bisitz 6474: table.LC_data_table {
1.347 albertel 6475: border: 1px solid #000000;
1.402 albertel 6476: border-collapse: separate;
1.426 albertel 6477: border-spacing: 1px;
1.610 albertel 6478: background: $pgbg;
1.347 albertel 6479: }
1.795 www 6480:
1.422 albertel 6481: .LC_data_table_dense {
6482: font-size: small;
6483: }
1.795 www 6484:
1.507 raeburn 6485: table.LC_nested_outer {
6486: border: 1px solid #000000;
1.589 raeburn 6487: border-collapse: collapse;
1.803 bisitz 6488: border-spacing: 0;
1.507 raeburn 6489: width: 100%;
6490: }
1.795 www 6491:
1.879 raeburn 6492: table.LC_innerpickbox,
1.507 raeburn 6493: table.LC_nested {
1.803 bisitz 6494: border: none;
1.589 raeburn 6495: border-collapse: collapse;
1.803 bisitz 6496: border-spacing: 0;
1.507 raeburn 6497: width: 100%;
6498: }
1.795 www 6499:
1.911 bisitz 6500: table.LC_data_table tr th,
6501: table.LC_calendar tr th,
1.879 raeburn 6502: table.LC_prior_tries tr th,
6503: table.LC_innerpickbox tr th {
1.349 albertel 6504: font-weight: bold;
6505: background-color: $data_table_head;
1.801 tempelho 6506: color:$fontmenu;
1.701 harmsja 6507: font-size:90%;
1.347 albertel 6508: }
1.795 www 6509:
1.879 raeburn 6510: table.LC_innerpickbox tr th,
6511: table.LC_innerpickbox tr td {
6512: vertical-align: top;
6513: }
6514:
1.711 raeburn 6515: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6516: background-color: #CCCCCC;
1.711 raeburn 6517: font-weight: bold;
6518: text-align: left;
6519: }
1.795 www 6520:
1.912 bisitz 6521: table.LC_data_table tr.LC_odd_row > td {
6522: background-color: $data_table_light;
6523: padding: 2px;
6524: vertical-align: top;
6525: }
6526:
1.809 bisitz 6527: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6528: background-color: $data_table_light;
1.912 bisitz 6529: vertical-align: top;
6530: }
6531:
6532: table.LC_data_table tr.LC_even_row > td {
6533: background-color: $data_table_dark;
1.425 albertel 6534: padding: 2px;
1.900 bisitz 6535: vertical-align: top;
1.347 albertel 6536: }
1.795 www 6537:
1.809 bisitz 6538: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6539: background-color: $data_table_dark;
1.900 bisitz 6540: vertical-align: top;
1.347 albertel 6541: }
1.795 www 6542:
1.425 albertel 6543: table.LC_data_table tr.LC_data_table_highlight td {
6544: background-color: $data_table_darker;
6545: }
1.795 www 6546:
1.639 raeburn 6547: table.LC_data_table tr td.LC_leftcol_header {
6548: background-color: $data_table_head;
6549: font-weight: bold;
6550: }
1.795 www 6551:
1.451 albertel 6552: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6553: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6554: font-weight: bold;
6555: font-style: italic;
6556: text-align: center;
6557: padding: 8px;
1.347 albertel 6558: }
1.795 www 6559:
1.1114 raeburn 6560: table.LC_data_table tr.LC_empty_row td,
6561: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6562: background-color: $sidebg;
6563: }
6564:
6565: table.LC_nested tr.LC_empty_row td {
6566: background-color: #FFFFFF;
6567: }
6568:
1.890 droeschl 6569: table.LC_caption {
6570: }
6571:
1.507 raeburn 6572: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6573: padding: 4ex
6574: }
1.795 www 6575:
1.507 raeburn 6576: table.LC_nested_outer tr th {
6577: font-weight: bold;
1.801 tempelho 6578: color:$fontmenu;
1.507 raeburn 6579: background-color: $data_table_head;
1.701 harmsja 6580: font-size: small;
1.507 raeburn 6581: border-bottom: 1px solid #000000;
6582: }
1.795 www 6583:
1.507 raeburn 6584: table.LC_nested_outer tr td.LC_subheader {
6585: background-color: $data_table_head;
6586: font-weight: bold;
6587: font-size: small;
6588: border-bottom: 1px solid #000000;
6589: text-align: right;
1.451 albertel 6590: }
1.795 www 6591:
1.507 raeburn 6592: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6593: background-color: #CCCCCC;
1.451 albertel 6594: font-weight: bold;
6595: font-size: small;
1.507 raeburn 6596: text-align: center;
6597: }
1.795 www 6598:
1.589 raeburn 6599: table.LC_nested tr.LC_info_row td.LC_left_item,
6600: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6601: text-align: left;
1.451 albertel 6602: }
1.795 www 6603:
1.507 raeburn 6604: table.LC_nested td {
1.735 bisitz 6605: background-color: #FFFFFF;
1.451 albertel 6606: font-size: small;
1.507 raeburn 6607: }
1.795 www 6608:
1.507 raeburn 6609: table.LC_nested_outer tr th.LC_right_item,
6610: table.LC_nested tr.LC_info_row td.LC_right_item,
6611: table.LC_nested tr.LC_odd_row td.LC_right_item,
6612: table.LC_nested tr td.LC_right_item {
1.451 albertel 6613: text-align: right;
6614: }
6615:
1.507 raeburn 6616: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6617: background-color: #EEEEEE;
1.451 albertel 6618: }
6619:
1.473 raeburn 6620: table.LC_createuser {
6621: }
6622:
6623: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6624: font-size: small;
1.473 raeburn 6625: }
6626:
6627: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6628: background-color: #CCCCCC;
1.473 raeburn 6629: font-weight: bold;
6630: text-align: center;
6631: }
6632:
1.349 albertel 6633: table.LC_calendar {
6634: border: 1px solid #000000;
6635: border-collapse: collapse;
1.917 raeburn 6636: width: 98%;
1.349 albertel 6637: }
1.795 www 6638:
1.349 albertel 6639: table.LC_calendar_pickdate {
6640: font-size: xx-small;
6641: }
1.795 www 6642:
1.349 albertel 6643: table.LC_calendar tr td {
6644: border: 1px solid #000000;
6645: vertical-align: top;
1.917 raeburn 6646: width: 14%;
1.349 albertel 6647: }
1.795 www 6648:
1.349 albertel 6649: table.LC_calendar tr td.LC_calendar_day_empty {
6650: background-color: $data_table_dark;
6651: }
1.795 www 6652:
1.779 bisitz 6653: table.LC_calendar tr td.LC_calendar_day_current {
6654: background-color: $data_table_highlight;
1.777 tempelho 6655: }
1.795 www 6656:
1.938 bisitz 6657: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6658: background-color: $mail_new;
6659: }
1.795 www 6660:
1.938 bisitz 6661: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6662: background-color: $mail_new_hover;
6663: }
1.795 www 6664:
1.938 bisitz 6665: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6666: background-color: $mail_read;
6667: }
1.795 www 6668:
1.938 bisitz 6669: /*
6670: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6671: background-color: $mail_read_hover;
6672: }
1.938 bisitz 6673: */
1.795 www 6674:
1.938 bisitz 6675: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6676: background-color: $mail_replied;
6677: }
1.795 www 6678:
1.938 bisitz 6679: /*
6680: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6681: background-color: $mail_replied_hover;
6682: }
1.938 bisitz 6683: */
1.795 www 6684:
1.938 bisitz 6685: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6686: background-color: $mail_other;
6687: }
1.795 www 6688:
1.938 bisitz 6689: /*
6690: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6691: background-color: $mail_other_hover;
6692: }
1.938 bisitz 6693: */
1.494 raeburn 6694:
1.777 tempelho 6695: table.LC_data_table tr > td.LC_browser_file,
6696: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6697: background: #AAEE77;
1.389 albertel 6698: }
1.795 www 6699:
1.777 tempelho 6700: table.LC_data_table tr > td.LC_browser_file_locked,
6701: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6702: background: #FFAA99;
1.387 albertel 6703: }
1.795 www 6704:
1.777 tempelho 6705: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6706: background: #888888;
1.779 bisitz 6707: }
1.795 www 6708:
1.777 tempelho 6709: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6710: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6711: background: #F8F866;
1.777 tempelho 6712: }
1.795 www 6713:
1.696 bisitz 6714: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6715: background: #E0E8FF;
1.387 albertel 6716: }
1.696 bisitz 6717:
1.707 bisitz 6718: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6719: /* background: #77FF77; */
1.707 bisitz 6720: }
1.795 www 6721:
1.707 bisitz 6722: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6723: border-right: 8px solid #FFFF77;
1.707 bisitz 6724: }
1.795 www 6725:
1.707 bisitz 6726: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6727: border-right: 8px solid #FFAA77;
1.707 bisitz 6728: }
1.795 www 6729:
1.707 bisitz 6730: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6731: border-right: 8px solid #FF7777;
1.707 bisitz 6732: }
1.795 www 6733:
1.707 bisitz 6734: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6735: border-right: 8px solid #AAFF77;
1.707 bisitz 6736: }
1.795 www 6737:
1.707 bisitz 6738: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6739: border-right: 8px solid #11CC55;
1.707 bisitz 6740: }
6741:
1.388 albertel 6742: span.LC_current_location {
1.701 harmsja 6743: font-size:larger;
1.388 albertel 6744: background: $pgbg;
6745: }
1.387 albertel 6746:
1.1029 www 6747: span.LC_current_nav_location {
6748: font-weight:bold;
6749: background: $sidebg;
6750: }
6751:
1.395 albertel 6752: span.LC_parm_menu_item {
6753: font-size: larger;
6754: }
1.795 www 6755:
1.395 albertel 6756: span.LC_parm_scope_all {
6757: color: red;
6758: }
1.795 www 6759:
1.395 albertel 6760: span.LC_parm_scope_folder {
6761: color: green;
6762: }
1.795 www 6763:
1.395 albertel 6764: span.LC_parm_scope_resource {
6765: color: orange;
6766: }
1.795 www 6767:
1.395 albertel 6768: span.LC_parm_part {
6769: color: blue;
6770: }
1.795 www 6771:
1.911 bisitz 6772: span.LC_parm_folder,
6773: span.LC_parm_symb {
1.395 albertel 6774: font-size: x-small;
6775: font-family: $mono;
6776: color: #AAAAAA;
6777: }
6778:
1.977 bisitz 6779: ul.LC_parm_parmlist li {
6780: display: inline-block;
6781: padding: 0.3em 0.8em;
6782: vertical-align: top;
6783: width: 150px;
6784: border-top:1px solid $lg_border_color;
6785: }
6786:
1.795 www 6787: td.LC_parm_overview_level_menu,
6788: td.LC_parm_overview_map_menu,
6789: td.LC_parm_overview_parm_selectors,
6790: td.LC_parm_overview_restrictions {
1.396 albertel 6791: border: 1px solid black;
6792: border-collapse: collapse;
6793: }
1.795 www 6794:
1.1285 raeburn 6795: span.LC_parm_recursive,
6796: td.LC_parm_recursive {
6797: font-weight: bold;
6798: font-size: smaller;
6799: }
6800:
1.396 albertel 6801: table.LC_parm_overview_restrictions td {
6802: border-width: 1px 4px 1px 4px;
6803: border-style: solid;
6804: border-color: $pgbg;
6805: text-align: center;
6806: }
1.795 www 6807:
1.396 albertel 6808: table.LC_parm_overview_restrictions th {
6809: background: $tabbg;
6810: border-width: 1px 4px 1px 4px;
6811: border-style: solid;
6812: border-color: $pgbg;
6813: }
1.795 www 6814:
1.398 albertel 6815: table#LC_helpmenu {
1.803 bisitz 6816: border: none;
1.398 albertel 6817: height: 55px;
1.803 bisitz 6818: border-spacing: 0;
1.398 albertel 6819: }
6820:
6821: table#LC_helpmenu fieldset legend {
6822: font-size: larger;
6823: }
1.795 www 6824:
1.397 albertel 6825: table#LC_helpmenu_links {
6826: width: 100%;
6827: border: 1px solid black;
6828: background: $pgbg;
1.803 bisitz 6829: padding: 0;
1.397 albertel 6830: border-spacing: 1px;
6831: }
1.795 www 6832:
1.397 albertel 6833: table#LC_helpmenu_links tr td {
6834: padding: 1px;
6835: background: $tabbg;
1.399 albertel 6836: text-align: center;
6837: font-weight: bold;
1.397 albertel 6838: }
1.396 albertel 6839:
1.795 www 6840: table#LC_helpmenu_links a:link,
6841: table#LC_helpmenu_links a:visited,
1.397 albertel 6842: table#LC_helpmenu_links a:active {
6843: text-decoration: none;
6844: color: $font;
6845: }
1.795 www 6846:
1.397 albertel 6847: table#LC_helpmenu_links a:hover {
6848: text-decoration: underline;
6849: color: $vlink;
6850: }
1.396 albertel 6851:
1.417 albertel 6852: .LC_chrt_popup_exists {
6853: border: 1px solid #339933;
6854: margin: -1px;
6855: }
1.795 www 6856:
1.417 albertel 6857: .LC_chrt_popup_up {
6858: border: 1px solid yellow;
6859: margin: -1px;
6860: }
1.795 www 6861:
1.417 albertel 6862: .LC_chrt_popup {
6863: border: 1px solid #8888FF;
6864: background: #CCCCFF;
6865: }
1.795 www 6866:
1.421 albertel 6867: table.LC_pick_box {
6868: border-collapse: separate;
6869: background: white;
6870: border: 1px solid black;
6871: border-spacing: 1px;
6872: }
1.795 www 6873:
1.421 albertel 6874: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6875: background: $sidebg;
1.421 albertel 6876: font-weight: bold;
1.900 bisitz 6877: text-align: left;
1.740 bisitz 6878: vertical-align: top;
1.421 albertel 6879: width: 184px;
6880: padding: 8px;
6881: }
1.795 www 6882:
1.579 raeburn 6883: table.LC_pick_box td.LC_pick_box_value {
6884: text-align: left;
6885: padding: 8px;
6886: }
1.795 www 6887:
1.579 raeburn 6888: table.LC_pick_box td.LC_pick_box_select {
6889: text-align: left;
6890: padding: 8px;
6891: }
1.795 www 6892:
1.424 albertel 6893: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6894: padding: 0;
1.421 albertel 6895: height: 1px;
6896: background: black;
6897: }
1.795 www 6898:
1.421 albertel 6899: table.LC_pick_box td.LC_pick_box_submit {
6900: text-align: right;
6901: }
1.795 www 6902:
1.579 raeburn 6903: table.LC_pick_box td.LC_evenrow_value {
6904: text-align: left;
6905: padding: 8px;
6906: background-color: $data_table_light;
6907: }
1.795 www 6908:
1.579 raeburn 6909: table.LC_pick_box td.LC_oddrow_value {
6910: text-align: left;
6911: padding: 8px;
6912: background-color: $data_table_light;
6913: }
1.795 www 6914:
1.579 raeburn 6915: span.LC_helpform_receipt_cat {
6916: font-weight: bold;
6917: }
1.795 www 6918:
1.424 albertel 6919: table.LC_group_priv_box {
6920: background: white;
6921: border: 1px solid black;
6922: border-spacing: 1px;
6923: }
1.795 www 6924:
1.424 albertel 6925: table.LC_group_priv_box td.LC_pick_box_title {
6926: background: $tabbg;
6927: font-weight: bold;
6928: text-align: right;
6929: width: 184px;
6930: }
1.795 www 6931:
1.424 albertel 6932: table.LC_group_priv_box td.LC_groups_fixed {
6933: background: $data_table_light;
6934: text-align: center;
6935: }
1.795 www 6936:
1.424 albertel 6937: table.LC_group_priv_box td.LC_groups_optional {
6938: background: $data_table_dark;
6939: text-align: center;
6940: }
1.795 www 6941:
1.424 albertel 6942: table.LC_group_priv_box td.LC_groups_functionality {
6943: background: $data_table_darker;
6944: text-align: center;
6945: font-weight: bold;
6946: }
1.795 www 6947:
1.424 albertel 6948: table.LC_group_priv td {
6949: text-align: left;
1.803 bisitz 6950: padding: 0;
1.424 albertel 6951: }
6952:
6953: .LC_navbuttons {
6954: margin: 2ex 0ex 2ex 0ex;
6955: }
1.795 www 6956:
1.423 albertel 6957: .LC_topic_bar {
6958: font-weight: bold;
6959: background: $tabbg;
1.918 wenzelju 6960: margin: 1em 0em 1em 2em;
1.805 bisitz 6961: padding: 3px;
1.918 wenzelju 6962: font-size: 1.2em;
1.423 albertel 6963: }
1.795 www 6964:
1.423 albertel 6965: .LC_topic_bar span {
1.918 wenzelju 6966: left: 0.5em;
6967: position: absolute;
1.423 albertel 6968: vertical-align: middle;
1.918 wenzelju 6969: font-size: 1.2em;
1.423 albertel 6970: }
1.795 www 6971:
1.423 albertel 6972: table.LC_course_group_status {
6973: margin: 20px;
6974: }
1.795 www 6975:
1.423 albertel 6976: table.LC_status_selector td {
6977: vertical-align: top;
6978: text-align: center;
1.424 albertel 6979: padding: 4px;
6980: }
1.795 www 6981:
1.599 albertel 6982: div.LC_feedback_link {
1.616 albertel 6983: clear: both;
1.829 kalberla 6984: background: $sidebg;
1.779 bisitz 6985: width: 100%;
1.829 kalberla 6986: padding-bottom: 10px;
6987: border: 1px $tabbg solid;
1.833 kalberla 6988: height: 22px;
6989: line-height: 22px;
6990: padding-top: 5px;
6991: }
6992:
6993: div.LC_feedback_link img {
6994: height: 22px;
1.867 kalberla 6995: vertical-align:middle;
1.829 kalberla 6996: }
6997:
1.911 bisitz 6998: div.LC_feedback_link a {
1.829 kalberla 6999: text-decoration: none;
1.489 raeburn 7000: }
1.795 www 7001:
1.867 kalberla 7002: div.LC_comblock {
1.911 bisitz 7003: display:inline;
1.867 kalberla 7004: color:$font;
7005: font-size:90%;
7006: }
7007:
7008: div.LC_feedback_link div.LC_comblock {
7009: padding-left:5px;
7010: }
7011:
7012: div.LC_feedback_link div.LC_comblock a {
7013: color:$font;
7014: }
7015:
1.489 raeburn 7016: span.LC_feedback_link {
1.858 bisitz 7017: /* background: $feedback_link_bg; */
1.599 albertel 7018: font-size: larger;
7019: }
1.795 www 7020:
1.599 albertel 7021: span.LC_message_link {
1.858 bisitz 7022: /* background: $feedback_link_bg; */
1.599 albertel 7023: font-size: larger;
7024: position: absolute;
7025: right: 1em;
1.489 raeburn 7026: }
1.421 albertel 7027:
1.515 albertel 7028: table.LC_prior_tries {
1.524 albertel 7029: border: 1px solid #000000;
7030: border-collapse: separate;
7031: border-spacing: 1px;
1.515 albertel 7032: }
1.523 albertel 7033:
1.515 albertel 7034: table.LC_prior_tries td {
1.524 albertel 7035: padding: 2px;
1.515 albertel 7036: }
1.523 albertel 7037:
7038: .LC_answer_correct {
1.795 www 7039: background: lightgreen;
7040: color: darkgreen;
7041: padding: 6px;
1.523 albertel 7042: }
1.795 www 7043:
1.523 albertel 7044: .LC_answer_charged_try {
1.797 www 7045: background: #FFAAAA;
1.795 www 7046: color: darkred;
7047: padding: 6px;
1.523 albertel 7048: }
1.795 www 7049:
1.779 bisitz 7050: .LC_answer_not_charged_try,
1.523 albertel 7051: .LC_answer_no_grade,
7052: .LC_answer_late {
1.795 www 7053: background: lightyellow;
1.523 albertel 7054: color: black;
1.795 www 7055: padding: 6px;
1.523 albertel 7056: }
1.795 www 7057:
1.523 albertel 7058: .LC_answer_previous {
1.795 www 7059: background: lightblue;
7060: color: darkblue;
7061: padding: 6px;
1.523 albertel 7062: }
1.795 www 7063:
1.779 bisitz 7064: .LC_answer_no_message {
1.777 tempelho 7065: background: #FFFFFF;
7066: color: black;
1.795 www 7067: padding: 6px;
1.779 bisitz 7068: }
1.795 www 7069:
1.779 bisitz 7070: .LC_answer_unknown {
7071: background: orange;
7072: color: black;
1.795 www 7073: padding: 6px;
1.777 tempelho 7074: }
1.795 www 7075:
1.529 albertel 7076: span.LC_prior_numerical,
7077: span.LC_prior_string,
7078: span.LC_prior_custom,
7079: span.LC_prior_reaction,
7080: span.LC_prior_math {
1.925 bisitz 7081: font-family: $mono;
1.523 albertel 7082: white-space: pre;
7083: }
7084:
1.525 albertel 7085: span.LC_prior_string {
1.925 bisitz 7086: font-family: $mono;
1.525 albertel 7087: white-space: pre;
7088: }
7089:
1.523 albertel 7090: table.LC_prior_option {
7091: width: 100%;
7092: border-collapse: collapse;
7093: }
1.795 www 7094:
1.911 bisitz 7095: table.LC_prior_rank,
1.795 www 7096: table.LC_prior_match {
1.528 albertel 7097: border-collapse: collapse;
7098: }
1.795 www 7099:
1.528 albertel 7100: table.LC_prior_option tr td,
7101: table.LC_prior_rank tr td,
7102: table.LC_prior_match tr td {
1.524 albertel 7103: border: 1px solid #000000;
1.515 albertel 7104: }
7105:
1.855 bisitz 7106: .LC_nobreak {
1.544 albertel 7107: white-space: nowrap;
1.519 raeburn 7108: }
7109:
1.576 raeburn 7110: span.LC_cusr_emph {
7111: font-style: italic;
7112: }
7113:
1.633 raeburn 7114: span.LC_cusr_subheading {
7115: font-weight: normal;
7116: font-size: 85%;
7117: }
7118:
1.861 bisitz 7119: div.LC_docs_entry_move {
1.859 bisitz 7120: border: 1px solid #BBBBBB;
1.545 albertel 7121: background: #DDDDDD;
1.861 bisitz 7122: width: 22px;
1.859 bisitz 7123: padding: 1px;
7124: margin: 0;
1.545 albertel 7125: }
7126:
1.861 bisitz 7127: table.LC_data_table tr > td.LC_docs_entry_commands,
7128: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7129: font-size: x-small;
7130: }
1.795 www 7131:
1.861 bisitz 7132: .LC_docs_entry_parameter {
7133: white-space: nowrap;
7134: }
7135:
1.544 albertel 7136: .LC_docs_copy {
1.545 albertel 7137: color: #000099;
1.544 albertel 7138: }
1.795 www 7139:
1.544 albertel 7140: .LC_docs_cut {
1.545 albertel 7141: color: #550044;
1.544 albertel 7142: }
1.795 www 7143:
1.544 albertel 7144: .LC_docs_rename {
1.545 albertel 7145: color: #009900;
1.544 albertel 7146: }
1.795 www 7147:
1.544 albertel 7148: .LC_docs_remove {
1.545 albertel 7149: color: #990000;
7150: }
7151:
1.1284 raeburn 7152: .LC_docs_alias {
7153: color: #440055;
7154: }
7155:
1.1286 raeburn 7156: .LC_domprefs_email,
1.1284 raeburn 7157: .LC_docs_alias_name,
1.547 albertel 7158: .LC_docs_reinit_warn,
7159: .LC_docs_ext_edit {
7160: font-size: x-small;
7161: }
7162:
1.545 albertel 7163: table.LC_docs_adddocs td,
7164: table.LC_docs_adddocs th {
7165: border: 1px solid #BBBBBB;
7166: padding: 4px;
7167: background: #DDDDDD;
1.543 albertel 7168: }
7169:
1.584 albertel 7170: table.LC_sty_begin {
7171: background: #BBFFBB;
7172: }
1.795 www 7173:
1.584 albertel 7174: table.LC_sty_end {
7175: background: #FFBBBB;
7176: }
7177:
1.589 raeburn 7178: table.LC_double_column {
1.803 bisitz 7179: border-width: 0;
1.589 raeburn 7180: border-collapse: collapse;
7181: width: 100%;
7182: padding: 2px;
7183: }
7184:
7185: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7186: top: 2px;
1.589 raeburn 7187: left: 2px;
7188: width: 47%;
7189: vertical-align: top;
7190: }
7191:
7192: table.LC_double_column tr td.LC_right_col {
7193: top: 2px;
1.779 bisitz 7194: right: 2px;
1.589 raeburn 7195: width: 47%;
7196: vertical-align: top;
7197: }
7198:
1.591 raeburn 7199: div.LC_left_float {
7200: float: left;
7201: padding-right: 5%;
1.597 albertel 7202: padding-bottom: 4px;
1.591 raeburn 7203: }
7204:
7205: div.LC_clear_float_header {
1.597 albertel 7206: padding-bottom: 2px;
1.591 raeburn 7207: }
7208:
7209: div.LC_clear_float_footer {
1.597 albertel 7210: padding-top: 10px;
1.591 raeburn 7211: clear: both;
7212: }
7213:
1.597 albertel 7214: div.LC_grade_show_user {
1.941 bisitz 7215: /* border-left: 5px solid $sidebg; */
7216: border-top: 5px solid #000000;
7217: margin: 50px 0 0 0;
1.936 bisitz 7218: padding: 15px 0 5px 10px;
1.597 albertel 7219: }
1.795 www 7220:
1.936 bisitz 7221: div.LC_grade_show_user_odd_row {
1.941 bisitz 7222: /* border-left: 5px solid #000000; */
7223: }
7224:
7225: div.LC_grade_show_user div.LC_Box {
7226: margin-right: 50px;
1.597 albertel 7227: }
7228:
7229: div.LC_grade_submissions,
7230: div.LC_grade_message_center,
1.936 bisitz 7231: div.LC_grade_info_links {
1.597 albertel 7232: margin: 5px;
7233: width: 99%;
7234: background: #FFFFFF;
7235: }
1.795 www 7236:
1.597 albertel 7237: div.LC_grade_submissions_header,
1.936 bisitz 7238: div.LC_grade_message_center_header {
1.705 tempelho 7239: font-weight: bold;
7240: font-size: large;
1.597 albertel 7241: }
1.795 www 7242:
1.597 albertel 7243: div.LC_grade_submissions_body,
1.936 bisitz 7244: div.LC_grade_message_center_body {
1.597 albertel 7245: border: 1px solid black;
7246: width: 99%;
7247: background: #FFFFFF;
7248: }
1.795 www 7249:
1.613 albertel 7250: table.LC_scantron_action {
7251: width: 100%;
7252: }
1.795 www 7253:
1.613 albertel 7254: table.LC_scantron_action tr th {
1.698 harmsja 7255: font-weight:bold;
7256: font-style:normal;
1.613 albertel 7257: }
1.795 www 7258:
1.779 bisitz 7259: .LC_edit_problem_header,
1.614 albertel 7260: div.LC_edit_problem_footer {
1.705 tempelho 7261: font-weight: normal;
7262: font-size: medium;
1.602 albertel 7263: margin: 2px;
1.1060 bisitz 7264: background-color: $sidebg;
1.600 albertel 7265: }
1.795 www 7266:
1.600 albertel 7267: div.LC_edit_problem_header,
1.602 albertel 7268: div.LC_edit_problem_header div,
1.614 albertel 7269: div.LC_edit_problem_footer,
7270: div.LC_edit_problem_footer div,
1.602 albertel 7271: div.LC_edit_problem_editxml_header,
7272: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7273: z-index: 100;
1.600 albertel 7274: }
1.795 www 7275:
1.600 albertel 7276: div.LC_edit_problem_header_title {
1.705 tempelho 7277: font-weight: bold;
7278: font-size: larger;
1.602 albertel 7279: background: $tabbg;
7280: padding: 3px;
1.1060 bisitz 7281: margin: 0 0 5px 0;
1.602 albertel 7282: }
1.795 www 7283:
1.602 albertel 7284: table.LC_edit_problem_header_title {
7285: width: 100%;
1.600 albertel 7286: background: $tabbg;
1.602 albertel 7287: }
7288:
1.1205 golterma 7289: div.LC_edit_actionbar {
7290: background-color: $sidebg;
1.1218 droeschl 7291: margin: 0;
7292: padding: 0;
7293: line-height: 200%;
1.602 albertel 7294: }
1.795 www 7295:
1.1218 droeschl 7296: div.LC_edit_actionbar div{
7297: padding: 0;
7298: margin: 0;
7299: display: inline-block;
1.600 albertel 7300: }
1.795 www 7301:
1.1124 bisitz 7302: .LC_edit_opt {
7303: padding-left: 1em;
7304: white-space: nowrap;
7305: }
7306:
1.1152 golterma 7307: .LC_edit_problem_latexhelper{
7308: text-align: right;
7309: }
7310:
7311: #LC_edit_problem_colorful div{
7312: margin-left: 40px;
7313: }
7314:
1.1205 golterma 7315: #LC_edit_problem_codemirror div{
7316: margin-left: 0px;
7317: }
7318:
1.911 bisitz 7319: img.stift {
1.803 bisitz 7320: border-width: 0;
7321: vertical-align: middle;
1.677 riegler 7322: }
1.680 riegler 7323:
1.923 bisitz 7324: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7325: vertical-align: top;
1.777 tempelho 7326: }
1.795 www 7327:
1.716 raeburn 7328: div.LC_createcourse {
1.911 bisitz 7329: margin: 10px 10px 10px 10px;
1.716 raeburn 7330: }
7331:
1.917 raeburn 7332: .LC_dccid {
1.1130 raeburn 7333: float: right;
1.917 raeburn 7334: margin: 0.2em 0 0 0;
7335: padding: 0;
7336: font-size: 90%;
7337: display:none;
7338: }
7339:
1.897 wenzelju 7340: ol.LC_primary_menu a:hover,
1.721 harmsja 7341: ol#LC_MenuBreadcrumbs a:hover,
7342: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7343: ul#LC_secondary_menu a:hover,
1.721 harmsja 7344: .LC_FormSectionClearButton input:hover
1.795 www 7345: ul.LC_TabContent li:hover a {
1.952 onken 7346: color:$button_hover;
1.911 bisitz 7347: text-decoration:none;
1.693 droeschl 7348: }
7349:
1.779 bisitz 7350: h1 {
1.911 bisitz 7351: padding: 0;
7352: line-height:130%;
1.693 droeschl 7353: }
1.698 harmsja 7354:
1.911 bisitz 7355: h2,
7356: h3,
7357: h4,
7358: h5,
7359: h6 {
7360: margin: 5px 0 5px 0;
7361: padding: 0;
7362: line-height:130%;
1.693 droeschl 7363: }
1.795 www 7364:
7365: .LC_hcell {
1.911 bisitz 7366: padding:3px 15px 3px 15px;
7367: margin: 0;
7368: background-color:$tabbg;
7369: color:$fontmenu;
7370: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7371: }
1.795 www 7372:
1.840 bisitz 7373: .LC_Box > .LC_hcell {
1.911 bisitz 7374: margin: 0 -10px 10px -10px;
1.835 bisitz 7375: }
7376:
1.721 harmsja 7377: .LC_noBorder {
1.911 bisitz 7378: border: 0;
1.698 harmsja 7379: }
1.693 droeschl 7380:
1.721 harmsja 7381: .LC_FormSectionClearButton input {
1.911 bisitz 7382: background-color:transparent;
7383: border: none;
7384: cursor:pointer;
7385: text-decoration:underline;
1.693 droeschl 7386: }
1.763 bisitz 7387:
7388: .LC_help_open_topic {
1.911 bisitz 7389: color: #FFFFFF;
7390: background-color: #EEEEFF;
7391: margin: 1px;
7392: padding: 4px;
7393: border: 1px solid #000033;
7394: white-space: nowrap;
7395: /* vertical-align: middle; */
1.759 neumanie 7396: }
1.693 droeschl 7397:
1.911 bisitz 7398: dl,
7399: ul,
7400: div,
7401: fieldset {
7402: margin: 10px 10px 10px 0;
7403: /* overflow: hidden; */
1.693 droeschl 7404: }
1.795 www 7405:
1.1211 raeburn 7406: article.geogebraweb div {
7407: margin: 0;
7408: }
7409:
1.838 bisitz 7410: fieldset > legend {
1.911 bisitz 7411: font-weight: bold;
7412: padding: 0 5px 0 5px;
1.838 bisitz 7413: }
7414:
1.813 bisitz 7415: #LC_nav_bar {
1.911 bisitz 7416: float: left;
1.995 raeburn 7417: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7418: margin: 0 0 2px 0;
1.807 droeschl 7419: }
7420:
1.916 droeschl 7421: #LC_realm {
7422: margin: 0.2em 0 0 0;
7423: padding: 0;
7424: font-weight: bold;
7425: text-align: center;
1.995 raeburn 7426: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7427: }
7428:
1.911 bisitz 7429: #LC_nav_bar em {
7430: font-weight: bold;
7431: font-style: normal;
1.807 droeschl 7432: }
7433:
1.897 wenzelju 7434: ol.LC_primary_menu {
1.934 droeschl 7435: margin: 0;
1.1076 raeburn 7436: padding: 0;
1.807 droeschl 7437: }
7438:
1.852 droeschl 7439: ol#LC_PathBreadcrumbs {
1.911 bisitz 7440: margin: 0;
1.693 droeschl 7441: }
7442:
1.897 wenzelju 7443: ol.LC_primary_menu li {
1.1076 raeburn 7444: color: RGB(80, 80, 80);
7445: vertical-align: middle;
7446: text-align: left;
7447: list-style: none;
1.1205 golterma 7448: position: relative;
1.1076 raeburn 7449: float: left;
1.1205 golterma 7450: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7451: line-height: 1.5em;
1.1076 raeburn 7452: }
7453:
1.1205 golterma 7454: ol.LC_primary_menu li a,
7455: ol.LC_primary_menu li p {
1.1076 raeburn 7456: display: block;
7457: margin: 0;
7458: padding: 0 5px 0 10px;
7459: text-decoration: none;
7460: }
7461:
1.1205 golterma 7462: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7463: display: inline-block;
7464: width: 95%;
7465: text-align: left;
7466: }
7467:
7468: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7469: display: inline-block;
7470: width: 5%;
7471: float: right;
7472: text-align: right;
7473: font-size: 70%;
7474: }
7475:
7476: ol.LC_primary_menu ul {
1.1076 raeburn 7477: display: none;
1.1205 golterma 7478: width: 15em;
1.1076 raeburn 7479: background-color: $data_table_light;
1.1205 golterma 7480: position: absolute;
7481: top: 100%;
1.1076 raeburn 7482: }
7483:
1.1205 golterma 7484: ol.LC_primary_menu ul ul {
7485: left: 100%;
7486: top: 0;
7487: }
7488:
7489: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7490: display: block;
7491: position: absolute;
7492: margin: 0;
7493: padding: 0;
1.1078 raeburn 7494: z-index: 2;
1.1076 raeburn 7495: }
7496:
7497: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7498: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7499: font-size: 90%;
1.911 bisitz 7500: vertical-align: top;
1.1076 raeburn 7501: float: none;
1.1079 raeburn 7502: border-left: 1px solid black;
7503: border-right: 1px solid black;
1.1205 golterma 7504: /* A dark bottom border to visualize different menu options;
7505: overwritten in the create_submenu routine for the last border-bottom of the menu */
7506: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7507: }
7508:
1.1205 golterma 7509: ol.LC_primary_menu li li p:hover {
7510: color:$button_hover;
7511: text-decoration:none;
7512: background-color:$data_table_dark;
1.1076 raeburn 7513: }
7514:
7515: ol.LC_primary_menu li li a:hover {
7516: color:$button_hover;
7517: background-color:$data_table_dark;
1.693 droeschl 7518: }
7519:
1.1205 golterma 7520: /* Font-size equal to the size of the predecessors*/
7521: ol.LC_primary_menu li:hover li li {
7522: font-size: 100%;
7523: }
7524:
1.897 wenzelju 7525: ol.LC_primary_menu li img {
1.911 bisitz 7526: vertical-align: bottom;
1.934 droeschl 7527: height: 1.1em;
1.1077 raeburn 7528: margin: 0.2em 0 0 0;
1.693 droeschl 7529: }
7530:
1.897 wenzelju 7531: ol.LC_primary_menu a {
1.911 bisitz 7532: color: RGB(80, 80, 80);
7533: text-decoration: none;
1.693 droeschl 7534: }
1.795 www 7535:
1.949 droeschl 7536: ol.LC_primary_menu a.LC_new_message {
7537: font-weight:bold;
7538: color: darkred;
7539: }
7540:
1.975 raeburn 7541: ol.LC_docs_parameters {
7542: margin-left: 0;
7543: padding: 0;
7544: list-style: none;
7545: }
7546:
7547: ol.LC_docs_parameters li {
7548: margin: 0;
7549: padding-right: 20px;
7550: display: inline;
7551: }
7552:
1.976 raeburn 7553: ol.LC_docs_parameters li:before {
7554: content: "\\002022 \\0020";
7555: }
7556:
7557: li.LC_docs_parameters_title {
7558: font-weight: bold;
7559: }
7560:
7561: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7562: content: "";
7563: }
7564:
1.897 wenzelju 7565: ul#LC_secondary_menu {
1.1107 raeburn 7566: clear: right;
1.911 bisitz 7567: color: $fontmenu;
7568: background: $tabbg;
7569: list-style: none;
7570: padding: 0;
7571: margin: 0;
7572: width: 100%;
1.995 raeburn 7573: text-align: left;
1.1107 raeburn 7574: float: left;
1.808 droeschl 7575: }
7576:
1.897 wenzelju 7577: ul#LC_secondary_menu li {
1.911 bisitz 7578: font-weight: bold;
7579: line-height: 1.8em;
1.1107 raeburn 7580: border-right: 1px solid black;
7581: float: left;
7582: }
7583:
7584: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7585: background-color: $data_table_light;
7586: }
7587:
7588: ul#LC_secondary_menu li a {
1.911 bisitz 7589: padding: 0 0.8em;
1.1107 raeburn 7590: }
7591:
7592: ul#LC_secondary_menu li ul {
7593: display: none;
7594: }
7595:
7596: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7597: display: block;
7598: position: absolute;
7599: margin: 0;
7600: padding: 0;
7601: list-style:none;
7602: float: none;
7603: background-color: $data_table_light;
7604: z-index: 2;
7605: margin-left: -1px;
7606: }
7607:
7608: ul#LC_secondary_menu li ul li {
7609: font-size: 90%;
7610: vertical-align: top;
7611: border-left: 1px solid black;
1.911 bisitz 7612: border-right: 1px solid black;
1.1119 raeburn 7613: background-color: $data_table_light;
1.1107 raeburn 7614: list-style:none;
7615: float: none;
7616: }
7617:
7618: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7619: background-color: $data_table_dark;
1.807 droeschl 7620: }
7621:
1.847 tempelho 7622: ul.LC_TabContent {
1.911 bisitz 7623: display:block;
7624: background: $sidebg;
7625: border-bottom: solid 1px $lg_border_color;
7626: list-style:none;
1.1020 raeburn 7627: margin: -1px -10px 0 -10px;
1.911 bisitz 7628: padding: 0;
1.693 droeschl 7629: }
7630:
1.795 www 7631: ul.LC_TabContent li,
7632: ul.LC_TabContentBigger li {
1.911 bisitz 7633: float:left;
1.741 harmsja 7634: }
1.795 www 7635:
1.897 wenzelju 7636: ul#LC_secondary_menu li a {
1.911 bisitz 7637: color: $fontmenu;
7638: text-decoration: none;
1.693 droeschl 7639: }
1.795 www 7640:
1.721 harmsja 7641: ul.LC_TabContent {
1.952 onken 7642: min-height:20px;
1.721 harmsja 7643: }
1.795 www 7644:
7645: ul.LC_TabContent li {
1.911 bisitz 7646: vertical-align:middle;
1.959 onken 7647: padding: 0 16px 0 10px;
1.911 bisitz 7648: background-color:$tabbg;
7649: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7650: border-left: solid 1px $font;
1.721 harmsja 7651: }
1.795 www 7652:
1.847 tempelho 7653: ul.LC_TabContent .right {
1.911 bisitz 7654: float:right;
1.847 tempelho 7655: }
7656:
1.911 bisitz 7657: ul.LC_TabContent li a,
7658: ul.LC_TabContent li {
7659: color:rgb(47,47,47);
7660: text-decoration:none;
7661: font-size:95%;
7662: font-weight:bold;
1.952 onken 7663: min-height:20px;
7664: }
7665:
1.959 onken 7666: ul.LC_TabContent li a:hover,
7667: ul.LC_TabContent li a:focus {
1.952 onken 7668: color: $button_hover;
1.959 onken 7669: background:none;
7670: outline:none;
1.952 onken 7671: }
7672:
7673: ul.LC_TabContent li:hover {
7674: color: $button_hover;
7675: cursor:pointer;
1.721 harmsja 7676: }
1.795 www 7677:
1.911 bisitz 7678: ul.LC_TabContent li.active {
1.952 onken 7679: color: $font;
1.911 bisitz 7680: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7681: border-bottom:solid 1px #FFFFFF;
7682: cursor: default;
1.744 ehlerst 7683: }
1.795 www 7684:
1.959 onken 7685: ul.LC_TabContent li.active a {
7686: color:$font;
7687: background:#FFFFFF;
7688: outline: none;
7689: }
1.1047 raeburn 7690:
7691: ul.LC_TabContent li.goback {
7692: float: left;
7693: border-left: none;
7694: }
7695:
1.870 tempelho 7696: #maincoursedoc {
1.911 bisitz 7697: clear:both;
1.870 tempelho 7698: }
7699:
7700: ul.LC_TabContentBigger {
1.911 bisitz 7701: display:block;
7702: list-style:none;
7703: padding: 0;
1.870 tempelho 7704: }
7705:
1.795 www 7706: ul.LC_TabContentBigger li {
1.911 bisitz 7707: vertical-align:bottom;
7708: height: 30px;
7709: font-size:110%;
7710: font-weight:bold;
7711: color: #737373;
1.841 tempelho 7712: }
7713:
1.957 onken 7714: ul.LC_TabContentBigger li.active {
7715: position: relative;
7716: top: 1px;
7717: }
7718:
1.870 tempelho 7719: ul.LC_TabContentBigger li a {
1.911 bisitz 7720: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7721: height: 30px;
7722: line-height: 30px;
7723: text-align: center;
7724: display: block;
7725: text-decoration: none;
1.958 onken 7726: outline: none;
1.741 harmsja 7727: }
1.795 www 7728:
1.870 tempelho 7729: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7730: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7731: color:$font;
1.744 ehlerst 7732: }
1.795 www 7733:
1.870 tempelho 7734: ul.LC_TabContentBigger li b {
1.911 bisitz 7735: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7736: display: block;
7737: float: left;
7738: padding: 0 30px;
1.957 onken 7739: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7740: }
7741:
1.956 onken 7742: ul.LC_TabContentBigger li:hover b {
7743: color:$button_hover;
7744: }
7745:
1.870 tempelho 7746: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7747: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7748: color:$font;
1.957 onken 7749: border: 0;
1.741 harmsja 7750: }
1.693 droeschl 7751:
1.870 tempelho 7752:
1.862 bisitz 7753: ul.LC_CourseBreadcrumbs {
7754: background: $sidebg;
1.1020 raeburn 7755: height: 2em;
1.862 bisitz 7756: padding-left: 10px;
1.1020 raeburn 7757: margin: 0;
1.862 bisitz 7758: list-style-position: inside;
7759: }
7760:
1.911 bisitz 7761: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7762: ol#LC_PathBreadcrumbs {
1.911 bisitz 7763: padding-left: 10px;
7764: margin: 0;
1.933 droeschl 7765: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7766: }
7767:
1.911 bisitz 7768: ol#LC_MenuBreadcrumbs li,
7769: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7770: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7771: display: inline;
1.933 droeschl 7772: white-space: normal;
1.693 droeschl 7773: }
7774:
1.823 bisitz 7775: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7776: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7777: text-decoration: none;
7778: font-size:90%;
1.693 droeschl 7779: }
1.795 www 7780:
1.969 droeschl 7781: ol#LC_MenuBreadcrumbs h1 {
7782: display: inline;
7783: font-size: 90%;
7784: line-height: 2.5em;
7785: margin: 0;
7786: padding: 0;
7787: }
7788:
1.795 www 7789: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7790: text-decoration:none;
7791: font-size:100%;
7792: font-weight:bold;
1.693 droeschl 7793: }
1.795 www 7794:
1.840 bisitz 7795: .LC_Box {
1.911 bisitz 7796: border: solid 1px $lg_border_color;
7797: padding: 0 10px 10px 10px;
1.746 neumanie 7798: }
1.795 www 7799:
1.1020 raeburn 7800: .LC_DocsBox {
7801: border: solid 1px $lg_border_color;
7802: padding: 0 0 10px 10px;
7803: }
7804:
1.795 www 7805: .LC_AboutMe_Image {
1.911 bisitz 7806: float:left;
7807: margin-right:10px;
1.747 neumanie 7808: }
1.795 www 7809:
7810: .LC_Clear_AboutMe_Image {
1.911 bisitz 7811: clear:left;
1.747 neumanie 7812: }
1.795 www 7813:
1.721 harmsja 7814: dl.LC_ListStyleClean dt {
1.911 bisitz 7815: padding-right: 5px;
7816: display: table-header-group;
1.693 droeschl 7817: }
7818:
1.721 harmsja 7819: dl.LC_ListStyleClean dd {
1.911 bisitz 7820: display: table-row;
1.693 droeschl 7821: }
7822:
1.721 harmsja 7823: .LC_ListStyleClean,
7824: .LC_ListStyleSimple,
7825: .LC_ListStyleNormal,
1.795 www 7826: .LC_ListStyleSpecial {
1.911 bisitz 7827: /* display:block; */
7828: list-style-position: inside;
7829: list-style-type: none;
7830: overflow: hidden;
7831: padding: 0;
1.693 droeschl 7832: }
7833:
1.721 harmsja 7834: .LC_ListStyleSimple li,
7835: .LC_ListStyleSimple dd,
7836: .LC_ListStyleNormal li,
7837: .LC_ListStyleNormal dd,
7838: .LC_ListStyleSpecial li,
1.795 www 7839: .LC_ListStyleSpecial dd {
1.911 bisitz 7840: margin: 0;
7841: padding: 5px 5px 5px 10px;
7842: clear: both;
1.693 droeschl 7843: }
7844:
1.721 harmsja 7845: .LC_ListStyleClean li,
7846: .LC_ListStyleClean dd {
1.911 bisitz 7847: padding-top: 0;
7848: padding-bottom: 0;
1.693 droeschl 7849: }
7850:
1.721 harmsja 7851: .LC_ListStyleSimple dd,
1.795 www 7852: .LC_ListStyleSimple li {
1.911 bisitz 7853: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7854: }
7855:
1.721 harmsja 7856: .LC_ListStyleSpecial li,
7857: .LC_ListStyleSpecial dd {
1.911 bisitz 7858: list-style-type: none;
7859: background-color: RGB(220, 220, 220);
7860: margin-bottom: 4px;
1.693 droeschl 7861: }
7862:
1.721 harmsja 7863: table.LC_SimpleTable {
1.911 bisitz 7864: margin:5px;
7865: border:solid 1px $lg_border_color;
1.795 www 7866: }
1.693 droeschl 7867:
1.721 harmsja 7868: table.LC_SimpleTable tr {
1.911 bisitz 7869: padding: 0;
7870: border:solid 1px $lg_border_color;
1.693 droeschl 7871: }
1.795 www 7872:
7873: table.LC_SimpleTable thead {
1.911 bisitz 7874: background:rgb(220,220,220);
1.693 droeschl 7875: }
7876:
1.721 harmsja 7877: div.LC_columnSection {
1.911 bisitz 7878: display: block;
7879: clear: both;
7880: overflow: hidden;
7881: margin: 0;
1.693 droeschl 7882: }
7883:
1.721 harmsja 7884: div.LC_columnSection>* {
1.911 bisitz 7885: float: left;
7886: margin: 10px 20px 10px 0;
7887: overflow:hidden;
1.693 droeschl 7888: }
1.721 harmsja 7889:
1.795 www 7890: table em {
1.911 bisitz 7891: font-weight: bold;
7892: font-style: normal;
1.748 schulted 7893: }
1.795 www 7894:
1.779 bisitz 7895: table.LC_tableBrowseRes,
1.795 www 7896: table.LC_tableOfContent {
1.911 bisitz 7897: border:none;
7898: border-spacing: 1px;
7899: padding: 3px;
7900: background-color: #FFFFFF;
7901: font-size: 90%;
1.753 droeschl 7902: }
1.789 droeschl 7903:
1.911 bisitz 7904: table.LC_tableOfContent {
7905: border-collapse: collapse;
1.789 droeschl 7906: }
7907:
1.771 droeschl 7908: table.LC_tableBrowseRes a,
1.768 schulted 7909: table.LC_tableOfContent a {
1.911 bisitz 7910: background-color: transparent;
7911: text-decoration: none;
1.753 droeschl 7912: }
7913:
1.795 www 7914: table.LC_tableOfContent img {
1.911 bisitz 7915: border: none;
7916: height: 1.3em;
7917: vertical-align: text-bottom;
7918: margin-right: 0.3em;
1.753 droeschl 7919: }
1.757 schulted 7920:
1.795 www 7921: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7922: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7923: }
7924:
1.795 www 7925: a#LC_content_toolbar_everything {
1.911 bisitz 7926: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7927: }
7928:
1.795 www 7929: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7930: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7931: }
7932:
1.795 www 7933: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7934: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7935: }
7936:
1.795 www 7937: a#LC_content_toolbar_changefolder {
1.911 bisitz 7938: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7939: }
7940:
1.795 www 7941: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7942: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7943: }
7944:
1.1043 raeburn 7945: a#LC_content_toolbar_edittoplevel {
7946: background-image:url(/res/adm/pages/edittoplevel.gif);
7947: }
7948:
1.795 www 7949: ul#LC_toolbar li a:hover {
1.911 bisitz 7950: background-position: bottom center;
1.757 schulted 7951: }
7952:
1.795 www 7953: ul#LC_toolbar {
1.911 bisitz 7954: padding: 0;
7955: margin: 2px;
7956: list-style:none;
7957: position:relative;
7958: background-color:white;
1.1082 raeburn 7959: overflow: auto;
1.757 schulted 7960: }
7961:
1.795 www 7962: ul#LC_toolbar li {
1.911 bisitz 7963: border:1px solid white;
7964: padding: 0;
7965: margin: 0;
7966: float: left;
7967: display:inline;
7968: vertical-align:middle;
1.1082 raeburn 7969: white-space: nowrap;
1.911 bisitz 7970: }
1.757 schulted 7971:
1.783 amueller 7972:
1.795 www 7973: a.LC_toolbarItem {
1.911 bisitz 7974: display:block;
7975: padding: 0;
7976: margin: 0;
7977: height: 32px;
7978: width: 32px;
7979: color:white;
7980: border: none;
7981: background-repeat:no-repeat;
7982: background-color:transparent;
1.757 schulted 7983: }
7984:
1.915 droeschl 7985: ul.LC_funclist {
7986: margin: 0;
7987: padding: 0.5em 1em 0.5em 0;
7988: }
7989:
1.933 droeschl 7990: ul.LC_funclist > li:first-child {
7991: font-weight:bold;
7992: margin-left:0.8em;
7993: }
7994:
1.915 droeschl 7995: ul.LC_funclist + ul.LC_funclist {
7996: /*
7997: left border as a seperator if we have more than
7998: one list
7999: */
8000: border-left: 1px solid $sidebg;
8001: /*
8002: this hides the left border behind the border of the
8003: outer box if element is wrapped to the next 'line'
8004: */
8005: margin-left: -1px;
8006: }
8007:
1.843 bisitz 8008: ul.LC_funclist li {
1.915 droeschl 8009: display: inline;
1.782 bisitz 8010: white-space: nowrap;
1.915 droeschl 8011: margin: 0 0 0 25px;
8012: line-height: 150%;
1.782 bisitz 8013: }
8014:
1.974 wenzelju 8015: .LC_hidden {
8016: display: none;
8017: }
8018:
1.1030 www 8019: .LCmodal-overlay {
8020: position:fixed;
8021: top:0;
8022: right:0;
8023: bottom:0;
8024: left:0;
8025: height:100%;
8026: width:100%;
8027: margin:0;
8028: padding:0;
8029: background:#999;
8030: opacity:.75;
8031: filter: alpha(opacity=75);
8032: -moz-opacity: 0.75;
8033: z-index:101;
8034: }
8035:
8036: * html .LCmodal-overlay {
8037: position: absolute;
8038: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8039: }
8040:
8041: .LCmodal-window {
8042: position:fixed;
8043: top:50%;
8044: left:50%;
8045: margin:0;
8046: padding:0;
8047: z-index:102;
8048: }
8049:
8050: * html .LCmodal-window {
8051: position:absolute;
8052: }
8053:
8054: .LCclose-window {
8055: position:absolute;
8056: width:32px;
8057: height:32px;
8058: right:8px;
8059: top:8px;
8060: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8061: text-indent:-99999px;
8062: overflow:hidden;
8063: cursor:pointer;
8064: }
8065:
1.1100 raeburn 8066: /*
1.1231 damieng 8067: styles used for response display
8068: */
8069: div.LC_radiofoil, div.LC_rankfoil {
8070: margin: .5em 0em .5em 0em;
8071: }
8072: table.LC_itemgroup {
8073: margin-top: 1em;
8074: }
8075:
8076: /*
1.1100 raeburn 8077: styles used by TTH when "Default set of options to pass to tth/m
8078: when converting TeX" in course settings has been set
8079:
8080: option passed: -t
8081:
8082: */
8083:
8084: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8085: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8086: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8087: td div.norm {line-height:normal;}
8088:
8089: /*
8090: option passed -y3
8091: */
8092:
8093: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8094: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8095: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8096:
1.1230 damieng 8097: /*
8098: sections with roles, for content only
8099: */
8100: section[class^="role-"] {
8101: padding-left: 10px;
8102: padding-right: 5px;
8103: margin-top: 8px;
8104: margin-bottom: 8px;
8105: border: 1px solid #2A4;
8106: border-radius: 5px;
8107: box-shadow: 0px 1px 1px #BBB;
8108: }
8109: section[class^="role-"]>h1 {
8110: position: relative;
8111: margin: 0px;
8112: padding-top: 10px;
8113: padding-left: 40px;
8114: }
8115: section[class^="role-"]>h1:before {
8116: position: absolute;
8117: left: -5px;
8118: top: 5px;
8119: }
8120: section.role-activity>h1:before {
8121: content:url('/adm/daxe/images/section_icons/activity.png');
8122: }
8123: section.role-advice>h1:before {
8124: content:url('/adm/daxe/images/section_icons/advice.png');
8125: }
8126: section.role-bibliography>h1:before {
8127: content:url('/adm/daxe/images/section_icons/bibliography.png');
8128: }
8129: section.role-citation>h1:before {
8130: content:url('/adm/daxe/images/section_icons/citation.png');
8131: }
8132: section.role-conclusion>h1:before {
8133: content:url('/adm/daxe/images/section_icons/conclusion.png');
8134: }
8135: section.role-definition>h1:before {
8136: content:url('/adm/daxe/images/section_icons/definition.png');
8137: }
8138: section.role-demonstration>h1:before {
8139: content:url('/adm/daxe/images/section_icons/demonstration.png');
8140: }
8141: section.role-example>h1:before {
8142: content:url('/adm/daxe/images/section_icons/example.png');
8143: }
8144: section.role-explanation>h1:before {
8145: content:url('/adm/daxe/images/section_icons/explanation.png');
8146: }
8147: section.role-introduction>h1:before {
8148: content:url('/adm/daxe/images/section_icons/introduction.png');
8149: }
8150: section.role-method>h1:before {
8151: content:url('/adm/daxe/images/section_icons/method.png');
8152: }
8153: section.role-more_information>h1:before {
8154: content:url('/adm/daxe/images/section_icons/more_information.png');
8155: }
8156: section.role-objectives>h1:before {
8157: content:url('/adm/daxe/images/section_icons/objectives.png');
8158: }
8159: section.role-prerequisites>h1:before {
8160: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8161: }
8162: section.role-remark>h1:before {
8163: content:url('/adm/daxe/images/section_icons/remark.png');
8164: }
8165: section.role-reminder>h1:before {
8166: content:url('/adm/daxe/images/section_icons/reminder.png');
8167: }
8168: section.role-summary>h1:before {
8169: content:url('/adm/daxe/images/section_icons/summary.png');
8170: }
8171: section.role-syntax>h1:before {
8172: content:url('/adm/daxe/images/section_icons/syntax.png');
8173: }
8174: section.role-warning>h1:before {
8175: content:url('/adm/daxe/images/section_icons/warning.png');
8176: }
8177:
1.1269 raeburn 8178: #LC_minitab_header {
8179: float:left;
8180: width:100%;
8181: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8182: font-size:93%;
8183: line-height:normal;
8184: margin: 0.5em 0 0.5em 0;
8185: }
8186: #LC_minitab_header ul {
8187: margin:0;
8188: padding:10px 10px 0;
8189: list-style:none;
8190: }
8191: #LC_minitab_header li {
8192: float:left;
8193: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8194: margin:0;
8195: padding:0 0 0 9px;
8196: }
8197: #LC_minitab_header a {
8198: display:block;
8199: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8200: padding:5px 15px 4px 6px;
8201: }
8202: #LC_minitab_header #LC_current_minitab {
8203: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8204: }
8205: #LC_minitab_header #LC_current_minitab a {
8206: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8207: padding-bottom:5px;
8208: }
8209:
8210:
1.343 albertel 8211: END
8212: }
8213:
1.306 albertel 8214: =pod
8215:
8216: =item * &headtag()
8217:
8218: Returns a uniform footer for LON-CAPA web pages.
8219:
1.307 albertel 8220: Inputs: $title - optional title for the head
8221: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8222: $args - optional arguments
1.319 albertel 8223: force_register - if is true call registerurl so the remote is
8224: informed
1.415 albertel 8225: redirect -> array ref of
8226: 1- seconds before redirect occurs
8227: 2- url to redirect to
8228: 3- whether the side effect should occur
1.315 albertel 8229: (side effect of setting
8230: $env{'internal.head.redirect'} to the url
8231: redirected too)
1.352 albertel 8232: domain -> force to color decorate a page for a specific
8233: domain
8234: function -> force usage of a specific rolish color scheme
8235: bgcolor -> override the default page bgcolor
1.460 albertel 8236: no_auto_mt_title
8237: -> prevent &mt()ing the title arg
1.464 albertel 8238:
1.306 albertel 8239: =cut
8240:
8241: sub headtag {
1.313 albertel 8242: my ($title,$head_extra,$args) = @_;
1.306 albertel 8243:
1.363 albertel 8244: my $function = $args->{'function'} || &get_users_function();
8245: my $domain = $args->{'domain'} || &determinedomain();
8246: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8247: my $httphost = $args->{'use_absolute'};
1.418 albertel 8248: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8249: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8250: #time(),
1.418 albertel 8251: $env{'environment.color.timestamp'},
1.363 albertel 8252: $function,$domain,$bgcolor);
8253:
1.369 www 8254: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8255:
1.308 albertel 8256: my $result =
8257: '<head>'.
1.1160 raeburn 8258: &font_settings($args);
1.319 albertel 8259:
1.1188 raeburn 8260: my $inhibitprint;
8261: if ($args->{'print_suppress'}) {
8262: $inhibitprint = &print_suppression();
8263: }
1.1064 raeburn 8264:
1.461 albertel 8265: if (!$args->{'frameset'}) {
8266: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8267: }
1.962 droeschl 8268: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8269: $result .= Apache::lonxml::display_title();
1.319 albertel 8270: }
1.436 albertel 8271: if (!$args->{'no_nav_bar'}
8272: && !$args->{'only_body'}
8273: && !$args->{'frameset'}) {
1.1154 raeburn 8274: $result .= &help_menu_js($httphost);
1.1032 www 8275: $result.=&modal_window();
1.1038 www 8276: $result.=&togglebox_script();
1.1034 www 8277: $result.=&wishlist_window();
1.1041 www 8278: $result.=&LCprogressbarUpdate_script();
1.1034 www 8279: } else {
8280: if ($args->{'add_modal'}) {
8281: $result.=&modal_window();
8282: }
8283: if ($args->{'add_wishlist'}) {
8284: $result.=&wishlist_window();
8285: }
1.1038 www 8286: if ($args->{'add_togglebox'}) {
8287: $result.=&togglebox_script();
8288: }
1.1041 www 8289: if ($args->{'add_progressbar'}) {
8290: $result.=&LCprogressbarUpdate_script();
8291: }
1.436 albertel 8292: }
1.314 albertel 8293: if (ref($args->{'redirect'})) {
1.414 albertel 8294: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8295: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8296: if (!$inhibit_continue) {
8297: $env{'internal.head.redirect'} = $url;
8298: }
1.313 albertel 8299: $result.=<<ADDMETA
8300: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8301: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8302: ADDMETA
1.1210 raeburn 8303: } else {
8304: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8305: my $requrl = $env{'request.uri'};
8306: if ($requrl eq '') {
8307: $requrl = $ENV{'REQUEST_URI'};
8308: $requrl =~ s/\?.+$//;
8309: }
8310: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8311: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8312: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8313: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8314: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8315: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
8316: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8317: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8318: if ($domdefs{'offloadnow'}{$lonhost}) {
8319: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8320: if (($newserver) && ($newserver ne $lonhost)) {
8321: my $numsec = 5;
8322: my $timeout = $numsec * 1000;
8323: my ($newurl,$locknum,%locks,$msg);
8324: if ($env{'request.role.adv'}) {
8325: ($locknum,%locks) = &Apache::lonnet::get_locks();
8326: }
8327: my $disable_submit = 0;
8328: if ($requrl =~ /$LONCAPA::assess_re/) {
8329: $disable_submit = 1;
8330: }
8331: if ($locknum) {
8332: my @lockinfo = sort(values(%locks));
8333: $msg = &mt('Once the following tasks are complete: ')."\\n".
8334: join(", ",sort(values(%locks)))."\\n".
8335: &mt('your session will be transferred to a different server, after you click "Roles".');
8336: } else {
8337: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8338: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
8339: }
8340: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8341: $newurl = '/adm/switchserver?otherserver='.$newserver;
8342: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8343: $newurl .= '&role='.$env{'request.role'};
8344: }
8345: if ($env{'request.symb'}) {
8346: $newurl .= '&symb='.$env{'request.symb'};
8347: } else {
8348: $newurl .= '&origurl='.$requrl;
8349: }
8350: }
1.1222 damieng 8351: &js_escape(\$msg);
1.1210 raeburn 8352: $result.=<<OFFLOAD
8353: <meta http-equiv="pragma" content="no-cache" />
8354: <script type="text/javascript">
1.1215 raeburn 8355: // <![CDATA[
1.1210 raeburn 8356: function LC_Offload_Now() {
8357: var dest = "$newurl";
8358: if (dest != '') {
8359: window.location.href="$newurl";
8360: }
8361: }
1.1214 raeburn 8362: \$(document).ready(function () {
8363: window.alert('$msg');
8364: if ($disable_submit) {
1.1210 raeburn 8365: \$(".LC_hwk_submit").prop("disabled", true);
8366: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8367: }
8368: setTimeout('LC_Offload_Now()', $timeout);
8369: });
1.1215 raeburn 8370: // ]]>
1.1210 raeburn 8371: </script>
8372: OFFLOAD
8373: }
8374: }
8375: }
8376: }
8377: }
8378: }
1.313 albertel 8379: }
1.306 albertel 8380: if (!defined($title)) {
8381: $title = 'The LearningOnline Network with CAPA';
8382: }
1.460 albertel 8383: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8384: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8385: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8386: if (!$args->{'frameset'}) {
8387: $result .= ' /';
8388: }
8389: $result .= '>'
1.1064 raeburn 8390: .$inhibitprint
1.414 albertel 8391: .$head_extra;
1.1242 raeburn 8392: my $clientmobile;
8393: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8394: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8395: } else {
8396: $clientmobile = $env{'browser.mobile'};
8397: }
8398: if ($clientmobile) {
1.1137 raeburn 8399: $result .= '
8400: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8401: <meta name="apple-mobile-web-app-capable" content="yes" />';
8402: }
1.1278 raeburn 8403: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8404: return $result.'</head>';
1.306 albertel 8405: }
8406:
8407: =pod
8408:
1.340 albertel 8409: =item * &font_settings()
8410:
8411: Returns neccessary <meta> to set the proper encoding
8412:
1.1160 raeburn 8413: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8414:
8415: =cut
8416:
8417: sub font_settings {
1.1160 raeburn 8418: my ($args) = @_;
1.340 albertel 8419: my $headerstring='';
1.1160 raeburn 8420: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8421: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8422: $headerstring.=
8423: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8424: if (!$args->{'frameset'}) {
8425: $headerstring.= ' /';
8426: }
8427: $headerstring .= '>'."\n";
1.340 albertel 8428: }
8429: return $headerstring;
8430: }
8431:
1.341 albertel 8432: =pod
8433:
1.1064 raeburn 8434: =item * &print_suppression()
8435:
8436: In course context returns css which causes the body to be blank when media="print",
8437: if printout generation is unavailable for the current resource.
8438:
8439: This could be because:
8440:
8441: (a) printstartdate is in the future
8442:
8443: (b) printenddate is in the past
8444:
8445: (c) there is an active exam block with "printout"
8446: functionality blocked
8447:
8448: Users with pav, pfo or evb privileges are exempt.
8449:
8450: Inputs: none
8451:
8452: =cut
8453:
8454:
8455: sub print_suppression {
8456: my $noprint;
8457: if ($env{'request.course.id'}) {
8458: my $scope = $env{'request.course.id'};
8459: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8460: (&Apache::lonnet::allowed('pfo',$scope))) {
8461: return;
8462: }
8463: if ($env{'request.course.sec'} ne '') {
8464: $scope .= "/$env{'request.course.sec'}";
8465: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8466: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8467: return;
1.1064 raeburn 8468: }
8469: }
8470: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8471: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8472: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8473: if ($blocked) {
8474: my $checkrole = "cm./$cdom/$cnum";
8475: if ($env{'request.course.sec'} ne '') {
8476: $checkrole .= "/$env{'request.course.sec'}";
8477: }
8478: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8479: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8480: $noprint = 1;
8481: }
8482: }
8483: unless ($noprint) {
8484: my $symb = &Apache::lonnet::symbread();
8485: if ($symb ne '') {
8486: my $navmap = Apache::lonnavmaps::navmap->new();
8487: if (ref($navmap)) {
8488: my $res = $navmap->getBySymb($symb);
8489: if (ref($res)) {
8490: if (!$res->resprintable()) {
8491: $noprint = 1;
8492: }
8493: }
8494: }
8495: }
8496: }
8497: if ($noprint) {
8498: return <<"ENDSTYLE";
8499: <style type="text/css" media="print">
8500: body { display:none }
8501: </style>
8502: ENDSTYLE
8503: }
8504: }
8505: return;
8506: }
8507:
8508: =pod
8509:
1.341 albertel 8510: =item * &xml_begin()
8511:
8512: Returns the needed doctype and <html>
8513:
8514: Inputs: none
8515:
8516: =cut
8517:
8518: sub xml_begin {
1.1168 raeburn 8519: my ($is_frameset) = @_;
1.341 albertel 8520: my $output='';
8521:
8522: if ($env{'browser.mathml'}) {
8523: $output='<?xml version="1.0"?>'
8524: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8525: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8526:
8527: # .'<!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">] >'
8528: .'<!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">'
8529: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8530: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8531: } elsif ($is_frameset) {
8532: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8533: '<html>'."\n";
1.341 albertel 8534: } else {
1.1168 raeburn 8535: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8536: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8537: }
8538: return $output;
8539: }
1.340 albertel 8540:
8541: =pod
8542:
1.306 albertel 8543: =item * &start_page()
8544:
8545: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8546:
1.648 raeburn 8547: Inputs:
8548:
8549: =over 4
8550:
8551: $title - optional title for the page
8552:
8553: $head_extra - optional extra HTML to incude inside the <head>
8554:
8555: $args - additional optional args supported are:
8556:
8557: =over 8
8558:
8559: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8560: arg on
1.814 bisitz 8561: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8562: add_entries -> additional attributes to add to the <body>
8563: domain -> force to color decorate a page for a
1.317 albertel 8564: specific domain
1.648 raeburn 8565: function -> force usage of a specific rolish color
1.317 albertel 8566: scheme
1.648 raeburn 8567: redirect -> see &headtag()
8568: bgcolor -> override the default page bg color
8569: js_ready -> return a string ready for being used in
1.317 albertel 8570: a javascript writeln
1.648 raeburn 8571: html_encode -> return a string ready for being used in
1.320 albertel 8572: a html attribute
1.648 raeburn 8573: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8574: $forcereg arg
1.648 raeburn 8575: frameset -> if true will start with a <frameset>
1.330 albertel 8576: rather than <body>
1.648 raeburn 8577: skip_phases -> hash ref of
1.338 albertel 8578: head -> skip the <html><head> generation
8579: body -> skip all <body> generation
1.648 raeburn 8580: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8581: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8582: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 8583: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8584: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 8585: group -> includes the current group, if page is for a
1.1274 raeburn 8586: specific group
8587: use_absolute -> for request for external resource or syllabus, this
8588: will contain https://<hostname> if server uses
8589: https (as per hosts.tab), but request is for http
8590: hostname -> hostname, originally from $r->hostname(), (optional).
1.361 albertel 8591:
1.648 raeburn 8592: =back
1.460 albertel 8593:
1.648 raeburn 8594: =back
1.562 albertel 8595:
1.306 albertel 8596: =cut
8597:
8598: sub start_page {
1.309 albertel 8599: my ($title,$head_extra,$args) = @_;
1.318 albertel 8600: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8601:
1.315 albertel 8602: $env{'internal.start_page'}++;
1.1096 raeburn 8603: my ($result,@advtools);
1.964 droeschl 8604:
1.338 albertel 8605: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8606: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8607: }
8608:
8609: if (! exists($args->{'skip_phases'}{'body'}) ) {
8610: if ($args->{'frameset'}) {
8611: my $attr_string = &make_attr_string($args->{'force_register'},
8612: $args->{'add_entries'});
8613: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8614: } else {
8615: $result .=
8616: &bodytag($title,
8617: $args->{'function'}, $args->{'add_entries'},
8618: $args->{'only_body'}, $args->{'domain'},
8619: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8620: $args->{'bgcolor'}, $args,
8621: \@advtools);
1.831 bisitz 8622: }
1.330 albertel 8623: }
1.338 albertel 8624:
1.315 albertel 8625: if ($args->{'js_ready'}) {
1.713 kaisler 8626: $result = &js_ready($result);
1.315 albertel 8627: }
1.320 albertel 8628: if ($args->{'html_encode'}) {
1.713 kaisler 8629: $result = &html_encode($result);
8630: }
8631:
1.813 bisitz 8632: # Preparation for new and consistent functionlist at top of screen
8633: # if ($args->{'functionlist'}) {
8634: # $result .= &build_functionlist();
8635: #}
8636:
1.964 droeschl 8637: # Don't add anything more if only_body wanted or in const space
8638: return $result if $args->{'only_body'}
8639: || $env{'request.state'} eq 'construct';
1.813 bisitz 8640:
8641: #Breadcrumbs
1.758 kaisler 8642: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8643: &Apache::lonhtmlcommon::clear_breadcrumbs();
8644: #if any br links exists, add them to the breadcrumbs
8645: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8646: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8647: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8648: }
8649: }
1.1096 raeburn 8650: # if @advtools array contains items add then to the breadcrumbs
8651: if (@advtools > 0) {
8652: &Apache::lonmenu::advtools_crumbs(@advtools);
8653: }
1.1272 raeburn 8654: my $menulink;
8655: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8656: if ((exists($args->{'bread_crumbs_nomenu'})) ||
8657: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
8658: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
8659: (!$env{'request.role.adv'}))) {
8660: $menulink = 0;
8661: } else {
8662: undef($menulink);
8663: }
1.758 kaisler 8664: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8665: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 8666: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 8667: } else {
1.1272 raeburn 8668: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8669: }
1.320 albertel 8670: }
1.315 albertel 8671: return $result;
1.306 albertel 8672: }
8673:
8674: sub end_page {
1.315 albertel 8675: my ($args) = @_;
8676: $env{'internal.end_page'}++;
1.330 albertel 8677: my $result;
1.335 albertel 8678: if ($args->{'discussion'}) {
8679: my ($target,$parser);
8680: if (ref($args->{'discussion'})) {
8681: ($target,$parser) =($args->{'discussion'}{'target'},
8682: $args->{'discussion'}{'parser'});
8683: }
8684: $result .= &Apache::lonxml::xmlend($target,$parser);
8685: }
1.330 albertel 8686: if ($args->{'frameset'}) {
8687: $result .= '</frameset>';
8688: } else {
1.635 raeburn 8689: $result .= &endbodytag($args);
1.330 albertel 8690: }
1.1080 raeburn 8691: unless ($args->{'notbody'}) {
8692: $result .= "\n</html>";
8693: }
1.330 albertel 8694:
1.315 albertel 8695: if ($args->{'js_ready'}) {
1.317 albertel 8696: $result = &js_ready($result);
1.315 albertel 8697: }
1.335 albertel 8698:
1.320 albertel 8699: if ($args->{'html_encode'}) {
8700: $result = &html_encode($result);
8701: }
1.335 albertel 8702:
1.315 albertel 8703: return $result;
8704: }
8705:
1.1034 www 8706: sub wishlist_window {
8707: return(<<'ENDWISHLIST');
1.1046 raeburn 8708: <script type="text/javascript">
1.1034 www 8709: // <![CDATA[
8710: // <!-- BEGIN LON-CAPA Internal
8711: function set_wishlistlink(title, path) {
8712: if (!title) {
8713: title = document.title;
8714: title = title.replace(/^LON-CAPA /,'');
8715: }
1.1175 raeburn 8716: title = encodeURIComponent(title);
1.1203 raeburn 8717: title = title.replace("'","\\\'");
1.1034 www 8718: if (!path) {
8719: path = location.pathname;
8720: }
1.1175 raeburn 8721: path = encodeURIComponent(path);
1.1203 raeburn 8722: path = path.replace("'","\\\'");
1.1034 www 8723: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8724: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8725: }
8726: // END LON-CAPA Internal -->
8727: // ]]>
8728: </script>
8729: ENDWISHLIST
8730: }
8731:
1.1030 www 8732: sub modal_window {
8733: return(<<'ENDMODAL');
1.1046 raeburn 8734: <script type="text/javascript">
1.1030 www 8735: // <![CDATA[
8736: // <!-- BEGIN LON-CAPA Internal
8737: var modalWindow = {
8738: parent:"body",
8739: windowId:null,
8740: content:null,
8741: width:null,
8742: height:null,
8743: close:function()
8744: {
8745: $(".LCmodal-window").remove();
8746: $(".LCmodal-overlay").remove();
8747: },
8748: open:function()
8749: {
8750: var modal = "";
8751: modal += "<div class=\"LCmodal-overlay\"></div>";
8752: 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;\">";
8753: modal += this.content;
8754: modal += "</div>";
8755:
8756: $(this.parent).append(modal);
8757:
8758: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8759: $(".LCclose-window").click(function(){modalWindow.close();});
8760: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8761: }
8762: };
1.1140 raeburn 8763: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8764: {
1.1266 raeburn 8765: source = source.replace(/'/g,"'");
1.1030 www 8766: modalWindow.windowId = "myModal";
8767: modalWindow.width = width;
8768: modalWindow.height = height;
1.1196 raeburn 8769: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8770: modalWindow.open();
1.1208 raeburn 8771: };
1.1030 www 8772: // END LON-CAPA Internal -->
8773: // ]]>
8774: </script>
8775: ENDMODAL
8776: }
8777:
8778: sub modal_link {
1.1140 raeburn 8779: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8780: unless ($width) { $width=480; }
8781: unless ($height) { $height=400; }
1.1031 www 8782: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8783: unless ($transparency) { $transparency='true'; }
8784:
1.1074 raeburn 8785: my $target_attr;
8786: if (defined($target)) {
8787: $target_attr = 'target="'.$target.'"';
8788: }
8789: return <<"ENDLINK";
1.1140 raeburn 8790: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8791: $linktext</a>
8792: ENDLINK
1.1030 www 8793: }
8794:
1.1032 www 8795: sub modal_adhoc_script {
8796: my ($funcname,$width,$height,$content)=@_;
8797: return (<<ENDADHOC);
1.1046 raeburn 8798: <script type="text/javascript">
1.1032 www 8799: // <![CDATA[
8800: var $funcname = function()
8801: {
8802: modalWindow.windowId = "myModal";
8803: modalWindow.width = $width;
8804: modalWindow.height = $height;
8805: modalWindow.content = '$content';
8806: modalWindow.open();
8807: };
8808: // ]]>
8809: </script>
8810: ENDADHOC
8811: }
8812:
1.1041 www 8813: sub modal_adhoc_inner {
8814: my ($funcname,$width,$height,$content)=@_;
8815: my $innerwidth=$width-20;
8816: $content=&js_ready(
1.1140 raeburn 8817: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8818: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8819: $content.
1.1041 www 8820: &end_scrollbox().
1.1140 raeburn 8821: &end_page()
1.1041 www 8822: );
8823: return &modal_adhoc_script($funcname,$width,$height,$content);
8824: }
8825:
8826: sub modal_adhoc_window {
8827: my ($funcname,$width,$height,$content,$linktext)=@_;
8828: return &modal_adhoc_inner($funcname,$width,$height,$content).
8829: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8830: }
8831:
8832: sub modal_adhoc_launch {
8833: my ($funcname,$width,$height,$content)=@_;
8834: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8835: <script type="text/javascript">
8836: // <![CDATA[
8837: $funcname();
8838: // ]]>
8839: </script>
8840: ENDLAUNCH
8841: }
8842:
8843: sub modal_adhoc_close {
8844: return (<<ENDCLOSE);
8845: <script type="text/javascript">
8846: // <![CDATA[
8847: modalWindow.close();
8848: // ]]>
8849: </script>
8850: ENDCLOSE
8851: }
8852:
1.1038 www 8853: sub togglebox_script {
8854: return(<<ENDTOGGLE);
8855: <script type="text/javascript">
8856: // <![CDATA[
8857: function LCtoggleDisplay(id,hidetext,showtext) {
8858: link = document.getElementById(id + "link").childNodes[0];
8859: with (document.getElementById(id).style) {
8860: if (display == "none" ) {
8861: display = "inline";
8862: link.nodeValue = hidetext;
8863: } else {
8864: display = "none";
8865: link.nodeValue = showtext;
8866: }
8867: }
8868: }
8869: // ]]>
8870: </script>
8871: ENDTOGGLE
8872: }
8873:
1.1039 www 8874: sub start_togglebox {
8875: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8876: unless ($heading) { $heading=''; } else { $heading.=' '; }
8877: unless ($showtext) { $showtext=&mt('show'); }
8878: unless ($hidetext) { $hidetext=&mt('hide'); }
8879: unless ($headerbg) { $headerbg='#FFFFFF'; }
8880: return &start_data_table().
8881: &start_data_table_header_row().
8882: '<td bgcolor="'.$headerbg.'">'.$heading.
8883: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8884: $showtext.'\')">'.$showtext.'</a>]</td>'.
8885: &end_data_table_header_row().
8886: '<tr id="'.$id.'" style="display:none""><td>';
8887: }
8888:
8889: sub end_togglebox {
8890: return '</td></tr>'.&end_data_table();
8891: }
8892:
1.1041 www 8893: sub LCprogressbar_script {
1.1045 www 8894: my ($id)=@_;
1.1041 www 8895: return(<<ENDPROGRESS);
8896: <script type="text/javascript">
8897: // <![CDATA[
1.1045 www 8898: \$('#progressbar$id').progressbar({
1.1041 www 8899: value: 0,
8900: change: function(event, ui) {
8901: var newVal = \$(this).progressbar('option', 'value');
8902: \$('.pblabel', this).text(LCprogressTxt);
8903: }
8904: });
8905: // ]]>
8906: </script>
8907: ENDPROGRESS
8908: }
8909:
8910: sub LCprogressbarUpdate_script {
8911: return(<<ENDPROGRESSUPDATE);
8912: <style type="text/css">
8913: .ui-progressbar { position:relative; }
8914: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8915: </style>
8916: <script type="text/javascript">
8917: // <![CDATA[
1.1045 www 8918: var LCprogressTxt='---';
8919:
8920: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8921: LCprogressTxt=progresstext;
1.1045 www 8922: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8923: }
8924: // ]]>
8925: </script>
8926: ENDPROGRESSUPDATE
8927: }
8928:
1.1042 www 8929: my $LClastpercent;
1.1045 www 8930: my $LCidcnt;
8931: my $LCcurrentid;
1.1042 www 8932:
1.1041 www 8933: sub LCprogressbar {
1.1042 www 8934: my ($r)=(@_);
8935: $LClastpercent=0;
1.1045 www 8936: $LCidcnt++;
8937: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8938: my $starting=&mt('Starting');
8939: my $content=(<<ENDPROGBAR);
1.1045 www 8940: <div id="progressbar$LCcurrentid">
1.1041 www 8941: <span class="pblabel">$starting</span>
8942: </div>
8943: ENDPROGBAR
1.1045 www 8944: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8945: }
8946:
8947: sub LCprogressbarUpdate {
1.1042 www 8948: my ($r,$val,$text)=@_;
8949: unless ($val) {
8950: if ($LClastpercent) {
8951: $val=$LClastpercent;
8952: } else {
8953: $val=0;
8954: }
8955: }
1.1041 www 8956: if ($val<0) { $val=0; }
8957: if ($val>100) { $val=0; }
1.1042 www 8958: $LClastpercent=$val;
1.1041 www 8959: unless ($text) { $text=$val.'%'; }
8960: $text=&js_ready($text);
1.1044 www 8961: &r_print($r,<<ENDUPDATE);
1.1041 www 8962: <script type="text/javascript">
8963: // <![CDATA[
1.1045 www 8964: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8965: // ]]>
8966: </script>
8967: ENDUPDATE
1.1035 www 8968: }
8969:
1.1042 www 8970: sub LCprogressbarClose {
8971: my ($r)=@_;
8972: $LClastpercent=0;
1.1044 www 8973: &r_print($r,<<ENDCLOSE);
1.1042 www 8974: <script type="text/javascript">
8975: // <![CDATA[
1.1045 www 8976: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8977: // ]]>
8978: </script>
8979: ENDCLOSE
1.1044 www 8980: }
8981:
8982: sub r_print {
8983: my ($r,$to_print)=@_;
8984: if ($r) {
8985: $r->print($to_print);
8986: $r->rflush();
8987: } else {
8988: print($to_print);
8989: }
1.1042 www 8990: }
8991:
1.320 albertel 8992: sub html_encode {
8993: my ($result) = @_;
8994:
1.322 albertel 8995: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8996:
8997: return $result;
8998: }
1.1044 www 8999:
1.317 albertel 9000: sub js_ready {
9001: my ($result) = @_;
9002:
1.323 albertel 9003: $result =~ s/[\n\r]/ /xmsg;
9004: $result =~ s/\\/\\\\/xmsg;
9005: $result =~ s/'/\\'/xmsg;
1.372 albertel 9006: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9007:
9008: return $result;
9009: }
9010:
1.315 albertel 9011: sub validate_page {
9012: if ( exists($env{'internal.start_page'})
1.316 albertel 9013: && $env{'internal.start_page'} > 1) {
9014: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9015: $env{'internal.start_page'}.' '.
1.316 albertel 9016: $ENV{'request.filename'});
1.315 albertel 9017: }
9018: if ( exists($env{'internal.end_page'})
1.316 albertel 9019: && $env{'internal.end_page'} > 1) {
9020: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9021: $env{'internal.end_page'}.' '.
1.316 albertel 9022: $env{'request.filename'});
1.315 albertel 9023: }
9024: if ( exists($env{'internal.start_page'})
9025: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9026: &Apache::lonnet::logthis('start_page called without end_page '.
9027: $env{'request.filename'});
1.315 albertel 9028: }
9029: if ( ! exists($env{'internal.start_page'})
9030: && exists($env{'internal.end_page'})) {
1.316 albertel 9031: &Apache::lonnet::logthis('end_page called without start_page'.
9032: $env{'request.filename'});
1.315 albertel 9033: }
1.306 albertel 9034: }
1.315 albertel 9035:
1.996 www 9036:
9037: sub start_scrollbox {
1.1140 raeburn 9038: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9039: unless ($outerwidth) { $outerwidth='520px'; }
9040: unless ($width) { $width='500px'; }
9041: unless ($height) { $height='200px'; }
1.1075 raeburn 9042: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9043: if ($id ne '') {
1.1140 raeburn 9044: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9045: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9046: }
1.1075 raeburn 9047: if ($bgcolor ne '') {
9048: $tdcol = "background-color: $bgcolor;";
9049: }
1.1137 raeburn 9050: my $nicescroll_js;
9051: if ($env{'browser.mobile'}) {
1.1140 raeburn 9052: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9053: }
9054: return <<"END";
9055: $nicescroll_js
9056:
9057: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9058: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9059: END
9060: }
9061:
9062: sub end_scrollbox {
9063: return '</div></td></tr></table>';
9064: }
9065:
9066: sub nicescroll_javascript {
9067: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9068: my %options;
9069: if (ref($cursor) eq 'HASH') {
9070: %options = %{$cursor};
9071: }
9072: unless ($options{'railalign'} =~ /^left|right$/) {
9073: $options{'railalign'} = 'left';
9074: }
9075: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9076: my $function = &get_users_function();
9077: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9078: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9079: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9080: }
1.1140 raeburn 9081: }
9082: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9083: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9084: $options{'cursoropacity'}='1.0';
9085: }
1.1140 raeburn 9086: } else {
9087: $options{'cursoropacity'}='1.0';
9088: }
9089: if ($options{'cursorfixedheight'} eq 'none') {
9090: delete($options{'cursorfixedheight'});
9091: } else {
9092: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9093: }
9094: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9095: delete($options{'railoffset'});
9096: }
9097: my @niceoptions;
9098: while (my($key,$value) = each(%options)) {
9099: if ($value =~ /^\{.+\}$/) {
9100: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9101: } else {
1.1140 raeburn 9102: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9103: }
1.1140 raeburn 9104: }
9105: my $nicescroll_js = '
1.1137 raeburn 9106: $(document).ready(
1.1140 raeburn 9107: function() {
9108: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9109: }
1.1137 raeburn 9110: );
9111: ';
1.1140 raeburn 9112: if ($framecheck) {
9113: $nicescroll_js .= '
9114: function expand_div(caller) {
9115: if (top === self) {
9116: document.getElementById("'.$id.'").style.width = "auto";
9117: document.getElementById("'.$id.'").style.height = "auto";
9118: } else {
9119: try {
9120: if (parent.frames) {
9121: if (parent.frames.length > 1) {
9122: var framesrc = parent.frames[1].location.href;
9123: var currsrc = framesrc.replace(/\#.*$/,"");
9124: if ((caller == "search") || (currsrc == "'.$location.'")) {
9125: document.getElementById("'.$id.'").style.width = "auto";
9126: document.getElementById("'.$id.'").style.height = "auto";
9127: }
9128: }
9129: }
9130: } catch (e) {
9131: return;
9132: }
1.1137 raeburn 9133: }
1.1140 raeburn 9134: return;
1.996 www 9135: }
1.1140 raeburn 9136: ';
9137: }
9138: if ($needjsready) {
9139: $nicescroll_js = '
9140: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9141: } else {
9142: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9143: }
9144: return $nicescroll_js;
1.996 www 9145: }
9146:
1.318 albertel 9147: sub simple_error_page {
1.1150 bisitz 9148: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 9149: if (ref($args) eq 'HASH') {
9150: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
9151: } else {
9152: $msg = &mt($msg);
9153: }
1.1150 bisitz 9154:
1.318 albertel 9155: my $page =
9156: &Apache::loncommon::start_page($title).
1.1150 bisitz 9157: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9158: &Apache::loncommon::end_page();
9159: if (ref($r)) {
9160: $r->print($page);
1.327 albertel 9161: return;
1.318 albertel 9162: }
9163: return $page;
9164: }
1.347 albertel 9165:
9166: {
1.610 albertel 9167: my @row_count;
1.961 onken 9168:
9169: sub start_data_table_count {
9170: unshift(@row_count, 0);
9171: return;
9172: }
9173:
9174: sub end_data_table_count {
9175: shift(@row_count);
9176: return;
9177: }
9178:
1.347 albertel 9179: sub start_data_table {
1.1018 raeburn 9180: my ($add_class,$id) = @_;
1.422 albertel 9181: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9182: my $table_id;
9183: if (defined($id)) {
9184: $table_id = ' id="'.$id.'"';
9185: }
1.961 onken 9186: &start_data_table_count();
1.1018 raeburn 9187: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9188: }
9189:
9190: sub end_data_table {
1.961 onken 9191: &end_data_table_count();
1.389 albertel 9192: return '</table>'."\n";;
1.347 albertel 9193: }
9194:
9195: sub start_data_table_row {
1.974 wenzelju 9196: my ($add_class, $id) = @_;
1.610 albertel 9197: $row_count[0]++;
9198: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9199: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9200: $id = (' id="'.$id.'"') unless ($id eq '');
9201: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9202: }
1.471 banghart 9203:
9204: sub continue_data_table_row {
1.974 wenzelju 9205: my ($add_class, $id) = @_;
1.610 albertel 9206: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9207: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9208: $id = (' id="'.$id.'"') unless ($id eq '');
9209: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9210: }
1.347 albertel 9211:
9212: sub end_data_table_row {
1.389 albertel 9213: return '</tr>'."\n";;
1.347 albertel 9214: }
1.367 www 9215:
1.421 albertel 9216: sub start_data_table_empty_row {
1.707 bisitz 9217: # $row_count[0]++;
1.421 albertel 9218: return '<tr class="LC_empty_row" >'."\n";;
9219: }
9220:
9221: sub end_data_table_empty_row {
9222: return '</tr>'."\n";;
9223: }
9224:
1.367 www 9225: sub start_data_table_header_row {
1.389 albertel 9226: return '<tr class="LC_header_row">'."\n";;
1.367 www 9227: }
9228:
9229: sub end_data_table_header_row {
1.389 albertel 9230: return '</tr>'."\n";;
1.367 www 9231: }
1.890 droeschl 9232:
9233: sub data_table_caption {
9234: my $caption = shift;
9235: return "<caption class=\"LC_caption\">$caption</caption>";
9236: }
1.347 albertel 9237: }
9238:
1.548 albertel 9239: =pod
9240:
9241: =item * &inhibit_menu_check($arg)
9242:
9243: Checks for a inhibitmenu state and generates output to preserve it
9244:
9245: Inputs: $arg - can be any of
9246: - undef - in which case the return value is a string
9247: to add into arguments list of a uri
9248: - 'input' - in which case the return value is a HTML
9249: <form> <input> field of type hidden to
9250: preserve the value
9251: - a url - in which case the return value is the url with
9252: the neccesary cgi args added to preserve the
9253: inhibitmenu state
9254: - a ref to a url - no return value, but the string is
9255: updated to include the neccessary cgi
9256: args to preserve the inhibitmenu state
9257:
9258: =cut
9259:
9260: sub inhibit_menu_check {
9261: my ($arg) = @_;
9262: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9263: if ($arg eq 'input') {
9264: if ($env{'form.inhibitmenu'}) {
9265: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9266: } else {
9267: return
9268: }
9269: }
9270: if ($env{'form.inhibitmenu'}) {
9271: if (ref($arg)) {
9272: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9273: } elsif ($arg eq '') {
9274: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9275: } else {
9276: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9277: }
9278: }
9279: if (!ref($arg)) {
9280: return $arg;
9281: }
9282: }
9283:
1.251 albertel 9284: ###############################################
1.182 matthew 9285:
9286: =pod
9287:
1.549 albertel 9288: =back
9289:
9290: =head1 User Information Routines
9291:
9292: =over 4
9293:
1.405 albertel 9294: =item * &get_users_function()
1.182 matthew 9295:
9296: Used by &bodytag to determine the current users primary role.
9297: Returns either 'student','coordinator','admin', or 'author'.
9298:
9299: =cut
9300:
9301: ###############################################
9302: sub get_users_function {
1.815 tempelho 9303: my $function = 'norole';
1.818 tempelho 9304: if ($env{'request.role'}=~/^(st)/) {
9305: $function='student';
9306: }
1.907 raeburn 9307: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9308: $function='coordinator';
9309: }
1.258 albertel 9310: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9311: $function='admin';
9312: }
1.826 bisitz 9313: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9314: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9315: $function='author';
9316: }
9317: return $function;
1.54 www 9318: }
1.99 www 9319:
9320: ###############################################
9321:
1.233 raeburn 9322: =pod
9323:
1.821 raeburn 9324: =item * &show_course()
9325:
9326: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9327: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9328:
9329: Inputs:
9330: None
9331:
9332: Outputs:
9333: Scalar: 1 if 'Course' to be used, 0 otherwise.
9334:
9335: =cut
9336:
9337: ###############################################
9338: sub show_course {
9339: my $course = !$env{'user.adv'};
9340: if (!$env{'user.adv'}) {
9341: foreach my $env (keys(%env)) {
9342: next if ($env !~ m/^user\.priv\./);
9343: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9344: $course = 0;
9345: last;
9346: }
9347: }
9348: }
9349: return $course;
9350: }
9351:
9352: ###############################################
9353:
9354: =pod
9355:
1.542 raeburn 9356: =item * &check_user_status()
1.274 raeburn 9357:
9358: Determines current status of supplied role for a
9359: specific user. Roles can be active, previous or future.
9360:
9361: Inputs:
9362: user's domain, user's username, course's domain,
1.375 raeburn 9363: course's number, optional section ID.
1.274 raeburn 9364:
9365: Outputs:
9366: role status: active, previous or future.
9367:
9368: =cut
9369:
9370: sub check_user_status {
1.412 raeburn 9371: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9372: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9373: my @uroles = keys(%userinfo);
1.274 raeburn 9374: my $srchstr;
9375: my $active_chk = 'none';
1.412 raeburn 9376: my $now = time;
1.274 raeburn 9377: if (@uroles > 0) {
1.908 raeburn 9378: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9379: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9380: } else {
1.412 raeburn 9381: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9382: }
9383: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9384: my $role_end = 0;
9385: my $role_start = 0;
9386: $active_chk = 'active';
1.412 raeburn 9387: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9388: $role_end = $1;
9389: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9390: $role_start = $1;
1.274 raeburn 9391: }
9392: }
9393: if ($role_start > 0) {
1.412 raeburn 9394: if ($now < $role_start) {
1.274 raeburn 9395: $active_chk = 'future';
9396: }
9397: }
9398: if ($role_end > 0) {
1.412 raeburn 9399: if ($now > $role_end) {
1.274 raeburn 9400: $active_chk = 'previous';
9401: }
9402: }
9403: }
9404: }
9405: return $active_chk;
9406: }
9407:
9408: ###############################################
9409:
9410: =pod
9411:
1.405 albertel 9412: =item * &get_sections()
1.233 raeburn 9413:
9414: Determines all the sections for a course including
9415: sections with students and sections containing other roles.
1.419 raeburn 9416: Incoming parameters:
9417:
9418: 1. domain
9419: 2. course number
9420: 3. reference to array containing roles for which sections should
9421: be gathered (optional).
9422: 4. reference to array containing status types for which sections
9423: should be gathered (optional).
9424:
9425: If the third argument is undefined, sections are gathered for any role.
9426: If the fourth argument is undefined, sections are gathered for any status.
9427: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9428:
1.374 raeburn 9429: Returns section hash (keys are section IDs, values are
9430: number of users in each section), subject to the
1.419 raeburn 9431: optional roles filter, optional status filter
1.233 raeburn 9432:
9433: =cut
9434:
9435: ###############################################
9436: sub get_sections {
1.419 raeburn 9437: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9438: if (!defined($cdom) || !defined($cnum)) {
9439: my $cid = $env{'request.course.id'};
9440:
9441: return if (!defined($cid));
9442:
9443: $cdom = $env{'course.'.$cid.'.domain'};
9444: $cnum = $env{'course.'.$cid.'.num'};
9445: }
9446:
9447: my %sectioncount;
1.419 raeburn 9448: my $now = time;
1.240 albertel 9449:
1.1118 raeburn 9450: my $check_students = 1;
9451: my $only_students = 0;
9452: if (ref($possible_roles) eq 'ARRAY') {
9453: if (grep(/^st$/,@{$possible_roles})) {
9454: if (@{$possible_roles} == 1) {
9455: $only_students = 1;
9456: }
9457: } else {
9458: $check_students = 0;
9459: }
9460: }
9461:
9462: if ($check_students) {
1.276 albertel 9463: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9464: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9465: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9466: my $start_index = &Apache::loncoursedata::CL_START();
9467: my $end_index = &Apache::loncoursedata::CL_END();
9468: my $status;
1.366 albertel 9469: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9470: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9471: $data->[$status_index],
9472: $data->[$start_index],
9473: $data->[$end_index]);
9474: if ($stu_status eq 'Active') {
9475: $status = 'active';
9476: } elsif ($end < $now) {
9477: $status = 'previous';
9478: } elsif ($start > $now) {
9479: $status = 'future';
9480: }
9481: if ($section ne '-1' && $section !~ /^\s*$/) {
9482: if ((!defined($possible_status)) || (($status ne '') &&
9483: (grep/^\Q$status\E$/,@{$possible_status}))) {
9484: $sectioncount{$section}++;
9485: }
1.240 albertel 9486: }
9487: }
9488: }
1.1118 raeburn 9489: if ($only_students) {
9490: return %sectioncount;
9491: }
1.240 albertel 9492: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9493: foreach my $user (sort(keys(%courseroles))) {
9494: if ($user !~ /^(\w{2})/) { next; }
9495: my ($role) = ($user =~ /^(\w{2})/);
9496: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9497: my ($section,$status);
1.240 albertel 9498: if ($role eq 'cr' &&
9499: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9500: $section=$1;
9501: }
9502: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9503: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9504: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9505: if ($end == -1 && $start == -1) {
9506: next; #deleted role
9507: }
9508: if (!defined($possible_status)) {
9509: $sectioncount{$section}++;
9510: } else {
9511: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9512: $status = 'active';
9513: } elsif ($end < $now) {
9514: $status = 'future';
9515: } elsif ($start > $now) {
9516: $status = 'previous';
9517: }
9518: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9519: $sectioncount{$section}++;
9520: }
9521: }
1.233 raeburn 9522: }
1.366 albertel 9523: return %sectioncount;
1.233 raeburn 9524: }
9525:
1.274 raeburn 9526: ###############################################
1.294 raeburn 9527:
9528: =pod
1.405 albertel 9529:
9530: =item * &get_course_users()
9531:
1.275 raeburn 9532: Retrieves usernames:domains for users in the specified course
9533: with specific role(s), and access status.
9534:
9535: Incoming parameters:
1.277 albertel 9536: 1. course domain
9537: 2. course number
9538: 3. access status: users must have - either active,
1.275 raeburn 9539: previous, future, or all.
1.277 albertel 9540: 4. reference to array of permissible roles
1.288 raeburn 9541: 5. reference to array of section restrictions (optional)
9542: 6. reference to results object (hash of hashes).
9543: 7. reference to optional userdata hash
1.609 raeburn 9544: 8. reference to optional statushash
1.630 raeburn 9545: 9. flag if privileged users (except those set to unhide in
9546: course settings) should be excluded
1.609 raeburn 9547: Keys of top level results hash are roles.
1.275 raeburn 9548: Keys of inner hashes are username:domain, with
9549: values set to access type.
1.288 raeburn 9550: Optional userdata hash returns an array with arguments in the
9551: same order as loncoursedata::get_classlist() for student data.
9552:
1.609 raeburn 9553: Optional statushash returns
9554:
1.288 raeburn 9555: Entries for end, start, section and status are blank because
9556: of the possibility of multiple values for non-student roles.
9557:
1.275 raeburn 9558: =cut
1.405 albertel 9559:
1.275 raeburn 9560: ###############################################
1.405 albertel 9561:
1.275 raeburn 9562: sub get_course_users {
1.630 raeburn 9563: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9564: my %idx = ();
1.419 raeburn 9565: my %seclists;
1.288 raeburn 9566:
9567: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9568: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9569: $idx{end} = &Apache::loncoursedata::CL_END();
9570: $idx{start} = &Apache::loncoursedata::CL_START();
9571: $idx{id} = &Apache::loncoursedata::CL_ID();
9572: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9573: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9574: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9575:
1.290 albertel 9576: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9577: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9578: my $now = time;
1.277 albertel 9579: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9580: my $match = 0;
1.412 raeburn 9581: my $secmatch = 0;
1.419 raeburn 9582: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9583: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9584: if ($section eq '') {
9585: $section = 'none';
9586: }
1.291 albertel 9587: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9588: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9589: $secmatch = 1;
9590: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9591: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9592: $secmatch = 1;
9593: }
9594: } else {
1.419 raeburn 9595: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9596: $secmatch = 1;
9597: }
1.290 albertel 9598: }
1.412 raeburn 9599: if (!$secmatch) {
9600: next;
9601: }
1.419 raeburn 9602: }
1.275 raeburn 9603: if (defined($$types{'active'})) {
1.288 raeburn 9604: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9605: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9606: $match = 1;
1.275 raeburn 9607: }
9608: }
9609: if (defined($$types{'previous'})) {
1.609 raeburn 9610: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9611: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9612: $match = 1;
1.275 raeburn 9613: }
9614: }
9615: if (defined($$types{'future'})) {
1.609 raeburn 9616: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9617: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9618: $match = 1;
1.275 raeburn 9619: }
9620: }
1.609 raeburn 9621: if ($match) {
9622: push(@{$seclists{$student}},$section);
9623: if (ref($userdata) eq 'HASH') {
9624: $$userdata{$student} = $$classlist{$student};
9625: }
9626: if (ref($statushash) eq 'HASH') {
9627: $statushash->{$student}{'st'}{$section} = $status;
9628: }
1.288 raeburn 9629: }
1.275 raeburn 9630: }
9631: }
1.412 raeburn 9632: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9633: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9634: my $now = time;
1.609 raeburn 9635: my %displaystatus = ( previous => 'Expired',
9636: active => 'Active',
9637: future => 'Future',
9638: );
1.1121 raeburn 9639: my (%nothide,@possdoms);
1.630 raeburn 9640: if ($hidepriv) {
9641: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9642: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9643: if ($user !~ /:/) {
9644: $nothide{join(':',split(/[\@]/,$user))}=1;
9645: } else {
9646: $nothide{$user} = 1;
9647: }
9648: }
1.1121 raeburn 9649: my @possdoms = ($cdom);
9650: if ($coursehash{'checkforpriv'}) {
9651: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9652: }
1.630 raeburn 9653: }
1.439 raeburn 9654: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9655: my $match = 0;
1.412 raeburn 9656: my $secmatch = 0;
1.439 raeburn 9657: my $status;
1.412 raeburn 9658: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9659: $user =~ s/:$//;
1.439 raeburn 9660: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9661: if ($end == -1 || $start == -1) {
9662: next;
9663: }
9664: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9665: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9666: my ($uname,$udom) = split(/:/,$user);
9667: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9668: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9669: $secmatch = 1;
9670: } elsif ($usec eq '') {
1.420 albertel 9671: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9672: $secmatch = 1;
9673: }
9674: } else {
9675: if (grep(/^\Q$usec\E$/,@{$sections})) {
9676: $secmatch = 1;
9677: }
9678: }
9679: if (!$secmatch) {
9680: next;
9681: }
1.288 raeburn 9682: }
1.419 raeburn 9683: if ($usec eq '') {
9684: $usec = 'none';
9685: }
1.275 raeburn 9686: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9687: if ($hidepriv) {
1.1121 raeburn 9688: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9689: (!$nothide{$uname.':'.$udom})) {
9690: next;
9691: }
9692: }
1.503 raeburn 9693: if ($end > 0 && $end < $now) {
1.439 raeburn 9694: $status = 'previous';
9695: } elsif ($start > $now) {
9696: $status = 'future';
9697: } else {
9698: $status = 'active';
9699: }
1.277 albertel 9700: foreach my $type (keys(%{$types})) {
1.275 raeburn 9701: if ($status eq $type) {
1.420 albertel 9702: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9703: push(@{$$users{$role}{$user}},$type);
9704: }
1.288 raeburn 9705: $match = 1;
9706: }
9707: }
1.419 raeburn 9708: if (($match) && (ref($userdata) eq 'HASH')) {
9709: if (!exists($$userdata{$uname.':'.$udom})) {
9710: &get_user_info($udom,$uname,\%idx,$userdata);
9711: }
1.420 albertel 9712: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9713: push(@{$seclists{$uname.':'.$udom}},$usec);
9714: }
1.609 raeburn 9715: if (ref($statushash) eq 'HASH') {
9716: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9717: }
1.275 raeburn 9718: }
9719: }
9720: }
9721: }
1.290 albertel 9722: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9723: if ((defined($cdom)) && (defined($cnum))) {
9724: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9725: if ( defined($csettings{'internal.courseowner'}) ) {
9726: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9727: next if ($owner eq '');
9728: my ($ownername,$ownerdom);
9729: if ($owner =~ /^([^:]+):([^:]+)$/) {
9730: $ownername = $1;
9731: $ownerdom = $2;
9732: } else {
9733: $ownername = $owner;
9734: $ownerdom = $cdom;
9735: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9736: }
9737: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9738: if (defined($userdata) &&
1.609 raeburn 9739: !exists($$userdata{$owner})) {
9740: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9741: if (!grep(/^none$/,@{$seclists{$owner}})) {
9742: push(@{$seclists{$owner}},'none');
9743: }
9744: if (ref($statushash) eq 'HASH') {
9745: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9746: }
1.290 albertel 9747: }
1.279 raeburn 9748: }
9749: }
9750: }
1.419 raeburn 9751: foreach my $user (keys(%seclists)) {
9752: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9753: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9754: }
1.275 raeburn 9755: }
9756: return;
9757: }
9758:
1.288 raeburn 9759: sub get_user_info {
9760: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9761: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9762: &plainname($uname,$udom,'lastname');
1.291 albertel 9763: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9764: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9765: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9766: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9767: return;
9768: }
1.275 raeburn 9769:
1.472 raeburn 9770: ###############################################
9771:
9772: =pod
9773:
9774: =item * &get_user_quota()
9775:
1.1134 raeburn 9776: Retrieves quota assigned for storage of user files.
9777: Default is to report quota for portfolio files.
1.472 raeburn 9778:
9779: Incoming parameters:
9780: 1. user's username
9781: 2. user's domain
1.1134 raeburn 9782: 3. quota name - portfolio, author, or course
1.1136 raeburn 9783: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9784: 4. crstype - official, unofficial, textbook, placement or community,
9785: if quota name is course
1.472 raeburn 9786:
9787: Returns:
1.1163 raeburn 9788: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9789: 2. (Optional) Type of setting: custom or default
9790: (individually assigned or default for user's
9791: institutional status).
9792: 3. (Optional) - User's institutional status (e.g., faculty, staff
9793: or student - types as defined in localenroll::inst_usertypes
9794: for user's domain, which determines default quota for user.
9795: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9796:
9797: If a value has been stored in the user's environment,
1.536 raeburn 9798: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9799: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9800:
9801: =cut
9802:
9803: ###############################################
9804:
9805:
9806: sub get_user_quota {
1.1136 raeburn 9807: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9808: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9809: if (!defined($udom)) {
9810: $udom = $env{'user.domain'};
9811: }
9812: if (!defined($uname)) {
9813: $uname = $env{'user.name'};
9814: }
9815: if (($udom eq '' || $uname eq '') ||
9816: ($udom eq 'public') && ($uname eq 'public')) {
9817: $quota = 0;
1.536 raeburn 9818: $quotatype = 'default';
9819: $defquota = 0;
1.472 raeburn 9820: } else {
1.536 raeburn 9821: my $inststatus;
1.1134 raeburn 9822: if ($quotaname eq 'course') {
9823: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9824: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9825: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9826: } else {
9827: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9828: $quota = $cenv{'internal.uploadquota'};
9829: }
1.536 raeburn 9830: } else {
1.1134 raeburn 9831: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9832: if ($quotaname eq 'author') {
9833: $quota = $env{'environment.authorquota'};
9834: } else {
9835: $quota = $env{'environment.portfolioquota'};
9836: }
9837: $inststatus = $env{'environment.inststatus'};
9838: } else {
9839: my %userenv =
9840: &Apache::lonnet::get('environment',['portfolioquota',
9841: 'authorquota','inststatus'],$udom,$uname);
9842: my ($tmp) = keys(%userenv);
9843: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9844: if ($quotaname eq 'author') {
9845: $quota = $userenv{'authorquota'};
9846: } else {
9847: $quota = $userenv{'portfolioquota'};
9848: }
9849: $inststatus = $userenv{'inststatus'};
9850: } else {
9851: undef(%userenv);
9852: }
9853: }
9854: }
9855: if ($quota eq '' || wantarray) {
9856: if ($quotaname eq 'course') {
9857: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9858: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9859: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9860: ($crstype eq 'placement')) {
1.1136 raeburn 9861: $defquota = $domdefs{$crstype.'quota'};
9862: }
9863: if ($defquota eq '') {
9864: $defquota = 500;
9865: }
1.1134 raeburn 9866: } else {
9867: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9868: }
9869: if ($quota eq '') {
9870: $quota = $defquota;
9871: $quotatype = 'default';
9872: } else {
9873: $quotatype = 'custom';
9874: }
1.472 raeburn 9875: }
9876: }
1.536 raeburn 9877: if (wantarray) {
9878: return ($quota,$quotatype,$settingstatus,$defquota);
9879: } else {
9880: return $quota;
9881: }
1.472 raeburn 9882: }
9883:
9884: ###############################################
9885:
9886: =pod
9887:
9888: =item * &default_quota()
9889:
1.536 raeburn 9890: Retrieves default quota assigned for storage of user portfolio files,
9891: given an (optional) user's institutional status.
1.472 raeburn 9892:
9893: Incoming parameters:
1.1142 raeburn 9894:
1.472 raeburn 9895: 1. domain
1.536 raeburn 9896: 2. (Optional) institutional status(es). This is a : separated list of
9897: status types (e.g., faculty, staff, student etc.)
9898: which apply to the user for whom the default is being retrieved.
9899: If the institutional status string in undefined, the domain
1.1134 raeburn 9900: default quota will be returned.
9901: 3. quota name - portfolio, author, or course
9902: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9903:
9904: Returns:
1.1142 raeburn 9905:
1.1163 raeburn 9906: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9907: 2. (Optional) institutional type which determined the value of the
9908: default quota.
1.472 raeburn 9909:
9910: If a value has been stored in the domain's configuration db,
9911: it will return that, otherwise it returns 20 (for backwards
9912: compatibility with domains which have not set up a configuration
1.1163 raeburn 9913: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9914:
1.536 raeburn 9915: If the user's status includes multiple types (e.g., staff and student),
9916: the largest default quota which applies to the user determines the
9917: default quota returned.
9918:
1.472 raeburn 9919: =cut
9920:
9921: ###############################################
9922:
9923:
9924: sub default_quota {
1.1134 raeburn 9925: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9926: my ($defquota,$settingstatus);
9927: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9928: ['quotas'],$udom);
1.1134 raeburn 9929: my $key = 'defaultquota';
9930: if ($quotaname eq 'author') {
9931: $key = 'authorquota';
9932: }
1.622 raeburn 9933: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9934: if ($inststatus ne '') {
1.765 raeburn 9935: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9936: foreach my $item (@statuses) {
1.1134 raeburn 9937: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9938: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9939: if ($defquota eq '') {
1.1134 raeburn 9940: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9941: $settingstatus = $item;
1.1134 raeburn 9942: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9943: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9944: $settingstatus = $item;
9945: }
9946: }
1.1134 raeburn 9947: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9948: if ($quotahash{'quotas'}{$item} ne '') {
9949: if ($defquota eq '') {
9950: $defquota = $quotahash{'quotas'}{$item};
9951: $settingstatus = $item;
9952: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9953: $defquota = $quotahash{'quotas'}{$item};
9954: $settingstatus = $item;
9955: }
1.536 raeburn 9956: }
9957: }
9958: }
9959: }
9960: if ($defquota eq '') {
1.1134 raeburn 9961: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9962: $defquota = $quotahash{'quotas'}{$key}{'default'};
9963: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9964: $defquota = $quotahash{'quotas'}{'default'};
9965: }
1.536 raeburn 9966: $settingstatus = 'default';
1.1139 raeburn 9967: if ($defquota eq '') {
9968: if ($quotaname eq 'author') {
9969: $defquota = 500;
9970: }
9971: }
1.536 raeburn 9972: }
9973: } else {
9974: $settingstatus = 'default';
1.1134 raeburn 9975: if ($quotaname eq 'author') {
9976: $defquota = 500;
9977: } else {
9978: $defquota = 20;
9979: }
1.536 raeburn 9980: }
9981: if (wantarray) {
9982: return ($defquota,$settingstatus);
1.472 raeburn 9983: } else {
1.536 raeburn 9984: return $defquota;
1.472 raeburn 9985: }
9986: }
9987:
1.1135 raeburn 9988: ###############################################
9989:
9990: =pod
9991:
1.1136 raeburn 9992: =item * &excess_filesize_warning()
1.1135 raeburn 9993:
9994: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9995: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9996: space to be exceeded.
1.1136 raeburn 9997:
9998: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9999: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10000:
1.1165 raeburn 10001: Inputs: 7
1.1136 raeburn 10002: 1. username or coursenum
1.1135 raeburn 10003: 2. domain
1.1136 raeburn 10004: 3. context ('author' or 'course')
1.1135 raeburn 10005: 4. filename of file for which action is being requested
10006: 5. filesize (kB) of file
10007: 6. action being taken: copy or upload.
1.1237 raeburn 10008: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10009:
10010: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10011: otherwise return null.
10012:
10013: =back
1.1135 raeburn 10014:
10015: =cut
10016:
1.1136 raeburn 10017: sub excess_filesize_warning {
1.1165 raeburn 10018: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10019: my $current_disk_usage = 0;
1.1165 raeburn 10020: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10021: if ($context eq 'author') {
10022: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10023: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10024: } else {
10025: foreach my $subdir ('docs','supplemental') {
10026: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10027: }
10028: }
1.1135 raeburn 10029: $disk_quota = int($disk_quota * 1000);
10030: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10031: return '<p class="LC_warning">'.
1.1135 raeburn 10032: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10033: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10034: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10035: $disk_quota,$current_disk_usage).
10036: '</p>';
10037: }
10038: return;
10039: }
10040:
10041: ###############################################
10042:
10043:
1.1136 raeburn 10044:
10045:
1.384 raeburn 10046: sub get_secgrprole_info {
10047: my ($cdom,$cnum,$needroles,$type) = @_;
10048: my %sections_count = &get_sections($cdom,$cnum);
10049: my @sections = (sort {$a <=> $b} keys(%sections_count));
10050: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10051: my @groups = sort(keys(%curr_groups));
10052: my $allroles = [];
10053: my $rolehash;
10054: my $accesshash = {
10055: active => 'Currently has access',
10056: future => 'Will have future access',
10057: previous => 'Previously had access',
10058: };
10059: if ($needroles) {
10060: $rolehash = {'all' => 'all'};
1.385 albertel 10061: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10062: if (&Apache::lonnet::error(%user_roles)) {
10063: undef(%user_roles);
10064: }
10065: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10066: my ($role)=split(/\:/,$item,2);
10067: if ($role eq 'cr') { next; }
10068: if ($role =~ /^cr/) {
10069: $$rolehash{$role} = (split('/',$role))[3];
10070: } else {
10071: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10072: }
10073: }
10074: foreach my $key (sort(keys(%{$rolehash}))) {
10075: push(@{$allroles},$key);
10076: }
10077: push (@{$allroles},'st');
10078: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10079: }
10080: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10081: }
10082:
1.555 raeburn 10083: sub user_picker {
1.1279 raeburn 10084: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10085: my $currdom = $dom;
1.1253 raeburn 10086: my @alldoms = &Apache::lonnet::all_domains();
10087: if (@alldoms == 1) {
10088: my %domsrch = &Apache::lonnet::get_dom('configuration',
10089: ['directorysrch'],$alldoms[0]);
10090: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10091: my $showdom = $domdesc;
10092: if ($showdom eq '') {
10093: $showdom = $dom;
10094: }
10095: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10096: if ((!$domsrch{'directorysrch'}{'available'}) &&
10097: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10098: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10099: }
10100: }
10101: }
1.555 raeburn 10102: my %curr_selected = (
10103: srchin => 'dom',
1.580 raeburn 10104: srchby => 'lastname',
1.555 raeburn 10105: );
10106: my $srchterm;
1.625 raeburn 10107: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10108: if ($srch->{'srchby'} ne '') {
10109: $curr_selected{'srchby'} = $srch->{'srchby'};
10110: }
10111: if ($srch->{'srchin'} ne '') {
10112: $curr_selected{'srchin'} = $srch->{'srchin'};
10113: }
10114: if ($srch->{'srchtype'} ne '') {
10115: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10116: }
10117: if ($srch->{'srchdomain'} ne '') {
10118: $currdom = $srch->{'srchdomain'};
10119: }
10120: $srchterm = $srch->{'srchterm'};
10121: }
1.1222 damieng 10122: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10123: 'usr' => 'Search criteria',
1.563 raeburn 10124: 'doma' => 'Domain/institution to search',
1.558 albertel 10125: 'uname' => 'username',
10126: 'lastname' => 'last name',
1.555 raeburn 10127: 'lastfirst' => 'last name, first name',
1.558 albertel 10128: 'crs' => 'in this course',
1.576 raeburn 10129: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10130: 'alc' => 'all LON-CAPA',
1.573 raeburn 10131: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10132: 'exact' => 'is',
10133: 'contains' => 'contains',
1.569 raeburn 10134: 'begins' => 'begins with',
1.1222 damieng 10135: );
10136: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10137: 'youm' => "You must include some text to search for.",
10138: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10139: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10140: 'yomc' => "You must choose a domain when using an institutional directory search.",
10141: 'ymcd' => "You must choose a domain when using a domain search.",
10142: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10143: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10144: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10145: );
1.1222 damieng 10146: &html_escape(\%html_lt);
10147: &js_escape(\%js_lt);
1.1255 raeburn 10148: my $domform;
1.1277 raeburn 10149: my $allow_blank = 1;
1.1255 raeburn 10150: if ($fixeddom) {
1.1277 raeburn 10151: $allow_blank = 0;
10152: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 10153: } else {
1.1287 raeburn 10154: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 10155: my ($trusted,$untrusted);
1.1287 raeburn 10156: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 10157: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 10158: } elsif ($context eq 'author') {
1.1288 raeburn 10159: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 10160: } elsif ($context eq 'domain') {
1.1288 raeburn 10161: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 10162: }
1.1288 raeburn 10163: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 10164: }
1.563 raeburn 10165: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10166:
10167: my @srchins = ('crs','dom','alc','instd');
10168:
10169: foreach my $option (@srchins) {
10170: # FIXME 'alc' option unavailable until
10171: # loncreateuser::print_user_query_page()
10172: # has been completed.
10173: next if ($option eq 'alc');
1.880 raeburn 10174: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10175: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 10176: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10177: if ($curr_selected{'srchin'} eq $option) {
10178: $srchinsel .= '
1.1222 damieng 10179: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10180: } else {
10181: $srchinsel .= '
1.1222 damieng 10182: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10183: }
1.555 raeburn 10184: }
1.563 raeburn 10185: $srchinsel .= "\n </select>\n";
1.555 raeburn 10186:
10187: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10188: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10189: if ($curr_selected{'srchby'} eq $option) {
10190: $srchbysel .= '
1.1222 damieng 10191: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10192: } else {
10193: $srchbysel .= '
1.1222 damieng 10194: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10195: }
10196: }
10197: $srchbysel .= "\n </select>\n";
10198:
10199: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10200: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10201: if ($curr_selected{'srchtype'} eq $option) {
10202: $srchtypesel .= '
1.1222 damieng 10203: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10204: } else {
10205: $srchtypesel .= '
1.1222 damieng 10206: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10207: }
10208: }
10209: $srchtypesel .= "\n </select>\n";
10210:
1.558 albertel 10211: my ($newuserscript,$new_user_create);
1.994 raeburn 10212: my $context_dom = $env{'request.role.domain'};
10213: if ($context eq 'requestcrs') {
10214: if ($env{'form.coursedom'} ne '') {
10215: $context_dom = $env{'form.coursedom'};
10216: }
10217: }
1.556 raeburn 10218: if ($forcenewuser) {
1.576 raeburn 10219: if (ref($srch) eq 'HASH') {
1.994 raeburn 10220: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10221: if ($cancreate) {
10222: $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>';
10223: } else {
1.799 bisitz 10224: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10225: my %usertypetext = (
10226: official => 'institutional',
10227: unofficial => 'non-institutional',
10228: );
1.799 bisitz 10229: $new_user_create = '<p class="LC_warning">'
10230: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10231: .' '
10232: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10233: ,'<a href="'.$helplink.'">','</a>')
10234: .'</p><br />';
1.627 raeburn 10235: }
1.576 raeburn 10236: }
10237: }
10238:
1.556 raeburn 10239: $newuserscript = <<"ENDSCRIPT";
10240:
1.570 raeburn 10241: function setSearch(createnew,callingForm) {
1.556 raeburn 10242: if (createnew == 1) {
1.570 raeburn 10243: for (var i=0; i<callingForm.srchby.length; i++) {
10244: if (callingForm.srchby.options[i].value == 'uname') {
10245: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10246: }
10247: }
1.570 raeburn 10248: for (var i=0; i<callingForm.srchin.length; i++) {
10249: if ( callingForm.srchin.options[i].value == 'dom') {
10250: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10251: }
10252: }
1.570 raeburn 10253: for (var i=0; i<callingForm.srchtype.length; i++) {
10254: if (callingForm.srchtype.options[i].value == 'exact') {
10255: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10256: }
10257: }
1.570 raeburn 10258: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10259: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10260: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10261: }
10262: }
10263: }
10264: }
10265: ENDSCRIPT
1.558 albertel 10266:
1.556 raeburn 10267: }
10268:
1.555 raeburn 10269: my $output = <<"END_BLOCK";
1.556 raeburn 10270: <script type="text/javascript">
1.824 bisitz 10271: // <![CDATA[
1.570 raeburn 10272: function validateEntry(callingForm) {
1.558 albertel 10273:
1.556 raeburn 10274: var checkok = 1;
1.558 albertel 10275: var srchin;
1.570 raeburn 10276: for (var i=0; i<callingForm.srchin.length; i++) {
10277: if ( callingForm.srchin[i].checked ) {
10278: srchin = callingForm.srchin[i].value;
1.558 albertel 10279: }
10280: }
10281:
1.570 raeburn 10282: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10283: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10284: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10285: var srchterm = callingForm.srchterm.value;
10286: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10287: var msg = "";
10288:
10289: if (srchterm == "") {
10290: checkok = 0;
1.1222 damieng 10291: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10292: }
10293:
1.569 raeburn 10294: if (srchtype== 'begins') {
10295: if (srchterm.length < 2) {
10296: checkok = 0;
1.1222 damieng 10297: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10298: }
10299: }
10300:
1.556 raeburn 10301: if (srchtype== 'contains') {
10302: if (srchterm.length < 3) {
10303: checkok = 0;
1.1222 damieng 10304: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10305: }
10306: }
10307: if (srchin == 'instd') {
10308: if (srchdomain == '') {
10309: checkok = 0;
1.1222 damieng 10310: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10311: }
10312: }
10313: if (srchin == 'dom') {
10314: if (srchdomain == '') {
10315: checkok = 0;
1.1222 damieng 10316: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10317: }
10318: }
10319: if (srchby == 'lastfirst') {
10320: if (srchterm.indexOf(",") == -1) {
10321: checkok = 0;
1.1222 damieng 10322: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10323: }
10324: if (srchterm.indexOf(",") == srchterm.length -1) {
10325: checkok = 0;
1.1222 damieng 10326: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10327: }
10328: }
10329: if (checkok == 0) {
1.1222 damieng 10330: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10331: return;
10332: }
10333: if (checkok == 1) {
1.570 raeburn 10334: callingForm.submit();
1.556 raeburn 10335: }
10336: }
10337:
10338: $newuserscript
10339:
1.824 bisitz 10340: // ]]>
1.556 raeburn 10341: </script>
1.558 albertel 10342:
10343: $new_user_create
10344:
1.555 raeburn 10345: END_BLOCK
1.558 albertel 10346:
1.876 raeburn 10347: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10348: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10349: $domform.
10350: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10351: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10352: $srchbysel.
10353: $srchtypesel.
10354: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10355: $srchinsel.
10356: &Apache::lonhtmlcommon::row_closure(1).
10357: &Apache::lonhtmlcommon::end_pick_box().
10358: '<br />';
1.1253 raeburn 10359: return ($output,1);
1.555 raeburn 10360: }
10361:
1.612 raeburn 10362: sub user_rule_check {
1.615 raeburn 10363: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10364: my ($response,%inst_response);
1.612 raeburn 10365: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10366: if (keys(%{$usershash}) > 1) {
10367: my (%by_username,%by_id,%userdoms);
10368: my $checkid;
10369: if (ref($checks) eq 'HASH') {
10370: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10371: $checkid = 1;
10372: }
10373: }
10374: foreach my $user (keys(%{$usershash})) {
10375: my ($uname,$udom) = split(/:/,$user);
10376: if ($checkid) {
10377: if (ref($usershash->{$user}) eq 'HASH') {
10378: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10379: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10380: $userdoms{$udom} = 1;
1.1227 raeburn 10381: if (ref($inst_results) eq 'HASH') {
10382: $inst_results->{$uname.':'.$udom} = {};
10383: }
1.1226 raeburn 10384: }
10385: }
10386: } else {
10387: $by_username{$udom}{$uname} = 1;
10388: $userdoms{$udom} = 1;
1.1227 raeburn 10389: if (ref($inst_results) eq 'HASH') {
10390: $inst_results->{$uname.':'.$udom} = {};
10391: }
1.1226 raeburn 10392: }
10393: }
10394: foreach my $udom (keys(%userdoms)) {
10395: if (!$got_rules->{$udom}) {
10396: my %domconfig = &Apache::lonnet::get_dom('configuration',
10397: ['usercreation'],$udom);
10398: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10399: foreach my $item ('username','id') {
10400: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10401: $$curr_rules{$udom}{$item} =
10402: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10403: }
10404: }
10405: }
10406: $got_rules->{$udom} = 1;
10407: }
1.612 raeburn 10408: }
1.1226 raeburn 10409: if ($checkid) {
10410: foreach my $udom (keys(%by_id)) {
10411: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10412: if ($outcome eq 'ok') {
1.1227 raeburn 10413: foreach my $id (keys(%{$by_id{$udom}})) {
10414: my $uname = $by_id{$udom}{$id};
10415: $inst_response{$uname.':'.$udom} = $outcome;
10416: }
1.1226 raeburn 10417: if (ref($results) eq 'HASH') {
10418: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10419: if (exists($inst_response{$uname.':'.$udom})) {
10420: $inst_response{$uname.':'.$udom} = $outcome;
10421: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10422: }
1.1226 raeburn 10423: }
10424: }
10425: }
1.612 raeburn 10426: }
1.615 raeburn 10427: } else {
1.1226 raeburn 10428: foreach my $udom (keys(%by_username)) {
10429: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10430: if ($outcome eq 'ok') {
1.1227 raeburn 10431: foreach my $uname (keys(%{$by_username{$udom}})) {
10432: $inst_response{$uname.':'.$udom} = $outcome;
10433: }
1.1226 raeburn 10434: if (ref($results) eq 'HASH') {
10435: foreach my $uname (keys(%{$results})) {
10436: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10437: }
10438: }
10439: }
10440: }
1.612 raeburn 10441: }
1.1226 raeburn 10442: } elsif (keys(%{$usershash}) == 1) {
10443: my $user = (keys(%{$usershash}))[0];
10444: my ($uname,$udom) = split(/:/,$user);
10445: if (($udom ne '') && ($uname ne '')) {
10446: if (ref($usershash->{$user}) eq 'HASH') {
10447: if (ref($checks) eq 'HASH') {
10448: if (defined($checks->{'username'})) {
10449: ($inst_response{$user},%{$inst_results->{$user}}) =
10450: &Apache::lonnet::get_instuser($udom,$uname);
10451: } elsif (defined($checks->{'id'})) {
10452: if ($usershash->{$user}->{'id'} ne '') {
10453: ($inst_response{$user},%{$inst_results->{$user}}) =
10454: &Apache::lonnet::get_instuser($udom,undef,
10455: $usershash->{$user}->{'id'});
10456: } else {
10457: ($inst_response{$user},%{$inst_results->{$user}}) =
10458: &Apache::lonnet::get_instuser($udom,$uname);
10459: }
1.585 raeburn 10460: }
1.1226 raeburn 10461: } else {
10462: ($inst_response{$user},%{$inst_results->{$user}}) =
10463: &Apache::lonnet::get_instuser($udom,$uname);
10464: return;
10465: }
10466: if (!$got_rules->{$udom}) {
10467: my %domconfig = &Apache::lonnet::get_dom('configuration',
10468: ['usercreation'],$udom);
10469: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10470: foreach my $item ('username','id') {
10471: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10472: $$curr_rules{$udom}{$item} =
10473: $domconfig{'usercreation'}{$item.'_rule'};
10474: }
10475: }
10476: }
10477: $got_rules->{$udom} = 1;
1.585 raeburn 10478: }
10479: }
1.1226 raeburn 10480: } else {
10481: return;
10482: }
10483: } else {
10484: return;
10485: }
10486: foreach my $user (keys(%{$usershash})) {
10487: my ($uname,$udom) = split(/:/,$user);
10488: next if (($udom eq '') || ($uname eq ''));
10489: my $id;
1.1227 raeburn 10490: if (ref($inst_results) eq 'HASH') {
10491: if (ref($inst_results->{$user}) eq 'HASH') {
10492: $id = $inst_results->{$user}->{'id'};
10493: }
10494: }
10495: if ($id eq '') {
10496: if (ref($usershash->{$user})) {
10497: $id = $usershash->{$user}->{'id'};
10498: }
1.585 raeburn 10499: }
1.612 raeburn 10500: foreach my $item (keys(%{$checks})) {
10501: if (ref($$curr_rules{$udom}) eq 'HASH') {
10502: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10503: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10504: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10505: $$curr_rules{$udom}{$item});
1.612 raeburn 10506: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10507: if ($rule_check{$rule}) {
10508: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10509: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10510: if (ref($inst_results) eq 'HASH') {
10511: if (ref($inst_results->{$user}) eq 'HASH') {
10512: if (keys(%{$inst_results->{$user}}) == 0) {
10513: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10514: } elsif ($item eq 'id') {
10515: if ($inst_results->{$user}->{'id'} eq '') {
10516: $$alerts{$item}{$udom}{$uname} = 1;
10517: }
1.615 raeburn 10518: }
1.612 raeburn 10519: }
10520: }
1.615 raeburn 10521: }
10522: last;
1.585 raeburn 10523: }
10524: }
10525: }
10526: }
10527: }
10528: }
10529: }
10530: }
1.612 raeburn 10531: return;
10532: }
10533:
10534: sub user_rule_formats {
10535: my ($domain,$domdesc,$curr_rules,$check) = @_;
10536: my %text = (
10537: 'username' => 'Usernames',
10538: 'id' => 'IDs',
10539: );
10540: my $output;
10541: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10542: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10543: if (@{$ruleorder} > 0) {
1.1102 raeburn 10544: $output = '<br />'.
10545: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10546: '<span class="LC_cusr_emph">','</span>',$domdesc).
10547: ' <ul>';
1.612 raeburn 10548: foreach my $rule (@{$ruleorder}) {
10549: if (ref($curr_rules) eq 'ARRAY') {
10550: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10551: if (ref($rules->{$rule}) eq 'HASH') {
10552: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10553: $rules->{$rule}{'desc'}.'</li>';
10554: }
10555: }
10556: }
10557: }
10558: $output .= '</ul>';
10559: }
10560: }
10561: return $output;
10562: }
10563:
10564: sub instrule_disallow_msg {
1.615 raeburn 10565: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10566: my $response;
10567: my %text = (
10568: item => 'username',
10569: items => 'usernames',
10570: match => 'matches',
10571: do => 'does',
10572: action => 'a username',
10573: one => 'one',
10574: );
10575: if ($count > 1) {
10576: $text{'item'} = 'usernames';
10577: $text{'match'} ='match';
10578: $text{'do'} = 'do';
10579: $text{'action'} = 'usernames',
10580: $text{'one'} = 'ones';
10581: }
10582: if ($checkitem eq 'id') {
10583: $text{'items'} = 'IDs';
10584: $text{'item'} = 'ID';
10585: $text{'action'} = 'an ID';
1.615 raeburn 10586: if ($count > 1) {
10587: $text{'item'} = 'IDs';
10588: $text{'action'} = 'IDs';
10589: }
1.612 raeburn 10590: }
1.674 bisitz 10591: $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 10592: if ($mode eq 'upload') {
10593: if ($checkitem eq 'username') {
10594: $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'}.");
10595: } elsif ($checkitem eq 'id') {
1.674 bisitz 10596: $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 10597: }
1.669 raeburn 10598: } elsif ($mode eq 'selfcreate') {
10599: if ($checkitem eq 'id') {
10600: $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.");
10601: }
1.615 raeburn 10602: } else {
10603: if ($checkitem eq 'username') {
10604: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10605: } elsif ($checkitem eq 'id') {
10606: $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.");
10607: }
1.612 raeburn 10608: }
10609: return $response;
1.585 raeburn 10610: }
10611:
1.624 raeburn 10612: sub personal_data_fieldtitles {
10613: my %fieldtitles = &Apache::lonlocal::texthash (
10614: id => 'Student/Employee ID',
10615: permanentemail => 'E-mail address',
10616: lastname => 'Last Name',
10617: firstname => 'First Name',
10618: middlename => 'Middle Name',
10619: generation => 'Generation',
10620: gen => 'Generation',
1.765 raeburn 10621: inststatus => 'Affiliation',
1.624 raeburn 10622: );
10623: return %fieldtitles;
10624: }
10625:
1.642 raeburn 10626: sub sorted_inst_types {
10627: my ($dom) = @_;
1.1185 raeburn 10628: my ($usertypes,$order);
10629: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10630: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10631: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10632: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10633: } else {
10634: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10635: }
1.642 raeburn 10636: my $othertitle = &mt('All users');
10637: if ($env{'request.course.id'}) {
1.668 raeburn 10638: $othertitle = &mt('Any users');
1.642 raeburn 10639: }
10640: my @types;
10641: if (ref($order) eq 'ARRAY') {
10642: @types = @{$order};
10643: }
10644: if (@types == 0) {
10645: if (ref($usertypes) eq 'HASH') {
10646: @types = sort(keys(%{$usertypes}));
10647: }
10648: }
10649: if (keys(%{$usertypes}) > 0) {
10650: $othertitle = &mt('Other users');
10651: }
10652: return ($othertitle,$usertypes,\@types);
10653: }
10654:
1.645 raeburn 10655: sub get_institutional_codes {
10656: my ($settings,$allcourses,$LC_code) = @_;
10657: # Get complete list of course sections to update
10658: my @currsections = ();
10659: my @currxlists = ();
10660: my $coursecode = $$settings{'internal.coursecode'};
10661:
10662: if ($$settings{'internal.sectionnums'} ne '') {
10663: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10664: }
10665:
10666: if ($$settings{'internal.crosslistings'} ne '') {
10667: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10668: }
10669:
10670: if (@currxlists > 0) {
10671: foreach (@currxlists) {
10672: if (m/^([^:]+):(\w*)$/) {
10673: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 10674: push(@{$allcourses},$1);
1.645 raeburn 10675: $$LC_code{$1} = $2;
10676: }
10677: }
10678: }
10679: }
10680:
10681: if (@currsections > 0) {
10682: foreach (@currsections) {
10683: if (m/^(\w+):(\w*)$/) {
10684: my $sec = $coursecode.$1;
10685: my $lc_sec = $2;
10686: unless (grep/^$sec$/,@{$allcourses}) {
1.1263 raeburn 10687: push(@{$allcourses},$sec);
1.645 raeburn 10688: $$LC_code{$sec} = $lc_sec;
10689: }
10690: }
10691: }
10692: }
10693: return;
10694: }
10695:
1.971 raeburn 10696: sub get_standard_codeitems {
10697: return ('Year','Semester','Department','Number','Section');
10698: }
10699:
1.112 bowersj2 10700: =pod
10701:
1.780 raeburn 10702: =head1 Slot Helpers
10703:
10704: =over 4
10705:
10706: =item * sorted_slots()
10707:
1.1040 raeburn 10708: Sorts an array of slot names in order of an optional sort key,
10709: default sort is by slot start time (earliest first).
1.780 raeburn 10710:
10711: Inputs:
10712:
10713: =over 4
10714:
10715: slotsarr - Reference to array of unsorted slot names.
10716:
10717: slots - Reference to hash of hash, where outer hash keys are slot names.
10718:
1.1040 raeburn 10719: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10720:
1.549 albertel 10721: =back
10722:
1.780 raeburn 10723: Returns:
10724:
10725: =over 4
10726:
1.1040 raeburn 10727: sorted - An array of slot names sorted by a specified sort key
10728: (default sort key is start time of the slot).
1.780 raeburn 10729:
10730: =back
10731:
10732: =cut
10733:
10734:
10735: sub sorted_slots {
1.1040 raeburn 10736: my ($slotsarr,$slots,$sortkey) = @_;
10737: if ($sortkey eq '') {
10738: $sortkey = 'starttime';
10739: }
1.780 raeburn 10740: my @sorted;
10741: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10742: @sorted =
10743: sort {
10744: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10745: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10746: }
10747: if (ref($slots->{$a})) { return -1;}
10748: if (ref($slots->{$b})) { return 1;}
10749: return 0;
10750: } @{$slotsarr};
10751: }
10752: return @sorted;
10753: }
10754:
1.1040 raeburn 10755: =pod
10756:
10757: =item * get_future_slots()
10758:
10759: Inputs:
10760:
10761: =over 4
10762:
10763: cnum - course number
10764:
10765: cdom - course domain
10766:
10767: now - current UNIX time
10768:
10769: symb - optional symb
10770:
10771: =back
10772:
10773: Returns:
10774:
10775: =over 4
10776:
10777: sorted_reservable - ref to array of student_schedulable slots currently
10778: reservable, ordered by end date of reservation period.
10779:
10780: reservable_now - ref to hash of student_schedulable slots currently
10781: reservable.
10782:
10783: Keys in inner hash are:
10784: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10785: (b) endreserve: end date of reservation period.
10786: (c) uniqueperiod: start,end dates when slot is to be uniquely
10787: selected.
1.1040 raeburn 10788:
10789: sorted_future - ref to array of student_schedulable slots reservable in
10790: the future, ordered by start date of reservation period.
10791:
10792: future_reservable - ref to hash of student_schedulable slots reservable
10793: in the future.
10794:
10795: Keys in inner hash are:
10796: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10797: (b) startreserve: start date of reservation period.
10798: (c) uniqueperiod: start,end dates when slot is to be uniquely
10799: selected.
1.1040 raeburn 10800:
10801: =back
10802:
10803: =cut
10804:
10805: sub get_future_slots {
10806: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10807: my $map;
10808: if ($symb) {
10809: ($map) = &Apache::lonnet::decode_symb($symb);
10810: }
1.1040 raeburn 10811: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10812: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10813: foreach my $slot (keys(%slots)) {
10814: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10815: if ($symb) {
1.1229 raeburn 10816: if ($slots{$slot}->{'symb'} ne '') {
10817: my $canuse;
10818: my %oksymbs;
10819: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10820: map { $oksymbs{$_} = 1; } @slotsymbs;
10821: if ($oksymbs{$symb}) {
10822: $canuse = 1;
10823: } else {
10824: foreach my $item (@slotsymbs) {
10825: if ($item =~ /\.(page|sequence)$/) {
10826: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10827: if (($map ne '') && ($map eq $sloturl)) {
10828: $canuse = 1;
10829: last;
10830: }
10831: }
10832: }
10833: }
10834: next unless ($canuse);
10835: }
1.1040 raeburn 10836: }
10837: if (($slots{$slot}->{'starttime'} > $now) &&
10838: ($slots{$slot}->{'endtime'} > $now)) {
10839: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10840: my $userallowed = 0;
10841: if ($slots{$slot}->{'allowedsections'}) {
10842: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10843: if (!defined($env{'request.role.sec'})
10844: && grep(/^No section assigned$/,@allowed_sec)) {
10845: $userallowed=1;
10846: } else {
10847: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10848: $userallowed=1;
10849: }
10850: }
10851: unless ($userallowed) {
10852: if (defined($env{'request.course.groups'})) {
10853: my @groups = split(/:/,$env{'request.course.groups'});
10854: foreach my $group (@groups) {
10855: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10856: $userallowed=1;
10857: last;
10858: }
10859: }
10860: }
10861: }
10862: }
10863: if ($slots{$slot}->{'allowedusers'}) {
10864: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10865: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10866: if (grep(/^\Q$user\E$/,@allowed_users)) {
10867: $userallowed = 1;
10868: }
10869: }
10870: next unless($userallowed);
10871: }
10872: my $startreserve = $slots{$slot}->{'startreserve'};
10873: my $endreserve = $slots{$slot}->{'endreserve'};
10874: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 10875: my $uniqueperiod;
10876: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10877: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10878: }
1.1040 raeburn 10879: if (($startreserve < $now) &&
10880: (!$endreserve || $endreserve > $now)) {
10881: my $lastres = $endreserve;
10882: if (!$lastres) {
10883: $lastres = $slots{$slot}->{'starttime'};
10884: }
10885: $reservable_now{$slot} = {
10886: symb => $symb,
1.1250 raeburn 10887: endreserve => $lastres,
10888: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10889: };
10890: } elsif (($startreserve > $now) &&
10891: (!$endreserve || $endreserve > $startreserve)) {
10892: $future_reservable{$slot} = {
10893: symb => $symb,
1.1250 raeburn 10894: startreserve => $startreserve,
10895: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10896: };
10897: }
10898: }
10899: }
10900: my @unsorted_reservable = keys(%reservable_now);
10901: if (@unsorted_reservable > 0) {
10902: @sorted_reservable =
10903: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10904: }
10905: my @unsorted_future = keys(%future_reservable);
10906: if (@unsorted_future > 0) {
10907: @sorted_future =
10908: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10909: }
10910: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10911: }
1.780 raeburn 10912:
10913: =pod
10914:
1.1057 foxr 10915: =back
10916:
1.549 albertel 10917: =head1 HTTP Helpers
10918:
10919: =over 4
10920:
1.648 raeburn 10921: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10922:
1.258 albertel 10923: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10924: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10925: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10926:
10927: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10928: $possible_names is an ref to an array of form element names. As an example:
10929: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10930: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10931:
10932: =cut
1.1 albertel 10933:
1.6 albertel 10934: sub get_unprocessed_cgi {
1.25 albertel 10935: my ($query,$possible_names)= @_;
1.26 matthew 10936: # $Apache::lonxml::debug=1;
1.356 albertel 10937: foreach my $pair (split(/&/,$query)) {
10938: my ($name, $value) = split(/=/,$pair);
1.369 www 10939: $name = &unescape($name);
1.25 albertel 10940: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10941: $value =~ tr/+/ /;
10942: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10943: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10944: }
1.16 harris41 10945: }
1.6 albertel 10946: }
10947:
1.112 bowersj2 10948: =pod
10949:
1.648 raeburn 10950: =item * &cacheheader()
1.112 bowersj2 10951:
10952: returns cache-controlling header code
10953:
10954: =cut
10955:
1.7 albertel 10956: sub cacheheader {
1.258 albertel 10957: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10958: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10959: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10960: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10961: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10962: return $output;
1.7 albertel 10963: }
10964:
1.112 bowersj2 10965: =pod
10966:
1.648 raeburn 10967: =item * &no_cache($r)
1.112 bowersj2 10968:
10969: specifies header code to not have cache
10970:
10971: =cut
10972:
1.9 albertel 10973: sub no_cache {
1.216 albertel 10974: my ($r) = @_;
10975: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10976: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10977: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10978: $r->no_cache(1);
10979: $r->header_out("Expires" => $date);
10980: $r->header_out("Pragma" => "no-cache");
1.123 www 10981: }
10982:
10983: sub content_type {
1.181 albertel 10984: my ($r,$type,$charset) = @_;
1.299 foxr 10985: if ($r) {
10986: # Note that printout.pl calls this with undef for $r.
10987: &no_cache($r);
10988: }
1.258 albertel 10989: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10990: unless ($charset) {
10991: $charset=&Apache::lonlocal::current_encoding;
10992: }
10993: if ($charset) { $type.='; charset='.$charset; }
10994: if ($r) {
10995: $r->content_type($type);
10996: } else {
10997: print("Content-type: $type\n\n");
10998: }
1.9 albertel 10999: }
1.25 albertel 11000:
1.112 bowersj2 11001: =pod
11002:
1.648 raeburn 11003: =item * &add_to_env($name,$value)
1.112 bowersj2 11004:
1.258 albertel 11005: adds $name to the %env hash with value
1.112 bowersj2 11006: $value, if $name already exists, the entry is converted to an array
11007: reference and $value is added to the array.
11008:
11009: =cut
11010:
1.25 albertel 11011: sub add_to_env {
11012: my ($name,$value)=@_;
1.258 albertel 11013: if (defined($env{$name})) {
11014: if (ref($env{$name})) {
1.25 albertel 11015: #already have multiple values
1.258 albertel 11016: push(@{ $env{$name} },$value);
1.25 albertel 11017: } else {
11018: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11019: my $first=$env{$name};
11020: undef($env{$name});
11021: push(@{ $env{$name} },$first,$value);
1.25 albertel 11022: }
11023: } else {
1.258 albertel 11024: $env{$name}=$value;
1.25 albertel 11025: }
1.31 albertel 11026: }
1.149 albertel 11027:
11028: =pod
11029:
1.648 raeburn 11030: =item * &get_env_multiple($name)
1.149 albertel 11031:
1.258 albertel 11032: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11033: values may be defined and end up as an array ref.
11034:
11035: returns an array of values
11036:
11037: =cut
11038:
11039: sub get_env_multiple {
11040: my ($name) = @_;
11041: my @values;
1.258 albertel 11042: if (defined($env{$name})) {
1.149 albertel 11043: # exists is it an array
1.258 albertel 11044: if (ref($env{$name})) {
11045: @values=@{ $env{$name} };
1.149 albertel 11046: } else {
1.258 albertel 11047: $values[0]=$env{$name};
1.149 albertel 11048: }
11049: }
11050: return(@values);
11051: }
11052:
1.1249 damieng 11053: # Looks at given dependencies, and returns something depending on the context.
11054: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11055: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11056: # For all other contexts, returns ($output, $counter, $numpathchg).
11057: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11058: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
11059: # $numpathchg: integer with the number of cleaned up dependency paths.
11060: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11061: # \%mapping: hash reference clean path -> original path for all dependencies.
11062: # @param {string} actionurl - The path to the handler, indicative of the context.
11063: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11064: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11065: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11066: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
11067: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11068: sub ask_for_embedded_content {
1.1249 damieng 11069: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11070: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11071: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11072: %currsubfile,%unused,$rem);
1.1071 raeburn 11073: my $counter = 0;
11074: my $numnew = 0;
1.987 raeburn 11075: my $numremref = 0;
11076: my $numinvalid = 0;
11077: my $numpathchg = 0;
11078: my $numexisting = 0;
1.1071 raeburn 11079: my $numunused = 0;
11080: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11081: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11082: my $heading = &mt('Upload embedded files');
11083: my $buttontext = &mt('Upload');
11084:
1.1249 damieng 11085: # fills these variables based on the context:
11086: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11087: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11088: if ($env{'request.course.id'}) {
1.1123 raeburn 11089: if ($actionurl eq '/adm/dependencies') {
11090: $navmap = Apache::lonnavmaps::navmap->new();
11091: }
11092: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11093: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11094: }
1.1123 raeburn 11095: if (($actionurl eq '/adm/portfolio') ||
11096: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11097: my $current_path='/';
11098: if ($env{'form.currentpath'}) {
11099: $current_path = $env{'form.currentpath'};
11100: }
11101: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11102: $udom = $cdom;
11103: $uname = $cnum;
1.984 raeburn 11104: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11105: } else {
11106: $udom = $env{'user.domain'};
11107: $uname = $env{'user.name'};
11108: $url = '/userfiles/portfolio';
11109: }
1.987 raeburn 11110: $toplevel = $url.'/';
1.984 raeburn 11111: $url .= $current_path;
11112: $getpropath = 1;
1.987 raeburn 11113: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11114: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11115: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11116: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11117: $toplevel = $url;
1.984 raeburn 11118: if ($rest ne '') {
1.987 raeburn 11119: $url .= $rest;
11120: }
11121: } elsif ($actionurl eq '/adm/coursedocs') {
11122: if (ref($args) eq 'HASH') {
1.1071 raeburn 11123: $url = $args->{'docs_url'};
11124: $toplevel = $url;
1.1084 raeburn 11125: if ($args->{'context'} eq 'paste') {
11126: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11127: ($path) =
11128: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11129: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11130: $fileloc =~ s{^/}{};
11131: }
1.1071 raeburn 11132: }
1.1084 raeburn 11133: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 11134: if ($env{'request.course.id'} ne '') {
11135: if (ref($args) eq 'HASH') {
11136: $url = $args->{'docs_url'};
11137: $title = $args->{'docs_title'};
1.1126 raeburn 11138: $toplevel = $url;
11139: unless ($toplevel =~ m{^/}) {
11140: $toplevel = "/$url";
11141: }
1.1085 raeburn 11142: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11143: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11144: $path = $1;
11145: } else {
11146: ($path) =
11147: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11148: }
1.1195 raeburn 11149: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11150: $fileloc = $toplevel;
11151: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11152: my ($udom,$uname,$fname) =
11153: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11154: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11155: } else {
11156: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11157: }
1.1071 raeburn 11158: $fileloc =~ s{^/}{};
11159: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11160: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11161: }
1.987 raeburn 11162: }
1.1123 raeburn 11163: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11164: $udom = $cdom;
11165: $uname = $cnum;
11166: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11167: $toplevel = $url;
11168: $path = $url;
11169: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11170: $fileloc =~ s{^/}{};
1.987 raeburn 11171: }
1.1249 damieng 11172:
11173: # parses the dependency paths to get some info
11174: # fills $newfiles, $mapping, $subdependencies, $dependencies
11175: # $newfiles: hash URL -> 1 for new files or external URLs
11176: # (will be completed later)
11177: # $mapping:
11178: # for external URLs: external URL -> external URL
11179: # for relative paths: clean path -> original path
11180: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11181: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11182: foreach my $file (keys(%{$allfiles})) {
11183: my $embed_file;
11184: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11185: $embed_file = $1;
11186: } else {
11187: $embed_file = $file;
11188: }
1.1158 raeburn 11189: my ($absolutepath,$cleaned_file);
11190: if ($embed_file =~ m{^\w+://}) {
11191: $cleaned_file = $embed_file;
1.1147 raeburn 11192: $newfiles{$cleaned_file} = 1;
11193: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11194: } else {
1.1158 raeburn 11195: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11196: if ($embed_file =~ m{^/}) {
11197: $absolutepath = $embed_file;
11198: }
1.1147 raeburn 11199: if ($cleaned_file =~ m{/}) {
11200: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11201: $path = &check_for_traversal($path,$url,$toplevel);
11202: my $item = $fname;
11203: if ($path ne '') {
11204: $item = $path.'/'.$fname;
11205: $subdependencies{$path}{$fname} = 1;
11206: } else {
11207: $dependencies{$item} = 1;
11208: }
11209: if ($absolutepath) {
11210: $mapping{$item} = $absolutepath;
11211: } else {
11212: $mapping{$item} = $embed_file;
11213: }
11214: } else {
11215: $dependencies{$embed_file} = 1;
11216: if ($absolutepath) {
1.1147 raeburn 11217: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11218: } else {
1.1147 raeburn 11219: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11220: }
11221: }
1.984 raeburn 11222: }
11223: }
1.1249 damieng 11224:
11225: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11226: # and lists
11227: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11228: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11229: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11230: # the path had to be cleaned up
11231: # $existing: hash clean path -> 1 if the file exists
11232: # $numexisting: number of keys in $existing
11233: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11234: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11235: # dependency subdirectories that are
11236: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11237: my $dirptr = 16384;
1.984 raeburn 11238: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11239: $currsubfile{$path} = {};
1.1123 raeburn 11240: if (($actionurl eq '/adm/portfolio') ||
11241: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11242: my ($sublistref,$listerror) =
11243: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11244: if (ref($sublistref) eq 'ARRAY') {
11245: foreach my $line (@{$sublistref}) {
11246: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11247: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11248: }
1.984 raeburn 11249: }
1.987 raeburn 11250: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11251: if (opendir(my $dir,$url.'/'.$path)) {
11252: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11253: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11254: }
1.1084 raeburn 11255: } elsif (($actionurl eq '/adm/dependencies') ||
11256: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11257: ($args->{'context'} eq 'paste')) ||
11258: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11259: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11260: my $dir;
11261: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11262: $dir = $fileloc;
11263: } else {
11264: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11265: }
1.1071 raeburn 11266: if ($dir ne '') {
11267: my ($sublistref,$listerror) =
11268: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11269: if (ref($sublistref) eq 'ARRAY') {
11270: foreach my $line (@{$sublistref}) {
11271: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11272: undef,$mtime)=split(/\&/,$line,12);
11273: unless (($testdir&$dirptr) ||
11274: ($file_name =~ /^\.\.?$/)) {
11275: $currsubfile{$path}{$file_name} = [$size,$mtime];
11276: }
11277: }
11278: }
11279: }
1.984 raeburn 11280: }
11281: }
11282: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11283: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11284: my $item = $path.'/'.$file;
11285: unless ($mapping{$item} eq $item) {
11286: $pathchanges{$item} = 1;
11287: }
11288: $existing{$item} = 1;
11289: $numexisting ++;
11290: } else {
11291: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11292: }
11293: }
1.1071 raeburn 11294: if ($actionurl eq '/adm/dependencies') {
11295: foreach my $path (keys(%currsubfile)) {
11296: if (ref($currsubfile{$path}) eq 'HASH') {
11297: foreach my $file (keys(%{$currsubfile{$path}})) {
11298: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11299: next if (($rem ne '') &&
11300: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11301: (ref($navmap) &&
11302: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11303: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11304: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11305: $unused{$path.'/'.$file} = 1;
11306: }
11307: }
11308: }
11309: }
11310: }
1.984 raeburn 11311: }
1.1249 damieng 11312:
11313: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11314: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11315: my %currfile;
1.1123 raeburn 11316: if (($actionurl eq '/adm/portfolio') ||
11317: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11318: my ($dirlistref,$listerror) =
11319: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11320: if (ref($dirlistref) eq 'ARRAY') {
11321: foreach my $line (@{$dirlistref}) {
11322: my ($file_name,$rest) = split(/\&/,$line,2);
11323: $currfile{$file_name} = 1;
11324: }
1.984 raeburn 11325: }
1.987 raeburn 11326: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11327: if (opendir(my $dir,$url)) {
1.987 raeburn 11328: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11329: map {$currfile{$_} = 1;} @dir_list;
11330: }
1.1084 raeburn 11331: } elsif (($actionurl eq '/adm/dependencies') ||
11332: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11333: ($args->{'context'} eq 'paste')) ||
11334: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11335: if ($env{'request.course.id'} ne '') {
11336: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11337: if ($dir ne '') {
11338: my ($dirlistref,$listerror) =
11339: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11340: if (ref($dirlistref) eq 'ARRAY') {
11341: foreach my $line (@{$dirlistref}) {
11342: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11343: $size,undef,$mtime)=split(/\&/,$line,12);
11344: unless (($testdir&$dirptr) ||
11345: ($file_name =~ /^\.\.?$/)) {
11346: $currfile{$file_name} = [$size,$mtime];
11347: }
11348: }
11349: }
11350: }
11351: }
1.984 raeburn 11352: }
1.1249 damieng 11353: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11354: # are not in subdirectories, using $currfile
1.984 raeburn 11355: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11356: if (exists($currfile{$file})) {
1.987 raeburn 11357: unless ($mapping{$file} eq $file) {
11358: $pathchanges{$file} = 1;
11359: }
11360: $existing{$file} = 1;
11361: $numexisting ++;
11362: } else {
1.984 raeburn 11363: $newfiles{$file} = 1;
11364: }
11365: }
1.1071 raeburn 11366: foreach my $file (keys(%currfile)) {
11367: unless (($file eq $filename) ||
11368: ($file eq $filename.'.bak') ||
11369: ($dependencies{$file})) {
1.1085 raeburn 11370: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11371: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11372: next if (($rem ne '') &&
11373: (($env{"httpref.$rem".$file} ne '') ||
11374: (ref($navmap) &&
11375: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11376: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11377: ($navmap->getResourceByUrl($rem.$1)))))));
11378: }
1.1085 raeburn 11379: }
1.1071 raeburn 11380: $unused{$file} = 1;
11381: }
11382: }
1.1249 damieng 11383:
11384: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11385: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11386: ($args->{'context'} eq 'paste')) {
11387: $counter = scalar(keys(%existing));
11388: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11389: return ($output,$counter,$numpathchg,\%existing);
11390: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11391: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11392: $counter = scalar(keys(%existing));
11393: $numpathchg = scalar(keys(%pathchanges));
11394: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11395: }
1.1249 damieng 11396:
11397: # returns HTML otherwise, with dependency results and to ask for more uploads
11398:
11399: # $upload_output: missing dependencies (with upload form)
11400: # $modify_output: uploaded dependencies (in use)
11401: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11402: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11403: if ($actionurl eq '/adm/dependencies') {
11404: next if ($embed_file =~ m{^\w+://});
11405: }
1.660 raeburn 11406: $upload_output .= &start_data_table_row().
1.1123 raeburn 11407: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11408: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11409: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11410: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11411: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11412: }
1.1123 raeburn 11413: $upload_output .= '</td>';
1.1071 raeburn 11414: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11415: $upload_output.='<td align="right">'.
11416: '<span class="LC_info LC_fontsize_medium">'.
11417: &mt("URL points to web address").'</span>';
1.987 raeburn 11418: $numremref++;
1.660 raeburn 11419: } elsif ($args->{'error_on_invalid_names'}
11420: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11421: $upload_output.='<td align="right"><span class="LC_warning">'.
11422: &mt('Invalid characters').'</span>';
1.987 raeburn 11423: $numinvalid++;
1.660 raeburn 11424: } else {
1.1123 raeburn 11425: $upload_output .= '<td>'.
11426: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11427: $embed_file,\%mapping,
1.1071 raeburn 11428: $allfiles,$codebase,'upload');
11429: $counter ++;
11430: $numnew ++;
1.987 raeburn 11431: }
11432: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11433: }
11434: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11435: if ($actionurl eq '/adm/dependencies') {
11436: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11437: $modify_output .= &start_data_table_row().
11438: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11439: '<img src="'.&icon($embed_file).'" border="0" />'.
11440: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11441: '<td>'.$size.'</td>'.
11442: '<td>'.$mtime.'</td>'.
11443: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11444: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11445: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11446: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11447: &embedded_file_element('upload_embedded',$counter,
11448: $embed_file,\%mapping,
11449: $allfiles,$codebase,'modify').
11450: '</div></td>'.
11451: &end_data_table_row()."\n";
11452: $counter ++;
11453: } else {
11454: $upload_output .= &start_data_table_row().
1.1123 raeburn 11455: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11456: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11457: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11458: &Apache::loncommon::end_data_table_row()."\n";
11459: }
11460: }
11461: my $delidx = $counter;
11462: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11463: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11464: $delete_output .= &start_data_table_row().
11465: '<td><img src="'.&icon($oldfile).'" />'.
11466: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11467: '<td>'.$size.'</td>'.
11468: '<td>'.$mtime.'</td>'.
11469: '<td><label><input type="checkbox" name="del_upload_dep" '.
11470: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11471: &embedded_file_element('upload_embedded',$delidx,
11472: $oldfile,\%mapping,$allfiles,
11473: $codebase,'delete').'</td>'.
11474: &end_data_table_row()."\n";
11475: $numunused ++;
11476: $delidx ++;
1.987 raeburn 11477: }
11478: if ($upload_output) {
11479: $upload_output = &start_data_table().
11480: $upload_output.
11481: &end_data_table()."\n";
11482: }
1.1071 raeburn 11483: if ($modify_output) {
11484: $modify_output = &start_data_table().
11485: &start_data_table_header_row().
11486: '<th>'.&mt('File').'</th>'.
11487: '<th>'.&mt('Size (KB)').'</th>'.
11488: '<th>'.&mt('Modified').'</th>'.
11489: '<th>'.&mt('Upload replacement?').'</th>'.
11490: &end_data_table_header_row().
11491: $modify_output.
11492: &end_data_table()."\n";
11493: }
11494: if ($delete_output) {
11495: $delete_output = &start_data_table().
11496: &start_data_table_header_row().
11497: '<th>'.&mt('File').'</th>'.
11498: '<th>'.&mt('Size (KB)').'</th>'.
11499: '<th>'.&mt('Modified').'</th>'.
11500: '<th>'.&mt('Delete?').'</th>'.
11501: &end_data_table_header_row().
11502: $delete_output.
11503: &end_data_table()."\n";
11504: }
1.987 raeburn 11505: my $applies = 0;
11506: if ($numremref) {
11507: $applies ++;
11508: }
11509: if ($numinvalid) {
11510: $applies ++;
11511: }
11512: if ($numexisting) {
11513: $applies ++;
11514: }
1.1071 raeburn 11515: if ($counter || $numunused) {
1.987 raeburn 11516: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11517: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11518: $state.'<h3>'.$heading.'</h3>';
11519: if ($actionurl eq '/adm/dependencies') {
11520: if ($numnew) {
11521: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11522: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11523: $upload_output.'<br />'."\n";
11524: }
11525: if ($numexisting) {
11526: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11527: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11528: $modify_output.'<br />'."\n";
11529: $buttontext = &mt('Save changes');
11530: }
11531: if ($numunused) {
11532: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11533: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11534: $delete_output.'<br />'."\n";
11535: $buttontext = &mt('Save changes');
11536: }
11537: } else {
11538: $output .= $upload_output.'<br />'."\n";
11539: }
11540: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11541: $counter.'" />'."\n";
11542: if ($actionurl eq '/adm/dependencies') {
11543: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11544: $numnew.'" />'."\n";
11545: } elsif ($actionurl eq '') {
1.987 raeburn 11546: $output .= '<input type="hidden" name="phase" value="three" />';
11547: }
11548: } elsif ($applies) {
11549: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11550: if ($applies > 1) {
11551: $output .=
1.1123 raeburn 11552: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11553: if ($numremref) {
11554: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11555: }
11556: if ($numinvalid) {
11557: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11558: }
11559: if ($numexisting) {
11560: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11561: }
11562: $output .= '</ul><br />';
11563: } elsif ($numremref) {
11564: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11565: } elsif ($numinvalid) {
11566: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11567: } elsif ($numexisting) {
11568: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11569: }
11570: $output .= $upload_output.'<br />';
11571: }
11572: my ($pathchange_output,$chgcount);
1.1071 raeburn 11573: $chgcount = $counter;
1.987 raeburn 11574: if (keys(%pathchanges) > 0) {
11575: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11576: if ($counter) {
1.987 raeburn 11577: $output .= &embedded_file_element('pathchange',$chgcount,
11578: $embed_file,\%mapping,
1.1071 raeburn 11579: $allfiles,$codebase,'change');
1.987 raeburn 11580: } else {
11581: $pathchange_output .=
11582: &start_data_table_row().
11583: '<td><input type ="checkbox" name="namechange" value="'.
11584: $chgcount.'" checked="checked" /></td>'.
11585: '<td>'.$mapping{$embed_file}.'</td>'.
11586: '<td>'.$embed_file.
11587: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11588: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11589: '</td>'.&end_data_table_row();
1.660 raeburn 11590: }
1.987 raeburn 11591: $numpathchg ++;
11592: $chgcount ++;
1.660 raeburn 11593: }
11594: }
1.1127 raeburn 11595: if (($counter) || ($numunused)) {
1.987 raeburn 11596: if ($numpathchg) {
11597: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11598: $numpathchg.'" />'."\n";
11599: }
11600: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11601: ($actionurl eq '/adm/imsimport')) {
11602: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11603: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11604: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11605: } elsif ($actionurl eq '/adm/dependencies') {
11606: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11607: }
1.1123 raeburn 11608: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11609: } elsif ($numpathchg) {
11610: my %pathchange = ();
11611: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11612: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11613: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11614: }
1.987 raeburn 11615: }
1.1071 raeburn 11616: return ($output,$counter,$numpathchg);
1.987 raeburn 11617: }
11618:
1.1147 raeburn 11619: =pod
11620:
11621: =item * clean_path($name)
11622:
11623: Performs clean-up of directories, subdirectories and filename in an
11624: embedded object, referenced in an HTML file which is being uploaded
11625: to a course or portfolio, where
11626: "Upload embedded images/multimedia files if HTML file" checkbox was
11627: checked.
11628:
11629: Clean-up is similar to replacements in lonnet::clean_filename()
11630: except each / between sub-directory and next level is preserved.
11631:
11632: =cut
11633:
11634: sub clean_path {
11635: my ($embed_file) = @_;
11636: $embed_file =~s{^/+}{};
11637: my @contents;
11638: if ($embed_file =~ m{/}) {
11639: @contents = split(/\//,$embed_file);
11640: } else {
11641: @contents = ($embed_file);
11642: }
11643: my $lastidx = scalar(@contents)-1;
11644: for (my $i=0; $i<=$lastidx; $i++) {
11645: $contents[$i]=~s{\\}{/}g;
11646: $contents[$i]=~s/\s+/\_/g;
11647: $contents[$i]=~s{[^/\w\.\-]}{}g;
11648: if ($i == $lastidx) {
11649: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11650: }
11651: }
11652: if ($lastidx > 0) {
11653: return join('/',@contents);
11654: } else {
11655: return $contents[0];
11656: }
11657: }
11658:
1.987 raeburn 11659: sub embedded_file_element {
1.1071 raeburn 11660: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11661: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11662: (ref($codebase) eq 'HASH'));
11663: my $output;
1.1071 raeburn 11664: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11665: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11666: }
11667: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11668: &escape($embed_file).'" />';
11669: unless (($context eq 'upload_embedded') &&
11670: ($mapping->{$embed_file} eq $embed_file)) {
11671: $output .='
11672: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11673: }
11674: my $attrib;
11675: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11676: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11677: }
11678: $output .=
11679: "\n\t\t".
11680: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11681: $attrib.'" />';
11682: if (exists($codebase->{$mapping->{$embed_file}})) {
11683: $output .=
11684: "\n\t\t".
11685: '<input name="codebase_'.$num.'" type="hidden" value="'.
11686: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11687: }
1.987 raeburn 11688: return $output;
1.660 raeburn 11689: }
11690:
1.1071 raeburn 11691: sub get_dependency_details {
11692: my ($currfile,$currsubfile,$embed_file) = @_;
11693: my ($size,$mtime,$showsize,$showmtime);
11694: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11695: if ($embed_file =~ m{/}) {
11696: my ($path,$fname) = split(/\//,$embed_file);
11697: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11698: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11699: }
11700: } else {
11701: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11702: ($size,$mtime) = @{$currfile->{$embed_file}};
11703: }
11704: }
11705: $showsize = $size/1024.0;
11706: $showsize = sprintf("%.1f",$showsize);
11707: if ($mtime > 0) {
11708: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11709: }
11710: }
11711: return ($showsize,$showmtime);
11712: }
11713:
11714: sub ask_embedded_js {
11715: return <<"END";
11716: <script type="text/javascript"">
11717: // <![CDATA[
11718: function toggleBrowse(counter) {
11719: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11720: var fileid = document.getElementById('embedded_item_'+counter);
11721: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11722: if (chkboxid.checked == true) {
11723: uploaddivid.style.display='block';
11724: } else {
11725: uploaddivid.style.display='none';
11726: fileid.value = '';
11727: }
11728: }
11729: // ]]>
11730: </script>
11731:
11732: END
11733: }
11734:
1.661 raeburn 11735: sub upload_embedded {
11736: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11737: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11738: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11739: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11740: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11741: my $orig_uploaded_filename =
11742: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11743: foreach my $type ('orig','ref','attrib','codebase') {
11744: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11745: $env{'form.embedded_'.$type.'_'.$i} =
11746: &unescape($env{'form.embedded_'.$type.'_'.$i});
11747: }
11748: }
1.661 raeburn 11749: my ($path,$fname) =
11750: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11751: # no path, whole string is fname
11752: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11753: $fname = &Apache::lonnet::clean_filename($fname);
11754: # See if there is anything left
11755: next if ($fname eq '');
11756:
11757: # Check if file already exists as a file or directory.
11758: my ($state,$msg);
11759: if ($context eq 'portfolio') {
11760: my $port_path = $dirpath;
11761: if ($group ne '') {
11762: $port_path = "groups/$group/$port_path";
11763: }
1.987 raeburn 11764: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11765: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11766: $dir_root,$port_path,$disk_quota,
11767: $current_disk_usage,$uname,$udom);
11768: if ($state eq 'will_exceed_quota'
1.984 raeburn 11769: || $state eq 'file_locked') {
1.661 raeburn 11770: $output .= $msg;
11771: next;
11772: }
11773: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11774: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11775: if ($state eq 'exists') {
11776: $output .= $msg;
11777: next;
11778: }
11779: }
11780: # Check if extension is valid
11781: if (($fname =~ /\.(\w+)$/) &&
11782: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11783: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11784: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11785: next;
11786: } elsif (($fname =~ /\.(\w+)$/) &&
11787: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11788: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11789: next;
11790: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11791: $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 11792: next;
11793: }
11794: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11795: my $subdir = $path;
11796: $subdir =~ s{/+$}{};
1.661 raeburn 11797: if ($context eq 'portfolio') {
1.984 raeburn 11798: my $result;
11799: if ($state eq 'existingfile') {
11800: $result=
11801: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11802: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11803: } else {
1.984 raeburn 11804: $result=
11805: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11806: $dirpath.
1.1123 raeburn 11807: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11808: if ($result !~ m|^/uploaded/|) {
11809: $output .= '<span class="LC_error">'
11810: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11811: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11812: .'</span><br />';
11813: next;
11814: } else {
1.987 raeburn 11815: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11816: $path.$fname.'</span>').'<br />';
1.984 raeburn 11817: }
1.661 raeburn 11818: }
1.1123 raeburn 11819: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11820: my $extendedsubdir = $dirpath.'/'.$subdir;
11821: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11822: my $result =
1.1126 raeburn 11823: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11824: if ($result !~ m|^/uploaded/|) {
11825: $output .= '<span class="LC_error">'
11826: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11827: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11828: .'</span><br />';
11829: next;
11830: } else {
11831: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11832: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11833: if ($context eq 'syllabus') {
11834: &Apache::lonnet::make_public_indefinitely($result);
11835: }
1.987 raeburn 11836: }
1.661 raeburn 11837: } else {
11838: # Save the file
11839: my $target = $env{'form.embedded_item_'.$i};
11840: my $fullpath = $dir_root.$dirpath.'/'.$path;
11841: my $dest = $fullpath.$fname;
11842: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11843: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11844: my $count;
11845: my $filepath = $dir_root;
1.1027 raeburn 11846: foreach my $subdir (@parts) {
11847: $filepath .= "/$subdir";
11848: if (!-e $filepath) {
1.661 raeburn 11849: mkdir($filepath,0770);
11850: }
11851: }
11852: my $fh;
11853: if (!open($fh,'>'.$dest)) {
11854: &Apache::lonnet::logthis('Failed to create '.$dest);
11855: $output .= '<span class="LC_error">'.
1.1071 raeburn 11856: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11857: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11858: '</span><br />';
11859: } else {
11860: if (!print $fh $env{'form.embedded_item_'.$i}) {
11861: &Apache::lonnet::logthis('Failed to write to '.$dest);
11862: $output .= '<span class="LC_error">'.
1.1071 raeburn 11863: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11864: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11865: '</span><br />';
11866: } else {
1.987 raeburn 11867: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11868: $url.'</span>').'<br />';
11869: unless ($context eq 'testbank') {
11870: $footer .= &mt('View embedded file: [_1]',
11871: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11872: }
11873: }
11874: close($fh);
11875: }
11876: }
11877: if ($env{'form.embedded_ref_'.$i}) {
11878: $pathchange{$i} = 1;
11879: }
11880: }
11881: if ($output) {
11882: $output = '<p>'.$output.'</p>';
11883: }
11884: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11885: $returnflag = 'ok';
1.1071 raeburn 11886: my $numpathchgs = scalar(keys(%pathchange));
11887: if ($numpathchgs > 0) {
1.987 raeburn 11888: if ($context eq 'portfolio') {
11889: $output .= '<p>'.&mt('or').'</p>';
11890: } elsif ($context eq 'testbank') {
1.1071 raeburn 11891: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11892: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11893: $returnflag = 'modify_orightml';
11894: }
11895: }
1.1071 raeburn 11896: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11897: }
11898:
11899: sub modify_html_form {
11900: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11901: my $end = 0;
11902: my $modifyform;
11903: if ($context eq 'upload_embedded') {
11904: return unless (ref($pathchange) eq 'HASH');
11905: if ($env{'form.number_embedded_items'}) {
11906: $end += $env{'form.number_embedded_items'};
11907: }
11908: if ($env{'form.number_pathchange_items'}) {
11909: $end += $env{'form.number_pathchange_items'};
11910: }
11911: if ($end) {
11912: for (my $i=0; $i<$end; $i++) {
11913: if ($i < $env{'form.number_embedded_items'}) {
11914: next unless($pathchange->{$i});
11915: }
11916: $modifyform .=
11917: &start_data_table_row().
11918: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11919: 'checked="checked" /></td>'.
11920: '<td>'.$env{'form.embedded_ref_'.$i}.
11921: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11922: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11923: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11924: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11925: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11926: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11927: '<td>'.$env{'form.embedded_orig_'.$i}.
11928: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11929: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11930: &end_data_table_row();
1.1071 raeburn 11931: }
1.987 raeburn 11932: }
11933: } else {
11934: $modifyform = $pathchgtable;
11935: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11936: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11937: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11938: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11939: }
11940: }
11941: if ($modifyform) {
1.1071 raeburn 11942: if ($actionurl eq '/adm/dependencies') {
11943: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11944: }
1.987 raeburn 11945: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11946: '<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".
11947: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11948: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11949: '</ol></p>'."\n".'<p>'.
11950: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11951: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11952: &start_data_table()."\n".
11953: &start_data_table_header_row().
11954: '<th>'.&mt('Change?').'</th>'.
11955: '<th>'.&mt('Current reference').'</th>'.
11956: '<th>'.&mt('Required reference').'</th>'.
11957: &end_data_table_header_row()."\n".
11958: $modifyform.
11959: &end_data_table().'<br />'."\n".$hiddenstate.
11960: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11961: '</form>'."\n";
11962: }
11963: return;
11964: }
11965:
11966: sub modify_html_refs {
1.1123 raeburn 11967: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11968: my $container;
11969: if ($context eq 'portfolio') {
11970: $container = $env{'form.container'};
11971: } elsif ($context eq 'coursedoc') {
11972: $container = $env{'form.primaryurl'};
1.1071 raeburn 11973: } elsif ($context eq 'manage_dependencies') {
11974: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11975: $container = "/$container";
1.1123 raeburn 11976: } elsif ($context eq 'syllabus') {
11977: $container = $url;
1.987 raeburn 11978: } else {
1.1027 raeburn 11979: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11980: }
11981: my (%allfiles,%codebase,$output,$content);
11982: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11983: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11984: if (wantarray) {
11985: return ('',0,0);
11986: } else {
11987: return;
11988: }
11989: }
11990: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11991: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11992: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11993: if (wantarray) {
11994: return ('',0,0);
11995: } else {
11996: return;
11997: }
11998: }
1.987 raeburn 11999: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12000: if ($content eq '-1') {
12001: if (wantarray) {
12002: return ('',0,0);
12003: } else {
12004: return;
12005: }
12006: }
1.987 raeburn 12007: } else {
1.1071 raeburn 12008: unless ($container =~ /^\Q$dir_root\E/) {
12009: if (wantarray) {
12010: return ('',0,0);
12011: } else {
12012: return;
12013: }
12014: }
1.987 raeburn 12015: if (open(my $fh,"<$container")) {
12016: $content = join('', <$fh>);
12017: close($fh);
12018: } else {
1.1071 raeburn 12019: if (wantarray) {
12020: return ('',0,0);
12021: } else {
12022: return;
12023: }
1.987 raeburn 12024: }
12025: }
12026: my ($count,$codebasecount) = (0,0);
12027: my $mm = new File::MMagic;
12028: my $mime_type = $mm->checktype_contents($content);
12029: if ($mime_type eq 'text/html') {
12030: my $parse_result =
12031: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12032: \%codebase,\$content);
12033: if ($parse_result eq 'ok') {
12034: foreach my $i (@changes) {
12035: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12036: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12037: if ($allfiles{$ref}) {
12038: my $newname = $orig;
12039: my ($attrib_regexp,$codebase);
1.1006 raeburn 12040: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12041: if ($attrib_regexp =~ /:/) {
12042: $attrib_regexp =~ s/\:/|/g;
12043: }
12044: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12045: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12046: $count += $numchg;
1.1123 raeburn 12047: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12048: delete($allfiles{$ref});
1.987 raeburn 12049: }
12050: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12051: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12052: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12053: $codebasecount ++;
12054: }
12055: }
12056: }
1.1123 raeburn 12057: my $skiprewrites;
1.987 raeburn 12058: if ($count || $codebasecount) {
12059: my $saveresult;
1.1071 raeburn 12060: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12061: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12062: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12063: if ($url eq $container) {
12064: my ($fname) = ($container =~ m{/([^/]+)$});
12065: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12066: $count,'<span class="LC_filename">'.
1.1071 raeburn 12067: $fname.'</span>').'</p>';
1.987 raeburn 12068: } else {
12069: $output = '<p class="LC_error">'.
12070: &mt('Error: update failed for: [_1].',
12071: '<span class="LC_filename">'.
12072: $container.'</span>').'</p>';
12073: }
1.1123 raeburn 12074: if ($context eq 'syllabus') {
12075: unless ($saveresult eq 'ok') {
12076: $skiprewrites = 1;
12077: }
12078: }
1.987 raeburn 12079: } else {
12080: if (open(my $fh,">$container")) {
12081: print $fh $content;
12082: close($fh);
12083: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12084: $count,'<span class="LC_filename">'.
12085: $container.'</span>').'</p>';
1.661 raeburn 12086: } else {
1.987 raeburn 12087: $output = '<p class="LC_error">'.
12088: &mt('Error: could not update [_1].',
12089: '<span class="LC_filename">'.
12090: $container.'</span>').'</p>';
1.661 raeburn 12091: }
12092: }
12093: }
1.1123 raeburn 12094: if (($context eq 'syllabus') && (!$skiprewrites)) {
12095: my ($actionurl,$state);
12096: $actionurl = "/public/$udom/$uname/syllabus";
12097: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12098: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12099: \%codebase,
12100: {'context' => 'rewrites',
12101: 'ignore_remote_references' => 1,});
12102: if (ref($mapping) eq 'HASH') {
12103: my $rewrites = 0;
12104: foreach my $key (keys(%{$mapping})) {
12105: next if ($key =~ m{^https?://});
12106: my $ref = $mapping->{$key};
12107: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12108: my $attrib;
12109: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12110: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12111: }
12112: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12113: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12114: $rewrites += $numchg;
12115: }
12116: }
12117: if ($rewrites) {
12118: my $saveresult;
12119: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12120: if ($url eq $container) {
12121: my ($fname) = ($container =~ m{/([^/]+)$});
12122: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12123: $count,'<span class="LC_filename">'.
12124: $fname.'</span>').'</p>';
12125: } else {
12126: $output .= '<p class="LC_error">'.
12127: &mt('Error: could not update links in [_1].',
12128: '<span class="LC_filename">'.
12129: $container.'</span>').'</p>';
12130:
12131: }
12132: }
12133: }
12134: }
1.987 raeburn 12135: } else {
12136: &logthis('Failed to parse '.$container.
12137: ' to modify references: '.$parse_result);
1.661 raeburn 12138: }
12139: }
1.1071 raeburn 12140: if (wantarray) {
12141: return ($output,$count,$codebasecount);
12142: } else {
12143: return $output;
12144: }
1.661 raeburn 12145: }
12146:
12147: sub check_for_existing {
12148: my ($path,$fname,$element) = @_;
12149: my ($state,$msg);
12150: if (-d $path.'/'.$fname) {
12151: $state = 'exists';
12152: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12153: } elsif (-e $path.'/'.$fname) {
12154: $state = 'exists';
12155: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12156: }
12157: if ($state eq 'exists') {
12158: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12159: }
12160: return ($state,$msg);
12161: }
12162:
12163: sub check_for_upload {
12164: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12165: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12166: my $filesize = length($env{'form.'.$element});
12167: if (!$filesize) {
12168: my $msg = '<span class="LC_error">'.
12169: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12170: '<span class="LC_filename">'.$fname.'</span>',
12171: $filesize).'<br />'.
1.1007 raeburn 12172: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12173: '</span>';
12174: return ('zero_bytes',$msg);
12175: }
12176: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12177: my $getpropath = 1;
1.1021 raeburn 12178: my ($dirlistref,$listerror) =
12179: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12180: my $found_file = 0;
12181: my $locked_file = 0;
1.991 raeburn 12182: my @lockers;
12183: my $navmap;
12184: if ($env{'request.course.id'}) {
12185: $navmap = Apache::lonnavmaps::navmap->new();
12186: }
1.1021 raeburn 12187: if (ref($dirlistref) eq 'ARRAY') {
12188: foreach my $line (@{$dirlistref}) {
12189: my ($file_name,$rest)=split(/\&/,$line,2);
12190: if ($file_name eq $fname){
12191: $file_name = $path.$file_name;
12192: if ($group ne '') {
12193: $file_name = $group.$file_name;
12194: }
12195: $found_file = 1;
12196: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12197: foreach my $lock (@lockers) {
12198: if (ref($lock) eq 'ARRAY') {
12199: my ($symb,$crsid) = @{$lock};
12200: if ($crsid eq $env{'request.course.id'}) {
12201: if (ref($navmap)) {
12202: my $res = $navmap->getBySymb($symb);
12203: foreach my $part (@{$res->parts()}) {
12204: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12205: unless (($slot_status == $res->RESERVED) ||
12206: ($slot_status == $res->RESERVED_LOCATION)) {
12207: $locked_file = 1;
12208: }
1.991 raeburn 12209: }
1.1021 raeburn 12210: } else {
12211: $locked_file = 1;
1.991 raeburn 12212: }
12213: } else {
12214: $locked_file = 1;
12215: }
12216: }
1.1021 raeburn 12217: }
12218: } else {
12219: my @info = split(/\&/,$rest);
12220: my $currsize = $info[6]/1000;
12221: if ($currsize < $filesize) {
12222: my $extra = $filesize - $currsize;
12223: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12224: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12225: &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 12226: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12227: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12228: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12229: return ('will_exceed_quota',$msg);
12230: }
1.984 raeburn 12231: }
12232: }
1.661 raeburn 12233: }
12234: }
12235: }
12236: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12237: my $msg = '<p class="LC_warning">'.
12238: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12239: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12240: return ('will_exceed_quota',$msg);
12241: } elsif ($found_file) {
12242: if ($locked_file) {
1.1179 bisitz 12243: my $msg = '<p class="LC_warning">';
1.661 raeburn 12244: $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 12245: $msg .= '</p>';
1.661 raeburn 12246: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12247: return ('file_locked',$msg);
12248: } else {
1.1179 bisitz 12249: my $msg = '<p class="LC_error">';
1.984 raeburn 12250: $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 12251: $msg .= '</p>';
1.984 raeburn 12252: return ('existingfile',$msg);
1.661 raeburn 12253: }
12254: }
12255: }
12256:
1.987 raeburn 12257: sub check_for_traversal {
12258: my ($path,$url,$toplevel) = @_;
12259: my @parts=split(/\//,$path);
12260: my $cleanpath;
12261: my $fullpath = $url;
12262: for (my $i=0;$i<@parts;$i++) {
12263: next if ($parts[$i] eq '.');
12264: if ($parts[$i] eq '..') {
12265: $fullpath =~ s{([^/]+/)$}{};
12266: } else {
12267: $fullpath .= $parts[$i].'/';
12268: }
12269: }
12270: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12271: $cleanpath = $1;
12272: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12273: my $curr_toprel = $1;
12274: my @parts = split(/\//,$curr_toprel);
12275: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12276: my @urlparts = split(/\//,$url_toprel);
12277: my $doubledots;
12278: my $startdiff = -1;
12279: for (my $i=0; $i<@urlparts; $i++) {
12280: if ($startdiff == -1) {
12281: unless ($urlparts[$i] eq $parts[$i]) {
12282: $startdiff = $i;
12283: $doubledots .= '../';
12284: }
12285: } else {
12286: $doubledots .= '../';
12287: }
12288: }
12289: if ($startdiff > -1) {
12290: $cleanpath = $doubledots;
12291: for (my $i=$startdiff; $i<@parts; $i++) {
12292: $cleanpath .= $parts[$i].'/';
12293: }
12294: }
12295: }
12296: $cleanpath =~ s{(/)$}{};
12297: return $cleanpath;
12298: }
1.31 albertel 12299:
1.1053 raeburn 12300: sub is_archive_file {
12301: my ($mimetype) = @_;
12302: if (($mimetype eq 'application/octet-stream') ||
12303: ($mimetype eq 'application/x-stuffit') ||
12304: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12305: return 1;
12306: }
12307: return;
12308: }
12309:
12310: sub decompress_form {
1.1065 raeburn 12311: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12312: my %lt = &Apache::lonlocal::texthash (
12313: this => 'This file is an archive file.',
1.1067 raeburn 12314: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12315: itsc => 'Its contents are as follows:',
1.1053 raeburn 12316: youm => 'You may wish to extract its contents.',
12317: extr => 'Extract contents',
1.1067 raeburn 12318: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12319: proa => 'Process automatically?',
1.1053 raeburn 12320: yes => 'Yes',
12321: no => 'No',
1.1067 raeburn 12322: fold => 'Title for folder containing movie',
12323: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12324: );
1.1065 raeburn 12325: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12326: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12327: my $info = &list_archive_contents($fileloc,\@paths);
12328: if (@paths) {
12329: foreach my $path (@paths) {
12330: $path =~ s{^/}{};
1.1067 raeburn 12331: if ($path =~ m{^([^/]+)/$}) {
12332: $topdir = $1;
12333: }
1.1065 raeburn 12334: if ($path =~ m{^([^/]+)/}) {
12335: $toplevel{$1} = $path;
12336: } else {
12337: $toplevel{$path} = $path;
12338: }
12339: }
12340: }
1.1067 raeburn 12341: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12342: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12343: "$topdir/media/",
12344: "$topdir/media/$topdir.mp4",
12345: "$topdir/media/FirstFrame.png",
12346: "$topdir/media/player.swf",
12347: "$topdir/media/swfobject.js",
12348: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12349: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12350: "$topdir/$topdir.mp4",
12351: "$topdir/$topdir\_config.xml",
12352: "$topdir/$topdir\_controller.swf",
12353: "$topdir/$topdir\_embed.css",
12354: "$topdir/$topdir\_First_Frame.png",
12355: "$topdir/$topdir\_player.html",
12356: "$topdir/$topdir\_Thumbnails.png",
12357: "$topdir/playerProductInstall.swf",
12358: "$topdir/scripts/",
12359: "$topdir/scripts/config_xml.js",
12360: "$topdir/scripts/handlebars.js",
12361: "$topdir/scripts/jquery-1.7.1.min.js",
12362: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12363: "$topdir/scripts/modernizr.js",
12364: "$topdir/scripts/player-min.js",
12365: "$topdir/scripts/swfobject.js",
12366: "$topdir/skins/",
12367: "$topdir/skins/configuration_express.xml",
12368: "$topdir/skins/express_show/",
12369: "$topdir/skins/express_show/player-min.css",
12370: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12371: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12372: "$topdir/$topdir.mp4",
12373: "$topdir/$topdir\_config.xml",
12374: "$topdir/$topdir\_controller.swf",
12375: "$topdir/$topdir\_embed.css",
12376: "$topdir/$topdir\_First_Frame.png",
12377: "$topdir/$topdir\_player.html",
12378: "$topdir/$topdir\_Thumbnails.png",
12379: "$topdir/playerProductInstall.swf",
12380: "$topdir/scripts/",
12381: "$topdir/scripts/config_xml.js",
12382: "$topdir/scripts/techsmith-smart-player.min.js",
12383: "$topdir/skins/",
12384: "$topdir/skins/configuration_express.xml",
12385: "$topdir/skins/express_show/",
12386: "$topdir/skins/express_show/spritesheet.min.css",
12387: "$topdir/skins/express_show/spritesheet.png",
12388: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12389: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12390: if (@diffs == 0) {
1.1164 raeburn 12391: $is_camtasia = 6;
12392: } else {
1.1197 raeburn 12393: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12394: if (@diffs == 0) {
12395: $is_camtasia = 8;
1.1197 raeburn 12396: } else {
12397: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12398: if (@diffs == 0) {
12399: $is_camtasia = 8;
12400: }
1.1164 raeburn 12401: }
1.1067 raeburn 12402: }
12403: }
12404: my $output;
12405: if ($is_camtasia) {
12406: $output = <<"ENDCAM";
12407: <script type="text/javascript" language="Javascript">
12408: // <![CDATA[
12409:
12410: function camtasiaToggle() {
12411: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12412: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12413: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12414: document.getElementById('camtasia_titles').style.display='block';
12415: } else {
12416: document.getElementById('camtasia_titles').style.display='none';
12417: }
12418: }
12419: }
12420: return;
12421: }
12422:
12423: // ]]>
12424: </script>
12425: <p>$lt{'camt'}</p>
12426: ENDCAM
1.1065 raeburn 12427: } else {
1.1067 raeburn 12428: $output = '<p>'.$lt{'this'};
12429: if ($info eq '') {
12430: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12431: } else {
12432: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12433: '<div><pre>'.$info.'</pre></div>';
12434: }
1.1065 raeburn 12435: }
1.1067 raeburn 12436: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12437: my $duplicates;
12438: my $num = 0;
12439: if (ref($dirlist) eq 'ARRAY') {
12440: foreach my $item (@{$dirlist}) {
12441: if (ref($item) eq 'ARRAY') {
12442: if (exists($toplevel{$item->[0]})) {
12443: $duplicates .=
12444: &start_data_table_row().
12445: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12446: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12447: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12448: 'value="1" />'.&mt('Yes').'</label>'.
12449: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12450: '<td>'.$item->[0].'</td>';
12451: if ($item->[2]) {
12452: $duplicates .= '<td>'.&mt('Directory').'</td>';
12453: } else {
12454: $duplicates .= '<td>'.&mt('File').'</td>';
12455: }
12456: $duplicates .= '<td>'.$item->[3].'</td>'.
12457: '<td>'.
12458: &Apache::lonlocal::locallocaltime($item->[4]).
12459: '</td>'.
12460: &end_data_table_row();
12461: $num ++;
12462: }
12463: }
12464: }
12465: }
12466: my $itemcount;
12467: if (@paths > 0) {
12468: $itemcount = scalar(@paths);
12469: } else {
12470: $itemcount = 1;
12471: }
1.1067 raeburn 12472: if ($is_camtasia) {
12473: $output .= $lt{'auto'}.'<br />'.
12474: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12475: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12476: $lt{'yes'}.'</label> <label>'.
12477: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12478: $lt{'no'}.'</label></span><br />'.
12479: '<div id="camtasia_titles" style="display:block">'.
12480: &Apache::lonhtmlcommon::start_pick_box().
12481: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12482: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12483: &Apache::lonhtmlcommon::row_closure().
12484: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12485: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12486: &Apache::lonhtmlcommon::row_closure(1).
12487: &Apache::lonhtmlcommon::end_pick_box().
12488: '</div>';
12489: }
1.1065 raeburn 12490: $output .=
12491: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12492: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12493: "\n";
1.1065 raeburn 12494: if ($duplicates ne '') {
12495: $output .= '<p><span class="LC_warning">'.
12496: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12497: &start_data_table().
12498: &start_data_table_header_row().
12499: '<th>'.&mt('Overwrite?').'</th>'.
12500: '<th>'.&mt('Name').'</th>'.
12501: '<th>'.&mt('Type').'</th>'.
12502: '<th>'.&mt('Size').'</th>'.
12503: '<th>'.&mt('Last modified').'</th>'.
12504: &end_data_table_header_row().
12505: $duplicates.
12506: &end_data_table().
12507: '</p>';
12508: }
1.1067 raeburn 12509: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12510: if (ref($hiddenelements) eq 'HASH') {
12511: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12512: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12513: }
12514: }
12515: $output .= <<"END";
1.1067 raeburn 12516: <br />
1.1053 raeburn 12517: <input type="submit" name="decompress" value="$lt{'extr'}" />
12518: </form>
12519: $noextract
12520: END
12521: return $output;
12522: }
12523:
1.1065 raeburn 12524: sub decompression_utility {
12525: my ($program) = @_;
12526: my @utilities = ('tar','gunzip','bunzip2','unzip');
12527: my $location;
12528: if (grep(/^\Q$program\E$/,@utilities)) {
12529: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12530: '/usr/sbin/') {
12531: if (-x $dir.$program) {
12532: $location = $dir.$program;
12533: last;
12534: }
12535: }
12536: }
12537: return $location;
12538: }
12539:
12540: sub list_archive_contents {
12541: my ($file,$pathsref) = @_;
12542: my (@cmd,$output);
12543: my $needsregexp;
12544: if ($file =~ /\.zip$/) {
12545: @cmd = (&decompression_utility('unzip'),"-l");
12546: $needsregexp = 1;
12547: } elsif (($file =~ m/\.tar\.gz$/) ||
12548: ($file =~ /\.tgz$/)) {
12549: @cmd = (&decompression_utility('tar'),"-ztf");
12550: } elsif ($file =~ /\.tar\.bz2$/) {
12551: @cmd = (&decompression_utility('tar'),"-jtf");
12552: } elsif ($file =~ m|\.tar$|) {
12553: @cmd = (&decompression_utility('tar'),"-tf");
12554: }
12555: if (@cmd) {
12556: undef($!);
12557: undef($@);
12558: if (open(my $fh,"-|", @cmd, $file)) {
12559: while (my $line = <$fh>) {
12560: $output .= $line;
12561: chomp($line);
12562: my $item;
12563: if ($needsregexp) {
12564: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12565: } else {
12566: $item = $line;
12567: }
12568: if ($item ne '') {
12569: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12570: push(@{$pathsref},$item);
12571: }
12572: }
12573: }
12574: close($fh);
12575: }
12576: }
12577: return $output;
12578: }
12579:
1.1053 raeburn 12580: sub decompress_uploaded_file {
12581: my ($file,$dir) = @_;
12582: &Apache::lonnet::appenv({'cgi.file' => $file});
12583: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12584: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12585: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12586: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12587: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12588: my $decompressed = $env{'cgi.decompressed'};
12589: &Apache::lonnet::delenv('cgi.file');
12590: &Apache::lonnet::delenv('cgi.dir');
12591: &Apache::lonnet::delenv('cgi.decompressed');
12592: return ($decompressed,$result);
12593: }
12594:
1.1055 raeburn 12595: sub process_decompression {
12596: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
12597: my ($dir,$error,$warning,$output);
1.1180 raeburn 12598: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12599: $error = &mt('Filename not a supported archive file type.').
12600: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12601: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12602: } else {
12603: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12604: if ($docuhome eq 'no_host') {
12605: $error = &mt('Could not determine home server for course.');
12606: } else {
12607: my @ids=&Apache::lonnet::current_machine_ids();
12608: my $currdir = "$dir_root/$destination";
12609: if (grep(/^\Q$docuhome\E$/,@ids)) {
12610: $dir = &LONCAPA::propath($docudom,$docuname).
12611: "$dir_root/$destination";
12612: } else {
12613: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12614: "$dir_root/$docudom/$docuname/$destination";
12615: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12616: $error = &mt('Archive file not found.');
12617: }
12618: }
1.1065 raeburn 12619: my (@to_overwrite,@to_skip);
12620: if ($env{'form.archive_overwrite_total'} > 0) {
12621: my $total = $env{'form.archive_overwrite_total'};
12622: for (my $i=0; $i<$total; $i++) {
12623: if ($env{'form.archive_overwrite_'.$i} == 1) {
12624: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12625: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12626: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12627: }
12628: }
12629: }
12630: my $numskip = scalar(@to_skip);
12631: if (($numskip > 0) &&
12632: ($numskip == $env{'form.archive_itemcount'})) {
12633: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12634: } elsif ($dir eq '') {
1.1055 raeburn 12635: $error = &mt('Directory containing archive file unavailable.');
12636: } elsif (!$error) {
1.1065 raeburn 12637: my ($decompressed,$display);
12638: if ($numskip > 0) {
12639: my $tempdir = time.'_'.$$.int(rand(10000));
12640: mkdir("$dir/$tempdir",0755);
12641: system("mv $dir/$file $dir/$tempdir/$file");
12642: ($decompressed,$display) =
12643: &decompress_uploaded_file($file,"$dir/$tempdir");
12644: foreach my $item (@to_skip) {
12645: if (($item ne '') && ($item !~ /\.\./)) {
12646: if (-f "$dir/$tempdir/$item") {
12647: unlink("$dir/$tempdir/$item");
12648: } elsif (-d "$dir/$tempdir/$item") {
12649: system("rm -rf $dir/$tempdir/$item");
12650: }
12651: }
12652: }
12653: system("mv $dir/$tempdir/* $dir");
12654: rmdir("$dir/$tempdir");
12655: } else {
12656: ($decompressed,$display) =
12657: &decompress_uploaded_file($file,$dir);
12658: }
1.1055 raeburn 12659: if ($decompressed eq 'ok') {
1.1065 raeburn 12660: $output = '<p class="LC_info">'.
12661: &mt('Files extracted successfully from archive.').
12662: '</p>'."\n";
1.1055 raeburn 12663: my ($warning,$result,@contents);
12664: my ($newdirlistref,$newlisterror) =
12665: &Apache::lonnet::dirlist($currdir,$docudom,
12666: $docuname,1);
12667: my (%is_dir,%changes,@newitems);
12668: my $dirptr = 16384;
1.1065 raeburn 12669: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12670: foreach my $dir_line (@{$newdirlistref}) {
12671: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 12672: unless (($item =~ /^\.+$/) || ($item eq $file) ||
12673: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 12674: push(@newitems,$item);
12675: if ($dirptr&$testdir) {
12676: $is_dir{$item} = 1;
12677: }
12678: $changes{$item} = 1;
12679: }
12680: }
12681: }
12682: if (keys(%changes) > 0) {
12683: foreach my $item (sort(@newitems)) {
12684: if ($changes{$item}) {
12685: push(@contents,$item);
12686: }
12687: }
12688: }
12689: if (@contents > 0) {
1.1067 raeburn 12690: my $wantform;
12691: unless ($env{'form.autoextract_camtasia'}) {
12692: $wantform = 1;
12693: }
1.1056 raeburn 12694: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12695: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12696: $currdir,\%is_dir,
12697: \%children,\%parent,
1.1056 raeburn 12698: \@contents,\%dirorder,
12699: \%titles,$wantform);
1.1055 raeburn 12700: if ($datatable ne '') {
12701: $output .= &archive_options_form('decompressed',$datatable,
12702: $count,$hiddenelem);
1.1065 raeburn 12703: my $startcount = 6;
1.1055 raeburn 12704: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12705: \%titles,\%children);
1.1055 raeburn 12706: }
1.1067 raeburn 12707: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12708: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12709: my %displayed;
12710: my $total = 1;
12711: $env{'form.archive_directory'} = [];
12712: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12713: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12714: $path =~ s{/$}{};
12715: my $item;
12716: if ($path ne '') {
12717: $item = "$path/$titles{$i}";
12718: } else {
12719: $item = $titles{$i};
12720: }
12721: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12722: if ($item eq $contents[0]) {
12723: push(@{$env{'form.archive_directory'}},$i);
12724: $env{'form.archive_'.$i} = 'display';
12725: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12726: $displayed{'folder'} = $i;
1.1164 raeburn 12727: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12728: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12729: $env{'form.archive_'.$i} = 'display';
12730: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12731: $displayed{'web'} = $i;
12732: } else {
1.1164 raeburn 12733: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12734: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12735: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12736: push(@{$env{'form.archive_directory'}},$i);
12737: }
12738: $env{'form.archive_'.$i} = 'dependency';
12739: }
12740: $total ++;
12741: }
12742: for (my $i=1; $i<$total; $i++) {
12743: next if ($i == $displayed{'web'});
12744: next if ($i == $displayed{'folder'});
12745: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12746: }
12747: $env{'form.phase'} = 'decompress_cleanup';
12748: $env{'form.archivedelete'} = 1;
12749: $env{'form.archive_count'} = $total-1;
12750: $output .=
12751: &process_extracted_files('coursedocs',$docudom,
12752: $docuname,$destination,
12753: $dir_root,$hiddenelem);
12754: }
1.1055 raeburn 12755: } else {
12756: $warning = &mt('No new items extracted from archive file.');
12757: }
12758: } else {
12759: $output = $display;
12760: $error = &mt('An error occurred during extraction from the archive file.');
12761: }
12762: }
12763: }
12764: }
12765: if ($error) {
12766: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12767: $error.'</p>'."\n";
12768: }
12769: if ($warning) {
12770: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12771: }
12772: return $output;
12773: }
12774:
12775: sub get_extracted {
1.1056 raeburn 12776: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12777: $titles,$wantform) = @_;
1.1055 raeburn 12778: my $count = 0;
12779: my $depth = 0;
12780: my $datatable;
1.1056 raeburn 12781: my @hierarchy;
1.1055 raeburn 12782: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12783: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12784: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12785: foreach my $item (@{$contents}) {
12786: $count ++;
1.1056 raeburn 12787: @{$dirorder->{$count}} = @hierarchy;
12788: $titles->{$count} = $item;
1.1055 raeburn 12789: &archive_hierarchy($depth,$count,$parent,$children);
12790: if ($wantform) {
12791: $datatable .= &archive_row($is_dir->{$item},$item,
12792: $currdir,$depth,$count);
12793: }
12794: if ($is_dir->{$item}) {
12795: $depth ++;
1.1056 raeburn 12796: push(@hierarchy,$count);
12797: $parent->{$depth} = $count;
1.1055 raeburn 12798: $datatable .=
12799: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12800: \$depth,\$count,\@hierarchy,$dirorder,
12801: $children,$parent,$titles,$wantform);
1.1055 raeburn 12802: $depth --;
1.1056 raeburn 12803: pop(@hierarchy);
1.1055 raeburn 12804: }
12805: }
12806: return ($count,$datatable);
12807: }
12808:
12809: sub recurse_extracted_archive {
1.1056 raeburn 12810: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12811: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12812: my $result='';
1.1056 raeburn 12813: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12814: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12815: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12816: return $result;
12817: }
12818: my $dirptr = 16384;
12819: my ($newdirlistref,$newlisterror) =
12820: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12821: if (ref($newdirlistref) eq 'ARRAY') {
12822: foreach my $dir_line (@{$newdirlistref}) {
12823: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12824: unless ($item =~ /^\.+$/) {
12825: $$count ++;
1.1056 raeburn 12826: @{$dirorder->{$$count}} = @{$hierarchy};
12827: $titles->{$$count} = $item;
1.1055 raeburn 12828: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12829:
1.1055 raeburn 12830: my $is_dir;
12831: if ($dirptr&$testdir) {
12832: $is_dir = 1;
12833: }
12834: if ($wantform) {
12835: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12836: }
12837: if ($is_dir) {
12838: $$depth ++;
1.1056 raeburn 12839: push(@{$hierarchy},$$count);
12840: $parent->{$$depth} = $$count;
1.1055 raeburn 12841: $result .=
12842: &recurse_extracted_archive("$currdir/$item",$docudom,
12843: $docuname,$depth,$count,
1.1056 raeburn 12844: $hierarchy,$dirorder,$children,
12845: $parent,$titles,$wantform);
1.1055 raeburn 12846: $$depth --;
1.1056 raeburn 12847: pop(@{$hierarchy});
1.1055 raeburn 12848: }
12849: }
12850: }
12851: }
12852: return $result;
12853: }
12854:
12855: sub archive_hierarchy {
12856: my ($depth,$count,$parent,$children) =@_;
12857: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12858: if (exists($parent->{$depth})) {
12859: $children->{$parent->{$depth}} .= $count.':';
12860: }
12861: }
12862: return;
12863: }
12864:
12865: sub archive_row {
12866: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12867: my ($name) = ($item =~ m{([^/]+)$});
12868: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12869: 'display' => 'Add as file',
1.1055 raeburn 12870: 'dependency' => 'Include as dependency',
12871: 'discard' => 'Discard',
12872: );
12873: if ($is_dir) {
1.1059 raeburn 12874: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12875: }
1.1056 raeburn 12876: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12877: my $offset = 0;
1.1055 raeburn 12878: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12879: $offset ++;
1.1065 raeburn 12880: if ($action ne 'display') {
12881: $offset ++;
12882: }
1.1055 raeburn 12883: $output .= '<td><span class="LC_nobreak">'.
12884: '<label><input type="radio" name="archive_'.$count.
12885: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12886: my $text = $choices{$action};
12887: if ($is_dir) {
12888: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12889: if ($action eq 'display') {
1.1059 raeburn 12890: $text = &mt('Add as folder');
1.1055 raeburn 12891: }
1.1056 raeburn 12892: } else {
12893: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12894:
12895: }
12896: $output .= ' /> '.$choices{$action}.'</label></span>';
12897: if ($action eq 'dependency') {
12898: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12899: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12900: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12901: '<option value=""></option>'."\n".
12902: '</select>'."\n".
12903: '</div>';
1.1059 raeburn 12904: } elsif ($action eq 'display') {
12905: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12906: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12907: '</div>';
1.1055 raeburn 12908: }
1.1056 raeburn 12909: $output .= '</td>';
1.1055 raeburn 12910: }
12911: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12912: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12913: for (my $i=0; $i<$depth; $i++) {
12914: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12915: }
12916: if ($is_dir) {
12917: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12918: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12919: } else {
12920: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12921: }
12922: $output .= ' '.$name.'</td>'."\n".
12923: &end_data_table_row();
12924: return $output;
12925: }
12926:
12927: sub archive_options_form {
1.1065 raeburn 12928: my ($form,$display,$count,$hiddenelem) = @_;
12929: my %lt = &Apache::lonlocal::texthash(
12930: perm => 'Permanently remove archive file?',
12931: hows => 'How should each extracted item be incorporated in the course?',
12932: cont => 'Content actions for all',
12933: addf => 'Add as folder/file',
12934: incd => 'Include as dependency for a displayed file',
12935: disc => 'Discard',
12936: no => 'No',
12937: yes => 'Yes',
12938: save => 'Save',
12939: );
12940: my $output = <<"END";
12941: <form name="$form" method="post" action="">
12942: <p><span class="LC_nobreak">$lt{'perm'}
12943: <label>
12944: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12945: </label>
12946:
12947: <label>
12948: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12949: </span>
12950: </p>
12951: <input type="hidden" name="phase" value="decompress_cleanup" />
12952: <br />$lt{'hows'}
12953: <div class="LC_columnSection">
12954: <fieldset>
12955: <legend>$lt{'cont'}</legend>
12956: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12957: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12958: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12959: </fieldset>
12960: </div>
12961: END
12962: return $output.
1.1055 raeburn 12963: &start_data_table()."\n".
1.1065 raeburn 12964: $display."\n".
1.1055 raeburn 12965: &end_data_table()."\n".
12966: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12967: $hiddenelem.
1.1065 raeburn 12968: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12969: '</form>';
12970: }
12971:
12972: sub archive_javascript {
1.1056 raeburn 12973: my ($startcount,$numitems,$titles,$children) = @_;
12974: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12975: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12976: my $scripttag = <<START;
12977: <script type="text/javascript">
12978: // <![CDATA[
12979:
12980: function checkAll(form,prefix) {
12981: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12982: for (var i=0; i < form.elements.length; i++) {
12983: var id = form.elements[i].id;
12984: if ((id != '') && (id != undefined)) {
12985: if (idstr.test(id)) {
12986: if (form.elements[i].type == 'radio') {
12987: form.elements[i].checked = true;
1.1056 raeburn 12988: var nostart = i-$startcount;
1.1059 raeburn 12989: var offset = nostart%7;
12990: var count = (nostart-offset)/7;
1.1056 raeburn 12991: dependencyCheck(form,count,offset);
1.1055 raeburn 12992: }
12993: }
12994: }
12995: }
12996: }
12997:
12998: function propagateCheck(form,count) {
12999: if (count > 0) {
1.1059 raeburn 13000: var startelement = $startcount + ((count-1) * 7);
13001: for (var j=1; j<6; j++) {
13002: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13003: var item = startelement + j;
13004: if (form.elements[item].type == 'radio') {
13005: if (form.elements[item].checked) {
13006: containerCheck(form,count,j);
13007: break;
13008: }
1.1055 raeburn 13009: }
13010: }
13011: }
13012: }
13013: }
13014:
13015: numitems = $numitems
1.1056 raeburn 13016: var titles = new Array(numitems);
13017: var parents = new Array(numitems);
1.1055 raeburn 13018: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13019: parents[i] = new Array;
1.1055 raeburn 13020: }
1.1059 raeburn 13021: var maintitle = '$maintitle';
1.1055 raeburn 13022:
13023: START
13024:
1.1056 raeburn 13025: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13026: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13027: for (my $i=0; $i<@contents; $i ++) {
13028: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13029: }
13030: }
13031:
1.1056 raeburn 13032: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13033: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13034: }
13035:
1.1055 raeburn 13036: $scripttag .= <<END;
13037:
13038: function containerCheck(form,count,offset) {
13039: if (count > 0) {
1.1056 raeburn 13040: dependencyCheck(form,count,offset);
1.1059 raeburn 13041: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13042: form.elements[item].checked = true;
13043: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13044: if (parents[count].length > 0) {
13045: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13046: containerCheck(form,parents[count][j],offset);
13047: }
13048: }
13049: }
13050: }
13051: }
13052:
13053: function dependencyCheck(form,count,offset) {
13054: if (count > 0) {
1.1059 raeburn 13055: var chosen = (offset+$startcount)+7*(count-1);
13056: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13057: var currtype = form.elements[depitem].type;
13058: if (form.elements[chosen].value == 'dependency') {
13059: document.getElementById('arc_depon_'+count).style.display='block';
13060: form.elements[depitem].options.length = 0;
13061: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13062: for (var i=1; i<=numitems; i++) {
13063: if (i == count) {
13064: continue;
13065: }
1.1059 raeburn 13066: var startelement = $startcount + (i-1) * 7;
13067: for (var j=1; j<6; j++) {
13068: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13069: var item = startelement + j;
13070: if (form.elements[item].type == 'radio') {
13071: if (form.elements[item].checked) {
13072: if (form.elements[item].value == 'display') {
13073: var n = form.elements[depitem].options.length;
13074: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13075: }
13076: }
13077: }
13078: }
13079: }
13080: }
13081: } else {
13082: document.getElementById('arc_depon_'+count).style.display='none';
13083: form.elements[depitem].options.length = 0;
13084: form.elements[depitem].options[0] = new Option('Select','',true,true);
13085: }
1.1059 raeburn 13086: titleCheck(form,count,offset);
1.1056 raeburn 13087: }
13088: }
13089:
13090: function propagateSelect(form,count,offset) {
13091: if (count > 0) {
1.1065 raeburn 13092: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13093: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13094: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13095: if (parents[count].length > 0) {
13096: for (var j=0; j<parents[count].length; j++) {
13097: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13098: }
13099: }
13100: }
13101: }
13102: }
1.1056 raeburn 13103:
13104: function containerSelect(form,count,offset,picked) {
13105: if (count > 0) {
1.1065 raeburn 13106: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13107: if (form.elements[item].type == 'radio') {
13108: if (form.elements[item].value == 'dependency') {
13109: if (form.elements[item+1].type == 'select-one') {
13110: for (var i=0; i<form.elements[item+1].options.length; i++) {
13111: if (form.elements[item+1].options[i].value == picked) {
13112: form.elements[item+1].selectedIndex = i;
13113: break;
13114: }
13115: }
13116: }
13117: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13118: if (parents[count].length > 0) {
13119: for (var j=0; j<parents[count].length; j++) {
13120: containerSelect(form,parents[count][j],offset,picked);
13121: }
13122: }
13123: }
13124: }
13125: }
13126: }
13127: }
13128:
1.1059 raeburn 13129: function titleCheck(form,count,offset) {
13130: if (count > 0) {
13131: var chosen = (offset+$startcount)+7*(count-1);
13132: var depitem = $startcount + ((count-1) * 7) + 2;
13133: var currtype = form.elements[depitem].type;
13134: if (form.elements[chosen].value == 'display') {
13135: document.getElementById('arc_title_'+count).style.display='block';
13136: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13137: document.getElementById('archive_title_'+count).value=maintitle;
13138: }
13139: } else {
13140: document.getElementById('arc_title_'+count).style.display='none';
13141: if (currtype == 'text') {
13142: document.getElementById('archive_title_'+count).value='';
13143: }
13144: }
13145: }
13146: return;
13147: }
13148:
1.1055 raeburn 13149: // ]]>
13150: </script>
13151: END
13152: return $scripttag;
13153: }
13154:
13155: sub process_extracted_files {
1.1067 raeburn 13156: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13157: my $numitems = $env{'form.archive_count'};
13158: return unless ($numitems);
13159: my @ids=&Apache::lonnet::current_machine_ids();
13160: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13161: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13162: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13163: if (grep(/^\Q$docuhome\E$/,@ids)) {
13164: $prefix = &LONCAPA::propath($docudom,$docuname);
13165: $pathtocheck = "$dir_root/$destination";
13166: $dir = $dir_root;
13167: $ishome = 1;
13168: } else {
13169: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13170: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
13171: $dir = "$dir_root/$docudom/$docuname";
13172: }
13173: my $currdir = "$dir_root/$destination";
13174: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13175: if ($env{'form.folderpath'}) {
13176: my @items = split('&',$env{'form.folderpath'});
13177: $folders{'0'} = $items[-2];
1.1099 raeburn 13178: if ($env{'form.folderpath'} =~ /\:1$/) {
13179: $containers{'0'}='page';
13180: } else {
13181: $containers{'0'}='sequence';
13182: }
1.1055 raeburn 13183: }
13184: my @archdirs = &get_env_multiple('form.archive_directory');
13185: if ($numitems) {
13186: for (my $i=1; $i<=$numitems; $i++) {
13187: my $path = $env{'form.archive_content_'.$i};
13188: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13189: my $item = $1;
13190: $toplevelitems{$item} = $i;
13191: if (grep(/^\Q$i\E$/,@archdirs)) {
13192: $is_dir{$item} = 1;
13193: }
13194: }
13195: }
13196: }
1.1067 raeburn 13197: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13198: if (keys(%toplevelitems) > 0) {
13199: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13200: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13201: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13202: }
1.1066 raeburn 13203: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13204: if ($numitems) {
13205: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13206: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13207: my $path = $env{'form.archive_content_'.$i};
13208: if ($path =~ /^\Q$pathtocheck\E/) {
13209: if ($env{'form.archive_'.$i} eq 'discard') {
13210: if ($prefix ne '' && $path ne '') {
13211: if (-e $prefix.$path) {
1.1066 raeburn 13212: if ((@archdirs > 0) &&
13213: (grep(/^\Q$i\E$/,@archdirs))) {
13214: $todeletedir{$prefix.$path} = 1;
13215: } else {
13216: $todelete{$prefix.$path} = 1;
13217: }
1.1055 raeburn 13218: }
13219: }
13220: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13221: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13222: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13223: $docstitle = $env{'form.archive_title_'.$i};
13224: if ($docstitle eq '') {
13225: $docstitle = $title;
13226: }
1.1055 raeburn 13227: $outer = 0;
1.1056 raeburn 13228: if (ref($dirorder{$i}) eq 'ARRAY') {
13229: if (@{$dirorder{$i}} > 0) {
13230: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13231: if ($env{'form.archive_'.$item} eq 'display') {
13232: $outer = $item;
13233: last;
13234: }
13235: }
13236: }
13237: }
13238: my ($errtext,$fatal) =
13239: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13240: '/'.$folders{$outer}.'.'.
13241: $containers{$outer});
13242: next if ($fatal);
13243: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13244: if ($context eq 'coursedocs') {
1.1056 raeburn 13245: $mapinner{$i} = time;
1.1055 raeburn 13246: $folders{$i} = 'default_'.$mapinner{$i};
13247: $containers{$i} = 'sequence';
13248: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13249: $folders{$i}.'.'.$containers{$i};
13250: my $newidx = &LONCAPA::map::getresidx();
13251: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13252: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13253: push(@LONCAPA::map::order,$newidx);
13254: my ($outtext,$errtext) =
13255: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13256: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13257: '.'.$containers{$outer},1,1);
1.1056 raeburn 13258: $newseqid{$i} = $newidx;
1.1067 raeburn 13259: unless ($errtext) {
13260: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
13261: }
1.1055 raeburn 13262: }
13263: } else {
13264: if ($context eq 'coursedocs') {
13265: my $newidx=&LONCAPA::map::getresidx();
13266: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13267: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13268: $title;
13269: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13270: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13271: }
13272: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13273: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13274: }
13275: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13276: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 13277: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 13278: unless ($ishome) {
13279: my $fetch = "$newdest{$i}/$title";
13280: $fetch =~ s/^\Q$prefix$dir\E//;
13281: $prompttofetch{$fetch} = 1;
13282: }
1.1055 raeburn 13283: }
13284: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13285: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13286: push(@LONCAPA::map::order, $newidx);
13287: my ($outtext,$errtext)=
13288: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13289: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13290: '.'.$containers{$outer},1,1);
1.1067 raeburn 13291: unless ($errtext) {
13292: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13293: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
13294: }
13295: }
1.1055 raeburn 13296: }
13297: }
1.1086 raeburn 13298: }
13299: } else {
13300: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13301: }
13302: }
13303: for (my $i=1; $i<=$numitems; $i++) {
13304: next unless ($env{'form.archive_'.$i} eq 'dependency');
13305: my $path = $env{'form.archive_content_'.$i};
13306: if ($path =~ /^\Q$pathtocheck\E/) {
13307: my ($title) = ($path =~ m{/([^/]+)$});
13308: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13309: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13310: if (ref($dirorder{$i}) eq 'ARRAY') {
13311: my ($itemidx,$fullpath,$relpath);
13312: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13313: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13314: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13315: if ($dirorder{$i}->[$j] eq $container) {
13316: $itemidx = $j;
1.1056 raeburn 13317: }
13318: }
1.1086 raeburn 13319: }
13320: if ($itemidx eq '') {
13321: $itemidx = 0;
13322: }
13323: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13324: if ($mapinner{$referrer{$i}}) {
13325: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13326: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13327: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13328: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13329: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13330: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13331: if (!-e $fullpath) {
13332: mkdir($fullpath,0755);
1.1056 raeburn 13333: }
13334: }
1.1086 raeburn 13335: } else {
13336: last;
1.1056 raeburn 13337: }
1.1086 raeburn 13338: }
13339: }
13340: } elsif ($newdest{$referrer{$i}}) {
13341: $fullpath = $newdest{$referrer{$i}};
13342: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13343: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13344: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13345: last;
13346: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13347: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13348: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13349: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13350: if (!-e $fullpath) {
13351: mkdir($fullpath,0755);
1.1056 raeburn 13352: }
13353: }
1.1086 raeburn 13354: } else {
13355: last;
1.1056 raeburn 13356: }
1.1055 raeburn 13357: }
13358: }
1.1086 raeburn 13359: if ($fullpath ne '') {
13360: if (-e "$prefix$path") {
13361: system("mv $prefix$path $fullpath/$title");
13362: }
13363: if (-e "$fullpath/$title") {
13364: my $showpath;
13365: if ($relpath ne '') {
13366: $showpath = "$relpath/$title";
13367: } else {
13368: $showpath = "/$title";
13369: }
13370: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
13371: }
13372: unless ($ishome) {
13373: my $fetch = "$fullpath/$title";
13374: $fetch =~ s/^\Q$prefix$dir\E//;
13375: $prompttofetch{$fetch} = 1;
13376: }
13377: }
1.1055 raeburn 13378: }
1.1086 raeburn 13379: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13380: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
13381: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 13382: }
13383: } else {
13384: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13385: }
13386: }
13387: if (keys(%todelete)) {
13388: foreach my $key (keys(%todelete)) {
13389: unlink($key);
1.1066 raeburn 13390: }
13391: }
13392: if (keys(%todeletedir)) {
13393: foreach my $key (keys(%todeletedir)) {
13394: rmdir($key);
13395: }
13396: }
13397: foreach my $dir (sort(keys(%is_dir))) {
13398: if (($pathtocheck ne '') && ($dir ne '')) {
13399: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13400: }
13401: }
1.1067 raeburn 13402: if ($result ne '') {
13403: $output .= '<ul>'."\n".
13404: $result."\n".
13405: '</ul>';
13406: }
13407: unless ($ishome) {
13408: my $replicationfail;
13409: foreach my $item (keys(%prompttofetch)) {
13410: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13411: unless ($fetchresult eq 'ok') {
13412: $replicationfail .= '<li>'.$item.'</li>'."\n";
13413: }
13414: }
13415: if ($replicationfail) {
13416: $output .= '<p class="LC_error">'.
13417: &mt('Course home server failed to retrieve:').'<ul>'.
13418: $replicationfail.
13419: '</ul></p>';
13420: }
13421: }
1.1055 raeburn 13422: } else {
13423: $warning = &mt('No items found in archive.');
13424: }
13425: if ($error) {
13426: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13427: $error.'</p>'."\n";
13428: }
13429: if ($warning) {
13430: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13431: }
13432: return $output;
13433: }
13434:
1.1066 raeburn 13435: sub cleanup_empty_dirs {
13436: my ($path) = @_;
13437: if (($path ne '') && (-d $path)) {
13438: if (opendir(my $dirh,$path)) {
13439: my @dircontents = grep(!/^\./,readdir($dirh));
13440: my $numitems = 0;
13441: foreach my $item (@dircontents) {
13442: if (-d "$path/$item") {
1.1111 raeburn 13443: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13444: if (-e "$path/$item") {
13445: $numitems ++;
13446: }
13447: } else {
13448: $numitems ++;
13449: }
13450: }
13451: if ($numitems == 0) {
13452: rmdir($path);
13453: }
13454: closedir($dirh);
13455: }
13456: }
13457: return;
13458: }
13459:
1.41 ng 13460: =pod
1.45 matthew 13461:
1.1162 raeburn 13462: =item * &get_folder_hierarchy()
1.1068 raeburn 13463:
13464: Provides hierarchy of names of folders/sub-folders containing the current
13465: item,
13466:
13467: Inputs: 3
13468: - $navmap - navmaps object
13469:
13470: - $map - url for map (either the trigger itself, or map containing
13471: the resource, which is the trigger).
13472:
13473: - $showitem - 1 => show title for map itself; 0 => do not show.
13474:
13475: Outputs: 1 @pathitems - array of folder/subfolder names.
13476:
13477: =cut
13478:
13479: sub get_folder_hierarchy {
13480: my ($navmap,$map,$showitem) = @_;
13481: my @pathitems;
13482: if (ref($navmap)) {
13483: my $mapres = $navmap->getResourceByUrl($map);
13484: if (ref($mapres)) {
13485: my $pcslist = $mapres->map_hierarchy();
13486: if ($pcslist ne '') {
13487: my @pcs = split(/,/,$pcslist);
13488: foreach my $pc (@pcs) {
13489: if ($pc == 1) {
1.1129 raeburn 13490: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13491: } else {
13492: my $res = $navmap->getByMapPc($pc);
13493: if (ref($res)) {
13494: my $title = $res->compTitle();
13495: $title =~ s/\W+/_/g;
13496: if ($title ne '') {
13497: push(@pathitems,$title);
13498: }
13499: }
13500: }
13501: }
13502: }
1.1071 raeburn 13503: if ($showitem) {
13504: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13505: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13506: } else {
13507: my $maptitle = $mapres->compTitle();
13508: $maptitle =~ s/\W+/_/g;
13509: if ($maptitle ne '') {
13510: push(@pathitems,$maptitle);
13511: }
1.1068 raeburn 13512: }
13513: }
13514: }
13515: }
13516: return @pathitems;
13517: }
13518:
13519: =pod
13520:
1.1015 raeburn 13521: =item * &get_turnedin_filepath()
13522:
13523: Determines path in a user's portfolio file for storage of files uploaded
13524: to a specific essayresponse or dropbox item.
13525:
13526: Inputs: 3 required + 1 optional.
13527: $symb is symb for resource, $uname and $udom are for current user (required).
13528: $caller is optional (can be "submission", if routine is called when storing
13529: an upoaded file when "Submit Answer" button was pressed).
13530:
13531: Returns array containing $path and $multiresp.
13532: $path is path in portfolio. $multiresp is 1 if this resource contains more
13533: than one file upload item. Callers of routine should append partid as a
13534: subdirectory to $path in cases where $multiresp is 1.
13535:
13536: Called by: homework/essayresponse.pm and homework/structuretags.pm
13537:
13538: =cut
13539:
13540: sub get_turnedin_filepath {
13541: my ($symb,$uname,$udom,$caller) = @_;
13542: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13543: my $turnindir;
13544: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13545: $turnindir = $userhash{'turnindir'};
13546: my ($path,$multiresp);
13547: if ($turnindir eq '') {
13548: if ($caller eq 'submission') {
13549: $turnindir = &mt('turned in');
13550: $turnindir =~ s/\W+/_/g;
13551: my %newhash = (
13552: 'turnindir' => $turnindir,
13553: );
13554: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13555: }
13556: }
13557: if ($turnindir ne '') {
13558: $path = '/'.$turnindir.'/';
13559: my ($multipart,$turnin,@pathitems);
13560: my $navmap = Apache::lonnavmaps::navmap->new();
13561: if (defined($navmap)) {
13562: my $mapres = $navmap->getResourceByUrl($map);
13563: if (ref($mapres)) {
13564: my $pcslist = $mapres->map_hierarchy();
13565: if ($pcslist ne '') {
13566: foreach my $pc (split(/,/,$pcslist)) {
13567: my $res = $navmap->getByMapPc($pc);
13568: if (ref($res)) {
13569: my $title = $res->compTitle();
13570: $title =~ s/\W+/_/g;
13571: if ($title ne '') {
1.1149 raeburn 13572: if (($pc > 1) && (length($title) > 12)) {
13573: $title = substr($title,0,12);
13574: }
1.1015 raeburn 13575: push(@pathitems,$title);
13576: }
13577: }
13578: }
13579: }
13580: my $maptitle = $mapres->compTitle();
13581: $maptitle =~ s/\W+/_/g;
13582: if ($maptitle ne '') {
1.1149 raeburn 13583: if (length($maptitle) > 12) {
13584: $maptitle = substr($maptitle,0,12);
13585: }
1.1015 raeburn 13586: push(@pathitems,$maptitle);
13587: }
13588: unless ($env{'request.state'} eq 'construct') {
13589: my $res = $navmap->getBySymb($symb);
13590: if (ref($res)) {
13591: my $partlist = $res->parts();
13592: my $totaluploads = 0;
13593: if (ref($partlist) eq 'ARRAY') {
13594: foreach my $part (@{$partlist}) {
13595: my @types = $res->responseType($part);
13596: my @ids = $res->responseIds($part);
13597: for (my $i=0; $i < scalar(@ids); $i++) {
13598: if ($types[$i] eq 'essay') {
13599: my $partid = $part.'_'.$ids[$i];
13600: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13601: $totaluploads ++;
13602: }
13603: }
13604: }
13605: }
13606: if ($totaluploads > 1) {
13607: $multiresp = 1;
13608: }
13609: }
13610: }
13611: }
13612: } else {
13613: return;
13614: }
13615: } else {
13616: return;
13617: }
13618: my $restitle=&Apache::lonnet::gettitle($symb);
13619: $restitle =~ s/\W+/_/g;
13620: if ($restitle eq '') {
13621: $restitle = ($resurl =~ m{/[^/]+$});
13622: if ($restitle eq '') {
13623: $restitle = time;
13624: }
13625: }
1.1149 raeburn 13626: if (length($restitle) > 12) {
13627: $restitle = substr($restitle,0,12);
13628: }
1.1015 raeburn 13629: push(@pathitems,$restitle);
13630: $path .= join('/',@pathitems);
13631: }
13632: return ($path,$multiresp);
13633: }
13634:
13635: =pod
13636:
1.464 albertel 13637: =back
1.41 ng 13638:
1.112 bowersj2 13639: =head1 CSV Upload/Handling functions
1.38 albertel 13640:
1.41 ng 13641: =over 4
13642:
1.648 raeburn 13643: =item * &upfile_store($r)
1.41 ng 13644:
13645: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13646: needs $env{'form.upfile'}
1.41 ng 13647: returns $datatoken to be put into hidden field
13648:
13649: =cut
1.31 albertel 13650:
13651: sub upfile_store {
13652: my $r=shift;
1.258 albertel 13653: $env{'form.upfile'}=~s/\r/\n/gs;
13654: $env{'form.upfile'}=~s/\f/\n/gs;
13655: $env{'form.upfile'}=~s/\n+/\n/gs;
13656: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13657:
1.258 albertel 13658: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
13659: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 13660: {
1.158 raeburn 13661: my $datafile = $r->dir_config('lonDaemons').
13662: '/tmp/'.$datatoken.'.tmp';
13663: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13664: print $fh $env{'form.upfile'};
1.158 raeburn 13665: close($fh);
13666: }
1.31 albertel 13667: }
13668: return $datatoken;
13669: }
13670:
1.56 matthew 13671: =pod
13672:
1.648 raeburn 13673: =item * &load_tmp_file($r)
1.41 ng 13674:
13675: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 13676: needs $env{'form.datatoken'},
13677: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13678:
13679: =cut
1.31 albertel 13680:
13681: sub load_tmp_file {
13682: my $r=shift;
13683: my @studentdata=();
13684: {
1.158 raeburn 13685: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 13686: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 13687: if ( open(my $fh,"<$studentfile") ) {
13688: @studentdata=<$fh>;
13689: close($fh);
13690: }
1.31 albertel 13691: }
1.258 albertel 13692: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13693: }
13694:
1.56 matthew 13695: =pod
13696:
1.648 raeburn 13697: =item * &upfile_record_sep()
1.41 ng 13698:
13699: Separate uploaded file into records
13700: returns array of records,
1.258 albertel 13701: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13702:
13703: =cut
1.31 albertel 13704:
13705: sub upfile_record_sep {
1.258 albertel 13706: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13707: } else {
1.248 albertel 13708: my @records;
1.258 albertel 13709: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13710: if ($line=~/^\s*$/) { next; }
13711: push(@records,$line);
13712: }
13713: return @records;
1.31 albertel 13714: }
13715: }
13716:
1.56 matthew 13717: =pod
13718:
1.648 raeburn 13719: =item * &record_sep($record)
1.41 ng 13720:
1.258 albertel 13721: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13722:
13723: =cut
13724:
1.263 www 13725: sub takeleft {
13726: my $index=shift;
13727: return substr('0000'.$index,-4,4);
13728: }
13729:
1.31 albertel 13730: sub record_sep {
13731: my $record=shift;
13732: my %components=();
1.258 albertel 13733: if ($env{'form.upfiletype'} eq 'xml') {
13734: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13735: my $i=0;
1.356 albertel 13736: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13737: $field=~s/^(\"|\')//;
13738: $field=~s/(\"|\')$//;
1.263 www 13739: $components{&takeleft($i)}=$field;
1.31 albertel 13740: $i++;
13741: }
1.258 albertel 13742: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13743: my $i=0;
1.356 albertel 13744: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13745: $field=~s/^(\"|\')//;
13746: $field=~s/(\"|\')$//;
1.263 www 13747: $components{&takeleft($i)}=$field;
1.31 albertel 13748: $i++;
13749: }
13750: } else {
1.561 www 13751: my $separator=',';
1.480 banghart 13752: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13753: $separator=';';
1.480 banghart 13754: }
1.31 albertel 13755: my $i=0;
1.561 www 13756: # the character we are looking for to indicate the end of a quote or a record
13757: my $looking_for=$separator;
13758: # do not add the characters to the fields
13759: my $ignore=0;
13760: # we just encountered a separator (or the beginning of the record)
13761: my $just_found_separator=1;
13762: # store the field we are working on here
13763: my $field='';
13764: # work our way through all characters in record
13765: foreach my $character ($record=~/(.)/g) {
13766: if ($character eq $looking_for) {
13767: if ($character ne $separator) {
13768: # Found the end of a quote, again looking for separator
13769: $looking_for=$separator;
13770: $ignore=1;
13771: } else {
13772: # Found a separator, store away what we got
13773: $components{&takeleft($i)}=$field;
13774: $i++;
13775: $just_found_separator=1;
13776: $ignore=0;
13777: $field='';
13778: }
13779: next;
13780: }
13781: # single or double quotation marks after a separator indicate beginning of a quote
13782: # we are now looking for the end of the quote and need to ignore separators
13783: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13784: $looking_for=$character;
13785: next;
13786: }
13787: # ignore would be true after we reached the end of a quote
13788: if ($ignore) { next; }
13789: if (($just_found_separator) && ($character=~/\s/)) { next; }
13790: $field.=$character;
13791: $just_found_separator=0;
1.31 albertel 13792: }
1.561 www 13793: # catch the very last entry, since we never encountered the separator
13794: $components{&takeleft($i)}=$field;
1.31 albertel 13795: }
13796: return %components;
13797: }
13798:
1.144 matthew 13799: ######################################################
13800: ######################################################
13801:
1.56 matthew 13802: =pod
13803:
1.648 raeburn 13804: =item * &upfile_select_html()
1.41 ng 13805:
1.144 matthew 13806: Return HTML code to select a file from the users machine and specify
13807: the file type.
1.41 ng 13808:
13809: =cut
13810:
1.144 matthew 13811: ######################################################
13812: ######################################################
1.31 albertel 13813: sub upfile_select_html {
1.144 matthew 13814: my %Types = (
13815: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13816: semisv => &mt('Semicolon separated values'),
1.144 matthew 13817: space => &mt('Space separated'),
13818: tab => &mt('Tabulator separated'),
13819: # xml => &mt('HTML/XML'),
13820: );
13821: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13822: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13823: foreach my $type (sort(keys(%Types))) {
13824: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13825: }
13826: $Str .= "</select>\n";
13827: return $Str;
1.31 albertel 13828: }
13829:
1.301 albertel 13830: sub get_samples {
13831: my ($records,$toget) = @_;
13832: my @samples=({});
13833: my $got=0;
13834: foreach my $rec (@$records) {
13835: my %temp = &record_sep($rec);
13836: if (! grep(/\S/, values(%temp))) { next; }
13837: if (%temp) {
13838: $samples[$got]=\%temp;
13839: $got++;
13840: if ($got == $toget) { last; }
13841: }
13842: }
13843: return \@samples;
13844: }
13845:
1.144 matthew 13846: ######################################################
13847: ######################################################
13848:
1.56 matthew 13849: =pod
13850:
1.648 raeburn 13851: =item * &csv_print_samples($r,$records)
1.41 ng 13852:
13853: Prints a table of sample values from each column uploaded $r is an
13854: Apache Request ref, $records is an arrayref from
13855: &Apache::loncommon::upfile_record_sep
13856:
13857: =cut
13858:
1.144 matthew 13859: ######################################################
13860: ######################################################
1.31 albertel 13861: sub csv_print_samples {
13862: my ($r,$records) = @_;
1.662 bisitz 13863: my $samples = &get_samples($records,5);
1.301 albertel 13864:
1.594 raeburn 13865: $r->print(&mt('Samples').'<br />'.&start_data_table().
13866: &start_data_table_header_row());
1.356 albertel 13867: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13868: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13869: $r->print(&end_data_table_header_row());
1.301 albertel 13870: foreach my $hash (@$samples) {
1.594 raeburn 13871: $r->print(&start_data_table_row());
1.356 albertel 13872: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13873: $r->print('<td>');
1.356 albertel 13874: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13875: $r->print('</td>');
13876: }
1.594 raeburn 13877: $r->print(&end_data_table_row());
1.31 albertel 13878: }
1.594 raeburn 13879: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13880: }
13881:
1.144 matthew 13882: ######################################################
13883: ######################################################
13884:
1.56 matthew 13885: =pod
13886:
1.648 raeburn 13887: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13888:
13889: Prints a table to create associations between values and table columns.
1.144 matthew 13890:
1.41 ng 13891: $r is an Apache Request ref,
13892: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13893: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13894:
13895: =cut
13896:
1.144 matthew 13897: ######################################################
13898: ######################################################
1.31 albertel 13899: sub csv_print_select_table {
13900: my ($r,$records,$d) = @_;
1.301 albertel 13901: my $i=0;
13902: my $samples = &get_samples($records,1);
1.144 matthew 13903: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13904: &start_data_table().&start_data_table_header_row().
1.144 matthew 13905: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13906: '<th>'.&mt('Column').'</th>'.
13907: &end_data_table_header_row()."\n");
1.356 albertel 13908: foreach my $array_ref (@$d) {
13909: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13910: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13911:
1.875 bisitz 13912: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13913: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13914: $r->print('<option value="none"></option>');
1.356 albertel 13915: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13916: $r->print('<option value="'.$sample.'"'.
13917: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13918: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13919: }
1.594 raeburn 13920: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13921: $i++;
13922: }
1.594 raeburn 13923: $r->print(&end_data_table());
1.31 albertel 13924: $i--;
13925: return $i;
13926: }
1.56 matthew 13927:
1.144 matthew 13928: ######################################################
13929: ######################################################
13930:
1.56 matthew 13931: =pod
1.31 albertel 13932:
1.648 raeburn 13933: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13934:
13935: Prints a table of sample values from the upload and can make associate samples to internal names.
13936:
13937: $r is an Apache Request ref,
13938: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13939: $d is an array of 2 element arrays (internal name, displayed name)
13940:
13941: =cut
13942:
1.144 matthew 13943: ######################################################
13944: ######################################################
1.31 albertel 13945: sub csv_samples_select_table {
13946: my ($r,$records,$d) = @_;
13947: my $i=0;
1.144 matthew 13948: #
1.662 bisitz 13949: my $max_samples = 5;
13950: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13951: $r->print(&start_data_table().
13952: &start_data_table_header_row().'<th>'.
13953: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13954: &end_data_table_header_row());
1.301 albertel 13955:
13956: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13957: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13958: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13959: foreach my $option (@$d) {
13960: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13961: $r->print('<option value="'.$value.'"'.
1.253 albertel 13962: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13963: $display.'</option>');
1.31 albertel 13964: }
13965: $r->print('</select></td><td>');
1.662 bisitz 13966: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13967: if (defined($samples->[$line]{$key})) {
13968: $r->print($samples->[$line]{$key}."<br />\n");
13969: }
13970: }
1.594 raeburn 13971: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13972: $i++;
13973: }
1.594 raeburn 13974: $r->print(&end_data_table());
1.31 albertel 13975: $i--;
13976: return($i);
1.115 matthew 13977: }
13978:
1.144 matthew 13979: ######################################################
13980: ######################################################
13981:
1.115 matthew 13982: =pod
13983:
1.648 raeburn 13984: =item * &clean_excel_name($name)
1.115 matthew 13985:
13986: Returns a replacement for $name which does not contain any illegal characters.
13987:
13988: =cut
13989:
1.144 matthew 13990: ######################################################
13991: ######################################################
1.115 matthew 13992: sub clean_excel_name {
13993: my ($name) = @_;
13994: $name =~ s/[:\*\?\/\\]//g;
13995: if (length($name) > 31) {
13996: $name = substr($name,0,31);
13997: }
13998: return $name;
1.25 albertel 13999: }
1.84 albertel 14000:
1.85 albertel 14001: =pod
14002:
1.648 raeburn 14003: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14004:
14005: Returns either 1 or undef
14006:
14007: 1 if the part is to be hidden, undef if it is to be shown
14008:
14009: Arguments are:
14010:
14011: $id the id of the part to be checked
14012: $symb, optional the symb of the resource to check
14013: $udom, optional the domain of the user to check for
14014: $uname, optional the username of the user to check for
14015:
14016: =cut
1.84 albertel 14017:
14018: sub check_if_partid_hidden {
14019: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14020: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14021: $symb,$udom,$uname);
1.141 albertel 14022: my $truth=1;
14023: #if the string starts with !, then the list is the list to show not hide
14024: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14025: my @hiddenlist=split(/,/,$hiddenparts);
14026: foreach my $checkid (@hiddenlist) {
1.141 albertel 14027: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14028: }
1.141 albertel 14029: return !$truth;
1.84 albertel 14030: }
1.127 matthew 14031:
1.138 matthew 14032:
14033: ############################################################
14034: ############################################################
14035:
14036: =pod
14037:
1.157 matthew 14038: =back
14039:
1.138 matthew 14040: =head1 cgi-bin script and graphing routines
14041:
1.157 matthew 14042: =over 4
14043:
1.648 raeburn 14044: =item * &get_cgi_id()
1.138 matthew 14045:
14046: Inputs: none
14047:
14048: Returns an id which can be used to pass environment variables
14049: to various cgi-bin scripts. These environment variables will
14050: be removed from the users environment after a given time by
14051: the routine &Apache::lonnet::transfer_profile_to_env.
14052:
14053: =cut
14054:
14055: ############################################################
14056: ############################################################
1.152 albertel 14057: my $uniq=0;
1.136 matthew 14058: sub get_cgi_id {
1.154 albertel 14059: $uniq=($uniq+1)%100000;
1.280 albertel 14060: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14061: }
14062:
1.127 matthew 14063: ############################################################
14064: ############################################################
14065:
14066: =pod
14067:
1.648 raeburn 14068: =item * &DrawBarGraph()
1.127 matthew 14069:
1.138 matthew 14070: Facilitates the plotting of data in a (stacked) bar graph.
14071: Puts plot definition data into the users environment in order for
14072: graph.png to plot it. Returns an <img> tag for the plot.
14073: The bars on the plot are labeled '1','2',...,'n'.
14074:
14075: Inputs:
14076:
14077: =over 4
14078:
14079: =item $Title: string, the title of the plot
14080:
14081: =item $xlabel: string, text describing the X-axis of the plot
14082:
14083: =item $ylabel: string, text describing the Y-axis of the plot
14084:
14085: =item $Max: scalar, the maximum Y value to use in the plot
14086: If $Max is < any data point, the graph will not be rendered.
14087:
1.140 matthew 14088: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14089: they are plotted. If undefined, default values will be used.
14090:
1.178 matthew 14091: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14092:
1.138 matthew 14093: =item @Values: An array of array references. Each array reference holds data
14094: to be plotted in a stacked bar chart.
14095:
1.239 matthew 14096: =item If the final element of @Values is a hash reference the key/value
14097: pairs will be added to the graph definition.
14098:
1.138 matthew 14099: =back
14100:
14101: Returns:
14102:
14103: An <img> tag which references graph.png and the appropriate identifying
14104: information for the plot.
14105:
1.127 matthew 14106: =cut
14107:
14108: ############################################################
14109: ############################################################
1.134 matthew 14110: sub DrawBarGraph {
1.178 matthew 14111: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14112: #
14113: if (! defined($colors)) {
14114: $colors = ['#33ff00',
14115: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14116: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14117: ];
14118: }
1.228 matthew 14119: my $extra_settings = {};
14120: if (ref($Values[-1]) eq 'HASH') {
14121: $extra_settings = pop(@Values);
14122: }
1.127 matthew 14123: #
1.136 matthew 14124: my $identifier = &get_cgi_id();
14125: my $id = 'cgi.'.$identifier;
1.129 matthew 14126: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14127: return '';
14128: }
1.225 matthew 14129: #
14130: my @Labels;
14131: if (defined($labels)) {
14132: @Labels = @$labels;
14133: } else {
14134: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 14135: push(@Labels,$i+1);
1.225 matthew 14136: }
14137: }
14138: #
1.129 matthew 14139: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14140: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14141: my %ValuesHash;
14142: my $NumSets=1;
14143: foreach my $array (@Values) {
14144: next if (! ref($array));
1.136 matthew 14145: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14146: join(',',@$array);
1.129 matthew 14147: }
1.127 matthew 14148: #
1.136 matthew 14149: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14150: if ($NumBars < 3) {
14151: $width = 120+$NumBars*32;
1.220 matthew 14152: $xskip = 1;
1.225 matthew 14153: $bar_width = 30;
14154: } elsif ($NumBars < 5) {
14155: $width = 120+$NumBars*20;
14156: $xskip = 1;
14157: $bar_width = 20;
1.220 matthew 14158: } elsif ($NumBars < 10) {
1.136 matthew 14159: $width = 120+$NumBars*15;
14160: $xskip = 1;
14161: $bar_width = 15;
14162: } elsif ($NumBars <= 25) {
14163: $width = 120+$NumBars*11;
14164: $xskip = 5;
14165: $bar_width = 8;
14166: } elsif ($NumBars <= 50) {
14167: $width = 120+$NumBars*8;
14168: $xskip = 5;
14169: $bar_width = 4;
14170: } else {
14171: $width = 120+$NumBars*8;
14172: $xskip = 5;
14173: $bar_width = 4;
14174: }
14175: #
1.137 matthew 14176: $Max = 1 if ($Max < 1);
14177: if ( int($Max) < $Max ) {
14178: $Max++;
14179: $Max = int($Max);
14180: }
1.127 matthew 14181: $Title = '' if (! defined($Title));
14182: $xlabel = '' if (! defined($xlabel));
14183: $ylabel = '' if (! defined($ylabel));
1.369 www 14184: $ValuesHash{$id.'.title'} = &escape($Title);
14185: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14186: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14187: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14188: $ValuesHash{$id.'.NumBars'} = $NumBars;
14189: $ValuesHash{$id.'.NumSets'} = $NumSets;
14190: $ValuesHash{$id.'.PlotType'} = 'bar';
14191: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14192: $ValuesHash{$id.'.height'} = $height;
14193: $ValuesHash{$id.'.width'} = $width;
14194: $ValuesHash{$id.'.xskip'} = $xskip;
14195: $ValuesHash{$id.'.bar_width'} = $bar_width;
14196: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14197: #
1.228 matthew 14198: # Deal with other parameters
14199: while (my ($key,$value) = each(%$extra_settings)) {
14200: $ValuesHash{$id.'.'.$key} = $value;
14201: }
14202: #
1.646 raeburn 14203: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14204: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14205: }
14206:
14207: ############################################################
14208: ############################################################
14209:
14210: =pod
14211:
1.648 raeburn 14212: =item * &DrawXYGraph()
1.137 matthew 14213:
1.138 matthew 14214: Facilitates the plotting of data in an XY graph.
14215: Puts plot definition data into the users environment in order for
14216: graph.png to plot it. Returns an <img> tag for the plot.
14217:
14218: Inputs:
14219:
14220: =over 4
14221:
14222: =item $Title: string, the title of the plot
14223:
14224: =item $xlabel: string, text describing the X-axis of the plot
14225:
14226: =item $ylabel: string, text describing the Y-axis of the plot
14227:
14228: =item $Max: scalar, the maximum Y value to use in the plot
14229: If $Max is < any data point, the graph will not be rendered.
14230:
14231: =item $colors: Array ref containing the hex color codes for the data to be
14232: plotted in. If undefined, default values will be used.
14233:
14234: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14235:
14236: =item $Ydata: Array ref containing Array refs.
1.185 www 14237: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14238:
14239: =item %Values: hash indicating or overriding any default values which are
14240: passed to graph.png.
14241: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14242:
14243: =back
14244:
14245: Returns:
14246:
14247: An <img> tag which references graph.png and the appropriate identifying
14248: information for the plot.
14249:
1.137 matthew 14250: =cut
14251:
14252: ############################################################
14253: ############################################################
14254: sub DrawXYGraph {
14255: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14256: #
14257: # Create the identifier for the graph
14258: my $identifier = &get_cgi_id();
14259: my $id = 'cgi.'.$identifier;
14260: #
14261: $Title = '' if (! defined($Title));
14262: $xlabel = '' if (! defined($xlabel));
14263: $ylabel = '' if (! defined($ylabel));
14264: my %ValuesHash =
14265: (
1.369 www 14266: $id.'.title' => &escape($Title),
14267: $id.'.xlabel' => &escape($xlabel),
14268: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14269: $id.'.y_max_value'=> $Max,
14270: $id.'.labels' => join(',',@$Xlabels),
14271: $id.'.PlotType' => 'XY',
14272: );
14273: #
14274: if (defined($colors) && ref($colors) eq 'ARRAY') {
14275: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14276: }
14277: #
14278: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14279: return '';
14280: }
14281: my $NumSets=1;
1.138 matthew 14282: foreach my $array (@{$Ydata}){
1.137 matthew 14283: next if (! ref($array));
14284: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14285: }
1.138 matthew 14286: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14287: #
14288: # Deal with other parameters
14289: while (my ($key,$value) = each(%Values)) {
14290: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14291: }
14292: #
1.646 raeburn 14293: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14294: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14295: }
14296:
14297: ############################################################
14298: ############################################################
14299:
14300: =pod
14301:
1.648 raeburn 14302: =item * &DrawXYYGraph()
1.138 matthew 14303:
14304: Facilitates the plotting of data in an XY graph with two Y axes.
14305: Puts plot definition data into the users environment in order for
14306: graph.png to plot it. Returns an <img> tag for the plot.
14307:
14308: Inputs:
14309:
14310: =over 4
14311:
14312: =item $Title: string, the title of the plot
14313:
14314: =item $xlabel: string, text describing the X-axis of the plot
14315:
14316: =item $ylabel: string, text describing the Y-axis of the plot
14317:
14318: =item $colors: Array ref containing the hex color codes for the data to be
14319: plotted in. If undefined, default values will be used.
14320:
14321: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14322:
14323: =item $Ydata1: The first data set
14324:
14325: =item $Min1: The minimum value of the left Y-axis
14326:
14327: =item $Max1: The maximum value of the left Y-axis
14328:
14329: =item $Ydata2: The second data set
14330:
14331: =item $Min2: The minimum value of the right Y-axis
14332:
14333: =item $Max2: The maximum value of the left Y-axis
14334:
14335: =item %Values: hash indicating or overriding any default values which are
14336: passed to graph.png.
14337: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14338:
14339: =back
14340:
14341: Returns:
14342:
14343: An <img> tag which references graph.png and the appropriate identifying
14344: information for the plot.
1.136 matthew 14345:
14346: =cut
14347:
14348: ############################################################
14349: ############################################################
1.137 matthew 14350: sub DrawXYYGraph {
14351: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14352: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14353: #
14354: # Create the identifier for the graph
14355: my $identifier = &get_cgi_id();
14356: my $id = 'cgi.'.$identifier;
14357: #
14358: $Title = '' if (! defined($Title));
14359: $xlabel = '' if (! defined($xlabel));
14360: $ylabel = '' if (! defined($ylabel));
14361: my %ValuesHash =
14362: (
1.369 www 14363: $id.'.title' => &escape($Title),
14364: $id.'.xlabel' => &escape($xlabel),
14365: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14366: $id.'.labels' => join(',',@$Xlabels),
14367: $id.'.PlotType' => 'XY',
14368: $id.'.NumSets' => 2,
1.137 matthew 14369: $id.'.two_axes' => 1,
14370: $id.'.y1_max_value' => $Max1,
14371: $id.'.y1_min_value' => $Min1,
14372: $id.'.y2_max_value' => $Max2,
14373: $id.'.y2_min_value' => $Min2,
1.136 matthew 14374: );
14375: #
1.137 matthew 14376: if (defined($colors) && ref($colors) eq 'ARRAY') {
14377: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14378: }
14379: #
14380: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14381: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14382: return '';
14383: }
14384: my $NumSets=1;
1.137 matthew 14385: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14386: next if (! ref($array));
14387: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14388: }
14389: #
14390: # Deal with other parameters
14391: while (my ($key,$value) = each(%Values)) {
14392: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14393: }
14394: #
1.646 raeburn 14395: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14396: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14397: }
14398:
14399: ############################################################
14400: ############################################################
14401:
14402: =pod
14403:
1.157 matthew 14404: =back
14405:
1.139 matthew 14406: =head1 Statistics helper routines?
14407:
14408: Bad place for them but what the hell.
14409:
1.157 matthew 14410: =over 4
14411:
1.648 raeburn 14412: =item * &chartlink()
1.139 matthew 14413:
14414: Returns a link to the chart for a specific student.
14415:
14416: Inputs:
14417:
14418: =over 4
14419:
14420: =item $linktext: The text of the link
14421:
14422: =item $sname: The students username
14423:
14424: =item $sdomain: The students domain
14425:
14426: =back
14427:
1.157 matthew 14428: =back
14429:
1.139 matthew 14430: =cut
14431:
14432: ############################################################
14433: ############################################################
14434: sub chartlink {
14435: my ($linktext, $sname, $sdomain) = @_;
14436: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14437: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14438: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14439: '">'.$linktext.'</a>';
1.153 matthew 14440: }
14441:
14442: #######################################################
14443: #######################################################
14444:
14445: =pod
14446:
14447: =head1 Course Environment Routines
1.157 matthew 14448:
14449: =over 4
1.153 matthew 14450:
1.648 raeburn 14451: =item * &restore_course_settings()
1.153 matthew 14452:
1.648 raeburn 14453: =item * &store_course_settings()
1.153 matthew 14454:
14455: Restores/Store indicated form parameters from the course environment.
14456: Will not overwrite existing values of the form parameters.
14457:
14458: Inputs:
14459: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14460:
14461: a hash ref describing the data to be stored. For example:
14462:
14463: %Save_Parameters = ('Status' => 'scalar',
14464: 'chartoutputmode' => 'scalar',
14465: 'chartoutputdata' => 'scalar',
14466: 'Section' => 'array',
1.373 raeburn 14467: 'Group' => 'array',
1.153 matthew 14468: 'StudentData' => 'array',
14469: 'Maps' => 'array');
14470:
14471: Returns: both routines return nothing
14472:
1.631 raeburn 14473: =back
14474:
1.153 matthew 14475: =cut
14476:
14477: #######################################################
14478: #######################################################
14479: sub store_course_settings {
1.496 albertel 14480: return &store_settings($env{'request.course.id'},@_);
14481: }
14482:
14483: sub store_settings {
1.153 matthew 14484: # save to the environment
14485: # appenv the same items, just to be safe
1.300 albertel 14486: my $udom = $env{'user.domain'};
14487: my $uname = $env{'user.name'};
1.496 albertel 14488: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14489: my %SaveHash;
14490: my %AppHash;
14491: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14492: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14493: my $envname = 'environment.'.$basename;
1.258 albertel 14494: if (exists($env{'form.'.$setting})) {
1.153 matthew 14495: # Save this value away
14496: if ($type eq 'scalar' &&
1.258 albertel 14497: (! exists($env{$envname}) ||
14498: $env{$envname} ne $env{'form.'.$setting})) {
14499: $SaveHash{$basename} = $env{'form.'.$setting};
14500: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14501: } elsif ($type eq 'array') {
14502: my $stored_form;
1.258 albertel 14503: if (ref($env{'form.'.$setting})) {
1.153 matthew 14504: $stored_form = join(',',
14505: map {
1.369 www 14506: &escape($_);
1.258 albertel 14507: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14508: } else {
14509: $stored_form =
1.369 www 14510: &escape($env{'form.'.$setting});
1.153 matthew 14511: }
14512: # Determine if the array contents are the same.
1.258 albertel 14513: if ($stored_form ne $env{$envname}) {
1.153 matthew 14514: $SaveHash{$basename} = $stored_form;
14515: $AppHash{$envname} = $stored_form;
14516: }
14517: }
14518: }
14519: }
14520: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14521: $udom,$uname);
1.153 matthew 14522: if ($put_result !~ /^(ok|delayed)/) {
14523: &Apache::lonnet::logthis('unable to save form parameters, '.
14524: 'got error:'.$put_result);
14525: }
14526: # Make sure these settings stick around in this session, too
1.646 raeburn 14527: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14528: return;
14529: }
14530:
14531: sub restore_course_settings {
1.499 albertel 14532: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14533: }
14534:
14535: sub restore_settings {
14536: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14537: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14538: next if (exists($env{'form.'.$setting}));
1.496 albertel 14539: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14540: '.'.$setting;
1.258 albertel 14541: if (exists($env{$envname})) {
1.153 matthew 14542: if ($type eq 'scalar') {
1.258 albertel 14543: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14544: } elsif ($type eq 'array') {
1.258 albertel 14545: $env{'form.'.$setting} = [
1.153 matthew 14546: map {
1.369 www 14547: &unescape($_);
1.258 albertel 14548: } split(',',$env{$envname})
1.153 matthew 14549: ];
14550: }
14551: }
14552: }
1.127 matthew 14553: }
14554:
1.618 raeburn 14555: #######################################################
14556: #######################################################
14557:
14558: =pod
14559:
14560: =head1 Domain E-mail Routines
14561:
14562: =over 4
14563:
1.648 raeburn 14564: =item * &build_recipient_list()
1.618 raeburn 14565:
1.1144 raeburn 14566: Build recipient lists for following types of e-mail:
1.766 raeburn 14567: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14568: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14569: module change checking, student/employee ID conflict checks, as
14570: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14571: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14572:
14573: Inputs:
1.619 raeburn 14574: defmail (scalar - email address of default recipient),
1.1144 raeburn 14575: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14576: requestsmail, updatesmail, or idconflictsmail).
14577:
1.619 raeburn 14578: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14579:
1.619 raeburn 14580: origmail (scalar - email address of recipient from loncapa.conf,
14581: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14582:
1.655 raeburn 14583: Returns: comma separated list of addresses to which to send e-mail.
14584:
14585: =back
1.618 raeburn 14586:
14587: =cut
14588:
14589: ############################################################
14590: ############################################################
14591: sub build_recipient_list {
1.619 raeburn 14592: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 14593: my @recipients;
1.1270 raeburn 14594: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14595: my %domconfig =
1.1270 raeburn 14596: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14597: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14598: if (exists($domconfig{'contacts'}{$mailing})) {
14599: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14600: my @contacts = ('adminemail','supportemail');
14601: foreach my $item (@contacts) {
14602: if ($domconfig{'contacts'}{$mailing}{$item}) {
14603: my $addr = $domconfig{'contacts'}{$item};
14604: if (!grep(/^\Q$addr\E$/,@recipients)) {
14605: push(@recipients,$addr);
14606: }
1.619 raeburn 14607: }
1.1270 raeburn 14608: }
14609: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14610: if ($mailing eq 'helpdeskmail') {
14611: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14612: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14613: my @ok_bccs;
14614: foreach my $bcc (@bccs) {
14615: $bcc =~ s/^\s+//g;
14616: $bcc =~ s/\s+$//g;
14617: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14618: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14619: push(@ok_bccs,$bcc);
14620: }
14621: }
14622: }
14623: if (@ok_bccs > 0) {
14624: $allbcc = join(', ',@ok_bccs);
14625: }
14626: }
14627: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14628: }
14629: }
1.766 raeburn 14630: } elsif ($origmail ne '') {
1.1270 raeburn 14631: $lastresort = $origmail;
1.618 raeburn 14632: }
1.619 raeburn 14633: } elsif ($origmail ne '') {
1.1270 raeburn 14634: $lastresort = $origmail;
14635: }
14636:
14637: if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
14638: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
14639: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
14640: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
14641: my %what = (
14642: perlvar => 1,
14643: );
14644: my $primary = &Apache::lonnet::domain($defdom,'primary');
14645: if ($primary) {
14646: my $gotaddr;
14647: my ($result,$returnhash) =
14648: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
14649: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
14650: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
14651: $lastresort = $returnhash->{'lonSupportEMail'};
14652: $gotaddr = 1;
14653: }
14654: }
14655: unless ($gotaddr) {
14656: my $uintdom = &Apache::lonnet::internet_dom($primary);
14657: my $intdom = &Apache::lonnet::internet_dom($lonhost);
14658: unless ($uintdom eq $intdom) {
14659: my %domconfig =
14660: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
14661: if (ref($domconfig{'contacts'}) eq 'HASH') {
14662: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
14663: my @contacts = ('adminemail','supportemail');
14664: foreach my $item (@contacts) {
14665: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
14666: my $addr = $domconfig{'contacts'}{$item};
14667: if (!grep(/^\Q$addr\E$/,@recipients)) {
14668: push(@recipients,$addr);
14669: }
14670: }
14671: }
14672: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
14673: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
14674: }
14675: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
14676: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
14677: my @ok_bccs;
14678: foreach my $bcc (@bccs) {
14679: $bcc =~ s/^\s+//g;
14680: $bcc =~ s/\s+$//g;
14681: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14682: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14683: push(@ok_bccs,$bcc);
14684: }
14685: }
14686: }
14687: if (@ok_bccs > 0) {
14688: $allbcc = join(', ',@ok_bccs);
14689: }
14690: }
14691: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
14692: }
14693: }
14694: }
14695: }
14696: }
14697: }
1.618 raeburn 14698: }
1.688 raeburn 14699: if (defined($defmail)) {
14700: if ($defmail ne '') {
14701: push(@recipients,$defmail);
14702: }
1.618 raeburn 14703: }
14704: if ($otheremails) {
1.619 raeburn 14705: my @others;
14706: if ($otheremails =~ /,/) {
14707: @others = split(/,/,$otheremails);
1.618 raeburn 14708: } else {
1.619 raeburn 14709: push(@others,$otheremails);
14710: }
14711: foreach my $addr (@others) {
14712: if (!grep(/^\Q$addr\E$/,@recipients)) {
14713: push(@recipients,$addr);
14714: }
1.618 raeburn 14715: }
14716: }
1.1270 raeburn 14717: if ($mailing eq 'helpdesk') {
14718: if ((!@recipients) && ($lastresort ne '')) {
14719: push(@recipients,$lastresort);
14720: }
14721: } elsif ($lastresort ne '') {
14722: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
14723: push(@recipients,$lastresort);
14724: }
14725: }
1.1271 raeburn 14726: my $recipientlist = join(',',@recipients);
1.1270 raeburn 14727: if (wantarray) {
14728: return ($recipientlist,$allbcc,$addtext);
14729: } else {
14730: return $recipientlist;
14731: }
1.618 raeburn 14732: }
14733:
1.127 matthew 14734: ############################################################
14735: ############################################################
1.154 albertel 14736:
1.655 raeburn 14737: =pod
14738:
1.1224 musolffc 14739: =over 4
14740:
1.1223 musolffc 14741: =item * &mime_email()
14742:
14743: Sends an email with a possible attachment
14744:
14745: Inputs:
14746:
14747: =over 4
14748:
14749: from - Sender's email address
14750:
14751: to - Email address of recipient
14752:
14753: subject - Subject of email
14754:
14755: body - Body of email
14756:
14757: cc_string - Carbon copy email address
14758:
14759: bcc - Blind carbon copy email address
14760:
14761: type - File type of attachment
14762:
14763: attachment_path - Path of file to be attached
14764:
14765: file_name - Name of file to be attached
14766:
14767: attachment_text - The body of an attachment of type "TEXT"
14768:
14769: =back
14770:
14771: =back
14772:
14773: =cut
14774:
14775: ############################################################
14776: ############################################################
14777:
14778: sub mime_email {
14779: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14780: $file_name, $attachment_text) = @_;
14781: my $msg = MIME::Lite->new(
14782: From => $from,
14783: To => $to,
14784: Subject => $subject,
14785: Type =>'TEXT',
14786: Data => $body,
14787: );
14788: if ($cc_string ne '') {
14789: $msg->add("Cc" => $cc_string);
14790: }
14791: if ($bcc ne '') {
14792: $msg->add("Bcc" => $bcc);
14793: }
14794: $msg->attr("content-type" => "text/plain");
14795: $msg->attr("content-type.charset" => "UTF-8");
14796: # Attach file if given
14797: if ($attachment_path) {
14798: unless ($file_name) {
14799: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
14800: }
14801: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
14802: $msg->attach(Type => $type,
14803: Path => $attachment_path,
14804: Filename => $file_name
14805: );
14806: # Otherwise attach text if given
14807: } elsif ($attachment_text) {
14808: $msg->attach(Type => 'TEXT',
14809: Data => $attachment_text);
14810: }
14811: # Send it
14812: $msg->send('sendmail');
14813: }
14814:
14815: ############################################################
14816: ############################################################
14817:
14818: =pod
14819:
1.655 raeburn 14820: =head1 Course Catalog Routines
14821:
14822: =over 4
14823:
14824: =item * &gather_categories()
14825:
14826: Converts category definitions - keys of categories hash stored in
14827: coursecategories in configuration.db on the primary library server in a
14828: domain - to an array. Also generates javascript and idx hash used to
14829: generate Domain Coordinator interface for editing Course Categories.
14830:
14831: Inputs:
1.663 raeburn 14832:
1.655 raeburn 14833: categories (reference to hash of category definitions).
1.663 raeburn 14834:
1.655 raeburn 14835: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14836: categories and subcategories).
1.663 raeburn 14837:
1.655 raeburn 14838: idx (reference to hash of counters used in Domain Coordinator interface for
14839: editing Course Categories).
1.663 raeburn 14840:
1.655 raeburn 14841: jsarray (reference to array of categories used to create Javascript arrays for
14842: Domain Coordinator interface for editing Course Categories).
14843:
14844: Returns: nothing
14845:
14846: Side effects: populates cats, idx and jsarray.
14847:
14848: =cut
14849:
14850: sub gather_categories {
14851: my ($categories,$cats,$idx,$jsarray) = @_;
14852: my %counters;
14853: my $num = 0;
14854: foreach my $item (keys(%{$categories})) {
14855: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14856: if ($container eq '' && $depth == 0) {
14857: $cats->[$depth][$categories->{$item}] = $cat;
14858: } else {
14859: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14860: }
14861: my ($escitem,$tail) = split(/:/,$item,2);
14862: if ($counters{$tail} eq '') {
14863: $counters{$tail} = $num;
14864: $num ++;
14865: }
14866: if (ref($idx) eq 'HASH') {
14867: $idx->{$item} = $counters{$tail};
14868: }
14869: if (ref($jsarray) eq 'ARRAY') {
14870: push(@{$jsarray->[$counters{$tail}]},$item);
14871: }
14872: }
14873: return;
14874: }
14875:
14876: =pod
14877:
14878: =item * &extract_categories()
14879:
14880: Used to generate breadcrumb trails for course categories.
14881:
14882: Inputs:
1.663 raeburn 14883:
1.655 raeburn 14884: categories (reference to hash of category definitions).
1.663 raeburn 14885:
1.655 raeburn 14886: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14887: categories and subcategories).
1.663 raeburn 14888:
1.655 raeburn 14889: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14890:
1.655 raeburn 14891: allitems (reference to hash - key is category key
14892: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14893:
1.655 raeburn 14894: idx (reference to hash of counters used in Domain Coordinator interface for
14895: editing Course Categories).
1.663 raeburn 14896:
1.655 raeburn 14897: jsarray (reference to array of categories used to create Javascript arrays for
14898: Domain Coordinator interface for editing Course Categories).
14899:
1.665 raeburn 14900: subcats (reference to hash of arrays containing all subcategories within each
14901: category, -recursive)
14902:
1.655 raeburn 14903: Returns: nothing
14904:
14905: Side effects: populates trails and allitems hash references.
14906:
14907: =cut
14908:
14909: sub extract_categories {
1.665 raeburn 14910: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 14911: if (ref($categories) eq 'HASH') {
14912: &gather_categories($categories,$cats,$idx,$jsarray);
14913: if (ref($cats->[0]) eq 'ARRAY') {
14914: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14915: my $name = $cats->[0][$i];
14916: my $item = &escape($name).'::0';
14917: my $trailstr;
14918: if ($name eq 'instcode') {
14919: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14920: } elsif ($name eq 'communities') {
14921: $trailstr = &mt('Communities');
1.1239 raeburn 14922: } elsif ($name eq 'placement') {
14923: $trailstr = &mt('Placement Tests');
1.655 raeburn 14924: } else {
14925: $trailstr = $name;
14926: }
14927: if ($allitems->{$item} eq '') {
14928: push(@{$trails},$trailstr);
14929: $allitems->{$item} = scalar(@{$trails})-1;
14930: }
14931: my @parents = ($name);
14932: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14933: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14934: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14935: if (ref($subcats) eq 'HASH') {
14936: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14937: }
14938: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
14939: }
14940: } else {
14941: if (ref($subcats) eq 'HASH') {
14942: $subcats->{$item} = [];
1.655 raeburn 14943: }
14944: }
14945: }
14946: }
14947: }
14948: return;
14949: }
14950:
14951: =pod
14952:
1.1162 raeburn 14953: =item * &recurse_categories()
1.655 raeburn 14954:
14955: Recursively used to generate breadcrumb trails for course categories.
14956:
14957: Inputs:
1.663 raeburn 14958:
1.655 raeburn 14959: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14960: categories and subcategories).
1.663 raeburn 14961:
1.655 raeburn 14962: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14963:
14964: category (current course category, for which breadcrumb trail is being generated).
14965:
14966: trails (reference to array of breadcrumb trails for each category).
14967:
1.655 raeburn 14968: allitems (reference to hash - key is category key
14969: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14970:
1.655 raeburn 14971: parents (array containing containers directories for current category,
14972: back to top level).
14973:
14974: Returns: nothing
14975:
14976: Side effects: populates trails and allitems hash references
14977:
14978: =cut
14979:
14980: sub recurse_categories {
1.665 raeburn 14981: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14982: my $shallower = $depth - 1;
14983: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14984: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14985: my $name = $cats->[$depth]{$category}[$k];
14986: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14987: my $trailstr = join(' -> ',(@{$parents},$category));
14988: if ($allitems->{$item} eq '') {
14989: push(@{$trails},$trailstr);
14990: $allitems->{$item} = scalar(@{$trails})-1;
14991: }
14992: my $deeper = $depth+1;
14993: push(@{$parents},$category);
1.665 raeburn 14994: if (ref($subcats) eq 'HASH') {
14995: my $subcat = &escape($name).':'.$category.':'.$depth;
14996: for (my $j=@{$parents}; $j>=0; $j--) {
14997: my $higher;
14998: if ($j > 0) {
14999: $higher = &escape($parents->[$j]).':'.
15000: &escape($parents->[$j-1]).':'.$j;
15001: } else {
15002: $higher = &escape($parents->[$j]).'::'.$j;
15003: }
15004: push(@{$subcats->{$higher}},$subcat);
15005: }
15006: }
15007: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
15008: $subcats);
1.655 raeburn 15009: pop(@{$parents});
15010: }
15011: } else {
15012: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
15013: my $trailstr = join(' -> ',(@{$parents},$category));
15014: if ($allitems->{$item} eq '') {
15015: push(@{$trails},$trailstr);
15016: $allitems->{$item} = scalar(@{$trails})-1;
15017: }
15018: }
15019: return;
15020: }
15021:
1.663 raeburn 15022: =pod
15023:
1.1162 raeburn 15024: =item * &assign_categories_table()
1.663 raeburn 15025:
15026: Create a datatable for display of hierarchical categories in a domain,
15027: with checkboxes to allow a course to be categorized.
15028:
15029: Inputs:
15030:
15031: cathash - reference to hash of categories defined for the domain (from
15032: configuration.db)
15033:
15034: currcat - scalar with an & separated list of categories assigned to a course.
15035:
1.919 raeburn 15036: type - scalar contains course type (Course or Community).
15037:
1.1260 raeburn 15038: disabled - scalar (optional) contains disabled="disabled" if input elements are
15039: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15040:
1.663 raeburn 15041: Returns: $output (markup to be displayed)
15042:
15043: =cut
15044:
15045: sub assign_categories_table {
1.1259 raeburn 15046: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15047: my $output;
15048: if (ref($cathash) eq 'HASH') {
15049: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
15050: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
15051: $maxdepth = scalar(@cats);
15052: if (@cats > 0) {
15053: my $itemcount = 0;
15054: if (ref($cats[0]) eq 'ARRAY') {
15055: my @currcategories;
15056: if ($currcat ne '') {
15057: @currcategories = split('&',$currcat);
15058: }
1.919 raeburn 15059: my $table;
1.663 raeburn 15060: for (my $i=0; $i<@{$cats[0]}; $i++) {
15061: my $parent = $cats[0][$i];
1.919 raeburn 15062: next if ($parent eq 'instcode');
15063: if ($type eq 'Community') {
15064: next unless ($parent eq 'communities');
1.1239 raeburn 15065: } elsif ($type eq 'Placement') {
15066: next unless ($parent eq 'placement');
1.919 raeburn 15067: } else {
1.1239 raeburn 15068: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 15069: }
1.663 raeburn 15070: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15071: my $item = &escape($parent).'::0';
15072: my $checked = '';
15073: if (@currcategories > 0) {
15074: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15075: $checked = ' checked="checked"';
1.663 raeburn 15076: }
15077: }
1.919 raeburn 15078: my $parent_title = $parent;
15079: if ($parent eq 'communities') {
15080: $parent_title = &mt('Communities');
1.1239 raeburn 15081: } elsif ($parent eq 'placement') {
15082: $parent_title = &mt('Placement Tests');
1.919 raeburn 15083: }
15084: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15085: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15086: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15087: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15088: my $depth = 1;
15089: push(@path,$parent);
1.1259 raeburn 15090: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15091: pop(@path);
1.919 raeburn 15092: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15093: $itemcount ++;
15094: }
1.919 raeburn 15095: if ($itemcount) {
15096: $output = &Apache::loncommon::start_data_table().
15097: $table.
15098: &Apache::loncommon::end_data_table();
15099: }
1.663 raeburn 15100: }
15101: }
15102: }
15103: return $output;
15104: }
15105:
15106: =pod
15107:
1.1162 raeburn 15108: =item * &assign_category_rows()
1.663 raeburn 15109:
15110: Create a datatable row for display of nested categories in a domain,
15111: with checkboxes to allow a course to be categorized,called recursively.
15112:
15113: Inputs:
15114:
15115: itemcount - track row number for alternating colors
15116:
15117: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15118: categories and subcategories.
15119:
15120: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15121:
15122: parent - parent of current category item
15123:
15124: path - Array containing all categories back up through the hierarchy from the
15125: current category to the top level.
15126:
15127: currcategories - reference to array of current categories assigned to the course
15128:
1.1260 raeburn 15129: disabled - scalar (optional) contains disabled="disabled" if input elements are
15130: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15131:
1.663 raeburn 15132: Returns: $output (markup to be displayed).
15133:
15134: =cut
15135:
15136: sub assign_category_rows {
1.1259 raeburn 15137: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15138: my ($text,$name,$item,$chgstr);
15139: if (ref($cats) eq 'ARRAY') {
15140: my $maxdepth = scalar(@{$cats});
15141: if (ref($cats->[$depth]) eq 'HASH') {
15142: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15143: my $numchildren = @{$cats->[$depth]{$parent}};
15144: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 15145: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15146: for (my $j=0; $j<$numchildren; $j++) {
15147: $name = $cats->[$depth]{$parent}[$j];
15148: $item = &escape($name).':'.&escape($parent).':'.$depth;
15149: my $deeper = $depth+1;
15150: my $checked = '';
15151: if (ref($currcategories) eq 'ARRAY') {
15152: if (@{$currcategories} > 0) {
15153: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15154: $checked = ' checked="checked"';
1.663 raeburn 15155: }
15156: }
15157: }
1.664 raeburn 15158: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15159: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15160: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15161: '<input type="hidden" name="catname" value="'.$name.'" />'.
15162: '</td><td>';
1.663 raeburn 15163: if (ref($path) eq 'ARRAY') {
15164: push(@{$path},$name);
1.1259 raeburn 15165: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15166: pop(@{$path});
15167: }
15168: $text .= '</td></tr>';
15169: }
15170: $text .= '</table></td>';
15171: }
15172: }
15173: }
15174: return $text;
15175: }
15176:
1.1181 raeburn 15177: =pod
15178:
15179: =back
15180:
15181: =cut
15182:
1.655 raeburn 15183: ############################################################
15184: ############################################################
15185:
15186:
1.443 albertel 15187: sub commit_customrole {
1.664 raeburn 15188: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15189: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15190: ($start?', '.&mt('starting').' '.localtime($start):'').
15191: ($end?', ending '.localtime($end):'').': <b>'.
15192: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15193: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15194: '</b><br />';
15195: return $output;
15196: }
15197:
15198: sub commit_standardrole {
1.1116 raeburn 15199: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15200: my ($output,$logmsg,$linefeed);
15201: if ($context eq 'auto') {
15202: $linefeed = "\n";
15203: } else {
15204: $linefeed = "<br />\n";
15205: }
1.443 albertel 15206: if ($three eq 'st') {
1.541 raeburn 15207: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 15208: $one,$two,$sec,$context,$credits);
1.541 raeburn 15209: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15210: ($result eq 'unknown_course') || ($result eq 'refused')) {
15211: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15212: } else {
1.541 raeburn 15213: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15214: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15215: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15216: if ($context eq 'auto') {
15217: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15218: } else {
15219: $output .= '<b>'.$result.'</b>'.$linefeed.
15220: &mt('Add to classlist').': <b>ok</b>';
15221: }
15222: $output .= $linefeed;
1.443 albertel 15223: }
15224: } else {
15225: $output = &mt('Assigning').' '.$three.' in '.$url.
15226: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15227: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15228: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15229: if ($context eq 'auto') {
15230: $output .= $result.$linefeed;
15231: } else {
15232: $output .= '<b>'.$result.'</b>'.$linefeed;
15233: }
1.443 albertel 15234: }
15235: return $output;
15236: }
15237:
15238: sub commit_studentrole {
1.1116 raeburn 15239: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15240: $credits) = @_;
1.626 raeburn 15241: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15242: if ($context eq 'auto') {
15243: $linefeed = "\n";
15244: } else {
15245: $linefeed = '<br />'."\n";
15246: }
1.443 albertel 15247: if (defined($one) && defined($two)) {
15248: my $cid=$one.'_'.$two;
15249: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15250: my $secchange = 0;
15251: my $expire_role_result;
15252: my $modify_section_result;
1.628 raeburn 15253: if ($oldsec ne '-1') {
15254: if ($oldsec ne $sec) {
1.443 albertel 15255: $secchange = 1;
1.628 raeburn 15256: my $now = time;
1.443 albertel 15257: my $uurl='/'.$cid;
15258: $uurl=~s/\_/\//g;
15259: if ($oldsec) {
15260: $uurl.='/'.$oldsec;
15261: }
1.626 raeburn 15262: $oldsecurl = $uurl;
1.628 raeburn 15263: $expire_role_result =
1.652 raeburn 15264: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15265: if ($env{'request.course.sec'} ne '') {
15266: if ($expire_role_result eq 'refused') {
15267: my @roles = ('st');
15268: my @statuses = ('previous');
15269: my @roledoms = ($one);
15270: my $withsec = 1;
15271: my %roleshash =
15272: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15273: \@statuses,\@roles,\@roledoms,$withsec);
15274: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15275: my ($oldstart,$oldend) =
15276: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15277: if ($oldend > 0 && $oldend <= $now) {
15278: $expire_role_result = 'ok';
15279: }
15280: }
15281: }
15282: }
1.443 albertel 15283: $result = $expire_role_result;
15284: }
15285: }
15286: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15287: $modify_section_result =
15288: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15289: undef,undef,undef,$sec,
15290: $end,$start,'','',$cid,
15291: '',$context,$credits);
1.443 albertel 15292: if ($modify_section_result =~ /^ok/) {
15293: if ($secchange == 1) {
1.628 raeburn 15294: if ($sec eq '') {
15295: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15296: } else {
15297: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15298: }
1.443 albertel 15299: } elsif ($oldsec eq '-1') {
1.628 raeburn 15300: if ($sec eq '') {
15301: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15302: } else {
15303: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15304: }
1.443 albertel 15305: } else {
1.628 raeburn 15306: if ($sec eq '') {
15307: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15308: } else {
15309: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15310: }
1.443 albertel 15311: }
15312: } else {
1.1115 raeburn 15313: if ($secchange) {
1.628 raeburn 15314: $$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;
15315: } else {
15316: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15317: }
1.443 albertel 15318: }
15319: $result = $modify_section_result;
15320: } elsif ($secchange == 1) {
1.628 raeburn 15321: if ($oldsec eq '') {
1.1103 raeburn 15322: $$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 15323: } else {
15324: $$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;
15325: }
1.626 raeburn 15326: if ($expire_role_result eq 'refused') {
15327: my $newsecurl = '/'.$cid;
15328: $newsecurl =~ s/\_/\//g;
15329: if ($sec ne '') {
15330: $newsecurl.='/'.$sec;
15331: }
15332: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15333: if ($sec eq '') {
15334: $$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;
15335: } else {
15336: $$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;
15337: }
15338: }
15339: }
1.443 albertel 15340: }
15341: } else {
1.626 raeburn 15342: $$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 15343: $result = "error: incomplete course id\n";
15344: }
15345: return $result;
15346: }
15347:
1.1108 raeburn 15348: sub show_role_extent {
15349: my ($scope,$context,$role) = @_;
15350: $scope =~ s{^/}{};
15351: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15352: push(@courseroles,'co');
15353: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15354: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15355: $scope =~ s{/}{_};
15356: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15357: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15358: my ($audom,$auname) = split(/\//,$scope);
15359: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15360: &Apache::loncommon::plainname($auname,$audom).'</span>');
15361: } else {
15362: $scope =~ s{/$}{};
15363: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15364: &Apache::lonnet::domain($scope,'description').'</span>');
15365: }
15366: }
15367:
1.443 albertel 15368: ############################################################
15369: ############################################################
15370:
1.566 albertel 15371: sub check_clone {
1.578 raeburn 15372: my ($args,$linefeed) = @_;
1.566 albertel 15373: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15374: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15375: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15376: my $clonemsg;
15377: my $can_clone = 0;
1.944 raeburn 15378: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15379: if ($lctype ne 'community') {
15380: $lctype = 'course';
15381: }
1.566 albertel 15382: if ($clonehome eq 'no_host') {
1.944 raeburn 15383: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15384: $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'});
15385: } else {
15386: $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'});
15387: }
1.566 albertel 15388: } else {
15389: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15390: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15391: if ($clonedesc{'type'} ne 'Community') {
1.1262 raeburn 15392: $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'});
1.908 raeburn 15393: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15394: }
15395: }
1.1262 raeburn 15396: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15397: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15398: $can_clone = 1;
15399: } else {
1.1221 raeburn 15400: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15401: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15402: if ($clonehash{'cloners'} eq '') {
15403: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15404: if ($domdefs{'canclone'}) {
15405: unless ($domdefs{'canclone'} eq 'none') {
15406: if ($domdefs{'canclone'} eq 'domain') {
15407: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15408: $can_clone = 1;
15409: }
15410: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15411: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15412: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15413: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15414: $can_clone = 1;
15415: }
15416: }
15417: }
15418: }
1.578 raeburn 15419: } else {
1.1221 raeburn 15420: my @cloners = split(/,/,$clonehash{'cloners'});
15421: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15422: $can_clone = 1;
1.1221 raeburn 15423: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15424: $can_clone = 1;
1.1225 raeburn 15425: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15426: $can_clone = 1;
1.1221 raeburn 15427: }
15428: unless ($can_clone) {
1.1225 raeburn 15429: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15430: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15431: my (%gotdomdefaults,%gotcodedefaults);
15432: foreach my $cloner (@cloners) {
15433: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15434: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15435: my (%codedefaults,@code_order);
15436: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15437: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15438: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15439: }
15440: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15441: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15442: }
15443: } else {
15444: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15445: \%codedefaults,
15446: \@code_order);
15447: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15448: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15449: }
15450: if (@code_order > 0) {
15451: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15452: $cloner,$clonehash{'internal.coursecode'},
15453: $args->{'crscode'})) {
15454: $can_clone = 1;
15455: last;
15456: }
15457: }
15458: }
15459: }
15460: }
1.1225 raeburn 15461: }
15462: }
15463: unless ($can_clone) {
15464: my $ccrole = 'cc';
15465: if ($args->{'crstype'} eq 'Community') {
15466: $ccrole = 'co';
15467: }
15468: my %roleshash =
15469: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15470: $args->{'ccdomain'},
15471: 'userroles',['active'],[$ccrole],
15472: [$args->{'clonedomain'}]);
15473: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15474: $can_clone = 1;
15475: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15476: $args->{'ccuname'},$args->{'ccdomain'})) {
15477: $can_clone = 1;
1.1221 raeburn 15478: }
15479: }
15480: unless ($can_clone) {
15481: if ($args->{'crstype'} eq 'Community') {
15482: $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'});
1.942 raeburn 15483: } else {
1.1221 raeburn 15484: $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'});
15485: }
1.566 albertel 15486: }
1.578 raeburn 15487: }
1.566 albertel 15488: }
15489: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15490: }
15491:
1.444 albertel 15492: sub construct_course {
1.1262 raeburn 15493: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
15494: $cnum,$category,$coderef) = @_;
1.444 albertel 15495: my $outcome;
1.541 raeburn 15496: my $linefeed = '<br />'."\n";
15497: if ($context eq 'auto') {
15498: $linefeed = "\n";
15499: }
1.566 albertel 15500:
15501: #
15502: # Are we cloning?
15503: #
15504: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15505: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15506: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15507: if ($context ne 'auto') {
1.578 raeburn 15508: if ($clonemsg ne '') {
15509: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15510: }
1.566 albertel 15511: }
15512: $outcome .= $clonemsg.$linefeed;
15513:
15514: if (!$can_clone) {
15515: return (0,$outcome);
15516: }
15517: }
15518:
1.444 albertel 15519: #
15520: # Open course
15521: #
1.1239 raeburn 15522: my $showncrstype;
15523: if ($args->{'crstype'} eq 'Placement') {
15524: $showncrstype = 'placement test';
15525: } else {
15526: $showncrstype = lc($args->{'crstype'});
15527: }
1.444 albertel 15528: my %cenv=();
15529: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15530: $args->{'cdescr'},
15531: $args->{'curl'},
15532: $args->{'course_home'},
15533: $args->{'nonstandard'},
15534: $args->{'crscode'},
15535: $args->{'ccuname'}.':'.
15536: $args->{'ccdomain'},
1.882 raeburn 15537: $args->{'crstype'},
1.885 raeburn 15538: $cnum,$context,$category);
1.444 albertel 15539:
15540: # Note: The testing routines depend on this being output; see
15541: # Utils::Course. This needs to at least be output as a comment
15542: # if anyone ever decides to not show this, and Utils::Course::new
15543: # will need to be suitably modified.
1.1239 raeburn 15544: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 15545: if ($$courseid =~ /^error:/) {
15546: return (0,$outcome);
15547: }
15548:
1.444 albertel 15549: #
15550: # Check if created correctly
15551: #
1.479 albertel 15552: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15553: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15554: if ($crsuhome eq 'no_host') {
15555: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15556: return (0,$outcome);
15557: }
1.541 raeburn 15558: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15559:
1.444 albertel 15560: #
1.566 albertel 15561: # Do the cloning
15562: #
15563: if ($can_clone && $cloneid) {
1.1239 raeburn 15564: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 15565: if ($context ne 'auto') {
15566: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15567: }
15568: $outcome .= $clonemsg.$linefeed;
15569: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15570: # Copy all files
1.637 www 15571: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15572: # Restore URL
1.566 albertel 15573: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15574: # Restore title
1.566 albertel 15575: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15576: # Restore creation date, creator and creation context.
15577: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15578: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15579: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15580: # Mark as cloned
1.566 albertel 15581: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15582: # Need to clone grading mode
15583: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15584: $cenv{'grading'}=$newenv{'grading'};
15585: # Do not clone these environment entries
15586: &Apache::lonnet::del('environment',
15587: ['default_enrollment_start_date',
15588: 'default_enrollment_end_date',
15589: 'question.email',
15590: 'policy.email',
15591: 'comment.email',
15592: 'pch.users.denied',
1.725 raeburn 15593: 'plc.users.denied',
15594: 'hidefromcat',
1.1121 raeburn 15595: 'checkforpriv',
1.1166 raeburn 15596: 'categories',
15597: 'internal.uniquecode'],
1.638 www 15598: $$crsudom,$$crsunum);
1.1170 raeburn 15599: if ($args->{'textbook'}) {
15600: $cenv{'internal.textbook'} = $args->{'textbook'};
15601: }
1.444 albertel 15602: }
1.566 albertel 15603:
1.444 albertel 15604: #
15605: # Set environment (will override cloned, if existing)
15606: #
15607: my @sections = ();
15608: my @xlists = ();
15609: if ($args->{'crstype'}) {
15610: $cenv{'type'}=$args->{'crstype'};
15611: }
15612: if ($args->{'crsid'}) {
15613: $cenv{'courseid'}=$args->{'crsid'};
15614: }
15615: if ($args->{'crscode'}) {
15616: $cenv{'internal.coursecode'}=$args->{'crscode'};
15617: }
15618: if ($args->{'crsquota'} ne '') {
15619: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15620: } else {
15621: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15622: }
15623: if ($args->{'ccuname'}) {
15624: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15625: ':'.$args->{'ccdomain'};
15626: } else {
15627: $cenv{'internal.courseowner'} = $args->{'curruser'};
15628: }
1.1116 raeburn 15629: if ($args->{'defaultcredits'}) {
15630: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15631: }
1.444 albertel 15632: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15633: if ($args->{'crssections'}) {
15634: $cenv{'internal.sectionnums'} = '';
15635: if ($args->{'crssections'} =~ m/,/) {
15636: @sections = split/,/,$args->{'crssections'};
15637: } else {
15638: $sections[0] = $args->{'crssections'};
15639: }
15640: if (@sections > 0) {
15641: foreach my $item (@sections) {
15642: my ($sec,$gp) = split/:/,$item;
15643: my $class = $args->{'crscode'}.$sec;
15644: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15645: $cenv{'internal.sectionnums'} .= $item.',';
15646: unless ($addcheck eq 'ok') {
1.1263 raeburn 15647: push(@badclasses,$class);
1.444 albertel 15648: }
15649: }
15650: $cenv{'internal.sectionnums'} =~ s/,$//;
15651: }
15652: }
15653: # do not hide course coordinator from staff listing,
15654: # even if privileged
15655: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15656: # add course coordinator's domain to domains to check for privileged users
15657: # if different to course domain
15658: if ($$crsudom ne $args->{'ccdomain'}) {
15659: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15660: }
1.444 albertel 15661: # add crosslistings
15662: if ($args->{'crsxlist'}) {
15663: $cenv{'internal.crosslistings'}='';
15664: if ($args->{'crsxlist'} =~ m/,/) {
15665: @xlists = split/,/,$args->{'crsxlist'};
15666: } else {
15667: $xlists[0] = $args->{'crsxlist'};
15668: }
15669: if (@xlists > 0) {
15670: foreach my $item (@xlists) {
15671: my ($xl,$gp) = split/:/,$item;
15672: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15673: $cenv{'internal.crosslistings'} .= $item.',';
15674: unless ($addcheck eq 'ok') {
1.1263 raeburn 15675: push(@badclasses,$xl);
1.444 albertel 15676: }
15677: }
15678: $cenv{'internal.crosslistings'} =~ s/,$//;
15679: }
15680: }
15681: if ($args->{'autoadds'}) {
15682: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15683: }
15684: if ($args->{'autodrops'}) {
15685: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15686: }
15687: # check for notification of enrollment changes
15688: my @notified = ();
15689: if ($args->{'notify_owner'}) {
15690: if ($args->{'ccuname'} ne '') {
15691: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15692: }
15693: }
15694: if ($args->{'notify_dc'}) {
15695: if ($uname ne '') {
1.630 raeburn 15696: push(@notified,$uname.':'.$udom);
1.444 albertel 15697: }
15698: }
15699: if (@notified > 0) {
15700: my $notifylist;
15701: if (@notified > 1) {
15702: $notifylist = join(',',@notified);
15703: } else {
15704: $notifylist = $notified[0];
15705: }
15706: $cenv{'internal.notifylist'} = $notifylist;
15707: }
15708: if (@badclasses > 0) {
15709: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 15710: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
15711: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
15712: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 15713: );
1.1264 raeburn 15714: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
15715: &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
1.541 raeburn 15716: if ($context eq 'auto') {
15717: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 15718: } else {
1.566 albertel 15719: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 15720: }
15721: foreach my $item (@badclasses) {
1.541 raeburn 15722: if ($context eq 'auto') {
1.1261 raeburn 15723: $outcome .= " - $item\n";
1.541 raeburn 15724: } else {
1.1261 raeburn 15725: $outcome .= "<li>$item</li>\n";
1.541 raeburn 15726: }
1.1261 raeburn 15727: }
15728: if ($context eq 'auto') {
15729: $outcome .= $linefeed;
15730: } else {
15731: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15732: }
1.444 albertel 15733: }
15734: if ($args->{'no_end_date'}) {
15735: $args->{'endaccess'} = 0;
15736: }
15737: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15738: $cenv{'internal.autoend'}=$args->{'enrollend'};
15739: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15740: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15741: if ($args->{'showphotos'}) {
15742: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15743: }
15744: $cenv{'internal.authtype'} = $args->{'authtype'};
15745: $cenv{'internal.autharg'} = $args->{'autharg'};
15746: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15747: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15748: 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');
15749: if ($context eq 'auto') {
15750: $outcome .= $krb_msg;
15751: } else {
1.566 albertel 15752: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15753: }
15754: $outcome .= $linefeed;
1.444 albertel 15755: }
15756: }
15757: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15758: if ($args->{'setpolicy'}) {
15759: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15760: }
15761: if ($args->{'setcontent'}) {
15762: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15763: }
1.1251 raeburn 15764: if ($args->{'setcomment'}) {
15765: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15766: }
1.444 albertel 15767: }
15768: if ($args->{'reshome'}) {
15769: $cenv{'reshome'}=$args->{'reshome'}.'/';
15770: $cenv{'reshome'}=~s/\/+$/\//;
15771: }
15772: #
15773: # course has keyed access
15774: #
15775: if ($args->{'setkeys'}) {
15776: $cenv{'keyaccess'}='yes';
15777: }
15778: # if specified, key authority is not course, but user
15779: # only active if keyaccess is yes
15780: if ($args->{'keyauth'}) {
1.487 albertel 15781: my ($user,$domain) = split(':',$args->{'keyauth'});
15782: $user = &LONCAPA::clean_username($user);
15783: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15784: if ($user ne '' && $domain ne '') {
1.487 albertel 15785: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15786: }
15787: }
15788:
1.1166 raeburn 15789: #
1.1167 raeburn 15790: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 15791: #
15792: if ($args->{'uniquecode'}) {
15793: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15794: if ($code) {
15795: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 15796: my %crsinfo =
15797: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15798: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15799: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15800: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15801: }
1.1166 raeburn 15802: if (ref($coderef)) {
15803: $$coderef = $code;
15804: }
15805: }
15806: }
15807:
1.444 albertel 15808: if ($args->{'disresdis'}) {
15809: $cenv{'pch.roles.denied'}='st';
15810: }
15811: if ($args->{'disablechat'}) {
15812: $cenv{'plc.roles.denied'}='st';
15813: }
15814:
15815: # Record we've not yet viewed the Course Initialization Helper for this
15816: # course
15817: $cenv{'course.helper.not.run'} = 1;
15818: #
15819: # Use new Randomseed
15820: #
15821: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15822: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15823: #
15824: # The encryption code and receipt prefix for this course
15825: #
15826: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15827: $cenv{'internal.encpref'}=100+int(9*rand(99));
15828: #
15829: # By default, use standard grading
15830: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15831:
1.541 raeburn 15832: $outcome .= $linefeed.&mt('Setting environment').': '.
15833: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15834: #
15835: # Open all assignments
15836: #
15837: if ($args->{'openall'}) {
15838: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15839: my %storecontent = ($storeunder => time,
15840: $storeunder.'.type' => 'date_start');
15841:
15842: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15843: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15844: }
15845: #
15846: # Set first page
15847: #
15848: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15849: || ($cloneid)) {
1.445 albertel 15850: use LONCAPA::map;
1.444 albertel 15851: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15852:
15853: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15854: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15855:
1.444 albertel 15856: $outcome .= ($fatal?$errtext:'read ok').' - ';
15857: my $title; my $url;
15858: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15859: $title=&mt('Syllabus');
1.444 albertel 15860: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15861: } else {
1.963 raeburn 15862: $title=&mt('Table of Contents');
1.444 albertel 15863: $url='/adm/navmaps';
15864: }
1.445 albertel 15865:
15866: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15867: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15868:
15869: if ($errtext) { $fatal=2; }
1.541 raeburn 15870: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15871: }
1.566 albertel 15872:
1.1237 raeburn 15873: #
15874: # Set params for Placement Tests
15875: #
1.1239 raeburn 15876: if ($args->{'crstype'} eq 'Placement') {
15877: my %storecontent;
15878: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
15879: my %defaults = (
15880: buttonshide => { value => 'yes',
15881: type => 'string_yesno',},
15882: type => { value => 'randomizetry',
15883: type => 'string_questiontype',},
15884: maxtries => { value => 1,
15885: type => 'int_pos',},
15886: problemstatus => { value => 'no',
15887: type => 'string_problemstatus',},
15888: );
15889: foreach my $key (keys(%defaults)) {
15890: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
15891: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
15892: }
1.1237 raeburn 15893: &Apache::lonnet::cput
15894: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
15895: }
15896:
1.566 albertel 15897: return (1,$outcome);
1.444 albertel 15898: }
15899:
1.1166 raeburn 15900: sub make_unique_code {
15901: my ($cdom,$cnum) = @_;
15902: # get lock on uniquecodes db
15903: my $lockhash = {
15904: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15905: ':'.$env{'user.domain'},
15906: };
15907: my $tries = 0;
15908: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15909: my ($code,$error);
15910:
15911: while (($gotlock ne 'ok') && ($tries<3)) {
15912: $tries ++;
15913: sleep 1;
15914: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15915: }
15916: if ($gotlock eq 'ok') {
15917: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15918: my $gotcode;
15919: my $attempts = 0;
15920: while ((!$gotcode) && ($attempts < 100)) {
15921: $code = &generate_code();
15922: if (!exists($currcodes{$code})) {
15923: $gotcode = 1;
15924: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15925: $error = 'nostore';
15926: }
15927: }
15928: $attempts ++;
15929: }
15930: my @del_lock = ($cnum."\0".'uniquecodes');
15931: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15932: } else {
15933: $error = 'nolock';
15934: }
15935: return ($code,$error);
15936: }
15937:
15938: sub generate_code {
15939: my $code;
15940: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15941: for (my $i=0; $i<6; $i++) {
15942: my $lettnum = int (rand 2);
15943: my $item = '';
15944: if ($lettnum) {
15945: $item = $letts[int( rand(18) )];
15946: } else {
15947: $item = 1+int( rand(8) );
15948: }
15949: $code .= $item;
15950: }
15951: return $code;
15952: }
15953:
1.444 albertel 15954: ############################################################
15955: ############################################################
15956:
1.1237 raeburn 15957: # Community, Course and Placement Test
1.378 raeburn 15958: sub course_type {
15959: my ($cid) = @_;
15960: if (!defined($cid)) {
15961: $cid = $env{'request.course.id'};
15962: }
1.404 albertel 15963: if (defined($env{'course.'.$cid.'.type'})) {
15964: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15965: } else {
15966: return 'Course';
1.377 raeburn 15967: }
15968: }
1.156 albertel 15969:
1.406 raeburn 15970: sub group_term {
15971: my $crstype = &course_type();
15972: my %names = (
15973: 'Course' => 'group',
1.865 raeburn 15974: 'Community' => 'group',
1.1237 raeburn 15975: 'Placement' => 'group',
1.406 raeburn 15976: );
15977: return $names{$crstype};
15978: }
15979:
1.902 raeburn 15980: sub course_types {
1.1237 raeburn 15981: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 15982: my %typename = (
15983: official => 'Official course',
15984: unofficial => 'Unofficial course',
15985: community => 'Community',
1.1165 raeburn 15986: textbook => 'Textbook course',
1.1237 raeburn 15987: placement => 'Placement test',
1.902 raeburn 15988: );
15989: return (\@types,\%typename);
15990: }
15991:
1.156 albertel 15992: sub icon {
15993: my ($file)=@_;
1.505 albertel 15994: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15995: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15996: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15997: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15998: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15999: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16000: $curfext.".gif") {
16001: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16002: $curfext.".gif";
16003: }
16004: }
1.249 albertel 16005: return &lonhttpdurl($iconname);
1.154 albertel 16006: }
1.84 albertel 16007:
1.575 albertel 16008: sub lonhttpdurl {
1.692 www 16009: #
16010: # Had been used for "small fry" static images on separate port 8080.
16011: # Modify here if lightweight http functionality desired again.
16012: # Currently eliminated due to increasing firewall issues.
16013: #
1.575 albertel 16014: my ($url)=@_;
1.692 www 16015: return $url;
1.215 albertel 16016: }
16017:
1.213 albertel 16018: sub connection_aborted {
16019: my ($r)=@_;
16020: $r->print(" ");$r->rflush();
16021: my $c = $r->connection;
16022: return $c->aborted();
16023: }
16024:
1.221 foxr 16025: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16026: # strings as 'strings'.
16027: sub escape_single {
1.221 foxr 16028: my ($input) = @_;
1.223 albertel 16029: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16030: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16031: return $input;
16032: }
1.223 albertel 16033:
1.222 foxr 16034: # Same as escape_single, but escape's "'s This
16035: # can be used for "strings"
16036: sub escape_double {
16037: my ($input) = @_;
16038: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16039: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16040: return $input;
16041: }
1.223 albertel 16042:
1.222 foxr 16043: # Escapes the last element of a full URL.
16044: sub escape_url {
16045: my ($url) = @_;
1.238 raeburn 16046: my @urlslices = split(/\//, $url,-1);
1.369 www 16047: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 16048: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16049: }
1.462 albertel 16050:
1.820 raeburn 16051: sub compare_arrays {
16052: my ($arrayref1,$arrayref2) = @_;
16053: my (@difference,%count);
16054: @difference = ();
16055: %count = ();
16056: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16057: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16058: foreach my $element (keys(%count)) {
16059: if ($count{$element} == 1) {
16060: push(@difference,$element);
16061: }
16062: }
16063: }
16064: return @difference;
16065: }
16066:
1.817 bisitz 16067: # -------------------------------------------------------- Initialize user login
1.462 albertel 16068: sub init_user_environment {
1.463 albertel 16069: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16070: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16071:
16072: my $public=($username eq 'public' && $domain eq 'public');
16073:
1.1062 raeburn 16074: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16075: my $now=time;
16076:
16077: if ($public) {
16078: my $max_public=100;
16079: my $oldest;
16080: my $oldest_time=0;
16081: for(my $next=1;$next<=$max_public;$next++) {
16082: if (-e $lonids."/publicuser_$next.id") {
16083: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16084: if ($mtime<$oldest_time || !$oldest_time) {
16085: $oldest_time=$mtime;
16086: $oldest=$next;
16087: }
16088: } else {
16089: $cookie="publicuser_$next";
16090: last;
16091: }
16092: }
16093: if (!$cookie) { $cookie="publicuser_$oldest"; }
16094: } else {
1.1275 raeburn 16095: # See if old ID present, if so, remove if this isn't a robot,
16096: # killing any existing non-robot sessions
1.463 albertel 16097: if (!$args->{'robot'}) {
16098: opendir(DIR,$lonids);
16099: while ($filename=readdir(DIR)) {
16100: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
16101: unlink($lonids.'/'.$filename);
16102: }
1.462 albertel 16103: }
1.463 albertel 16104: closedir(DIR);
1.1204 raeburn 16105: # If there is a undeleted lockfile for the user's paste buffer remove it.
16106: my $namespace = 'nohist_courseeditor';
16107: my $lockingkey = 'paste'."\0".'locked_num';
16108: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16109: $domain,$username);
16110: if (exists($lockhash{$lockingkey})) {
16111: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16112: unless ($delresult eq 'ok') {
16113: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16114: }
16115: }
1.462 albertel 16116: }
16117: # Give them a new cookie
1.463 albertel 16118: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16119: : $now.$$.int(rand(10000)));
1.463 albertel 16120: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16121:
16122: # Initialize roles
16123:
1.1062 raeburn 16124: ($userroles,$firstaccenv,$timerintenv) =
16125: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16126: }
16127: # ------------------------------------ Check browser type and MathML capability
16128:
1.1194 raeburn 16129: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16130: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16131:
16132: # ------------------------------------------------------------- Get environment
16133:
16134: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16135: my ($tmp) = keys(%userenv);
1.1275 raeburn 16136: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 16137: undef(%userenv);
16138: }
16139: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16140: $form->{'interface'}=$userenv{'interface'};
16141: }
16142: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16143:
16144: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16145: foreach my $option ('interface','localpath','localres') {
16146: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16147: }
16148: # --------------------------------------------------------- Write first profile
16149:
16150: {
16151: my %initial_env =
16152: ("user.name" => $username,
16153: "user.domain" => $domain,
16154: "user.home" => $authhost,
16155: "browser.type" => $clientbrowser,
16156: "browser.version" => $clientversion,
16157: "browser.mathml" => $clientmathml,
16158: "browser.unicode" => $clientunicode,
16159: "browser.os" => $clientos,
1.1137 raeburn 16160: "browser.mobile" => $clientmobile,
1.1141 raeburn 16161: "browser.info" => $clientinfo,
1.1194 raeburn 16162: "browser.osversion" => $clientosversion,
1.462 albertel 16163: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16164: "request.course.fn" => '',
16165: "request.course.uri" => '',
16166: "request.course.sec" => '',
16167: "request.role" => 'cm',
16168: "request.role.adv" => $env{'user.adv'},
16169: "request.host" => $ENV{'REMOTE_ADDR'},);
16170:
16171: if ($form->{'localpath'}) {
16172: $initial_env{"browser.localpath"} = $form->{'localpath'};
16173: $initial_env{"browser.localres"} = $form->{'localres'};
16174: }
16175:
16176: if ($form->{'interface'}) {
16177: $form->{'interface'}=~s/\W//gs;
16178: $initial_env{"browser.interface"} = $form->{'interface'};
16179: $env{'browser.interface'}=$form->{'interface'};
16180: }
16181:
1.1157 raeburn 16182: if ($form->{'iptoken'}) {
16183: my $lonhost = $r->dir_config('lonHostID');
16184: $initial_env{"user.noloadbalance"} = $lonhost;
16185: $env{'user.noloadbalance'} = $lonhost;
16186: }
16187:
1.1268 raeburn 16188: if ($form->{'noloadbalance'}) {
16189: my @hosts = &Apache::lonnet::current_machine_ids();
16190: my $hosthere = $form->{'noloadbalance'};
16191: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16192: $initial_env{"user.noloadbalance"} = $hosthere;
16193: $env{'user.noloadbalance'} = $hosthere;
16194: }
16195: }
16196:
1.1016 raeburn 16197: unless ($domain eq 'public') {
1.1273 raeburn 16198: my %is_adv = ( is_adv => $env{'user.adv'} );
16199: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
16200:
16201: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16202: $userenv{'availabletools.'.$tool} =
16203: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16204: undef,\%userenv,\%domdef,\%is_adv);
16205: }
1.980 raeburn 16206:
1.1273 raeburn 16207: foreach my $crstype ('official','unofficial','community','textbook','placement') {
16208: $userenv{'canrequest.'.$crstype} =
16209: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16210: 'reload','requestcourses',
16211: \%userenv,\%domdef,\%is_adv);
16212: }
1.724 raeburn 16213:
1.1273 raeburn 16214: $userenv{'canrequest.author'} =
16215: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16216: 'reload','requestauthor',
1.980 raeburn 16217: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 16218: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16219: $domain,$username);
16220: my $reqstatus = $reqauthor{'author_status'};
16221: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16222: if (ref($reqauthor{'author'}) eq 'HASH') {
16223: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16224: $reqauthor{'author'}{'timestamp'};
16225: }
1.1092 raeburn 16226: }
1.1287 raeburn 16227: my ($types,$typename) = &course_types();
16228: if (ref($types) eq 'ARRAY') {
16229: my @options = ('approval','validate','autolimit');
16230: my $optregex = join('|',@options);
16231: my (%willtrust,%trustchecked);
16232: foreach my $type (@{$types}) {
16233: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
16234: if ($dom_str ne '') {
16235: my $updatedstr = '';
16236: my @possdomains = split(',',$dom_str);
16237: foreach my $entry (@possdomains) {
16238: my ($extdom,$extopt) = split(':',$entry);
16239: unless ($trustchecked{$extdom}) {
16240: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
16241: $trustchecked{$extdom} = 1;
16242: }
16243: if ($willtrust{$extdom}) {
16244: $updatedstr .= $entry.',';
16245: }
16246: }
16247: $updatedstr =~ s/,$//;
16248: if ($updatedstr) {
16249: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
16250: } else {
16251: delete($userenv{'reqcrsotherdom.'.$type});
16252: }
16253: }
16254: }
16255: }
1.1092 raeburn 16256: }
1.462 albertel 16257: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16258:
1.462 albertel 16259: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16260: &GDBM_WRCREAT(),0640)) {
16261: &_add_to_env(\%disk_env,\%initial_env);
16262: &_add_to_env(\%disk_env,\%userenv,'environment.');
16263: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16264: if (ref($firstaccenv) eq 'HASH') {
16265: &_add_to_env(\%disk_env,$firstaccenv);
16266: }
16267: if (ref($timerintenv) eq 'HASH') {
16268: &_add_to_env(\%disk_env,$timerintenv);
16269: }
1.463 albertel 16270: if (ref($args->{'extra_env'})) {
16271: &_add_to_env(\%disk_env,$args->{'extra_env'});
16272: }
1.462 albertel 16273: untie(%disk_env);
16274: } else {
1.705 tempelho 16275: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16276: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16277: return 'error: '.$!;
16278: }
16279: }
16280: $env{'request.role'}='cm';
16281: $env{'request.role.adv'}=$env{'user.adv'};
16282: $env{'browser.type'}=$clientbrowser;
16283:
16284: return $cookie;
16285:
16286: }
16287:
16288: sub _add_to_env {
16289: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16290: if (ref($env_data) eq 'HASH') {
16291: while (my ($key,$value) = each(%$env_data)) {
16292: $idf->{$prefix.$key} = $value;
16293: $env{$prefix.$key} = $value;
16294: }
1.462 albertel 16295: }
16296: }
16297:
1.685 tempelho 16298: # --- Get the symbolic name of a problem and the url
16299: sub get_symb {
16300: my ($request,$silent) = @_;
1.726 raeburn 16301: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16302: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16303: if ($symb eq '') {
16304: if (!$silent) {
1.1071 raeburn 16305: if (ref($request)) {
16306: $request->print("Unable to handle ambiguous references:$url:.");
16307: }
1.685 tempelho 16308: return ();
16309: }
16310: }
16311: &Apache::lonenc::check_decrypt(\$symb);
16312: return ($symb);
16313: }
16314:
16315: # --------------------------------------------------------------Get annotation
16316:
16317: sub get_annotation {
16318: my ($symb,$enc) = @_;
16319:
16320: my $key = $symb;
16321: if (!$enc) {
16322: $key =
16323: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16324: }
16325: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16326: return $annotation{$key};
16327: }
16328:
16329: sub clean_symb {
1.731 raeburn 16330: my ($symb,$delete_enc) = @_;
1.685 tempelho 16331:
16332: &Apache::lonenc::check_decrypt(\$symb);
16333: my $enc = $env{'request.enc'};
1.731 raeburn 16334: if ($delete_enc) {
1.730 raeburn 16335: delete($env{'request.enc'});
16336: }
1.685 tempelho 16337:
16338: return ($symb,$enc);
16339: }
1.462 albertel 16340:
1.1181 raeburn 16341: ############################################################
16342: ############################################################
16343:
16344: =pod
16345:
16346: =head1 Routines for building display used to search for courses
16347:
16348:
16349: =over 4
16350:
16351: =item * &build_filters()
16352:
16353: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16354: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16355: and quotacheck.pl
16356:
1.1181 raeburn 16357:
16358: Inputs:
16359:
16360: filterlist - anonymous array of fields to include as potential filters
16361:
16362: crstype - course type
16363:
16364: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16365: to pop-open a course selector (will contain "extra element").
16366:
16367: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16368:
16369: filter - anonymous hash of criteria and their values
16370:
16371: action - form action
16372:
16373: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16374:
1.1182 raeburn 16375: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16376:
16377: cloneruname - username of owner of new course who wants to clone
16378:
16379: clonerudom - domain of owner of new course who wants to clone
16380:
16381: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16382:
16383: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16384:
16385: codedom - domain
16386:
16387: formname - value of form element named "form".
16388:
16389: fixeddom - domain, if fixed.
16390:
16391: prevphase - value to assign to form element named "phase" when going back to the previous screen
16392:
16393: cnameelement - name of form element in form on opener page which will receive title of selected course
16394:
16395: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16396:
16397: cdomelement - name of form element in form on opener page which will receive domain of selected course
16398:
16399: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16400:
16401: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16402:
16403: clonewarning - warning message about missing information for intended course owner when DC creates a course
16404:
1.1182 raeburn 16405:
1.1181 raeburn 16406: Returns: $output - HTML for display of search criteria, and hidden form elements.
16407:
1.1182 raeburn 16408:
1.1181 raeburn 16409: Side Effects: None
16410:
16411: =cut
16412:
16413: # ---------------------------------------------- search for courses based on last activity etc.
16414:
16415: sub build_filters {
16416: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16417: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16418: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16419: $cnameelement,$cnumelement,$cdomelement,$setroles,
16420: $clonetext,$clonewarning) = @_;
1.1182 raeburn 16421: my ($list,$jscript);
1.1181 raeburn 16422: my $onchange = 'javascript:updateFilters(this)';
16423: my ($domainselectform,$sincefilterform,$createdfilterform,
16424: $ownerdomselectform,$persondomselectform,$instcodeform,
16425: $typeselectform,$instcodetitle);
16426: if ($formname eq '') {
16427: $formname = $caller;
16428: }
16429: foreach my $item (@{$filterlist}) {
16430: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16431: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16432: if ($item eq 'domainfilter') {
16433: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16434: } elsif ($item eq 'coursefilter') {
16435: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16436: } elsif ($item eq 'ownerfilter') {
16437: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16438: } elsif ($item eq 'ownerdomfilter') {
16439: $filter->{'ownerdomfilter'} =
16440: &LONCAPA::clean_domain($filter->{$item});
16441: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16442: 'ownerdomfilter',1);
16443: } elsif ($item eq 'personfilter') {
16444: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16445: } elsif ($item eq 'persondomfilter') {
16446: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16447: 'persondomfilter',1);
16448: } else {
16449: $filter->{$item} =~ s/\W//g;
16450: }
16451: if (!$filter->{$item}) {
16452: $filter->{$item} = '';
16453: }
16454: }
16455: if ($item eq 'domainfilter') {
16456: my $allow_blank = 1;
16457: if ($formname eq 'portform') {
16458: $allow_blank=0;
16459: } elsif ($formname eq 'studentform') {
16460: $allow_blank=0;
16461: }
16462: if ($fixeddom) {
16463: $domainselectform = '<input type="hidden" name="domainfilter"'.
16464: ' value="'.$codedom.'" />'.
16465: &Apache::lonnet::domain($codedom,'description');
16466: } else {
16467: $domainselectform = &select_dom_form($filter->{$item},
16468: 'domainfilter',
16469: $allow_blank,'',$onchange);
16470: }
16471: } else {
16472: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16473: }
16474: }
16475:
16476: # last course activity filter and selection
16477: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16478:
16479: # course created filter and selection
16480: if (exists($filter->{'createdfilter'})) {
16481: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16482: }
16483:
1.1239 raeburn 16484: my $prefix = $crstype;
16485: if ($crstype eq 'Placement') {
16486: $prefix = 'Placement Test'
16487: }
1.1181 raeburn 16488: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 16489: 'cac' => "$prefix Activity",
16490: 'ccr' => "$prefix Created",
16491: 'cde' => "$prefix Title",
16492: 'cdo' => "$prefix Domain",
1.1181 raeburn 16493: 'ins' => 'Institutional Code',
16494: 'inc' => 'Institutional Categorization',
1.1239 raeburn 16495: 'cow' => "$prefix Owner/Co-owner",
16496: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 16497: 'cog' => 'Type',
16498: );
16499:
16500: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16501: my $typeval = 'Course';
16502: if ($crstype eq 'Community') {
16503: $typeval = 'Community';
1.1239 raeburn 16504: } elsif ($crstype eq 'Placement') {
16505: $typeval = 'Placement';
1.1181 raeburn 16506: }
16507: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16508: } else {
16509: $typeselectform = '<select name="type" size="1"';
16510: if ($onchange) {
16511: $typeselectform .= ' onchange="'.$onchange.'"';
16512: }
16513: $typeselectform .= '>'."\n";
1.1237 raeburn 16514: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 16515: my $shown;
16516: if ($posstype eq 'Placement') {
16517: $shown = &mt('Placement Test');
16518: } else {
16519: $shown = &mt($posstype);
16520: }
1.1181 raeburn 16521: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 16522: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 16523: }
16524: $typeselectform.="</select>";
16525: }
16526:
16527: my ($cloneableonlyform,$cloneabletitle);
16528: if (exists($filter->{'cloneableonly'})) {
16529: my $cloneableon = '';
16530: my $cloneableoff = ' checked="checked"';
16531: if ($filter->{'cloneableonly'}) {
16532: $cloneableon = $cloneableoff;
16533: $cloneableoff = '';
16534: }
16535: $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>';
16536: if ($formname eq 'ccrs') {
1.1187 bisitz 16537: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 16538: } else {
16539: $cloneabletitle = &mt('Cloneable by you');
16540: }
16541: }
16542: my $officialjs;
16543: if ($crstype eq 'Course') {
16544: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 16545: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16546: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16547: if ($codedom) {
1.1181 raeburn 16548: $officialjs = 1;
16549: ($instcodeform,$jscript,$$numtitlesref) =
16550: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16551: $officialjs,$codetitlesref);
16552: if ($jscript) {
1.1182 raeburn 16553: $jscript = '<script type="text/javascript">'."\n".
16554: '// <![CDATA['."\n".
16555: $jscript."\n".
16556: '// ]]>'."\n".
16557: '</script>'."\n";
1.1181 raeburn 16558: }
16559: }
16560: if ($instcodeform eq '') {
16561: $instcodeform =
16562: '<input type="text" name="instcodefilter" size="10" value="'.
16563: $list->{'instcodefilter'}.'" />';
16564: $instcodetitle = $lt{'ins'};
16565: } else {
16566: $instcodetitle = $lt{'inc'};
16567: }
16568: if ($fixeddom) {
16569: $instcodetitle .= '<br />('.$codedom.')';
16570: }
16571: }
16572: }
16573: my $output = qq|
16574: <form method="post" name="filterpicker" action="$action">
16575: <input type="hidden" name="form" value="$formname" />
16576: |;
16577: if ($formname eq 'modifycourse') {
16578: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16579: '<input type="hidden" name="prevphase" value="'.
16580: $prevphase.'" />'."\n";
1.1198 musolffc 16581: } elsif ($formname eq 'quotacheck') {
16582: $output .= qq|
16583: <input type="hidden" name="sortby" value="" />
16584: <input type="hidden" name="sortorder" value="" />
16585: |;
16586: } else {
1.1181 raeburn 16587: my $name_input;
16588: if ($cnameelement ne '') {
16589: $name_input = '<input type="hidden" name="cnameelement" value="'.
16590: $cnameelement.'" />';
16591: }
16592: $output .= qq|
1.1182 raeburn 16593: <input type="hidden" name="cnumelement" value="$cnumelement" />
16594: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 16595: $name_input
16596: $roleelement
16597: $multelement
16598: $typeelement
16599: |;
16600: if ($formname eq 'portform') {
16601: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16602: }
16603: }
16604: if ($fixeddom) {
16605: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16606: }
16607: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16608: if ($sincefilterform) {
16609: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16610: .$sincefilterform
16611: .&Apache::lonhtmlcommon::row_closure();
16612: }
16613: if ($createdfilterform) {
16614: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16615: .$createdfilterform
16616: .&Apache::lonhtmlcommon::row_closure();
16617: }
16618: if ($domainselectform) {
16619: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16620: .$domainselectform
16621: .&Apache::lonhtmlcommon::row_closure();
16622: }
16623: if ($typeselectform) {
16624: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16625: $output .= $typeselectform;
16626: } else {
16627: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16628: .$typeselectform
16629: .&Apache::lonhtmlcommon::row_closure();
16630: }
16631: }
16632: if ($instcodeform) {
16633: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16634: .$instcodeform
16635: .&Apache::lonhtmlcommon::row_closure();
16636: }
16637: if (exists($filter->{'ownerfilter'})) {
16638: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16639: '<table><tr><td>'.&mt('Username').'<br />'.
16640: '<input type="text" name="ownerfilter" size="20" value="'.
16641: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16642: $ownerdomselectform.'</td></tr></table>'.
16643: &Apache::lonhtmlcommon::row_closure();
16644: }
16645: if (exists($filter->{'personfilter'})) {
16646: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16647: '<table><tr><td>'.&mt('Username').'<br />'.
16648: '<input type="text" name="personfilter" size="20" value="'.
16649: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16650: $persondomselectform.'</td></tr></table>'.
16651: &Apache::lonhtmlcommon::row_closure();
16652: }
16653: if (exists($filter->{'coursefilter'})) {
16654: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16655: .'<input type="text" name="coursefilter" size="25" value="'
16656: .$list->{'coursefilter'}.'" />'
16657: .&Apache::lonhtmlcommon::row_closure();
16658: }
16659: if ($cloneableonlyform) {
16660: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16661: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16662: }
16663: if (exists($filter->{'descriptfilter'})) {
16664: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16665: .'<input type="text" name="descriptfilter" size="40" value="'
16666: .$list->{'descriptfilter'}.'" />'
16667: .&Apache::lonhtmlcommon::row_closure(1);
16668: }
16669: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16670: '<input type="hidden" name="updater" value="" />'."\n".
16671: '<input type="submit" name="gosearch" value="'.
16672: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16673: return $jscript.$clonewarning.$output;
16674: }
16675:
16676: =pod
16677:
16678: =item * &timebased_select_form()
16679:
1.1182 raeburn 16680: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 16681: filter e.g., Course Activity, Course Created, when searching for courses
16682: or communities
16683:
16684: Inputs:
16685:
16686: item - name of form element (sincefilter or createdfilter)
16687:
16688: filter - anonymous hash of criteria and their values
16689:
16690: Returns: HTML for a select box contained a blank, then six time selections,
16691: with value set in incoming form variables currently selected.
16692:
16693: Side Effects: None
16694:
16695: =cut
16696:
16697: sub timebased_select_form {
16698: my ($item,$filter) = @_;
16699: if (ref($filter) eq 'HASH') {
16700: $filter->{$item} =~ s/[^\d-]//g;
16701: if (!$filter->{$item}) { $filter->{$item}=-1; }
16702: return &select_form(
16703: $filter->{$item},
16704: $item,
16705: { '-1' => '',
16706: '86400' => &mt('today'),
16707: '604800' => &mt('last week'),
16708: '2592000' => &mt('last month'),
16709: '7776000' => &mt('last three months'),
16710: '15552000' => &mt('last six months'),
16711: '31104000' => &mt('last year'),
16712: 'select_form_order' =>
16713: ['-1','86400','604800','2592000','7776000',
16714: '15552000','31104000']});
16715: }
16716: }
16717:
16718: =pod
16719:
16720: =item * &js_changer()
16721:
16722: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 16723: when course type or domain is changed, and also to hide 'Searching ...' on
16724: page load completion for page showing search result.
1.1181 raeburn 16725:
16726: Inputs: None
16727:
1.1183 raeburn 16728: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16729:
16730: Side Effects: None
16731:
16732: =cut
16733:
16734: sub js_changer {
16735: return <<ENDJS;
16736: <script type="text/javascript">
16737: // <![CDATA[
16738: function updateFilters(caller) {
16739: if (typeof(caller) != "undefined") {
16740: document.filterpicker.updater.value = caller.name;
16741: }
16742: document.filterpicker.submit();
16743: }
1.1183 raeburn 16744:
16745: function hideSearching() {
16746: if (document.getElementById('searching')) {
16747: document.getElementById('searching').style.display = 'none';
16748: }
16749: return;
16750: }
16751:
1.1181 raeburn 16752: // ]]>
16753: </script>
16754:
16755: ENDJS
16756: }
16757:
16758: =pod
16759:
1.1182 raeburn 16760: =item * &search_courses()
16761:
16762: Process selected filters form course search form and pass to lonnet::courseiddump
16763: to retrieve a hash for which keys are courseIDs which match the selected filters.
16764:
16765: Inputs:
16766:
16767: dom - domain being searched
16768:
16769: type - course type ('Course' or 'Community' or '.' if any).
16770:
16771: filter - anonymous hash of criteria and their values
16772:
16773: numtitles - for institutional codes - number of categories
16774:
16775: cloneruname - optional username of new course owner
16776:
16777: clonerudom - optional domain of new course owner
16778:
1.1221 raeburn 16779: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 16780: (used when DC is using course creation form)
16781:
16782: codetitles - reference to array of titles of components in institutional codes (official courses).
16783:
1.1221 raeburn 16784: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16785: (and so can clone automatically)
16786:
16787: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16788:
16789: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16790: courses to clone
1.1182 raeburn 16791:
16792: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16793:
16794:
16795: Side Effects: None
16796:
16797: =cut
16798:
16799:
16800: sub search_courses {
1.1221 raeburn 16801: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16802: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 16803: my (%courses,%showcourses,$cloner);
16804: if (($filter->{'ownerfilter'} ne '') ||
16805: ($filter->{'ownerdomfilter'} ne '')) {
16806: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16807: $filter->{'ownerdomfilter'};
16808: }
16809: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16810: if (!$filter->{$item}) {
16811: $filter->{$item}='.';
16812: }
16813: }
16814: my $now = time;
16815: my $timefilter =
16816: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16817: my ($createdbefore,$createdafter);
16818: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16819: $createdbefore = $now;
16820: $createdafter = $now-$filter->{'createdfilter'};
16821: }
16822: my ($instcodefilter,$regexpok);
16823: if ($numtitles) {
16824: if ($env{'form.official'} eq 'on') {
16825: $instcodefilter =
16826: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16827: $regexpok = 1;
16828: } elsif ($env{'form.official'} eq 'off') {
16829: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16830: unless ($instcodefilter eq '') {
16831: $regexpok = -1;
16832: }
16833: }
16834: } else {
16835: $instcodefilter = $filter->{'instcodefilter'};
16836: }
16837: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16838: if ($type eq '') { $type = '.'; }
16839:
16840: if (($clonerudom ne '') && ($cloneruname ne '')) {
16841: $cloner = $cloneruname.':'.$clonerudom;
16842: }
16843: %courses = &Apache::lonnet::courseiddump($dom,
16844: $filter->{'descriptfilter'},
16845: $timefilter,
16846: $instcodefilter,
16847: $filter->{'combownerfilter'},
16848: $filter->{'coursefilter'},
16849: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 16850: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 16851: $filter->{'cloneableonly'},
16852: $createdbefore,$createdafter,undef,
1.1221 raeburn 16853: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 16854: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16855: my $ccrole;
16856: if ($type eq 'Community') {
16857: $ccrole = 'co';
16858: } else {
16859: $ccrole = 'cc';
16860: }
16861: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16862: $filter->{'persondomfilter'},
16863: 'userroles',undef,
16864: [$ccrole,'in','ad','ep','ta','cr'],
16865: $dom);
16866: foreach my $role (keys(%rolehash)) {
16867: my ($cnum,$cdom,$courserole) = split(':',$role);
16868: my $cid = $cdom.'_'.$cnum;
16869: if (exists($courses{$cid})) {
16870: if (ref($courses{$cid}) eq 'HASH') {
16871: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16872: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 16873: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 16874: }
16875: } else {
16876: $courses{$cid}{roles} = [$courserole];
16877: }
16878: $showcourses{$cid} = $courses{$cid};
16879: }
16880: }
16881: }
16882: %courses = %showcourses;
16883: }
16884: return %courses;
16885: }
16886:
16887: =pod
16888:
1.1181 raeburn 16889: =back
16890:
1.1207 raeburn 16891: =head1 Routines for version requirements for current course.
16892:
16893: =over 4
16894:
16895: =item * &check_release_required()
16896:
16897: Compares required LON-CAPA version with version on server, and
16898: if required version is newer looks for a server with the required version.
16899:
16900: Looks first at servers in user's owen domain; if none suitable, looks at
16901: servers in course's domain are permitted to host sessions for user's domain.
16902:
16903: Inputs:
16904:
16905: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16906:
16907: $courseid - Course ID of current course
16908:
16909: $rolecode - User's current role in course (for switchserver query string).
16910:
16911: $required - LON-CAPA version needed by course (format: Major.Minor).
16912:
16913:
16914: Returns:
16915:
16916: $switchserver - query string tp append to /adm/switchserver call (if
16917: current server's LON-CAPA version is too old.
16918:
16919: $warning - Message is displayed if no suitable server could be found.
16920:
16921: =cut
16922:
16923: sub check_release_required {
16924: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16925: my ($switchserver,$warning);
16926: if ($required ne '') {
16927: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16928: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16929: if ($reqdmajor ne '' && $reqdminor ne '') {
16930: my $otherserver;
16931: if (($major eq '' && $minor eq '') ||
16932: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16933: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16934: my $switchlcrev =
16935: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16936: $userdomserver);
16937: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16938: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16939: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16940: my $cdom = $env{'course.'.$courseid.'.domain'};
16941: if ($cdom ne $env{'user.domain'}) {
16942: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16943: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16944: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16945: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16946: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16947: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16948: my $canhost =
16949: &Apache::lonnet::can_host_session($env{'user.domain'},
16950: $coursedomserver,
16951: $remoterev,
16952: $udomdefaults{'remotesessions'},
16953: $defdomdefaults{'hostedsessions'});
16954:
16955: if ($canhost) {
16956: $otherserver = $coursedomserver;
16957: } else {
16958: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
16959: }
16960: } else {
16961: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
16962: }
16963: } else {
16964: $otherserver = $userdomserver;
16965: }
16966: }
16967: if ($otherserver ne '') {
16968: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16969: }
16970: }
16971: }
16972: return ($switchserver,$warning);
16973: }
16974:
16975: =pod
16976:
16977: =item * &check_release_result()
16978:
16979: Inputs:
16980:
16981: $switchwarning - Warning message if no suitable server found to host session.
16982:
16983: $switchserver - query string to append to /adm/switchserver containing lonHostID
16984: and current role.
16985:
16986: Returns: HTML to display with information about requirement to switch server.
16987: Either displaying warning with link to Roles/Courses screen or
16988: display link to switchserver.
16989:
1.1181 raeburn 16990: =cut
16991:
1.1207 raeburn 16992: sub check_release_result {
16993: my ($switchwarning,$switchserver) = @_;
16994: my $output = &start_page('Selected course unavailable on this server').
16995: '<p class="LC_warning">';
16996: if ($switchwarning) {
16997: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16998: if (&show_course()) {
16999: $output .= &mt('Display courses');
17000: } else {
17001: $output .= &mt('Display roles');
17002: }
17003: $output .= '</a>';
17004: } elsif ($switchserver) {
17005: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17006: '<br />'.
17007: '<a href="/adm/switchserver?'.$switchserver.'">'.
17008: &mt('Switch Server').
17009: '</a>';
17010: }
17011: $output .= '</p>'.&end_page();
17012: return $output;
17013: }
17014:
17015: =pod
17016:
17017: =item * &needs_coursereinit()
17018:
17019: Determine if course contents stored for user's session needs to be
17020: refreshed, because content has changed since "Big Hash" last tied.
17021:
17022: Check for change is made if time last checked is more than 10 minutes ago
17023: (by default).
17024:
17025: Inputs:
17026:
17027: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17028:
17029: $interval (optional) - Time which may elapse (in s) between last check for content
17030: change in current course. (default: 600 s).
17031:
17032: Returns: an array; first element is:
17033:
17034: =over 4
17035:
17036: 'switch' - if content updates mean user's session
17037: needs to be switched to a server running a newer LON-CAPA version
17038:
17039: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17040: on current server hosting user's session
17041:
17042: '' - if no action required.
17043:
17044: =back
17045:
17046: If first item element is 'switch':
17047:
17048: second item is $switchwarning - Warning message if no suitable server found to host session.
17049:
17050: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17051: and current role.
17052:
17053: otherwise: no other elements returned.
17054:
17055: =back
17056:
17057: =cut
17058:
17059: sub needs_coursereinit {
17060: my ($loncaparev,$interval) = @_;
17061: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17062: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17063: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17064: my $now = time;
17065: if ($interval eq '') {
17066: $interval = 600;
17067: }
17068: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 17069: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1283 raeburn 17070: my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
1.1282 raeburn 17071: if ($blocked) {
17072: return ();
17073: }
1.1207 raeburn 17074: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
17075: if ($lastchange > $env{'request.course.tied'}) {
17076: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17077: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17078: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17079: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17080: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17081: $curr_reqd_hash{'internal.releaserequired'}});
17082: my ($switchserver,$switchwarning) =
17083: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17084: $curr_reqd_hash{'internal.releaserequired'});
17085: if ($switchwarning ne '' || $switchserver ne '') {
17086: return ('switch',$switchwarning,$switchserver);
17087: }
17088: }
17089: }
17090: return ('update');
17091: }
17092: }
17093: return ();
17094: }
1.1181 raeburn 17095:
1.1083 raeburn 17096: sub update_content_constraints {
17097: my ($cdom,$cnum,$chome,$cid) = @_;
17098: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17099: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
17100: my %checkresponsetypes;
17101: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 17102: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 17103: if ($item eq 'resourcetag') {
17104: if ($name eq 'responsetype') {
17105: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17106: }
17107: }
17108: }
17109: my $navmap = Apache::lonnavmaps::navmap->new();
17110: if (defined($navmap)) {
17111: my %allresponses;
17112: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
17113: my %responses = $res->responseTypes();
17114: foreach my $key (keys(%responses)) {
17115: next unless(exists($checkresponsetypes{$key}));
17116: $allresponses{$key} += $responses{$key};
17117: }
17118: }
17119: foreach my $key (keys(%allresponses)) {
17120: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17121: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17122: ($reqdmajor,$reqdminor) = ($major,$minor);
17123: }
17124: }
17125: undef($navmap);
17126: }
17127: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17128: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17129: }
17130: return;
17131: }
17132:
1.1110 raeburn 17133: sub allmaps_incourse {
17134: my ($cdom,$cnum,$chome,$cid) = @_;
17135: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17136: $cid = $env{'request.course.id'};
17137: $cdom = $env{'course.'.$cid.'.domain'};
17138: $cnum = $env{'course.'.$cid.'.num'};
17139: $chome = $env{'course.'.$cid.'.home'};
17140: }
17141: my %allmaps = ();
17142: my $lastchange =
17143: &Apache::lonnet::get_coursechange($cdom,$cnum);
17144: if ($lastchange > $env{'request.course.tied'}) {
17145: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17146: unless ($ferr) {
17147: &update_content_constraints($cdom,$cnum,$chome,$cid);
17148: }
17149: }
17150: my $navmap = Apache::lonnavmaps::navmap->new();
17151: if (defined($navmap)) {
17152: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17153: $allmaps{$res->src()} = 1;
17154: }
17155: }
17156: return \%allmaps;
17157: }
17158:
1.1083 raeburn 17159: sub parse_supplemental_title {
17160: my ($title) = @_;
17161:
17162: my ($foldertitle,$renametitle);
17163: if ($title =~ /&&&/) {
17164: $title = &HTML::Entites::decode($title);
17165: }
17166: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17167: $renametitle=$4;
17168: my ($time,$uname,$udom) = ($1,$2,$3);
17169: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17170: my $name = &plainname($uname,$udom);
17171: $name = &HTML::Entities::encode($name,'"<>&\'');
17172: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17173: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17174: $name.': <br />'.$foldertitle;
17175: }
17176: if (wantarray) {
17177: return ($title,$foldertitle,$renametitle);
17178: }
17179: return $title;
17180: }
17181:
1.1143 raeburn 17182: sub recurse_supplemental {
17183: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
17184: if ($suppmap) {
17185: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17186: if ($fatal) {
17187: $errors ++;
17188: } else {
17189: if ($#LONCAPA::map::resources > 0) {
17190: foreach my $res (@LONCAPA::map::resources) {
17191: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
17192: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 17193: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
17194: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 17195: } else {
17196: $numfiles ++;
17197: }
17198: }
17199: }
17200: }
17201: }
17202: }
17203: return ($numfiles,$errors);
17204: }
17205:
1.1101 raeburn 17206: sub symb_to_docspath {
1.1267 raeburn 17207: my ($symb,$navmapref) = @_;
17208: return unless ($symb && ref($navmapref));
1.1101 raeburn 17209: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17210: if ($resurl=~/\.(sequence|page)$/) {
17211: $mapurl=$resurl;
17212: } elsif ($resurl eq 'adm/navmaps') {
17213: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17214: }
17215: my $mapresobj;
1.1267 raeburn 17216: unless (ref($$navmapref)) {
17217: $$navmapref = Apache::lonnavmaps::navmap->new();
17218: }
17219: if (ref($$navmapref)) {
17220: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 17221: }
17222: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17223: my $type=$2;
17224: my $path;
17225: if (ref($mapresobj)) {
17226: my $pcslist = $mapresobj->map_hierarchy();
17227: if ($pcslist ne '') {
17228: foreach my $pc (split(/,/,$pcslist)) {
17229: next if ($pc <= 1);
1.1267 raeburn 17230: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 17231: if (ref($res)) {
17232: my $thisurl = $res->src();
17233: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17234: my $thistitle = $res->title();
17235: $path .= '&'.
17236: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 17237: &escape($thistitle).
1.1101 raeburn 17238: ':'.$res->randompick().
17239: ':'.$res->randomout().
17240: ':'.$res->encrypted().
17241: ':'.$res->randomorder().
17242: ':'.$res->is_page();
17243: }
17244: }
17245: }
17246: $path =~ s/^\&//;
17247: my $maptitle = $mapresobj->title();
17248: if ($mapurl eq 'default') {
1.1129 raeburn 17249: $maptitle = 'Main Content';
1.1101 raeburn 17250: }
17251: $path .= (($path ne '')? '&' : '').
17252: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17253: &escape($maptitle).
1.1101 raeburn 17254: ':'.$mapresobj->randompick().
17255: ':'.$mapresobj->randomout().
17256: ':'.$mapresobj->encrypted().
17257: ':'.$mapresobj->randomorder().
17258: ':'.$mapresobj->is_page();
17259: } else {
17260: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17261: my $ispage = (($type eq 'page')? 1 : '');
17262: if ($mapurl eq 'default') {
1.1129 raeburn 17263: $maptitle = 'Main Content';
1.1101 raeburn 17264: }
17265: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17266: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 17267: }
17268: unless ($mapurl eq 'default') {
17269: $path = 'default&'.
1.1146 raeburn 17270: &escape('Main Content').
1.1101 raeburn 17271: ':::::&'.$path;
17272: }
17273: return $path;
17274: }
17275:
1.1094 raeburn 17276: sub captcha_display {
17277: my ($context,$lonhost) = @_;
17278: my ($output,$error);
1.1234 raeburn 17279: my ($captcha,$pubkey,$privkey,$version) =
17280: &get_captcha_config($context,$lonhost);
1.1095 raeburn 17281: if ($captcha eq 'original') {
1.1094 raeburn 17282: $output = &create_captcha();
17283: unless ($output) {
1.1172 raeburn 17284: $error = 'captcha';
1.1094 raeburn 17285: }
17286: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17287: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17288: unless ($output) {
1.1172 raeburn 17289: $error = 'recaptcha';
1.1094 raeburn 17290: }
17291: }
1.1234 raeburn 17292: return ($output,$error,$captcha,$version);
1.1094 raeburn 17293: }
17294:
17295: sub captcha_response {
17296: my ($context,$lonhost) = @_;
17297: my ($captcha_chk,$captcha_error);
1.1234 raeburn 17298: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 17299: if ($captcha eq 'original') {
1.1094 raeburn 17300: ($captcha_chk,$captcha_error) = &check_captcha();
17301: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17302: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17303: } else {
17304: $captcha_chk = 1;
17305: }
17306: return ($captcha_chk,$captcha_error);
17307: }
17308:
17309: sub get_captcha_config {
17310: my ($context,$lonhost) = @_;
1.1234 raeburn 17311: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17312: my $hostname = &Apache::lonnet::hostname($lonhost);
17313: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17314: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17315: if ($context eq 'usercreation') {
17316: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17317: if (ref($domconfig{$context}) eq 'HASH') {
17318: $hashtocheck = $domconfig{$context}{'cancreate'};
17319: if (ref($hashtocheck) eq 'HASH') {
17320: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17321: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17322: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17323: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17324: }
17325: if ($privkey && $pubkey) {
17326: $captcha = 'recaptcha';
1.1234 raeburn 17327: $version = $hashtocheck->{'recaptchaversion'};
17328: if ($version ne '2') {
17329: $version = 1;
17330: }
1.1095 raeburn 17331: } else {
17332: $captcha = 'original';
17333: }
17334: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17335: $captcha = 'original';
17336: }
1.1094 raeburn 17337: }
1.1095 raeburn 17338: } else {
17339: $captcha = 'captcha';
17340: }
17341: } elsif ($context eq 'login') {
17342: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17343: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17344: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17345: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17346: if ($privkey && $pubkey) {
17347: $captcha = 'recaptcha';
1.1234 raeburn 17348: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17349: if ($version ne '2') {
17350: $version = 1;
17351: }
1.1095 raeburn 17352: } else {
17353: $captcha = 'original';
1.1094 raeburn 17354: }
1.1095 raeburn 17355: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17356: $captcha = 'original';
1.1094 raeburn 17357: }
17358: }
1.1234 raeburn 17359: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 17360: }
17361:
17362: sub create_captcha {
17363: my %captcha_params = &captcha_settings();
17364: my ($output,$maxtries,$tries) = ('',10,0);
17365: while ($tries < $maxtries) {
17366: $tries ++;
17367: my $captcha = Authen::Captcha->new (
17368: output_folder => $captcha_params{'output_dir'},
17369: data_folder => $captcha_params{'db_dir'},
17370: );
17371: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17372:
17373: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17374: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
17375: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 17376: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
17377: '<br />'.
17378: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 17379: last;
17380: }
17381: }
17382: return $output;
17383: }
17384:
17385: sub captcha_settings {
17386: my %captcha_params = (
17387: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17388: www_output_dir => "/captchaspool",
17389: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17390: numchars => '5',
17391: );
17392: return %captcha_params;
17393: }
17394:
17395: sub check_captcha {
17396: my ($captcha_chk,$captcha_error);
17397: my $code = $env{'form.code'};
17398: my $md5sum = $env{'form.crypt'};
17399: my %captcha_params = &captcha_settings();
17400: my $captcha = Authen::Captcha->new(
17401: output_folder => $captcha_params{'output_dir'},
17402: data_folder => $captcha_params{'db_dir'},
17403: );
1.1109 raeburn 17404: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 17405: my %captcha_hash = (
17406: 0 => 'Code not checked (file error)',
17407: -1 => 'Failed: code expired',
17408: -2 => 'Failed: invalid code (not in database)',
17409: -3 => 'Failed: invalid code (code does not match crypt)',
17410: );
17411: if ($captcha_chk != 1) {
17412: $captcha_error = $captcha_hash{$captcha_chk}
17413: }
17414: return ($captcha_chk,$captcha_error);
17415: }
17416:
17417: sub create_recaptcha {
1.1234 raeburn 17418: my ($pubkey,$version) = @_;
17419: if ($version >= 2) {
17420: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17421: } else {
17422: my $use_ssl;
17423: if ($ENV{'SERVER_PORT'} == 443) {
17424: $use_ssl = 1;
17425: }
17426: my $captcha = Captcha::reCAPTCHA->new;
17427: return $captcha->get_options_setter({theme => 'white'})."\n".
17428: $captcha->get_html($pubkey,undef,$use_ssl).
17429: &mt('If the text is hard to read, [_1] will replace them.',
17430: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17431: '<br /><br />';
17432: }
1.1094 raeburn 17433: }
17434:
17435: sub check_recaptcha {
1.1234 raeburn 17436: my ($privkey,$version) = @_;
1.1094 raeburn 17437: my $captcha_chk;
1.1234 raeburn 17438: if ($version >= 2) {
17439: my %info = (
17440: secret => $privkey,
17441: response => $env{'form.g-recaptcha-response'},
17442: remoteip => $ENV{'REMOTE_ADDR'},
17443: );
1.1280 raeburn 17444: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
17445: $request->content(join('&',map {
17446: my $name = escape($_);
17447: "$name=" . ( ref($info{$_}) eq 'ARRAY'
17448: ? join("&$name=", map {escape($_) } @{$info{$_}})
17449: : &escape($info{$_}) );
17450: } keys(%info)));
17451: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 17452: if ($response->is_success) {
17453: my $data = JSON::DWIW->from_json($response->decoded_content);
17454: if (ref($data) eq 'HASH') {
17455: if ($data->{'success'}) {
17456: $captcha_chk = 1;
17457: }
17458: }
17459: }
17460: } else {
17461: my $captcha = Captcha::reCAPTCHA->new;
17462: my $captcha_result =
17463: $captcha->check_answer(
17464: $privkey,
17465: $ENV{'REMOTE_ADDR'},
17466: $env{'form.recaptcha_challenge_field'},
17467: $env{'form.recaptcha_response_field'},
17468: );
17469: if ($captcha_result->{is_valid}) {
17470: $captcha_chk = 1;
17471: }
1.1094 raeburn 17472: }
17473: return $captcha_chk;
17474: }
17475:
1.1174 raeburn 17476: sub emailusername_info {
1.1244 raeburn 17477: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 17478: my %titles = &Apache::lonlocal::texthash (
17479: lastname => 'Last Name',
17480: firstname => 'First Name',
17481: institution => 'School/college/university',
17482: location => "School's city, state/province, country",
17483: web => "School's web address",
17484: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 17485: id => 'Student/Employee ID',
1.1174 raeburn 17486: );
17487: return (\@fields,\%titles);
17488: }
17489:
1.1161 raeburn 17490: sub cleanup_html {
17491: my ($incoming) = @_;
17492: my $outgoing;
17493: if ($incoming ne '') {
17494: $outgoing = $incoming;
17495: $outgoing =~ s/;/;/g;
17496: $outgoing =~ s/\#/#/g;
17497: $outgoing =~ s/\&/&/g;
17498: $outgoing =~ s/</</g;
17499: $outgoing =~ s/>/>/g;
17500: $outgoing =~ s/\(/(/g;
17501: $outgoing =~ s/\)/)/g;
17502: $outgoing =~ s/"/"/g;
17503: $outgoing =~ s/'/'/g;
17504: $outgoing =~ s/\$/$/g;
17505: $outgoing =~ s{/}{/}g;
17506: $outgoing =~ s/=/=/g;
17507: $outgoing =~ s/\\/\/g
17508: }
17509: return $outgoing;
17510: }
17511:
1.1190 musolffc 17512: # Checks for critical messages and returns a redirect url if one exists.
17513: # $interval indicates how often to check for messages.
1.1282 raeburn 17514: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 17515: sub critical_redirect {
1.1282 raeburn 17516: my ($interval,$context) = @_;
1.1190 musolffc 17517: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 17518: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
17519: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17520: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17521: my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
17522: if ($blocked) {
17523: my $checkrole = "cm./$cdom/$cnum";
17524: if ($env{'request.course.sec'} ne '') {
17525: $checkrole .= "/$env{'request.course.sec'}";
17526: }
17527: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
17528: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
17529: return;
17530: }
17531: }
17532: }
1.1190 musolffc 17533: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17534: $env{'user.name'});
17535: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 17536: my $redirecturl;
1.1190 musolffc 17537: if ($what[0]) {
17538: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17539: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 17540: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17541: return (1, $url);
1.1190 musolffc 17542: }
1.1191 raeburn 17543: }
17544: }
17545: return ();
1.1190 musolffc 17546: }
17547:
1.1174 raeburn 17548: # Use:
17549: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17550: #
17551: ##################################################
17552: # password associated functions #
17553: ##################################################
17554: sub des_keys {
17555: # Make a new key for DES encryption.
17556: # Each key has two parts which are returned separately.
17557: # Please note: Each key must be passed through the &hex function
17558: # before it is output to the web browser. The hex versions cannot
17559: # be used to decrypt.
17560: my @hexstr=('0','1','2','3','4','5','6','7',
17561: '8','9','a','b','c','d','e','f');
17562: my $lkey='';
17563: for (0..7) {
17564: $lkey.=$hexstr[rand(15)];
17565: }
17566: my $ukey='';
17567: for (0..7) {
17568: $ukey.=$hexstr[rand(15)];
17569: }
17570: return ($lkey,$ukey);
17571: }
17572:
17573: sub des_decrypt {
17574: my ($key,$cyphertext) = @_;
17575: my $keybin=pack("H16",$key);
17576: my $cypher;
17577: if ($Crypt::DES::VERSION>=2.03) {
17578: $cypher=new Crypt::DES $keybin;
17579: } else {
17580: $cypher=new DES $keybin;
17581: }
1.1233 raeburn 17582: my $plaintext='';
17583: my $cypherlength = length($cyphertext);
17584: my $numchunks = int($cypherlength/32);
17585: for (my $j=0; $j<$numchunks; $j++) {
17586: my $start = $j*32;
17587: my $cypherblock = substr($cyphertext,$start,32);
17588: my $chunk =
17589: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17590: $chunk .=
17591: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17592: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17593: $plaintext .= $chunk;
17594: }
1.1174 raeburn 17595: return $plaintext;
17596: }
17597:
1.112 bowersj2 17598: 1;
17599: __END__;
1.41 ng 17600:
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