Annotation of loncom/interface/loncommon.pm, revision 1.1309
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1309 ! raeburn 4: # $Id: loncommon.pm,v 1.1308 2018/01/03 04:20:54 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.1292 raeburn 87: use File::Copy();
1.1300 raeburn 88: use File::Path();
1.1309 ! raeburn 89: use String::CRC32();
! 90: use Short::URL();
1.117 www 91:
1.517 raeburn 92: # ---------------------------------------------- Designs
93: use vars qw(%defaultdesign);
94:
1.22 www 95: my $readit;
96:
1.517 raeburn 97:
1.157 matthew 98: ##
99: ## Global Variables
100: ##
1.46 matthew 101:
1.643 foxr 102:
103: # ----------------------------------------------- SSI with retries:
104: #
105:
106: =pod
107:
1.648 raeburn 108: =head1 Server Side include with retries:
1.643 foxr 109:
110: =over 4
111:
1.648 raeburn 112: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 113:
114: Performs an ssi with some number of retries. Retries continue either
115: until the result is ok or until the retry count supplied by the
116: caller is exhausted.
117:
118: Inputs:
1.648 raeburn 119:
120: =over 4
121:
1.643 foxr 122: resource - Identifies the resource to insert.
1.648 raeburn 123:
1.643 foxr 124: retries - Count of the number of retries allowed.
1.648 raeburn 125:
1.643 foxr 126: form - Hash that identifies the rendering options.
127:
1.648 raeburn 128: =back
129:
130: Returns:
131:
132: =over 4
133:
1.643 foxr 134: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 135:
1.643 foxr 136: response - The response from the last attempt (which may or may not have been successful.
137:
1.648 raeburn 138: =back
139:
140: =back
141:
1.643 foxr 142: =cut
143:
144: sub ssi_with_retries {
145: my ($resource, $retries, %form) = @_;
146:
147:
148: my $ok = 0; # True if we got a good response.
149: my $content;
150: my $response;
151:
152: # Try to get the ssi done. within the retries count:
153:
154: do {
155: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
156: $ok = $response->is_success;
1.650 www 157: if (!$ok) {
158: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
159: }
1.643 foxr 160: $retries--;
161: } while (!$ok && ($retries > 0));
162:
163: if (!$ok) {
164: $content = ''; # On error return an empty content.
165: }
166: return ($content, $response);
167:
168: }
169:
170:
171:
1.20 www 172: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 173: my %language;
1.124 www 174: my %supported_language;
1.1088 foxr 175: my %supported_codes;
1.1048 foxr 176: my %latex_language; # For choosing hyphenation in <transl..>
177: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 178: my %cprtag;
1.192 taceyjo1 179: my %scprtag;
1.351 www 180: my %fe; my %fd; my %fm;
1.41 ng 181: my %category_extensions;
1.12 harris41 182:
1.46 matthew 183: # ---------------------------------------------- Thesaurus variables
1.144 matthew 184: #
185: # %Keywords:
186: # A hash used by &keyword to determine if a word is considered a keyword.
187: # $thesaurus_db_file
188: # Scalar containing the full path to the thesaurus database.
1.46 matthew 189:
190: my %Keywords;
191: my $thesaurus_db_file;
192:
1.144 matthew 193: #
194: # Initialize values from language.tab, copyright.tab, filetypes.tab,
195: # thesaurus.tab, and filecategories.tab.
196: #
1.18 www 197: BEGIN {
1.46 matthew 198: # Variable initialization
199: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
200: #
1.22 www 201: unless ($readit) {
1.12 harris41 202: # ------------------------------------------------------------------- languages
203: {
1.158 raeburn 204: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
205: '/language.tab';
206: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 207: while (my $line = <$fh>) {
208: next if ($line=~/^\#/);
209: chomp($line);
1.1088 foxr 210: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 211: $language{$key}=$val.' - '.$enc;
212: if ($sup) {
213: $supported_language{$key}=$sup;
1.1088 foxr 214: $supported_codes{$key} = $code;
1.158 raeburn 215: }
1.1048 foxr 216: if ($latex) {
217: $latex_language_bykey{$key} = $latex;
1.1088 foxr 218: $latex_language{$code} = $latex;
1.1048 foxr 219: }
1.158 raeburn 220: }
221: close($fh);
222: }
1.12 harris41 223: }
224: # ------------------------------------------------------------------ copyrights
225: {
1.158 raeburn 226: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
227: '/copyright.tab';
228: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 229: while (my $line = <$fh>) {
230: next if ($line=~/^\#/);
231: chomp($line);
232: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 233: $cprtag{$key}=$val;
234: }
235: close($fh);
236: }
1.12 harris41 237: }
1.351 www 238: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 239: {
240: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
241: '/source_copyright.tab';
242: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 243: while (my $line = <$fh>) {
244: next if ($line =~ /^\#/);
245: chomp($line);
246: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 247: $scprtag{$key}=$val;
248: }
249: close($fh);
250: }
251: }
1.63 www 252:
1.517 raeburn 253: # -------------------------------------------------------------- default domain designs
1.63 www 254: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 255: my $designfile = $designdir.'/default.tab';
256: if ( open (my $fh,"<$designfile") ) {
257: while (my $line = <$fh>) {
258: next if ($line =~ /^\#/);
259: chomp($line);
260: my ($key,$val)=(split(/\=/,$line));
261: if ($val) { $defaultdesign{$key}=$val; }
262: }
263: close($fh);
1.63 www 264: }
265:
1.15 harris41 266: # ------------------------------------------------------------- file categories
267: {
1.158 raeburn 268: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
269: '/filecategories.tab';
270: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 271: while (my $line = <$fh>) {
272: next if ($line =~ /^\#/);
273: chomp($line);
274: my ($extension,$category)=(split(/\s+/,$line,2));
1.1263 raeburn 275: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 276: }
277: close($fh);
278: }
279:
1.15 harris41 280: }
1.12 harris41 281: # ------------------------------------------------------------------ file types
282: {
1.158 raeburn 283: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
284: '/filetypes.tab';
285: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 286: while (my $line = <$fh>) {
287: next if ($line =~ /^\#/);
288: chomp($line);
289: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 290: if ($descr ne '') {
291: $fe{$ending}=lc($emb);
292: $fd{$ending}=$descr;
1.351 www 293: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 294: }
295: }
296: close($fh);
297: }
1.12 harris41 298: }
1.22 www 299: &Apache::lonnet::logthis(
1.705 tempelho 300: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 301: $readit=1;
1.46 matthew 302: } # end of unless($readit)
1.32 matthew 303:
304: }
1.112 bowersj2 305:
1.42 matthew 306: ###############################################################
307: ## HTML and Javascript Helper Functions ##
308: ###############################################################
309:
310: =pod
311:
1.112 bowersj2 312: =head1 HTML and Javascript Functions
1.42 matthew 313:
1.112 bowersj2 314: =over 4
315:
1.648 raeburn 316: =item * &browser_and_searcher_javascript()
1.112 bowersj2 317:
318: X<browsing, javascript>X<searching, javascript>Returns a string
319: containing javascript with two functions, C<openbrowser> and
320: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
321: tags.
1.42 matthew 322:
1.648 raeburn 323: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 324:
325: inputs: formname, elementname, only, omit
326:
327: formname and elementname indicate the name of the html form and name of
328: the element that the results of the browsing selection are to be placed in.
329:
330: Specifying 'only' will restrict the browser to displaying only files
1.185 www 331: with the given extension. Can be a comma separated list.
1.42 matthew 332:
333: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 334: with the given extension. Can be a comma separated list.
1.42 matthew 335:
1.648 raeburn 336: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 337:
338: Inputs: formname, elementname
339:
340: formname and elementname specify the name of the html form and the name
341: of the element the selection from the search results will be placed in.
1.542 raeburn 342:
1.42 matthew 343: =cut
344:
345: sub browser_and_searcher_javascript {
1.199 albertel 346: my ($mode)=@_;
347: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 348: my $resurl=&escape_single(&lastresurl());
1.42 matthew 349: return <<END;
1.219 albertel 350: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 351: var editbrowser = null;
1.135 albertel 352: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 353: var url = '$resurl/?';
1.42 matthew 354: if (editbrowser == null) {
355: url += 'launch=1&';
356: }
357: url += 'catalogmode=interactive&';
1.199 albertel 358: url += 'mode=$mode&';
1.611 albertel 359: url += 'inhibitmenu=yes&';
1.42 matthew 360: url += 'form=' + formname + '&';
361: if (only != null) {
362: url += 'only=' + only + '&';
1.217 albertel 363: } else {
364: url += 'only=&';
365: }
1.42 matthew 366: if (omit != null) {
367: url += 'omit=' + omit + '&';
1.217 albertel 368: } else {
369: url += 'omit=&';
370: }
1.135 albertel 371: if (titleelement != null) {
372: url += 'titleelement=' + titleelement + '&';
1.217 albertel 373: } else {
374: url += 'titleelement=&';
375: }
1.42 matthew 376: url += 'element=' + elementname + '';
377: var title = 'Browser';
1.435 albertel 378: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 379: options += ',width=700,height=600';
380: editbrowser = open(url,title,options,'1');
381: editbrowser.focus();
382: }
383: var editsearcher;
1.135 albertel 384: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 385: var url = '/adm/searchcat?';
386: if (editsearcher == null) {
387: url += 'launch=1&';
388: }
389: url += 'catalogmode=interactive&';
1.199 albertel 390: url += 'mode=$mode&';
1.42 matthew 391: url += 'form=' + formname + '&';
1.135 albertel 392: if (titleelement != null) {
393: url += 'titleelement=' + titleelement + '&';
1.217 albertel 394: } else {
395: url += 'titleelement=&';
396: }
1.42 matthew 397: url += 'element=' + elementname + '';
398: var title = 'Search';
1.435 albertel 399: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 400: options += ',width=700,height=600';
401: editsearcher = open(url,title,options,'1');
402: editsearcher.focus();
403: }
1.219 albertel 404: // END LON-CAPA Internal -->
1.42 matthew 405: END
1.170 www 406: }
407:
408: sub lastresurl {
1.258 albertel 409: if ($env{'environment.lastresurl'}) {
410: return $env{'environment.lastresurl'}
1.170 www 411: } else {
412: return '/res';
413: }
414: }
415:
416: sub storeresurl {
417: my $resurl=&Apache::lonnet::clutter(shift);
418: unless ($resurl=~/^\/res/) { return 0; }
419: $resurl=~s/\/$//;
420: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 421: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 422: return 1;
1.42 matthew 423: }
424:
1.74 www 425: sub studentbrowser_javascript {
1.111 www 426: unless (
1.258 albertel 427: (($env{'request.course.id'}) &&
1.302 albertel 428: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
429: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
430: '/'.$env{'request.course.sec'})
431: ))
1.258 albertel 432: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 433: ) { return ''; }
1.74 www 434: return (<<'ENDSTDBRW');
1.776 bisitz 435: <script type="text/javascript" language="Javascript">
1.824 bisitz 436: // <![CDATA[
1.74 www 437: var stdeditbrowser;
1.999 www 438: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 439: var url = '/adm/pickstudent?';
440: var filter;
1.558 albertel 441: if (!ignorefilter) {
442: eval('filter=document.'+formname+'.'+uname+'.value;');
443: }
1.74 www 444: if (filter != null) {
445: if (filter != '') {
446: url += 'filter='+filter+'&';
447: }
448: }
449: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 450: '&udomelement='+udom+
451: '&clicker='+clicker;
1.111 www 452: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 453: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 454: var title = 'Student_Browser';
1.74 www 455: var options = 'scrollbars=1,resizable=1,menubar=0';
456: options += ',width=700,height=600';
457: stdeditbrowser = open(url,title,options,'1');
458: stdeditbrowser.focus();
459: }
1.824 bisitz 460: // ]]>
1.74 www 461: </script>
462: ENDSTDBRW
463: }
1.42 matthew 464:
1.1003 www 465: sub resourcebrowser_javascript {
466: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 467: return (<<'ENDRESBRW');
1.1003 www 468: <script type="text/javascript" language="Javascript">
469: // <![CDATA[
470: var reseditbrowser;
1.1004 www 471: function openresbrowser(formname,reslink) {
1.1005 www 472: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 473: var title = 'Resource_Browser';
474: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 475: options += ',width=700,height=500';
1.1004 www 476: reseditbrowser = open(url,title,options,'1');
477: reseditbrowser.focus();
1.1003 www 478: }
479: // ]]>
480: </script>
1.1004 www 481: ENDRESBRW
1.1003 www 482: }
483:
1.74 www 484: sub selectstudent_link {
1.999 www 485: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
486: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
487: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
488: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 489: if ($env{'request.course.id'}) {
1.302 albertel 490: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
491: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
492: '/'.$env{'request.course.sec'})) {
1.111 www 493: return '';
494: }
1.999 www 495: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 496: if ($courseadvonly) {
497: $callargs .= ",'',1,1";
498: }
499: return '<span class="LC_nobreak">'.
500: '<a href="javascript:openstdbrowser('.$callargs.');">'.
501: &mt('Select User').'</a></span>';
1.74 www 502: }
1.258 albertel 503: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 504: $callargs .= ",'',1";
1.793 raeburn 505: return '<span class="LC_nobreak">'.
506: '<a href="javascript:openstdbrowser('.$callargs.');">'.
507: &mt('Select User').'</a></span>';
1.111 www 508: }
509: return '';
1.91 www 510: }
511:
1.1004 www 512: sub selectresource_link {
513: my ($form,$reslink,$arg)=@_;
514:
515: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
516: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
517: unless ($env{'request.course.id'}) { return $arg; }
518: return '<span class="LC_nobreak">'.
519: '<a href="javascript:openresbrowser('.$callargs.');">'.
520: $arg.'</a></span>';
521: }
522:
523:
524:
1.653 raeburn 525: sub authorbrowser_javascript {
526: return <<"ENDAUTHORBRW";
1.776 bisitz 527: <script type="text/javascript" language="JavaScript">
1.824 bisitz 528: // <![CDATA[
1.653 raeburn 529: var stdeditbrowser;
530:
531: function openauthorbrowser(formname,udom) {
532: var url = '/adm/pickauthor?';
533: url += 'form='+formname+'&roledom='+udom;
534: var title = 'Author_Browser';
535: var options = 'scrollbars=1,resizable=1,menubar=0';
536: options += ',width=700,height=600';
537: stdeditbrowser = open(url,title,options,'1');
538: stdeditbrowser.focus();
539: }
540:
1.824 bisitz 541: // ]]>
1.653 raeburn 542: </script>
543: ENDAUTHORBRW
544: }
545:
1.91 www 546: sub coursebrowser_javascript {
1.1116 raeburn 547: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 548: $credits_element,$instcode) = @_;
1.932 raeburn 549: my $wintitle = 'Course_Browser';
1.931 raeburn 550: if ($crstype eq 'Community') {
1.932 raeburn 551: $wintitle = 'Community_Browser';
1.909 raeburn 552: }
1.876 raeburn 553: my $id_functions = &javascript_index_functions();
554: my $output = '
1.776 bisitz 555: <script type="text/javascript" language="JavaScript">
1.824 bisitz 556: // <![CDATA[
1.468 raeburn 557: var stdeditbrowser;'."\n";
1.876 raeburn 558:
559: $output .= <<"ENDSTDBRW";
1.909 raeburn 560: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 561: var url = '/adm/pickcourse?';
1.895 raeburn 562: var formid = getFormIdByName(formname);
1.876 raeburn 563: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 564: if (domainfilter != null) {
565: if (domainfilter != '') {
566: url += 'domainfilter='+domainfilter+'&';
567: }
568: }
1.91 www 569: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 570: '&cdomelement='+udom+
571: '&cnameelement='+desc;
1.468 raeburn 572: if (extra_element !=null && extra_element != '') {
1.594 raeburn 573: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 574: url += '&roleelement='+extra_element;
575: if (domainfilter == null || domainfilter == '') {
576: url += '&domainfilter='+extra_element;
577: }
1.234 raeburn 578: }
1.468 raeburn 579: else {
580: if (formname == 'portform') {
581: url += '&setroles='+extra_element;
1.800 raeburn 582: } else {
583: if (formname == 'rules') {
584: url += '&fixeddom='+extra_element;
585: }
1.468 raeburn 586: }
587: }
1.230 raeburn 588: }
1.909 raeburn 589: if (type != null && type != '') {
590: url += '&type='+type;
591: }
592: if (type_elem != null && type_elem != '') {
593: url += '&typeelement='+type_elem;
594: }
1.872 raeburn 595: if (formname == 'ccrs') {
596: var ownername = document.forms[formid].ccuname.value;
597: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 598: url += '&cloner='+ownername+':'+ownerdom;
599: if (type == 'Course') {
600: url += '&crscode='+document.forms[formid].crscode.value;
601: }
1.1221 raeburn 602: }
603: if (formname == 'requestcrs') {
604: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 605: }
1.293 raeburn 606: if (multflag !=null && multflag != '') {
607: url += '&multiple='+multflag;
608: }
1.909 raeburn 609: var title = '$wintitle';
1.91 www 610: var options = 'scrollbars=1,resizable=1,menubar=0';
611: options += ',width=700,height=600';
612: stdeditbrowser = open(url,title,options,'1');
613: stdeditbrowser.focus();
614: }
1.876 raeburn 615: $id_functions
616: ENDSTDBRW
1.1116 raeburn 617: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
618: $output .= &setsec_javascript($sec_element,$formname,$role_element,
619: $credits_element);
1.876 raeburn 620: }
621: $output .= '
622: // ]]>
623: </script>';
624: return $output;
625: }
626:
627: sub javascript_index_functions {
628: return <<"ENDJS";
629:
630: function getFormIdByName(formname) {
631: for (var i=0;i<document.forms.length;i++) {
632: if (document.forms[i].name == formname) {
633: return i;
634: }
635: }
636: return -1;
637: }
638:
639: function getIndexByName(formid,item) {
640: for (var i=0;i<document.forms[formid].elements.length;i++) {
641: if (document.forms[formid].elements[i].name == item) {
642: return i;
643: }
644: }
645: return -1;
646: }
1.468 raeburn 647:
1.876 raeburn 648: function getDomainFromSelectbox(formname,udom) {
649: var userdom;
650: var formid = getFormIdByName(formname);
651: if (formid > -1) {
652: var domid = getIndexByName(formid,udom);
653: if (domid > -1) {
654: if (document.forms[formid].elements[domid].type == 'select-one') {
655: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
656: }
657: if (document.forms[formid].elements[domid].type == 'hidden') {
658: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 659: }
660: }
661: }
1.876 raeburn 662: return userdom;
663: }
664:
665: ENDJS
1.468 raeburn 666:
1.876 raeburn 667: }
668:
1.1017 raeburn 669: sub javascript_array_indexof {
1.1018 raeburn 670: return <<ENDJS;
1.1017 raeburn 671: <script type="text/javascript" language="JavaScript">
672: // <![CDATA[
673:
674: if (!Array.prototype.indexOf) {
675: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
676: "use strict";
677: if (this === void 0 || this === null) {
678: throw new TypeError();
679: }
680: var t = Object(this);
681: var len = t.length >>> 0;
682: if (len === 0) {
683: return -1;
684: }
685: var n = 0;
686: if (arguments.length > 0) {
687: n = Number(arguments[1]);
1.1088 foxr 688: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 689: n = 0;
690: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
691: n = (n > 0 || -1) * Math.floor(Math.abs(n));
692: }
693: }
694: if (n >= len) {
695: return -1;
696: }
697: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
698: for (; k < len; k++) {
699: if (k in t && t[k] === searchElement) {
700: return k;
701: }
702: }
703: return -1;
704: }
705: }
706:
707: // ]]>
708: </script>
709:
710: ENDJS
711:
712: }
713:
1.876 raeburn 714: sub userbrowser_javascript {
715: my $id_functions = &javascript_index_functions();
716: return <<"ENDUSERBRW";
717:
1.888 raeburn 718: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 719: var url = '/adm/pickuser?';
720: var userdom = getDomainFromSelectbox(formname,udom);
721: if (userdom != null) {
722: if (userdom != '') {
723: url += 'srchdom='+userdom+'&';
724: }
725: }
726: url += 'form=' + formname + '&unameelement='+uname+
727: '&udomelement='+udom+
728: '&ulastelement='+ulast+
729: '&ufirstelement='+ufirst+
730: '&uemailelement='+uemail+
1.881 raeburn 731: '&hideudomelement='+hideudom+
732: '&coursedom='+crsdom;
1.888 raeburn 733: if ((caller != null) && (caller != undefined)) {
734: url += '&caller='+caller;
735: }
1.876 raeburn 736: var title = 'User_Browser';
737: var options = 'scrollbars=1,resizable=1,menubar=0';
738: options += ',width=700,height=600';
739: var stdeditbrowser = open(url,title,options,'1');
740: stdeditbrowser.focus();
741: }
742:
1.888 raeburn 743: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 744: var formid = getFormIdByName(formname);
745: if (formid > -1) {
1.888 raeburn 746: var unameid = getIndexByName(formid,uname);
1.876 raeburn 747: var domid = getIndexByName(formid,udom);
748: var hidedomid = getIndexByName(formid,origdom);
749: if (hidedomid > -1) {
750: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 751: var unameval = document.forms[formid].elements[unameid].value;
752: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
753: if (domid > -1) {
754: var slct = document.forms[formid].elements[domid];
755: if (slct.type == 'select-one') {
756: var i;
757: for (i=0;i<slct.length;i++) {
758: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
759: }
760: }
761: if (slct.type == 'hidden') {
762: slct.value = fixeddom;
1.876 raeburn 763: }
764: }
1.468 raeburn 765: }
766: }
767: }
1.876 raeburn 768: return;
769: }
770:
771: $id_functions
772: ENDUSERBRW
1.468 raeburn 773: }
774:
775: sub setsec_javascript {
1.1116 raeburn 776: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 777: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
778: $communityrolestr);
779: if ($role_element ne '') {
780: my @allroles = ('st','ta','ep','in','ad');
781: foreach my $crstype ('Course','Community') {
782: if ($crstype eq 'Community') {
783: foreach my $role (@allroles) {
784: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
785: }
786: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
787: } else {
788: foreach my $role (@allroles) {
789: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
790: }
791: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
792: }
793: }
794: $rolestr = '"'.join('","',@allroles).'"';
795: $courserolestr = '"'.join('","',@courserolenames).'"';
796: $communityrolestr = '"'.join('","',@communityrolenames).'"';
797: }
1.468 raeburn 798: my $setsections = qq|
799: function setSect(sectionlist) {
1.629 raeburn 800: var sectionsArray = new Array();
801: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
802: sectionsArray = sectionlist.split(",");
803: }
1.468 raeburn 804: var numSections = sectionsArray.length;
805: document.$formname.$sec_element.length = 0;
806: if (numSections == 0) {
807: document.$formname.$sec_element.multiple=false;
808: document.$formname.$sec_element.size=1;
809: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
810: } else {
811: if (numSections == 1) {
812: document.$formname.$sec_element.multiple=false;
813: document.$formname.$sec_element.size=1;
814: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
815: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
816: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
817: } else {
818: for (var i=0; i<numSections; i++) {
819: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
820: }
821: document.$formname.$sec_element.multiple=true
822: if (numSections < 3) {
823: document.$formname.$sec_element.size=numSections;
824: } else {
825: document.$formname.$sec_element.size=3;
826: }
827: document.$formname.$sec_element.options[0].selected = false
828: }
829: }
1.91 www 830: }
1.905 raeburn 831:
832: function setRole(crstype) {
1.468 raeburn 833: |;
1.905 raeburn 834: if ($role_element eq '') {
835: $setsections .= ' return;
836: }
837: ';
838: } else {
839: $setsections .= qq|
840: var elementLength = document.$formname.$role_element.length;
841: var allroles = Array($rolestr);
842: var courserolenames = Array($courserolestr);
843: var communityrolenames = Array($communityrolestr);
844: if (elementLength != undefined) {
845: if (document.$formname.$role_element.options[5].value == 'cc') {
846: if (crstype == 'Course') {
847: return;
848: } else {
849: allroles[5] = 'co';
850: for (var i=0; i<6; i++) {
851: document.$formname.$role_element.options[i].value = allroles[i];
852: document.$formname.$role_element.options[i].text = communityrolenames[i];
853: }
854: }
855: } else {
856: if (crstype == 'Community') {
857: return;
858: } else {
859: allroles[5] = 'cc';
860: for (var i=0; i<6; i++) {
861: document.$formname.$role_element.options[i].value = allroles[i];
862: document.$formname.$role_element.options[i].text = courserolenames[i];
863: }
864: }
865: }
866: }
867: return;
868: }
869: |;
870: }
1.1116 raeburn 871: if ($credits_element) {
872: $setsections .= qq|
873: function setCredits(defaultcredits) {
874: document.$formname.$credits_element.value = defaultcredits;
875: return;
876: }
877: |;
878: }
1.468 raeburn 879: return $setsections;
880: }
881:
1.91 www 882: sub selectcourse_link {
1.909 raeburn 883: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
884: $typeelement) = @_;
885: my $type = $selecttype;
1.871 raeburn 886: my $linktext = &mt('Select Course');
887: if ($selecttype eq 'Community') {
1.909 raeburn 888: $linktext = &mt('Select Community');
1.1239 raeburn 889: } elsif ($selecttype eq 'Placement') {
890: $linktext = &mt('Select Placement Test');
1.906 raeburn 891: } elsif ($selecttype eq 'Course/Community') {
892: $linktext = &mt('Select Course/Community');
1.909 raeburn 893: $type = '';
1.1019 raeburn 894: } elsif ($selecttype eq 'Select') {
895: $linktext = &mt('Select');
896: $type = '';
1.871 raeburn 897: }
1.787 bisitz 898: return '<span class="LC_nobreak">'
899: ."<a href='"
900: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
901: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 902: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 903: ."'>".$linktext.'</a>'
1.787 bisitz 904: .'</span>';
1.74 www 905: }
1.42 matthew 906:
1.653 raeburn 907: sub selectauthor_link {
908: my ($form,$udom)=@_;
909: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
910: &mt('Select Author').'</a>';
911: }
912:
1.876 raeburn 913: sub selectuser_link {
1.881 raeburn 914: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 915: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 916: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 917: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 918: ');">'.$linktext.'</a>';
1.876 raeburn 919: }
920:
1.273 raeburn 921: sub check_uncheck_jscript {
922: my $jscript = <<"ENDSCRT";
923: function checkAll(field) {
924: if (field.length > 0) {
925: for (i = 0; i < field.length; i++) {
1.1093 raeburn 926: if (!field[i].disabled) {
927: field[i].checked = true;
928: }
1.273 raeburn 929: }
930: } else {
1.1093 raeburn 931: if (!field.disabled) {
932: field.checked = true;
933: }
1.273 raeburn 934: }
935: }
936:
937: function uncheckAll(field) {
938: if (field.length > 0) {
939: for (i = 0; i < field.length; i++) {
940: field[i].checked = false ;
1.543 albertel 941: }
942: } else {
1.273 raeburn 943: field.checked = false ;
944: }
945: }
946: ENDSCRT
947: return $jscript;
948: }
949:
1.656 www 950: sub select_timezone {
1.1256 raeburn 951: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
952: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 953: if ($includeempty) {
954: $output .= '<option value=""';
955: if (($selected eq '') || ($selected eq 'local')) {
956: $output .= ' selected="selected" ';
957: }
958: $output .= '> </option>';
959: }
1.657 raeburn 960: my @timezones = DateTime::TimeZone->all_names;
961: foreach my $tzone (@timezones) {
962: $output.= '<option value="'.$tzone.'"';
963: if ($tzone eq $selected) {
964: $output.=' selected="selected"';
965: }
966: $output.=">$tzone</option>\n";
1.656 www 967: }
968: $output.="</select>";
969: return $output;
970: }
1.273 raeburn 971:
1.687 raeburn 972: sub select_datelocale {
1.1256 raeburn 973: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
974: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 975: if ($includeempty) {
976: $output .= '<option value=""';
977: if ($selected eq '') {
978: $output .= ' selected="selected" ';
979: }
980: $output .= '> </option>';
981: }
1.1241 raeburn 982: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 983: my (@possibles,%locale_names);
1.1241 raeburn 984: my @locales = DateTime::Locale->ids();
985: foreach my $id (@locales) {
986: if ($id ne '') {
987: my ($en_terr,$native_terr);
988: my $loc = DateTime::Locale->load($id);
989: if (ref($loc)) {
990: $en_terr = $loc->name();
991: $native_terr = $loc->native_name();
1.687 raeburn 992: if (grep(/^en$/,@languages) || !@languages) {
993: if ($en_terr ne '') {
994: $locale_names{$id} = '('.$en_terr.')';
995: } elsif ($native_terr ne '') {
996: $locale_names{$id} = $native_terr;
997: }
998: } else {
999: if ($native_terr ne '') {
1000: $locale_names{$id} = $native_terr.' ';
1001: } elsif ($en_terr ne '') {
1002: $locale_names{$id} = '('.$en_terr.')';
1003: }
1004: }
1.1220 raeburn 1005: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1006: push(@possibles,$id);
1007: }
1.687 raeburn 1008: }
1009: }
1010: foreach my $item (sort(@possibles)) {
1011: $output.= '<option value="'.$item.'"';
1012: if ($item eq $selected) {
1013: $output.=' selected="selected"';
1014: }
1015: $output.=">$item";
1016: if ($locale_names{$item} ne '') {
1.1220 raeburn 1017: $output.=' '.$locale_names{$item};
1.687 raeburn 1018: }
1019: $output.="</option>\n";
1020: }
1021: $output.="</select>";
1022: return $output;
1023: }
1024:
1.792 raeburn 1025: sub select_language {
1.1256 raeburn 1026: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1027: my %langchoices;
1028: if ($includeempty) {
1.1117 raeburn 1029: %langchoices = ('' => 'No language preference');
1.792 raeburn 1030: }
1031: foreach my $id (&languageids()) {
1032: my $code = &supportedlanguagecode($id);
1033: if ($code) {
1034: $langchoices{$code} = &plainlanguagedescription($id);
1035: }
1036: }
1.1117 raeburn 1037: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256 raeburn 1038: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1039: }
1040:
1.42 matthew 1041: =pod
1.36 matthew 1042:
1.1088 foxr 1043:
1044: =item * &list_languages()
1045:
1046: Returns an array reference that is suitable for use in language prompters.
1047: Each array element is itself a two element array. The first element
1048: is the language code. The second element a descsriptiuon of the
1049: language itself. This is suitable for use in e.g.
1050: &Apache::edit::select_arg (once dereferenced that is).
1051:
1052: =cut
1053:
1054: sub list_languages {
1055: my @lang_choices;
1056:
1057: foreach my $id (&languageids()) {
1058: my $code = &supportedlanguagecode($id);
1059: if ($code) {
1060: my $selector = $supported_codes{$id};
1061: my $description = &plainlanguagedescription($id);
1.1263 raeburn 1062: push(@lang_choices, [$selector, $description]);
1.1088 foxr 1063: }
1064: }
1065: return \@lang_choices;
1066: }
1067:
1068: =pod
1069:
1.648 raeburn 1070: =item * &linked_select_forms(...)
1.36 matthew 1071:
1072: linked_select_forms returns a string containing a <script></script> block
1073: and html for two <select> menus. The select menus will be linked in that
1074: changing the value of the first menu will result in new values being placed
1075: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1076: order unless a defined order is provided.
1.36 matthew 1077:
1078: linked_select_forms takes the following ordered inputs:
1079:
1080: =over 4
1081:
1.112 bowersj2 1082: =item * $formname, the name of the <form> tag
1.36 matthew 1083:
1.112 bowersj2 1084: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1085:
1.112 bowersj2 1086: =item * $firstdefault, the default value for the first menu
1.36 matthew 1087:
1.112 bowersj2 1088: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1089:
1.112 bowersj2 1090: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1091:
1.112 bowersj2 1092: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1093:
1.609 raeburn 1094: =item * $menuorder, the order of values in the first menu
1095:
1.1115 raeburn 1096: =item * $onchangefirst, additional javascript call to execute for an onchange
1097: event for the first <select> tag
1098:
1099: =item * $onchangesecond, additional javascript call to execute for an onchange
1100: event for the second <select> tag
1101:
1.1245 raeburn 1102: =item * $suffix, to differentiate separate uses of select2data javascript
1103: objects in a page.
1104:
1.41 ng 1105: =back
1106:
1.36 matthew 1107: Below is an example of such a hash. Only the 'text', 'default', and
1108: 'select2' keys must appear as stated. keys(%menu) are the possible
1109: values for the first select menu. The text that coincides with the
1.41 ng 1110: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1111: and text for the second menu are given in the hash pointed to by
1112: $menu{$choice1}->{'select2'}.
1113:
1.112 bowersj2 1114: my %menu = ( A1 => { text =>"Choice A1" ,
1115: default => "B3",
1116: select2 => {
1117: B1 => "Choice B1",
1118: B2 => "Choice B2",
1119: B3 => "Choice B3",
1120: B4 => "Choice B4"
1.609 raeburn 1121: },
1122: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1123: },
1124: A2 => { text =>"Choice A2" ,
1125: default => "C2",
1126: select2 => {
1127: C1 => "Choice C1",
1128: C2 => "Choice C2",
1129: C3 => "Choice C3"
1.609 raeburn 1130: },
1131: order => ['C2','C1','C3'],
1.112 bowersj2 1132: },
1133: A3 => { text =>"Choice A3" ,
1134: default => "D6",
1135: select2 => {
1136: D1 => "Choice D1",
1137: D2 => "Choice D2",
1138: D3 => "Choice D3",
1139: D4 => "Choice D4",
1140: D5 => "Choice D5",
1141: D6 => "Choice D6",
1142: D7 => "Choice D7"
1.609 raeburn 1143: },
1144: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1145: }
1146: );
1.36 matthew 1147:
1148: =cut
1149:
1150: sub linked_select_forms {
1151: my ($formname,
1152: $middletext,
1153: $firstdefault,
1154: $firstselectname,
1155: $secondselectname,
1.609 raeburn 1156: $hashref,
1157: $menuorder,
1.1115 raeburn 1158: $onchangefirst,
1.1245 raeburn 1159: $onchangesecond,
1160: $suffix
1.36 matthew 1161: ) = @_;
1162: my $second = "document.$formname.$secondselectname";
1163: my $first = "document.$formname.$firstselectname";
1164: # output the javascript to do the changing
1165: my $result = '';
1.776 bisitz 1166: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1167: $result.="// <![CDATA[\n";
1.1245 raeburn 1168: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1169: $" = '","';
1170: my $debug = '';
1171: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1172: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1173: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1174: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1175: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1176: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1177: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1178: @s2values = @{$hashref->{$s1}->{'order'}};
1179: }
1.36 matthew 1180: $result.="\"@s2values\");\n";
1.1245 raeburn 1181: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1182: my @s2texts;
1183: foreach my $value (@s2values) {
1.1263 raeburn 1184: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1185: }
1186: $result.="\"@s2texts\");\n";
1187: }
1188: $"=' ';
1189: $result.= <<"END";
1190:
1.1245 raeburn 1191: function select1${suffix}_changed() {
1.36 matthew 1192: // Determine new choice
1.1245 raeburn 1193: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1194: // update select2
1.1245 raeburn 1195: var values = select2data${suffix}[newvalue].values;
1196: var texts = select2data${suffix}[newvalue].texts;
1197: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1198: var i;
1199: // out with the old
1.1245 raeburn 1200: $second.options.length = 0;
1201: // in with the new
1.36 matthew 1202: for (i=0;i<values.length; i++) {
1203: $second.options[i] = new Option(values[i]);
1.143 matthew 1204: $second.options[i].value = values[i];
1.36 matthew 1205: $second.options[i].text = texts[i];
1206: if (values[i] == select2def) {
1207: $second.options[i].selected = true;
1208: }
1209: }
1210: }
1.824 bisitz 1211: // ]]>
1.36 matthew 1212: </script>
1213: END
1214: # output the initial values for the selection lists
1.1245 raeburn 1215: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1216: my @order = sort(keys(%{$hashref}));
1217: if (ref($menuorder) eq 'ARRAY') {
1218: @order = @{$menuorder};
1219: }
1220: foreach my $value (@order) {
1.36 matthew 1221: $result.=" <option value=\"$value\" ";
1.253 albertel 1222: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1223: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1224: }
1225: $result .= "</select>\n";
1226: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1227: $result .= $middletext;
1.1115 raeburn 1228: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1229: if ($onchangesecond) {
1230: $result .= ' onchange="'.$onchangesecond.'"';
1231: }
1232: $result .= ">\n";
1.36 matthew 1233: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1234:
1235: my @secondorder = sort(keys(%select2));
1236: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1237: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1238: }
1239: foreach my $value (@secondorder) {
1.36 matthew 1240: $result.=" <option value=\"$value\" ";
1.253 albertel 1241: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1242: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1243: }
1244: $result .= "</select>\n";
1245: # return $debug;
1246: return $result;
1247: } # end of sub linked_select_forms {
1248:
1.45 matthew 1249: =pod
1.44 bowersj2 1250:
1.973 raeburn 1251: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1252:
1.112 bowersj2 1253: Returns a string corresponding to an HTML link to the given help
1254: $topic, where $topic corresponds to the name of a .tex file in
1255: /home/httpd/html/adm/help/tex, with underscores replaced by
1256: spaces.
1257:
1258: $text will optionally be linked to the same topic, allowing you to
1259: link text in addition to the graphic. If you do not want to link
1260: text, but wish to specify one of the later parameters, pass an
1261: empty string.
1262:
1263: $stayOnPage is a value that will be interpreted as a boolean. If true,
1264: the link will not open a new window. If false, the link will open
1265: a new window using Javascript. (Default is false.)
1266:
1267: $width and $height are optional numerical parameters that will
1268: override the width and height of the popped up window, which may
1.973 raeburn 1269: be useful for certain help topics with big pictures included.
1270:
1271: $imgid is the id of the img tag used for the help icon. This may be
1272: used in a javascript call to switch the image src. See
1273: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1274:
1275: =cut
1276:
1277: sub help_open_topic {
1.973 raeburn 1278: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1279: $text = "" if (not defined $text);
1.44 bowersj2 1280: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1281: $width = 500 if (not defined $width);
1.44 bowersj2 1282: $height = 400 if (not defined $height);
1283: my $filename = $topic;
1284: $filename =~ s/ /_/g;
1285:
1.48 bowersj2 1286: my $template = "";
1287: my $link;
1.572 banghart 1288:
1.159 www 1289: $topic=~s/\W/\_/g;
1.44 bowersj2 1290:
1.572 banghart 1291: if (!$stayOnPage) {
1.1033 www 1292: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1293: } elsif ($stayOnPage eq 'popup') {
1294: $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 1295: } else {
1.48 bowersj2 1296: $link = "/adm/help/${filename}.hlp";
1297: }
1298:
1299: # Add the text
1.755 neumanie 1300: if ($text ne "") {
1.763 bisitz 1301: $template.='<span class="LC_help_open_topic">'
1302: .'<a target="_top" href="'.$link.'">'
1303: .$text.'</a>';
1.48 bowersj2 1304: }
1305:
1.763 bisitz 1306: # (Always) Add the graphic
1.179 matthew 1307: my $title = &mt('Online Help');
1.667 raeburn 1308: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1309: if ($imgid ne '') {
1310: $imgid = ' id="'.$imgid.'"';
1311: }
1.763 bisitz 1312: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1313: .'<img src="'.$helpicon.'" border="0"'
1314: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1315: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1316: .' /></a>';
1317: if ($text ne "") {
1318: $template.='</span>';
1319: }
1.44 bowersj2 1320: return $template;
1321:
1.106 bowersj2 1322: }
1323:
1324: # This is a quicky function for Latex cheatsheet editing, since it
1325: # appears in at least four places
1326: sub helpLatexCheatsheet {
1.1037 www 1327: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1328: my $out;
1.106 bowersj2 1329: my $addOther = '';
1.732 raeburn 1330: if ($topic) {
1.1037 www 1331: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1332: }
1333: $out = '<span>' # Start cheatsheet
1334: .$addOther
1335: .'<span>'
1.1037 www 1336: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1337: .'</span> <span>'
1.1037 www 1338: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1339: .'</span>';
1.732 raeburn 1340: unless ($not_author) {
1.1186 kruse 1341: $out .= '<span>'
1342: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1343: .'</span> <span>'
1344: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1345: .'</span>';
1.732 raeburn 1346: }
1.763 bisitz 1347: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1348: return $out;
1.172 www 1349: }
1350:
1.430 albertel 1351: sub general_help {
1352: my $helptopic='Student_Intro';
1353: if ($env{'request.role'}=~/^(ca|au)/) {
1354: $helptopic='Authoring_Intro';
1.907 raeburn 1355: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1356: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1357: } elsif ($env{'request.role'}=~/^dc/) {
1358: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1359: }
1360: return $helptopic;
1361: }
1362:
1363: sub update_help_link {
1364: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1365: my $origurl = $ENV{'REQUEST_URI'};
1366: $origurl=~s|^/~|/priv/|;
1367: my $timestamp = time;
1368: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1369: $$datum = &escape($$datum);
1370: }
1371:
1372: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1373: my $output .= <<"ENDOUTPUT";
1374: <script type="text/javascript">
1.824 bisitz 1375: // <![CDATA[
1.430 albertel 1376: banner_link = '$banner_link';
1.824 bisitz 1377: // ]]>
1.430 albertel 1378: </script>
1379: ENDOUTPUT
1380: return $output;
1381: }
1382:
1383: # now just updates the help link and generates a blue icon
1.193 raeburn 1384: sub help_open_menu {
1.430 albertel 1385: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1386: = @_;
1.949 droeschl 1387: $stayOnPage = 1;
1.430 albertel 1388: my $output;
1389: if ($component_help) {
1390: if (!$text) {
1391: $output=&help_open_topic($component_help,undef,$stayOnPage,
1392: $width,$height);
1393: } else {
1394: my $help_text;
1395: $help_text=&unescape($topic);
1396: $output='<table><tr><td>'.
1397: &help_open_topic($component_help,$help_text,$stayOnPage,
1398: $width,$height).'</td></tr></table>';
1399: }
1400: }
1401: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1402: return $output.$banner_link;
1403: }
1404:
1405: sub top_nav_help {
1406: my ($text) = @_;
1.436 albertel 1407: $text = &mt($text);
1.949 droeschl 1408: my $stay_on_page = 1;
1409:
1.1168 raeburn 1410: my ($link,$banner_link);
1411: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1412: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1413: : "javascript:helpMenu('open')";
1414: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1415: }
1.201 raeburn 1416: my $title = &mt('Get help');
1.1168 raeburn 1417: if ($link) {
1418: return <<"END";
1.436 albertel 1419: $banner_link
1.1159 raeburn 1420: <a href="$link" title="$title">$text</a>
1.436 albertel 1421: END
1.1168 raeburn 1422: } else {
1423: return ' '.$text.' ';
1424: }
1.436 albertel 1425: }
1426:
1427: sub help_menu_js {
1.1154 raeburn 1428: my ($httphost) = @_;
1.949 droeschl 1429: my $stayOnPage = 1;
1.436 albertel 1430: my $width = 620;
1431: my $height = 600;
1.430 albertel 1432: my $helptopic=&general_help();
1.1154 raeburn 1433: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1434: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1435: my $start_page =
1436: &Apache::loncommon::start_page('Help Menu', undef,
1437: {'frameset' => 1,
1438: 'js_ready' => 1,
1.1154 raeburn 1439: 'use_absolute' => $httphost,
1.331 albertel 1440: 'add_entries' => {
1.1168 raeburn 1441: 'border' => '0',
1.579 raeburn 1442: 'rows' => "110,*",},});
1.331 albertel 1443: my $end_page =
1444: &Apache::loncommon::end_page({'frameset' => 1,
1445: 'js_ready' => 1,});
1446:
1.436 albertel 1447: my $template .= <<"ENDTEMPLATE";
1448: <script type="text/javascript">
1.877 bisitz 1449: // <![CDATA[
1.253 albertel 1450: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1451: var banner_link = '';
1.243 raeburn 1452: function helpMenu(target) {
1453: var caller = this;
1454: if (target == 'open') {
1455: var newWindow = null;
1456: try {
1.262 albertel 1457: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1458: }
1459: catch(error) {
1460: writeHelp(caller);
1461: return;
1462: }
1463: if (newWindow) {
1464: caller = newWindow;
1465: }
1.193 raeburn 1466: }
1.243 raeburn 1467: writeHelp(caller);
1468: return;
1469: }
1470: function writeHelp(caller) {
1.1168 raeburn 1471: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1472: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1473: caller.document.close();
1474: caller.focus();
1.193 raeburn 1475: }
1.877 bisitz 1476: // END LON-CAPA Internal -->
1.253 albertel 1477: // ]]>
1.436 albertel 1478: </script>
1.193 raeburn 1479: ENDTEMPLATE
1480: return $template;
1481: }
1482:
1.172 www 1483: sub help_open_bug {
1484: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1485: unless ($env{'user.adv'}) { return ''; }
1.172 www 1486: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1487: $text = "" if (not defined $text);
1488: $stayOnPage=1;
1.184 albertel 1489: $width = 600 if (not defined $width);
1490: $height = 600 if (not defined $height);
1.172 www 1491:
1492: $topic=~s/\W+/\+/g;
1493: my $link='';
1494: my $template='';
1.379 albertel 1495: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1496: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1497: if (!$stayOnPage)
1498: {
1499: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1500: }
1501: else
1502: {
1503: $link = $url;
1504: }
1505: # Add the text
1506: if ($text ne "")
1507: {
1508: $template .=
1509: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1510: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1511: }
1512:
1513: # Add the graphic
1.179 matthew 1514: my $title = &mt('Report a Bug');
1.215 albertel 1515: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1516: $template .= <<"ENDTEMPLATE";
1.436 albertel 1517: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1518: ENDTEMPLATE
1519: if ($text ne '') { $template.='</td></tr></table>' };
1520: return $template;
1521:
1522: }
1523:
1524: sub help_open_faq {
1525: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1526: unless ($env{'user.adv'}) { return ''; }
1.172 www 1527: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1528: $text = "" if (not defined $text);
1529: $stayOnPage=1;
1530: $width = 350 if (not defined $width);
1531: $height = 400 if (not defined $height);
1532:
1533: $topic=~s/\W+/\+/g;
1534: my $link='';
1535: my $template='';
1536: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1537: if (!$stayOnPage)
1538: {
1539: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1540: }
1541: else
1542: {
1543: $link = $url;
1544: }
1545:
1546: # Add the text
1547: if ($text ne "")
1548: {
1549: $template .=
1.173 www 1550: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1551: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1552: }
1553:
1554: # Add the graphic
1.179 matthew 1555: my $title = &mt('View the FAQ');
1.215 albertel 1556: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1557: $template .= <<"ENDTEMPLATE";
1.436 albertel 1558: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1559: ENDTEMPLATE
1560: if ($text ne '') { $template.='</td></tr></table>' };
1561: return $template;
1562:
1.44 bowersj2 1563: }
1.37 matthew 1564:
1.180 matthew 1565: ###############################################################
1566: ###############################################################
1567:
1.45 matthew 1568: =pod
1569:
1.648 raeburn 1570: =item * &change_content_javascript():
1.256 matthew 1571:
1572: This and the next function allow you to create small sections of an
1573: otherwise static HTML page that you can update on the fly with
1574: Javascript, even in Netscape 4.
1575:
1576: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1577: must be written to the HTML page once. It will prove the Javascript
1578: function "change(name, content)". Calling the change function with the
1579: name of the section
1580: you want to update, matching the name passed to C<changable_area>, and
1581: the new content you want to put in there, will put the content into
1582: that area.
1583:
1584: B<Note>: Netscape 4 only reserves enough space for the changable area
1585: to contain room for the original contents. You need to "make space"
1586: for whatever changes you wish to make, and be B<sure> to check your
1587: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1588: it's adequate for updating a one-line status display, but little more.
1589: This script will set the space to 100% width, so you only need to
1590: worry about height in Netscape 4.
1591:
1592: Modern browsers are much less limiting, and if you can commit to the
1593: user not using Netscape 4, this feature may be used freely with
1594: pretty much any HTML.
1595:
1596: =cut
1597:
1598: sub change_content_javascript {
1599: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1600: if ($env{'browser.type'} eq 'netscape' &&
1601: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1602: return (<<NETSCAPE4);
1603: function change(name, content) {
1604: doc = document.layers[name+"___escape"].layers[0].document;
1605: doc.open();
1606: doc.write(content);
1607: doc.close();
1608: }
1609: NETSCAPE4
1610: } else {
1611: # Otherwise, we need to use semi-standards-compliant code
1612: # (technically, "innerHTML" isn't standard but the equivalent
1613: # is really scary, and every useful browser supports it
1614: return (<<DOMBASED);
1615: function change(name, content) {
1616: element = document.getElementById(name);
1617: element.innerHTML = content;
1618: }
1619: DOMBASED
1620: }
1621: }
1622:
1623: =pod
1624:
1.648 raeburn 1625: =item * &changable_area($name,$origContent):
1.256 matthew 1626:
1627: This provides a "changable area" that can be modified on the fly via
1628: the Javascript code provided in C<change_content_javascript>. $name is
1629: the name you will use to reference the area later; do not repeat the
1630: same name on a given HTML page more then once. $origContent is what
1631: the area will originally contain, which can be left blank.
1632:
1633: =cut
1634:
1635: sub changable_area {
1636: my ($name, $origContent) = @_;
1637:
1.258 albertel 1638: if ($env{'browser.type'} eq 'netscape' &&
1639: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1640: # If this is netscape 4, we need to use the Layer tag
1641: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1642: } else {
1643: return "<span id='$name'>$origContent</span>";
1644: }
1645: }
1646:
1647: =pod
1648:
1.648 raeburn 1649: =item * &viewport_geometry_js
1.590 raeburn 1650:
1651: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1652:
1653: =cut
1654:
1655:
1656: sub viewport_geometry_js {
1657: return <<"GEOMETRY";
1658: var Geometry = {};
1659: function init_geometry() {
1660: if (Geometry.init) { return };
1661: Geometry.init=1;
1662: if (window.innerHeight) {
1663: Geometry.getViewportHeight = function() { return window.innerHeight; };
1664: Geometry.getViewportWidth = function() { return window.innerWidth; };
1665: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1666: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1667: }
1668: else if (document.documentElement && document.documentElement.clientHeight) {
1669: Geometry.getViewportHeight =
1670: function() { return document.documentElement.clientHeight; };
1671: Geometry.getViewportWidth =
1672: function() { return document.documentElement.clientWidth; };
1673:
1674: Geometry.getHorizontalScroll =
1675: function() { return document.documentElement.scrollLeft; };
1676: Geometry.getVerticalScroll =
1677: function() { return document.documentElement.scrollTop; };
1678: }
1679: else if (document.body.clientHeight) {
1680: Geometry.getViewportHeight =
1681: function() { return document.body.clientHeight; };
1682: Geometry.getViewportWidth =
1683: function() { return document.body.clientWidth; };
1684: Geometry.getHorizontalScroll =
1685: function() { return document.body.scrollLeft; };
1686: Geometry.getVerticalScroll =
1687: function() { return document.body.scrollTop; };
1688: }
1689: }
1690:
1691: GEOMETRY
1692: }
1693:
1694: =pod
1695:
1.648 raeburn 1696: =item * &viewport_size_js()
1.590 raeburn 1697:
1698: 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.
1699:
1700: =cut
1701:
1702: sub viewport_size_js {
1703: my $geometry = &viewport_geometry_js();
1704: return <<"DIMS";
1705:
1706: $geometry
1707:
1708: function getViewportDims(width,height) {
1709: init_geometry();
1710: width.value = Geometry.getViewportWidth();
1711: height.value = Geometry.getViewportHeight();
1712: return;
1713: }
1714:
1715: DIMS
1716: }
1717:
1718: =pod
1719:
1.648 raeburn 1720: =item * &resize_textarea_js()
1.565 albertel 1721:
1722: emits the needed javascript to resize a textarea to be as big as possible
1723:
1724: creates a function resize_textrea that takes two IDs first should be
1725: the id of the element to resize, second should be the id of a div that
1726: surrounds everything that comes after the textarea, this routine needs
1727: to be attached to the <body> for the onload and onresize events.
1728:
1.648 raeburn 1729: =back
1.565 albertel 1730:
1731: =cut
1732:
1733: sub resize_textarea_js {
1.590 raeburn 1734: my $geometry = &viewport_geometry_js();
1.565 albertel 1735: return <<"RESIZE";
1736: <script type="text/javascript">
1.824 bisitz 1737: // <![CDATA[
1.590 raeburn 1738: $geometry
1.565 albertel 1739:
1.588 albertel 1740: function getX(element) {
1741: var x = 0;
1742: while (element) {
1743: x += element.offsetLeft;
1744: element = element.offsetParent;
1745: }
1746: return x;
1747: }
1748: function getY(element) {
1749: var y = 0;
1750: while (element) {
1751: y += element.offsetTop;
1752: element = element.offsetParent;
1753: }
1754: return y;
1755: }
1756:
1757:
1.565 albertel 1758: function resize_textarea(textarea_id,bottom_id) {
1759: init_geometry();
1760: var textarea = document.getElementById(textarea_id);
1761: //alert(textarea);
1762:
1.588 albertel 1763: var textarea_top = getY(textarea);
1.565 albertel 1764: var textarea_height = textarea.offsetHeight;
1765: var bottom = document.getElementById(bottom_id);
1.588 albertel 1766: var bottom_top = getY(bottom);
1.565 albertel 1767: var bottom_height = bottom.offsetHeight;
1768: var window_height = Geometry.getViewportHeight();
1.588 albertel 1769: var fudge = 23;
1.565 albertel 1770: var new_height = window_height-fudge-textarea_top-bottom_height;
1771: if (new_height < 300) {
1772: new_height = 300;
1773: }
1774: textarea.style.height=new_height+'px';
1775: }
1.824 bisitz 1776: // ]]>
1.565 albertel 1777: </script>
1778: RESIZE
1779:
1780: }
1781:
1.1205 golterma 1782: sub colorfuleditor_js {
1.1248 raeburn 1783: my $browse_or_search;
1784: my $respath;
1785: my ($cnum,$cdom) = &crsauthor_url();
1786: if ($cnum) {
1787: $respath = "/res/$cdom/$cnum/";
1788: my %js_lt = &Apache::lonlocal::texthash(
1789: sunm => 'Sub-directory name',
1790: save => 'Save page to make this permanent',
1791: );
1792: &js_escape(\%js_lt);
1793: $browse_or_search = <<"END";
1794:
1795: function toggleChooser(form,element,titleid,only,search) {
1796: var disp = 'none';
1797: if (document.getElementById('chooser_'+element)) {
1798: var curr = document.getElementById('chooser_'+element).style.display;
1799: if (curr == 'none') {
1800: disp='inline';
1801: if (form.elements['chooser_'+element].length) {
1802: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1803: form.elements['chooser_'+element][i].checked = false;
1804: }
1805: }
1806: toggleResImport(form,element);
1807: }
1808: document.getElementById('chooser_'+element).style.display = disp;
1809: }
1810: }
1811:
1812: function toggleCrsFile(form,element,numdirs) {
1813: if (document.getElementById('chooser_'+element+'_crsres')) {
1814: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1815: if (curr == 'none') {
1816: if (numdirs) {
1817: form.elements['coursepath_'+element].selectedIndex = 0;
1818: if (numdirs > 1) {
1819: window['select1'+element+'_changed']();
1820: }
1821: }
1822: }
1823: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1824:
1825: }
1826: if (document.getElementById('chooser_'+element+'_upload')) {
1827: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1828: if (document.getElementById('uploadcrsres_'+element)) {
1829: document.getElementById('uploadcrsres_'+element).value = '';
1830: }
1831: }
1832: return;
1833: }
1834:
1835: function toggleCrsUpload(form,element,numcrsdirs) {
1836: if (document.getElementById('chooser_'+element+'_crsres')) {
1837: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1838: }
1839: if (document.getElementById('chooser_'+element+'_upload')) {
1840: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1841: if (curr == 'none') {
1842: if (numcrsdirs) {
1843: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1844: form.elements['newsubdir_'+element][0].checked = true;
1845: toggleNewsubdir(form,element);
1846: }
1847: }
1848: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1849: }
1850: return;
1851: }
1852:
1853: function toggleResImport(form,element) {
1854: var choices = new Array('crsres','upload');
1855: for (var i=0; i<choices.length; i++) {
1856: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1857: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1858: }
1859: }
1860: }
1861:
1862: function toggleNewsubdir(form,element) {
1863: var newsub = form.elements['newsubdir_'+element];
1864: if (newsub) {
1865: if (newsub.length) {
1866: for (var j=0; j<newsub.length; j++) {
1867: if (newsub[j].checked) {
1868: if (document.getElementById('newsubdirname_'+element)) {
1869: if (newsub[j].value == '1') {
1870: document.getElementById('newsubdirname_'+element).type = "text";
1871: if (document.getElementById('newsubdir_'+element)) {
1872: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1873: }
1874: } else {
1875: document.getElementById('newsubdirname_'+element).type = "hidden";
1876: document.getElementById('newsubdirname_'+element).value = "";
1877: document.getElementById('newsubdir_'+element).innerHTML = "";
1878: }
1879: }
1880: break;
1881: }
1882: }
1883: }
1884: }
1885: }
1886:
1887: function updateCrsFile(form,element) {
1888: var directory = form.elements['coursepath_'+element];
1889: var filename = form.elements['coursefile_'+element];
1890: var path = directory.options[directory.selectedIndex].value;
1891: var file = filename.options[filename.selectedIndex].value;
1892: form.elements[element].value = '$respath';
1893: if (path == '/') {
1894: form.elements[element].value += file;
1895: } else {
1896: form.elements[element].value += path+'/'+file;
1897: }
1898: unClean();
1899: if (document.getElementById('previewimg_'+element)) {
1900: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1901: var newsrc = document.getElementById('previewimg_'+element).src;
1902: }
1903: if (document.getElementById('showimg_'+element)) {
1904: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1905: }
1906: toggleChooser(form,element);
1907: return;
1908: }
1909:
1910: function uploadDone(suffix,name) {
1911: if (name) {
1912: document.forms["lonhomework"].elements[suffix].value = name;
1913: unClean();
1914: toggleChooser(document.forms["lonhomework"],suffix);
1915: }
1916: }
1917:
1918: \$(document).ready(function(){
1919:
1920: \$(document).delegate('form :submit', 'click', function( event ) {
1921: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1922: var buttonId = this.id;
1923: var suffix = buttonId.toString();
1924: suffix = suffix.replace(/^crsupload_/,'');
1925: event.preventDefault();
1926: document.lonhomework.target = 'crsupload_target_'+suffix;
1927: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1928: \$(this.form).submit();
1929: document.lonhomework.target = '';
1930: if (document.getElementById('crsuploadto_'+suffix)) {
1931: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1932: }
1933: return false;
1934: }
1935: });
1936: });
1937: END
1938: }
1.1205 golterma 1939: return <<"COLORFULEDIT"
1940: <script type="text/javascript">
1941: // <![CDATA[>
1942: function fold_box(curDepth, lastresource){
1943:
1944: // we need a list because there can be several blocks you need to fold in one tag
1945: var block = document.getElementsByName('foldblock_'+curDepth);
1946: // but there is only one folding button per tag
1947: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1948:
1949: if(block.item(0).style.display == 'none'){
1950:
1951: foldbutton.value = '@{[&mt("Hide")]}';
1952: for (i = 0; i < block.length; i++){
1953: block.item(i).style.display = '';
1954: }
1955: }else{
1956:
1957: foldbutton.value = '@{[&mt("Show")]}';
1958: for (i = 0; i < block.length; i++){
1959: // block.item(i).style.visibility = 'collapse';
1960: block.item(i).style.display = 'none';
1961: }
1962: };
1963: saveState(lastresource);
1964: }
1965:
1966: function saveState (lastresource) {
1967:
1968: var tag_list = getTagList();
1969: if(tag_list != null){
1970: var timestamp = new Date().getTime();
1971: var key = lastresource;
1972:
1973: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1974: // starting with timestamp
1975: var value = timestamp+';';
1976:
1977: // building the list of key-value pairs
1978: for(var i = 0; i < tag_list.length; i++){
1979: value += tag_list[i]+',';
1980: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1981: }
1982:
1983: // only iterate whole storage if nothing to override
1984: if(localStorage.getItem(key) == null){
1985:
1986: // prevent storage from growing large
1987: if(localStorage.length > 50){
1988: var regex_getTimestamp = /^(?:\d)+;/;
1989: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1990: var oldest_key;
1991:
1992: for(var i = 1; i < localStorage.length; i++){
1993: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1994: oldest_key = localStorage.key(i);
1995: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1996: }
1997: }
1998: localStorage.removeItem(oldest_key);
1999: }
2000: }
2001: localStorage.setItem(key,value);
2002: }
2003: }
2004:
2005: // restore folding status of blocks (on page load)
2006: function restoreState (lastresource) {
2007: if(localStorage.getItem(lastresource) != null){
2008: var key = lastresource;
2009: var value = localStorage.getItem(key);
2010: var regex_delTimestamp = /^\d+;/;
2011:
2012: value.replace(regex_delTimestamp, '');
2013:
2014: var valueArr = value.split(';');
2015: var pairs;
2016: var elements;
2017: for (var i = 0; i < valueArr.length; i++){
2018: pairs = valueArr[i].split(',');
2019: elements = document.getElementsByName(pairs[0]);
2020:
2021: for (var j = 0; j < elements.length; j++){
2022: elements[j].style.display = pairs[1];
2023: if (pairs[1] == "none"){
2024: var regex_id = /([_\\d]+)\$/;
2025: regex_id.exec(pairs[0]);
2026: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2027: }
2028: }
2029: }
2030: }
2031: }
2032:
2033: function getTagList () {
2034:
2035: var stringToSearch = document.lonhomework.innerHTML;
2036:
2037: var ret = new Array();
2038: var regex_findBlock = /(foldblock_.*?)"/g;
2039: var tag_list = stringToSearch.match(regex_findBlock);
2040:
2041: if(tag_list != null){
2042: for(var i = 0; i < tag_list.length; i++){
2043: ret.push(tag_list[i].replace(/"/, ''));
2044: }
2045: }
2046: return ret;
2047: }
2048:
2049: function saveScrollPosition (resource) {
2050: var tag_list = getTagList();
2051:
2052: // we dont always want to jump to the first block
2053: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2054: if(\$(window).scrollTop() > 170){
2055: if(tag_list != null){
2056: var result;
2057: for(var i = 0; i < tag_list.length; i++){
2058: if(isElementInViewport(tag_list[i])){
2059: result += tag_list[i]+';';
2060: }
2061: }
2062: sessionStorage.setItem('anchor_'+resource, result);
2063: }
2064: } else {
2065: // we dont need to save zero, just delete the item to leave everything tidy
2066: sessionStorage.removeItem('anchor_'+resource);
2067: }
2068: }
2069:
2070: function restoreScrollPosition(resource){
2071:
2072: var elem = sessionStorage.getItem('anchor_'+resource);
2073: if(elem != null){
2074: var tag_list = elem.split(';');
2075: var elem_list;
2076:
2077: for(var i = 0; i < tag_list.length; i++){
2078: elem_list = document.getElementsByName(tag_list[i]);
2079:
2080: if(elem_list.length > 0){
2081: elem = elem_list[0];
2082: break;
2083: }
2084: }
2085: elem.scrollIntoView();
2086: }
2087: }
2088:
2089: function isElementInViewport(el) {
2090:
2091: // change to last element instead of first
2092: var elem = document.getElementsByName(el);
2093: var rect = elem[0].getBoundingClientRect();
2094:
2095: return (
2096: rect.top >= 0 &&
2097: rect.left >= 0 &&
2098: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2099: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2100: );
2101: }
2102:
2103: function autosize(depth){
2104: var cmInst = window['cm'+depth];
2105: var fitsizeButton = document.getElementById('fitsize'+depth);
2106:
2107: // is fixed size, switching to dynamic
2108: if (sessionStorage.getItem("autosized_"+depth) == null) {
2109: cmInst.setSize("","auto");
2110: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2111: sessionStorage.setItem("autosized_"+depth, "yes");
2112:
2113: // is dynamic size, switching to fixed
2114: } else {
2115: cmInst.setSize("","300px");
2116: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2117: sessionStorage.removeItem("autosized_"+depth);
2118: }
2119: }
2120:
1.1248 raeburn 2121: $browse_or_search
1.1205 golterma 2122:
2123: // ]]>
2124: </script>
2125: COLORFULEDIT
2126: }
2127:
2128: sub xmleditor_js {
2129: return <<XMLEDIT
2130: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2131: <script type="text/javascript">
2132: // <![CDATA[>
2133:
2134: function saveScrollPosition (resource) {
2135:
2136: var scrollPos = \$(window).scrollTop();
2137: sessionStorage.setItem(resource,scrollPos);
2138: }
2139:
2140: function restoreScrollPosition(resource){
2141:
2142: var scrollPos = sessionStorage.getItem(resource);
2143: \$(window).scrollTop(scrollPos);
2144: }
2145:
2146: // unless internet explorer
2147: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2148:
2149: \$(document).ready(function() {
2150: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2151: });
2152: }
2153:
2154: // inserts text at cursor position into codemirror (xml editor only)
2155: function insertText(text){
2156: cm.focus();
2157: var curPos = cm.getCursor();
2158: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2159: }
2160: // ]]>
2161: </script>
2162: XMLEDIT
2163: }
2164:
2165: sub insert_folding_button {
2166: my $curDepth = $Apache::lonxml::curdepth;
2167: my $lastresource = $env{'request.ambiguous'};
2168:
2169: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2170: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2171: }
2172:
1.1248 raeburn 2173: sub crsauthor_url {
2174: my ($url) = @_;
2175: if ($url eq '') {
2176: $url = $ENV{'REQUEST_URI'};
2177: }
2178: my ($cnum,$cdom);
2179: if ($env{'request.course.id'}) {
2180: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2181: if ($audom ne '' && $auname ne '') {
2182: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2183: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2184: $cnum = $auname;
2185: $cdom = $audom;
2186: }
2187: }
2188: }
2189: return ($cnum,$cdom);
2190: }
2191:
2192: sub import_crsauthor_form {
1.1265 raeburn 2193: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2194: return (0) unless ($env{'request.course.id'});
2195: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2196: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2197: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2198: return (0) unless (($cnum ne '') && ($cdom ne ''));
2199: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2200: my @ids=&Apache::lonnet::current_machine_ids();
2201: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2202:
2203: if (grep(/^\Q$crshome\E$/,@ids)) {
2204: $is_home = 1;
2205: }
2206: $relpath = "/priv/$cdom/$cnum";
2207: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2208: my %lt = &Apache::lonlocal::texthash (
2209: fnam => 'Filename',
2210: dire => 'Directory',
2211: );
2212: my $numdirs = scalar(keys(%files));
2213: my (%possexts,$singledir,@singledirfiles);
2214: if ($only) {
2215: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2216: }
2217: my (%nonemptydirs,$possdirs);
2218: if ($numdirs > 1) {
2219: my @order;
2220: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2221: if (ref($files{$key}) eq 'HASH') {
2222: my $shown = $key;
2223: if ($key eq '') {
2224: $shown = '/';
2225: }
2226: my @ordered = ();
2227: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
2228: if ($only) {
2229: my ($ext) = ($file =~ /\.([^.]+)$/);
2230: unless ($possexts{lc($ext)}) {
2231: next;
2232: }
2233: }
2234: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2235: push(@ordered,$file);
2236: }
2237: if (@ordered) {
2238: push(@order,$key);
2239: $nonemptydirs{$key} = 1;
2240: $selimport_menus{$key}->{'text'} = $shown;
2241: $selimport_menus{$key}->{'default'} = '';
2242: $selimport_menus{$key}->{'select2'}->{''} = '';
2243: $selimport_menus{$key}->{'order'} = \@ordered;
2244: }
2245: }
2246: }
2247: $possdirs = scalar(keys(%nonemptydirs));
2248: if ($possdirs > 1) {
2249: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2250: $output = $lt{'dire'}.
2251: &linked_select_forms($form,'<br />'.
2252: $lt{'fnam'},'',
2253: $firstselectname,$secondselectname,
2254: \%selimport_menus,\@order,
2255: $onchangefirst,'',$suffix).'<br />';
2256: } elsif ($possdirs == 1) {
2257: $singledir = (keys(%nonemptydirs))[0];
2258: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2259: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2260: }
2261: delete($selimport_menus{$singledir});
2262: }
2263: } elsif ($numdirs == 1) {
2264: $singledir = (keys(%files))[0];
2265: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2266: if ($only) {
2267: my ($ext) = ($file =~ /\.([^.]+)$/);
2268: unless ($possexts{lc($ext)}) {
2269: next;
2270: }
2271: }
2272: push(@singledirfiles,$file);
2273: }
2274: if (@singledirfiles) {
2275: $possdirs == 1;
2276: }
2277: }
2278: if (($possdirs == 1) && (@singledirfiles)) {
2279: my $showdir = $singledir;
2280: if ($singledir eq '') {
2281: $showdir = '/';
2282: }
2283: $output = $lt{'dire'}.
2284: '<select name="'.$firstselectname.'">'.
2285: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2286: '</select><br />'.
2287: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2288: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2289: foreach my $file (@singledirfiles) {
2290: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2291: }
2292: $output .= '</select><br />'."\n";
2293: }
2294: return ($possdirs,$output);
2295: }
2296:
1.565 albertel 2297: =pod
2298:
1.256 matthew 2299: =head1 Excel and CSV file utility routines
2300:
2301: =cut
2302:
2303: ###############################################################
2304: ###############################################################
2305:
2306: =pod
2307:
1.1162 raeburn 2308: =over 4
2309:
1.648 raeburn 2310: =item * &csv_translate($text)
1.37 matthew 2311:
1.185 www 2312: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2313: format.
2314:
2315: =cut
2316:
1.180 matthew 2317: ###############################################################
2318: ###############################################################
1.37 matthew 2319: sub csv_translate {
2320: my $text = shift;
2321: $text =~ s/\"/\"\"/g;
1.209 albertel 2322: $text =~ s/\n/ /g;
1.37 matthew 2323: return $text;
2324: }
1.180 matthew 2325:
2326: ###############################################################
2327: ###############################################################
2328:
2329: =pod
2330:
1.648 raeburn 2331: =item * &define_excel_formats()
1.180 matthew 2332:
2333: Define some commonly used Excel cell formats.
2334:
2335: Currently supported formats:
2336:
2337: =over 4
2338:
2339: =item header
2340:
2341: =item bold
2342:
2343: =item h1
2344:
2345: =item h2
2346:
2347: =item h3
2348:
1.256 matthew 2349: =item h4
2350:
2351: =item i
2352:
1.180 matthew 2353: =item date
2354:
2355: =back
2356:
2357: Inputs: $workbook
2358:
2359: Returns: $format, a hash reference.
2360:
1.1057 foxr 2361:
1.180 matthew 2362: =cut
2363:
2364: ###############################################################
2365: ###############################################################
2366: sub define_excel_formats {
2367: my ($workbook) = @_;
2368: my $format;
2369: $format->{'header'} = $workbook->add_format(bold => 1,
2370: bottom => 1,
2371: align => 'center');
2372: $format->{'bold'} = $workbook->add_format(bold=>1);
2373: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2374: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2375: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2376: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2377: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2378: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2379: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2380: return $format;
2381: }
2382:
2383: ###############################################################
2384: ###############################################################
1.113 bowersj2 2385:
2386: =pod
2387:
1.648 raeburn 2388: =item * &create_workbook()
1.255 matthew 2389:
2390: Create an Excel worksheet. If it fails, output message on the
2391: request object and return undefs.
2392:
2393: Inputs: Apache request object
2394:
2395: Returns (undef) on failure,
2396: Excel worksheet object, scalar with filename, and formats
2397: from &Apache::loncommon::define_excel_formats on success
2398:
2399: =cut
2400:
2401: ###############################################################
2402: ###############################################################
2403: sub create_workbook {
2404: my ($r) = @_;
2405: #
2406: # Create the excel spreadsheet
2407: my $filename = '/prtspool/'.
1.258 albertel 2408: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2409: time.'_'.rand(1000000000).'.xls';
2410: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2411: if (! defined($workbook)) {
2412: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2413: $r->print(
2414: '<p class="LC_error">'
2415: .&mt('Problems occurred in creating the new Excel file.')
2416: .' '.&mt('This error has been logged.')
2417: .' '.&mt('Please alert your LON-CAPA administrator.')
2418: .'</p>'
2419: );
1.255 matthew 2420: return (undef);
2421: }
2422: #
1.1014 foxr 2423: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2424: #
2425: my $format = &Apache::loncommon::define_excel_formats($workbook);
2426: return ($workbook,$filename,$format);
2427: }
2428:
2429: ###############################################################
2430: ###############################################################
2431:
2432: =pod
2433:
1.648 raeburn 2434: =item * &create_text_file()
1.113 bowersj2 2435:
1.542 raeburn 2436: Create a file to write to and eventually make available to the user.
1.256 matthew 2437: If file creation fails, outputs an error message on the request object and
2438: return undefs.
1.113 bowersj2 2439:
1.256 matthew 2440: Inputs: Apache request object, and file suffix
1.113 bowersj2 2441:
1.256 matthew 2442: Returns (undef) on failure,
2443: Filehandle and filename on success.
1.113 bowersj2 2444:
2445: =cut
2446:
1.256 matthew 2447: ###############################################################
2448: ###############################################################
2449: sub create_text_file {
2450: my ($r,$suffix) = @_;
2451: if (! defined($suffix)) { $suffix = 'txt'; };
2452: my $fh;
2453: my $filename = '/prtspool/'.
1.258 albertel 2454: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2455: time.'_'.rand(1000000000).'.'.$suffix;
2456: $fh = Apache::File->new('>/home/httpd'.$filename);
2457: if (! defined($fh)) {
2458: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2459: $r->print(
2460: '<p class="LC_error">'
2461: .&mt('Problems occurred in creating the output file.')
2462: .' '.&mt('This error has been logged.')
2463: .' '.&mt('Please alert your LON-CAPA administrator.')
2464: .'</p>'
2465: );
1.113 bowersj2 2466: }
1.256 matthew 2467: return ($fh,$filename)
1.113 bowersj2 2468: }
2469:
2470:
1.256 matthew 2471: =pod
1.113 bowersj2 2472:
2473: =back
2474:
2475: =cut
1.37 matthew 2476:
2477: ###############################################################
1.33 matthew 2478: ## Home server <option> list generating code ##
2479: ###############################################################
1.35 matthew 2480:
1.169 www 2481: # ------------------------------------------
2482:
2483: sub domain_select {
1.1289 raeburn 2484: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2485: my @possdoms;
2486: if (ref($incdoms) eq 'ARRAY') {
2487: @possdoms = @{$incdoms};
2488: } else {
2489: @possdoms = &Apache::lonnet::all_domains();
2490: }
2491:
1.169 www 2492: my %domains=map {
1.514 albertel 2493: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2494: } @possdoms;
2495:
2496: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2497: foreach my $dom (@{$excdoms}) {
2498: delete($domains{$dom});
2499: }
2500: }
2501:
1.169 www 2502: if ($multiple) {
2503: $domains{''}=&mt('Any domain');
1.550 albertel 2504: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2505: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2506: } else {
1.550 albertel 2507: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2508: return &select_form($name,$value,\%domains);
1.169 www 2509: }
2510: }
2511:
1.282 albertel 2512: #-------------------------------------------
2513:
2514: =pod
2515:
1.519 raeburn 2516: =head1 Routines for form select boxes
2517:
2518: =over 4
2519:
1.648 raeburn 2520: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2521:
2522: Returns a string containing a <select> element int multiple mode
2523:
2524:
2525: Args:
2526: $name - name of the <select> element
1.506 raeburn 2527: $value - scalar or array ref of values that should already be selected
1.282 albertel 2528: $size - number of rows long the select element is
1.283 albertel 2529: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2530: (shown text should already have been &mt())
1.506 raeburn 2531: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2532:
1.282 albertel 2533: =cut
2534:
2535: #-------------------------------------------
1.169 www 2536: sub multiple_select_form {
1.284 albertel 2537: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2538: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2539: my $output='';
1.191 matthew 2540: if (! defined($size)) {
2541: $size = 4;
1.283 albertel 2542: if (scalar(keys(%$hash))<4) {
2543: $size = scalar(keys(%$hash));
1.191 matthew 2544: }
2545: }
1.734 bisitz 2546: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2547: my @order;
1.506 raeburn 2548: if (ref($order) eq 'ARRAY') {
2549: @order = @{$order};
2550: } else {
2551: @order = sort(keys(%$hash));
1.501 banghart 2552: }
2553: if (exists($$hash{'select_form_order'})) {
2554: @order = @{$$hash{'select_form_order'}};
2555: }
2556:
1.284 albertel 2557: foreach my $key (@order) {
1.356 albertel 2558: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2559: $output.='selected="selected" ' if ($selected{$key});
2560: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2561: }
2562: $output.="</select>\n";
2563: return $output;
2564: }
2565:
1.88 www 2566: #-------------------------------------------
2567:
2568: =pod
2569:
1.1254 raeburn 2570: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2571:
2572: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2573: allow a user to select options from a ref to a hash containing:
2574: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2575: a javascript onchange item, e.g., onchange="this.form.submit();".
2576: An optional arg -- $readonly -- if true will cause the select form
2577: to be disabled, e.g., for the case where an instructor has a section-
2578: specific role, and is viewing/modifying parameters.
1.970 raeburn 2579:
1.88 www 2580: See lonrights.pm for an example invocation and use.
2581:
2582: =cut
2583:
2584: #-------------------------------------------
2585: sub select_form {
1.1228 raeburn 2586: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2587: return unless (ref($hashref) eq 'HASH');
2588: if ($onchange) {
2589: $onchange = ' onchange="'.$onchange.'"';
2590: }
1.1228 raeburn 2591: my $disabled;
2592: if ($readonly) {
2593: $disabled = ' disabled="disabled"';
2594: }
2595: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2596: my @keys;
1.970 raeburn 2597: if (exists($hashref->{'select_form_order'})) {
2598: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2599: } else {
1.970 raeburn 2600: @keys=sort(keys(%{$hashref}));
1.128 albertel 2601: }
1.356 albertel 2602: foreach my $key (@keys) {
2603: $selectform.=
2604: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2605: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2606: ">".$hashref->{$key}."</option>\n";
1.88 www 2607: }
2608: $selectform.="</select>";
2609: return $selectform;
2610: }
2611:
1.475 www 2612: # For display filters
2613:
2614: sub display_filter {
1.1074 raeburn 2615: my ($context) = @_;
1.475 www 2616: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2617: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2618: my $phraseinput = 'hidden';
2619: my $includeinput = 'hidden';
2620: my ($checked,$includetypestext);
2621: if ($env{'form.displayfilter'} eq 'containing') {
2622: $phraseinput = 'text';
2623: if ($context eq 'parmslog') {
2624: $includeinput = 'checkbox';
2625: if ($env{'form.includetypes'}) {
2626: $checked = ' checked="checked"';
2627: }
2628: $includetypestext = &mt('Include parameter types');
2629: }
2630: } else {
2631: $includetypestext = ' ';
2632: }
2633: my ($additional,$secondid,$thirdid);
2634: if ($context eq 'parmslog') {
2635: $additional =
2636: '<label><input type="'.$includeinput.'" name="includetypes"'.
2637: $checked.' name="includetypes" value="1" id="includetypes" />'.
2638: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2639: '</label>';
2640: $secondid = 'includetypes';
2641: $thirdid = 'includetypestext';
2642: }
2643: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2644: '$secondid','$thirdid')";
2645: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2646: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2647: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2648: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2649: &mt('Filter: [_1]',
1.477 www 2650: &select_form($env{'form.displayfilter'},
2651: 'displayfilter',
1.970 raeburn 2652: {'currentfolder' => 'Current folder/page',
1.477 www 2653: 'containing' => 'Containing phrase',
1.1074 raeburn 2654: 'none' => 'None'},$onchange)).' '.
2655: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2656: &HTML::Entities::encode($env{'form.containingphrase'}).
2657: '" />'.$additional;
2658: }
2659:
2660: sub display_filter_js {
2661: my $includetext = &mt('Include parameter types');
2662: return <<"ENDJS";
2663:
2664: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2665: var firstType = 'hidden';
2666: if (setter.options[setter.selectedIndex].value == 'containing') {
2667: firstType = 'text';
2668: }
2669: firstObject = document.getElementById(firstid);
2670: if (typeof(firstObject) == 'object') {
2671: if (firstObject.type != firstType) {
2672: changeInputType(firstObject,firstType);
2673: }
2674: }
2675: if (context == 'parmslog') {
2676: var secondType = 'hidden';
2677: if (firstType == 'text') {
2678: secondType = 'checkbox';
2679: }
2680: secondObject = document.getElementById(secondid);
2681: if (typeof(secondObject) == 'object') {
2682: if (secondObject.type != secondType) {
2683: changeInputType(secondObject,secondType);
2684: }
2685: }
2686: var textItem = document.getElementById(thirdid);
2687: var currtext = textItem.innerHTML;
2688: var newtext;
2689: if (firstType == 'text') {
2690: newtext = '$includetext';
2691: } else {
2692: newtext = ' ';
2693: }
2694: if (currtext != newtext) {
2695: textItem.innerHTML = newtext;
2696: }
2697: }
2698: return;
2699: }
2700:
2701: function changeInputType(oldObject,newType) {
2702: var newObject = document.createElement('input');
2703: newObject.type = newType;
2704: if (oldObject.size) {
2705: newObject.size = oldObject.size;
2706: }
2707: if (oldObject.value) {
2708: newObject.value = oldObject.value;
2709: }
2710: if (oldObject.name) {
2711: newObject.name = oldObject.name;
2712: }
2713: if (oldObject.id) {
2714: newObject.id = oldObject.id;
2715: }
2716: oldObject.parentNode.replaceChild(newObject,oldObject);
2717: return;
2718: }
2719:
2720: ENDJS
1.475 www 2721: }
2722:
1.167 www 2723: sub gradeleveldescription {
2724: my $gradelevel=shift;
2725: my %gradelevels=(0 => 'Not specified',
2726: 1 => 'Grade 1',
2727: 2 => 'Grade 2',
2728: 3 => 'Grade 3',
2729: 4 => 'Grade 4',
2730: 5 => 'Grade 5',
2731: 6 => 'Grade 6',
2732: 7 => 'Grade 7',
2733: 8 => 'Grade 8',
2734: 9 => 'Grade 9',
2735: 10 => 'Grade 10',
2736: 11 => 'Grade 11',
2737: 12 => 'Grade 12',
2738: 13 => 'Grade 13',
2739: 14 => '100 Level',
2740: 15 => '200 Level',
2741: 16 => '300 Level',
2742: 17 => '400 Level',
2743: 18 => 'Graduate Level');
2744: return &mt($gradelevels{$gradelevel});
2745: }
2746:
1.163 www 2747: sub select_level_form {
2748: my ($deflevel,$name)=@_;
2749: unless ($deflevel) { $deflevel=0; }
1.167 www 2750: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2751: for (my $i=0; $i<=18; $i++) {
2752: $selectform.="<option value=\"$i\" ".
1.253 albertel 2753: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2754: ">".&gradeleveldescription($i)."</option>\n";
2755: }
2756: $selectform.="</select>";
2757: return $selectform;
1.163 www 2758: }
1.167 www 2759:
1.35 matthew 2760: #-------------------------------------------
2761:
1.45 matthew 2762: =pod
2763:
1.1256 raeburn 2764: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2765:
2766: Returns a string containing a <select name='$name' size='1'> form to
2767: allow a user to select the domain to preform an operation in.
2768: See loncreateuser.pm for an example invocation and use.
2769:
1.90 www 2770: If the $includeempty flag is set, it also includes an empty choice ("no domain
2771: selected");
2772:
1.743 raeburn 2773: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2774:
1.910 raeburn 2775: 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.
2776:
1.1121 raeburn 2777: The optional $incdoms is a reference to an array of domains which will be the only available options.
2778:
2779: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2780:
1.1256 raeburn 2781: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2782:
1.35 matthew 2783: =cut
2784:
2785: #-------------------------------------------
1.34 matthew 2786: sub select_dom_form {
1.1256 raeburn 2787: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2788: if ($onchange) {
1.874 raeburn 2789: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2790: }
1.1256 raeburn 2791: if ($disabled) {
2792: $disabled = ' disabled="disabled"';
2793: }
1.1121 raeburn 2794: my (@domains,%exclude);
1.910 raeburn 2795: if (ref($incdoms) eq 'ARRAY') {
2796: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2797: } else {
2798: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2799: }
1.90 www 2800: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2801: if (ref($excdoms) eq 'ARRAY') {
2802: map { $exclude{$_} = 1; } @{$excdoms};
2803: }
1.1256 raeburn 2804: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2805: foreach my $dom (@domains) {
1.1121 raeburn 2806: next if ($exclude{$dom});
1.356 albertel 2807: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2808: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2809: if ($showdomdesc) {
2810: if ($dom ne '') {
2811: my $domdesc = &Apache::lonnet::domain($dom,'description');
2812: if ($domdesc ne '') {
2813: $selectdomain .= ' ('.$domdesc.')';
2814: }
2815: }
2816: }
2817: $selectdomain .= "</option>\n";
1.34 matthew 2818: }
2819: $selectdomain.="</select>";
2820: return $selectdomain;
2821: }
2822:
1.35 matthew 2823: #-------------------------------------------
2824:
1.45 matthew 2825: =pod
2826:
1.648 raeburn 2827: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2828:
1.586 raeburn 2829: input: 4 arguments (two required, two optional) -
2830: $domain - domain of new user
2831: $name - name of form element
2832: $default - Value of 'default' causes a default item to be first
2833: option, and selected by default.
2834: $hide - Value of 'hide' causes hiding of the name of the server,
2835: if 1 server found, or default, if 0 found.
1.594 raeburn 2836: output: returns 2 items:
1.586 raeburn 2837: (a) form element which contains either:
2838: (i) <select name="$name">
2839: <option value="$hostid1">$hostid $servers{$hostid}</option>
2840: <option value="$hostid2">$hostid $servers{$hostid}</option>
2841: </select>
2842: form item if there are multiple library servers in $domain, or
2843: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2844: if there is only one library server in $domain.
2845:
2846: (b) number of library servers found.
2847:
2848: See loncreateuser.pm for example of use.
1.35 matthew 2849:
2850: =cut
2851:
2852: #-------------------------------------------
1.586 raeburn 2853: sub home_server_form_item {
2854: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2855: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2856: my $result;
2857: my $numlib = keys(%servers);
2858: if ($numlib > 1) {
2859: $result .= '<select name="'.$name.'" />'."\n";
2860: if ($default) {
1.804 bisitz 2861: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2862: '</option>'."\n";
2863: }
2864: foreach my $hostid (sort(keys(%servers))) {
2865: $result.= '<option value="'.$hostid.'">'.
2866: $hostid.' '.$servers{$hostid}."</option>\n";
2867: }
2868: $result .= '</select>'."\n";
2869: } elsif ($numlib == 1) {
2870: my $hostid;
2871: foreach my $item (keys(%servers)) {
2872: $hostid = $item;
2873: }
2874: $result .= '<input type="hidden" name="'.$name.'" value="'.
2875: $hostid.'" />';
2876: if (!$hide) {
2877: $result .= $hostid.' '.$servers{$hostid};
2878: }
2879: $result .= "\n";
2880: } elsif ($default) {
2881: $result .= '<input type="hidden" name="'.$name.
2882: '" value="default" />';
2883: if (!$hide) {
2884: $result .= &mt('default');
2885: }
2886: $result .= "\n";
1.33 matthew 2887: }
1.586 raeburn 2888: return ($result,$numlib);
1.33 matthew 2889: }
1.112 bowersj2 2890:
2891: =pod
2892:
1.534 albertel 2893: =back
2894:
1.112 bowersj2 2895: =cut
1.87 matthew 2896:
2897: ###############################################################
1.112 bowersj2 2898: ## Decoding User Agent ##
1.87 matthew 2899: ###############################################################
2900:
2901: =pod
2902:
1.112 bowersj2 2903: =head1 Decoding the User Agent
2904:
2905: =over 4
2906:
2907: =item * &decode_user_agent()
1.87 matthew 2908:
2909: Inputs: $r
2910:
2911: Outputs:
2912:
2913: =over 4
2914:
1.112 bowersj2 2915: =item * $httpbrowser
1.87 matthew 2916:
1.112 bowersj2 2917: =item * $clientbrowser
1.87 matthew 2918:
1.112 bowersj2 2919: =item * $clientversion
1.87 matthew 2920:
1.112 bowersj2 2921: =item * $clientmathml
1.87 matthew 2922:
1.112 bowersj2 2923: =item * $clientunicode
1.87 matthew 2924:
1.112 bowersj2 2925: =item * $clientos
1.87 matthew 2926:
1.1137 raeburn 2927: =item * $clientmobile
2928:
1.1141 raeburn 2929: =item * $clientinfo
2930:
1.1194 raeburn 2931: =item * $clientosversion
2932:
1.87 matthew 2933: =back
2934:
1.157 matthew 2935: =back
2936:
1.87 matthew 2937: =cut
2938:
2939: ###############################################################
2940: ###############################################################
2941: sub decode_user_agent {
1.247 albertel 2942: my ($r)=@_;
1.87 matthew 2943: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2944: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2945: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2946: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2947: my $clientbrowser='unknown';
2948: my $clientversion='0';
2949: my $clientmathml='';
2950: my $clientunicode='0';
1.1137 raeburn 2951: my $clientmobile=0;
1.1194 raeburn 2952: my $clientosversion='';
1.87 matthew 2953: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2954: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2955: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2956: $clientbrowser=$bname;
2957: $httpbrowser=~/$vreg/i;
2958: $clientversion=$1;
2959: $clientmathml=($clientversion>=$minv);
2960: $clientunicode=($clientversion>=$univ);
2961: }
2962: }
2963: my $clientos='unknown';
1.1141 raeburn 2964: my $clientinfo;
1.87 matthew 2965: if (($httpbrowser=~/linux/i) ||
2966: ($httpbrowser=~/unix/i) ||
2967: ($httpbrowser=~/ux/i) ||
2968: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2969: if (($httpbrowser=~/vax/i) ||
2970: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2971: if ($httpbrowser=~/next/i) { $clientos='next'; }
2972: if (($httpbrowser=~/mac/i) ||
2973: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2974: if ($httpbrowser=~/win/i) {
2975: $clientos='win';
2976: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2977: $clientosversion = $1;
2978: }
2979: }
1.87 matthew 2980: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2981: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2982: $clientmobile=lc($1);
2983: }
1.1141 raeburn 2984: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2985: $clientinfo = 'firefox-'.$1;
2986: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2987: $clientinfo = 'chromeframe-'.$1;
2988: }
1.87 matthew 2989: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2990: $clientunicode,$clientos,$clientmobile,$clientinfo,
2991: $clientosversion);
1.87 matthew 2992: }
2993:
1.32 matthew 2994: ###############################################################
2995: ## Authentication changing form generation subroutines ##
2996: ###############################################################
2997: ##
2998: ## All of the authform_xxxxxxx subroutines take their inputs in a
2999: ## hash, and have reasonable default values.
3000: ##
3001: ## formname = the name given in the <form> tag.
1.35 matthew 3002: #-------------------------------------------
3003:
1.45 matthew 3004: =pod
3005:
1.112 bowersj2 3006: =head1 Authentication Routines
3007:
3008: =over 4
3009:
1.648 raeburn 3010: =item * &authform_xxxxxx()
1.35 matthew 3011:
3012: The authform_xxxxxx subroutines provide javascript and html forms which
3013: handle some of the conveniences required for authentication forms.
3014: This is not an optimal method, but it works.
3015:
3016: =over 4
3017:
1.112 bowersj2 3018: =item * authform_header
1.35 matthew 3019:
1.112 bowersj2 3020: =item * authform_authorwarning
1.35 matthew 3021:
1.112 bowersj2 3022: =item * authform_nochange
1.35 matthew 3023:
1.112 bowersj2 3024: =item * authform_kerberos
1.35 matthew 3025:
1.112 bowersj2 3026: =item * authform_internal
1.35 matthew 3027:
1.112 bowersj2 3028: =item * authform_filesystem
1.35 matthew 3029:
3030: =back
3031:
1.648 raeburn 3032: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3033:
1.35 matthew 3034: =cut
3035:
3036: #-------------------------------------------
1.32 matthew 3037: sub authform_header{
3038: my %in = (
3039: formname => 'cu',
1.80 albertel 3040: kerb_def_dom => '',
1.32 matthew 3041: @_,
3042: );
3043: $in{'formname'} = 'document.' . $in{'formname'};
3044: my $result='';
1.80 albertel 3045:
3046: #---------------------------------------------- Code for upper case translation
3047: my $Javascript_toUpperCase;
3048: unless ($in{kerb_def_dom}) {
3049: $Javascript_toUpperCase =<<"END";
3050: switch (choice) {
3051: case 'krb': currentform.elements[choicearg].value =
3052: currentform.elements[choicearg].value.toUpperCase();
3053: break;
3054: default:
3055: }
3056: END
3057: } else {
3058: $Javascript_toUpperCase = "";
3059: }
3060:
1.165 raeburn 3061: my $radioval = "'nochange'";
1.591 raeburn 3062: if (defined($in{'curr_authtype'})) {
3063: if ($in{'curr_authtype'} ne '') {
3064: $radioval = "'".$in{'curr_authtype'}."arg'";
3065: }
1.174 matthew 3066: }
1.165 raeburn 3067: my $argfield = 'null';
1.591 raeburn 3068: if (defined($in{'mode'})) {
1.165 raeburn 3069: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3070: if (defined($in{'curr_autharg'})) {
3071: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3072: $argfield = "'$in{'curr_autharg'}'";
3073: }
3074: }
3075: }
3076: }
3077:
1.32 matthew 3078: $result.=<<"END";
3079: var current = new Object();
1.165 raeburn 3080: current.radiovalue = $radioval;
3081: current.argfield = $argfield;
1.32 matthew 3082:
3083: function changed_radio(choice,currentform) {
3084: var choicearg = choice + 'arg';
3085: // If a radio button in changed, we need to change the argfield
3086: if (current.radiovalue != choice) {
3087: current.radiovalue = choice;
3088: if (current.argfield != null) {
3089: currentform.elements[current.argfield].value = '';
3090: }
3091: if (choice == 'nochange') {
3092: current.argfield = null;
3093: } else {
3094: current.argfield = choicearg;
3095: switch(choice) {
3096: case 'krb':
3097: currentform.elements[current.argfield].value =
3098: "$in{'kerb_def_dom'}";
3099: break;
3100: default:
3101: break;
3102: }
3103: }
3104: }
3105: return;
3106: }
1.22 www 3107:
1.32 matthew 3108: function changed_text(choice,currentform) {
3109: var choicearg = choice + 'arg';
3110: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3111: $Javascript_toUpperCase
1.32 matthew 3112: // clear old field
3113: if ((current.argfield != choicearg) && (current.argfield != null)) {
3114: currentform.elements[current.argfield].value = '';
3115: }
3116: current.argfield = choicearg;
3117: }
3118: set_auth_radio_buttons(choice,currentform);
3119: return;
1.20 www 3120: }
1.32 matthew 3121:
3122: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3123: var numauthchoices = currentform.login.length;
3124: if (typeof numauthchoices == "undefined") {
3125: return;
3126: }
1.32 matthew 3127: var i=0;
1.986 raeburn 3128: while (i < numauthchoices) {
1.32 matthew 3129: if (currentform.login[i].value == newvalue) { break; }
3130: i++;
3131: }
1.986 raeburn 3132: if (i == numauthchoices) {
1.32 matthew 3133: return;
3134: }
3135: current.radiovalue = newvalue;
3136: currentform.login[i].checked = true;
3137: return;
3138: }
3139: END
3140: return $result;
3141: }
3142:
1.1106 raeburn 3143: sub authform_authorwarning {
1.32 matthew 3144: my $result='';
1.144 matthew 3145: $result='<i>'.
3146: &mt('As a general rule, only authors or co-authors should be '.
3147: 'filesystem authenticated '.
3148: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3149: return $result;
3150: }
3151:
1.1106 raeburn 3152: sub authform_nochange {
1.32 matthew 3153: my %in = (
3154: formname => 'document.cu',
3155: kerb_def_dom => 'MSU.EDU',
3156: @_,
3157: );
1.1106 raeburn 3158: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3159: my $result;
1.1104 raeburn 3160: if (!$authnum) {
1.1105 raeburn 3161: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3162: } else {
3163: $result = '<label>'.&mt('[_1] Do not change login data',
3164: '<input type="radio" name="login" value="nochange" '.
3165: 'checked="checked" onclick="'.
1.281 albertel 3166: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3167: '</label>';
1.586 raeburn 3168: }
1.32 matthew 3169: return $result;
3170: }
3171:
1.591 raeburn 3172: sub authform_kerberos {
1.32 matthew 3173: my %in = (
3174: formname => 'document.cu',
3175: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3176: kerb_def_auth => 'krb4',
1.32 matthew 3177: @_,
3178: );
1.586 raeburn 3179: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3180: $autharg,$jscall,$disabled);
1.1106 raeburn 3181: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3182: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3183: $check5 = ' checked="checked"';
1.80 albertel 3184: } else {
1.772 bisitz 3185: $check4 = ' checked="checked"';
1.80 albertel 3186: }
1.1259 raeburn 3187: if ($in{'readonly'}) {
3188: $disabled = ' disabled="disabled"';
3189: }
1.165 raeburn 3190: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3191: if (defined($in{'curr_authtype'})) {
3192: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3193: $krbcheck = ' checked="checked"';
1.623 raeburn 3194: if (defined($in{'mode'})) {
3195: if ($in{'mode'} eq 'modifyuser') {
3196: $krbcheck = '';
3197: }
3198: }
1.591 raeburn 3199: if (defined($in{'curr_kerb_ver'})) {
3200: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3201: $check5 = ' checked="checked"';
1.591 raeburn 3202: $check4 = '';
3203: } else {
1.772 bisitz 3204: $check4 = ' checked="checked"';
1.591 raeburn 3205: $check5 = '';
3206: }
1.586 raeburn 3207: }
1.591 raeburn 3208: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3209: $krbarg = $in{'curr_autharg'};
3210: }
1.586 raeburn 3211: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3212: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3213: $result =
3214: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3215: $in{'curr_autharg'},$krbver);
3216: } else {
3217: $result =
3218: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3219: }
3220: return $result;
3221: }
3222: }
3223: } else {
3224: if ($authnum == 1) {
1.784 bisitz 3225: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3226: }
3227: }
1.586 raeburn 3228: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3229: return;
1.587 raeburn 3230: } elsif ($authtype eq '') {
1.591 raeburn 3231: if (defined($in{'mode'})) {
1.587 raeburn 3232: if ($in{'mode'} eq 'modifycourse') {
3233: if ($authnum == 1) {
1.1259 raeburn 3234: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3235: }
3236: }
3237: }
1.586 raeburn 3238: }
3239: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3240: if ($authtype eq '') {
3241: $authtype = '<input type="radio" name="login" value="krb" '.
3242: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3243: $krbcheck.$disabled.' />';
1.586 raeburn 3244: }
3245: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3246: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3247: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3248: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3249: $in{'curr_authtype'} eq 'krb4')) {
3250: $result .= &mt
1.144 matthew 3251: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3252: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3253: '<label>'.$authtype,
1.281 albertel 3254: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3255: 'value="'.$krbarg.'" '.
1.1259 raeburn 3256: 'onchange="'.$jscall.'"'.$disabled.' />',
3257: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3258: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3259: '</label>');
1.586 raeburn 3260: } elsif ($can_assign{'krb4'}) {
3261: $result .= &mt
3262: ('[_1] Kerberos authenticated with domain [_2] '.
3263: '[_3] Version 4 [_4]',
3264: '<label>'.$authtype,
3265: '</label><input type="text" size="10" name="krbarg" '.
3266: 'value="'.$krbarg.'" '.
1.1259 raeburn 3267: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3268: '<label><input type="hidden" name="krbver" value="4" />',
3269: '</label>');
3270: } elsif ($can_assign{'krb5'}) {
3271: $result .= &mt
3272: ('[_1] Kerberos authenticated with domain [_2] '.
3273: '[_3] Version 5 [_4]',
3274: '<label>'.$authtype,
3275: '</label><input type="text" size="10" name="krbarg" '.
3276: 'value="'.$krbarg.'" '.
1.1259 raeburn 3277: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3278: '<label><input type="hidden" name="krbver" value="5" />',
3279: '</label>');
3280: }
1.32 matthew 3281: return $result;
3282: }
3283:
1.1106 raeburn 3284: sub authform_internal {
1.586 raeburn 3285: my %in = (
1.32 matthew 3286: formname => 'document.cu',
3287: kerb_def_dom => 'MSU.EDU',
3288: @_,
3289: );
1.1259 raeburn 3290: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3291: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3292: if ($in{'readonly'}) {
3293: $disabled = ' disabled="disabled"';
3294: }
1.591 raeburn 3295: if (defined($in{'curr_authtype'})) {
3296: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3297: if ($can_assign{'int'}) {
1.772 bisitz 3298: $intcheck = 'checked="checked" ';
1.623 raeburn 3299: if (defined($in{'mode'})) {
3300: if ($in{'mode'} eq 'modifyuser') {
3301: $intcheck = '';
3302: }
3303: }
1.591 raeburn 3304: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3305: $intarg = $in{'curr_autharg'};
3306: }
3307: } else {
3308: $result = &mt('Currently internally authenticated.');
3309: return $result;
1.165 raeburn 3310: }
3311: }
1.586 raeburn 3312: } else {
3313: if ($authnum == 1) {
1.784 bisitz 3314: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3315: }
3316: }
3317: if (!$can_assign{'int'}) {
3318: return;
1.587 raeburn 3319: } elsif ($authtype eq '') {
1.591 raeburn 3320: if (defined($in{'mode'})) {
1.587 raeburn 3321: if ($in{'mode'} eq 'modifycourse') {
3322: if ($authnum == 1) {
1.1259 raeburn 3323: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3324: }
3325: }
3326: }
1.165 raeburn 3327: }
1.586 raeburn 3328: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3329: if ($authtype eq '') {
3330: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3331: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3332: }
1.605 bisitz 3333: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3334: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3335: $result = &mt
1.144 matthew 3336: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3337: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3338: $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 3339: return $result;
3340: }
3341:
1.1104 raeburn 3342: sub authform_local {
1.32 matthew 3343: my %in = (
3344: formname => 'document.cu',
3345: kerb_def_dom => 'MSU.EDU',
3346: @_,
3347: );
1.1259 raeburn 3348: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3349: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3350: if ($in{'readonly'}) {
3351: $disabled = ' disabled="disabled"';
3352: }
1.591 raeburn 3353: if (defined($in{'curr_authtype'})) {
3354: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3355: if ($can_assign{'loc'}) {
1.772 bisitz 3356: $loccheck = 'checked="checked" ';
1.623 raeburn 3357: if (defined($in{'mode'})) {
3358: if ($in{'mode'} eq 'modifyuser') {
3359: $loccheck = '';
3360: }
3361: }
1.591 raeburn 3362: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3363: $locarg = $in{'curr_autharg'};
3364: }
3365: } else {
3366: $result = &mt('Currently using local (institutional) authentication.');
3367: return $result;
1.165 raeburn 3368: }
3369: }
1.586 raeburn 3370: } else {
3371: if ($authnum == 1) {
1.784 bisitz 3372: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3373: }
3374: }
3375: if (!$can_assign{'loc'}) {
3376: return;
1.587 raeburn 3377: } elsif ($authtype eq '') {
1.591 raeburn 3378: if (defined($in{'mode'})) {
1.587 raeburn 3379: if ($in{'mode'} eq 'modifycourse') {
3380: if ($authnum == 1) {
1.1259 raeburn 3381: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3382: }
3383: }
3384: }
1.165 raeburn 3385: }
1.586 raeburn 3386: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3387: if ($authtype eq '') {
3388: $authtype = '<input type="radio" name="login" value="loc" '.
3389: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3390: $jscall.'"'.$disabled.' />';
1.586 raeburn 3391: }
3392: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3393: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3394: $result = &mt('[_1] Local Authentication with argument [_2]',
3395: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3396: return $result;
3397: }
3398:
1.1106 raeburn 3399: sub authform_filesystem {
1.32 matthew 3400: my %in = (
3401: formname => 'document.cu',
3402: kerb_def_dom => 'MSU.EDU',
3403: @_,
3404: );
1.1259 raeburn 3405: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3406: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3407: if ($in{'readonly'}) {
3408: $disabled = ' disabled="disabled"';
3409: }
1.591 raeburn 3410: if (defined($in{'curr_authtype'})) {
3411: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3412: if ($can_assign{'fsys'}) {
1.772 bisitz 3413: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3414: if (defined($in{'mode'})) {
3415: if ($in{'mode'} eq 'modifyuser') {
3416: $fsyscheck = '';
3417: }
3418: }
1.586 raeburn 3419: } else {
3420: $result = &mt('Currently Filesystem Authenticated.');
3421: return $result;
1.1259 raeburn 3422: }
1.586 raeburn 3423: }
3424: } else {
3425: if ($authnum == 1) {
1.784 bisitz 3426: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3427: }
3428: }
3429: if (!$can_assign{'fsys'}) {
3430: return;
1.587 raeburn 3431: } elsif ($authtype eq '') {
1.591 raeburn 3432: if (defined($in{'mode'})) {
1.587 raeburn 3433: if ($in{'mode'} eq 'modifycourse') {
3434: if ($authnum == 1) {
1.1259 raeburn 3435: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3436: }
3437: }
3438: }
1.586 raeburn 3439: }
3440: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3441: if ($authtype eq '') {
3442: $authtype = '<input type="radio" name="login" value="fsys" '.
3443: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3444: $jscall.'"'.$disabled.' />';
1.586 raeburn 3445: }
3446: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3447: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3448: $result = &mt
1.144 matthew 3449: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3450: '<label><input type="radio" name="login" value="fsys" '.
1.1259 raeburn 3451: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
1.605 bisitz 3452: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.1259 raeburn 3453: 'onchange="'.$jscall.'"'.$disabled.' />');
1.32 matthew 3454: return $result;
3455: }
3456:
1.586 raeburn 3457: sub get_assignable_auth {
3458: my ($dom) = @_;
3459: if ($dom eq '') {
3460: $dom = $env{'request.role.domain'};
3461: }
3462: my %can_assign = (
3463: krb4 => 1,
3464: krb5 => 1,
3465: int => 1,
3466: loc => 1,
3467: );
3468: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3469: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3470: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3471: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3472: my $context;
3473: if ($env{'request.role'} =~ /^au/) {
3474: $context = 'author';
1.1259 raeburn 3475: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3476: $context = 'domain';
3477: } elsif ($env{'request.course.id'}) {
3478: $context = 'course';
3479: }
3480: if ($context) {
3481: if (ref($authhash->{$context}) eq 'HASH') {
3482: %can_assign = %{$authhash->{$context}};
3483: }
3484: }
3485: }
3486: }
3487: my $authnum = 0;
3488: foreach my $key (keys(%can_assign)) {
3489: if ($can_assign{$key}) {
3490: $authnum ++;
3491: }
3492: }
3493: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3494: $authnum --;
3495: }
3496: return ($authnum,%can_assign);
3497: }
3498:
1.80 albertel 3499: ###############################################################
3500: ## Get Kerberos Defaults for Domain ##
3501: ###############################################################
3502: ##
3503: ## Returns default kerberos version and an associated argument
3504: ## as listed in file domain.tab. If not listed, provides
3505: ## appropriate default domain and kerberos version.
3506: ##
3507: #-------------------------------------------
3508:
3509: =pod
3510:
1.648 raeburn 3511: =item * &get_kerberos_defaults()
1.80 albertel 3512:
3513: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3514: version and domain. If not found, it defaults to version 4 and the
3515: domain of the server.
1.80 albertel 3516:
1.648 raeburn 3517: =over 4
3518:
1.80 albertel 3519: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3520:
1.648 raeburn 3521: =back
3522:
3523: =back
3524:
1.80 albertel 3525: =cut
3526:
3527: #-------------------------------------------
3528: sub get_kerberos_defaults {
3529: my $domain=shift;
1.641 raeburn 3530: my ($krbdef,$krbdefdom);
3531: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3532: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3533: $krbdef = $domdefaults{'auth_def'};
3534: $krbdefdom = $domdefaults{'auth_arg_def'};
3535: } else {
1.80 albertel 3536: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3537: my $krbdefdom=$1;
3538: $krbdefdom=~tr/a-z/A-Z/;
3539: $krbdef = "krb4";
3540: }
3541: return ($krbdef,$krbdefdom);
3542: }
1.112 bowersj2 3543:
1.32 matthew 3544:
1.46 matthew 3545: ###############################################################
3546: ## Thesaurus Functions ##
3547: ###############################################################
1.20 www 3548:
1.46 matthew 3549: =pod
1.20 www 3550:
1.112 bowersj2 3551: =head1 Thesaurus Functions
3552:
3553: =over 4
3554:
1.648 raeburn 3555: =item * &initialize_keywords()
1.46 matthew 3556:
3557: Initializes the package variable %Keywords if it is empty. Uses the
3558: package variable $thesaurus_db_file.
3559:
3560: =cut
3561:
3562: ###################################################
3563:
3564: sub initialize_keywords {
3565: return 1 if (scalar keys(%Keywords));
3566: # If we are here, %Keywords is empty, so fill it up
3567: # Make sure the file we need exists...
3568: if (! -e $thesaurus_db_file) {
3569: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3570: " failed because it does not exist");
3571: return 0;
3572: }
3573: # Set up the hash as a database
3574: my %thesaurus_db;
3575: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3576: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3577: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3578: $thesaurus_db_file);
3579: return 0;
3580: }
3581: # Get the average number of appearances of a word.
3582: my $avecount = $thesaurus_db{'average.count'};
3583: # Put keywords (those that appear > average) into %Keywords
3584: while (my ($word,$data)=each (%thesaurus_db)) {
3585: my ($count,undef) = split /:/,$data;
3586: $Keywords{$word}++ if ($count > $avecount);
3587: }
3588: untie %thesaurus_db;
3589: # Remove special values from %Keywords.
1.356 albertel 3590: foreach my $value ('total.count','average.count') {
3591: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3592: }
1.46 matthew 3593: return 1;
3594: }
3595:
3596: ###################################################
3597:
3598: =pod
3599:
1.648 raeburn 3600: =item * &keyword($word)
1.46 matthew 3601:
3602: Returns true if $word is a keyword. A keyword is a word that appears more
3603: than the average number of times in the thesaurus database. Calls
3604: &initialize_keywords
3605:
3606: =cut
3607:
3608: ###################################################
1.20 www 3609:
3610: sub keyword {
1.46 matthew 3611: return if (!&initialize_keywords());
3612: my $word=lc(shift());
3613: $word=~s/\W//g;
3614: return exists($Keywords{$word});
1.20 www 3615: }
1.46 matthew 3616:
3617: ###############################################################
3618:
3619: =pod
1.20 www 3620:
1.648 raeburn 3621: =item * &get_related_words()
1.46 matthew 3622:
1.160 matthew 3623: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3624: an array of words. If the keyword is not in the thesaurus, an empty array
3625: will be returned. The order of the words returned is determined by the
3626: database which holds them.
3627:
3628: Uses global $thesaurus_db_file.
3629:
1.1057 foxr 3630:
1.46 matthew 3631: =cut
3632:
3633: ###############################################################
3634: sub get_related_words {
3635: my $keyword = shift;
3636: my %thesaurus_db;
3637: if (! -e $thesaurus_db_file) {
3638: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3639: "failed because the file does not exist");
3640: return ();
3641: }
3642: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3643: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3644: return ();
3645: }
3646: my @Words=();
1.429 www 3647: my $count=0;
1.46 matthew 3648: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3649: # The first element is the number of times
3650: # the word appears. We do not need it now.
1.429 www 3651: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3652: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3653: my $threshold=$mostfrequentcount/10;
3654: foreach my $possibleword (@RelatedWords) {
3655: my ($word,$wordcount)=split(/\,/,$possibleword);
3656: if ($wordcount>$threshold) {
3657: push(@Words,$word);
3658: $count++;
3659: if ($count>10) { last; }
3660: }
1.20 www 3661: }
3662: }
1.46 matthew 3663: untie %thesaurus_db;
3664: return @Words;
1.14 harris41 3665: }
1.1090 foxr 3666: ###############################################################
3667: #
3668: # Spell checking
3669: #
3670:
3671: =pod
3672:
1.1142 raeburn 3673: =back
3674:
1.1090 foxr 3675: =head1 Spell checking
3676:
3677: =over 4
3678:
3679: =item * &check_spelling($wordlist $language)
3680:
3681: Takes a string containing words and feeds it to an external
3682: spellcheck program via a pipeline. Returns a string containing
3683: them mis-spelled words.
3684:
3685: Parameters:
3686:
3687: =over 4
3688:
3689: =item - $wordlist
3690:
3691: String that will be fed into the spellcheck program.
3692:
3693: =item - $language
3694:
3695: Language string that specifies the language for which the spell
3696: check will be performed.
3697:
3698: =back
3699:
3700: =back
3701:
3702: Note: This sub assumes that aspell is installed.
3703:
3704:
3705: =cut
3706:
1.46 matthew 3707:
1.1090 foxr 3708: sub check_spelling {
3709: my ($wordlist, $language) = @_;
1.1091 foxr 3710: my @misspellings;
3711:
3712: # Generate the speller and set the langauge.
3713: # if explicitly selected:
1.1090 foxr 3714:
1.1091 foxr 3715: my $speller = Text::Aspell->new;
1.1090 foxr 3716: if ($language) {
1.1091 foxr 3717: $speller->set_option('lang', $language);
1.1090 foxr 3718: }
3719:
1.1091 foxr 3720: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3721:
1.1091 foxr 3722: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3723:
1.1091 foxr 3724: foreach my $word (@words) {
3725: if(! $speller->check($word)) {
3726: push(@misspellings, $word);
1.1090 foxr 3727: }
3728: }
1.1091 foxr 3729: return join(' ', @misspellings);
3730:
1.1090 foxr 3731: }
3732:
1.61 www 3733: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3734: =pod
3735:
1.112 bowersj2 3736: =head1 User Name Functions
3737:
3738: =over 4
3739:
1.648 raeburn 3740: =item * &plainname($uname,$udom,$first)
1.81 albertel 3741:
1.112 bowersj2 3742: Takes a users logon name and returns it as a string in
1.226 albertel 3743: "first middle last generation" form
3744: if $first is set to 'lastname' then it returns it as
3745: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3746:
3747: =cut
1.61 www 3748:
1.295 www 3749:
1.81 albertel 3750: ###############################################################
1.61 www 3751: sub plainname {
1.226 albertel 3752: my ($uname,$udom,$first)=@_;
1.537 albertel 3753: return if (!defined($uname) || !defined($udom));
1.295 www 3754: my %names=&getnames($uname,$udom);
1.226 albertel 3755: my $name=&Apache::lonnet::format_name($names{'firstname'},
3756: $names{'middlename'},
3757: $names{'lastname'},
3758: $names{'generation'},$first);
3759: $name=~s/^\s+//;
1.62 www 3760: $name=~s/\s+$//;
3761: $name=~s/\s+/ /g;
1.353 albertel 3762: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3763: return $name;
1.61 www 3764: }
1.66 www 3765:
3766: # -------------------------------------------------------------------- Nickname
1.81 albertel 3767: =pod
3768:
1.648 raeburn 3769: =item * &nickname($uname,$udom)
1.81 albertel 3770:
3771: Gets a users name and returns it as a string as
3772:
3773: ""nickname""
1.66 www 3774:
1.81 albertel 3775: if the user has a nickname or
3776:
3777: "first middle last generation"
3778:
3779: if the user does not
3780:
3781: =cut
1.66 www 3782:
3783: sub nickname {
3784: my ($uname,$udom)=@_;
1.537 albertel 3785: return if (!defined($uname) || !defined($udom));
1.295 www 3786: my %names=&getnames($uname,$udom);
1.68 albertel 3787: my $name=$names{'nickname'};
1.66 www 3788: if ($name) {
3789: $name='"'.$name.'"';
3790: } else {
3791: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3792: $names{'lastname'}.' '.$names{'generation'};
3793: $name=~s/\s+$//;
3794: $name=~s/\s+/ /g;
3795: }
3796: return $name;
3797: }
3798:
1.295 www 3799: sub getnames {
3800: my ($uname,$udom)=@_;
1.537 albertel 3801: return if (!defined($uname) || !defined($udom));
1.433 albertel 3802: if ($udom eq 'public' && $uname eq 'public') {
3803: return ('lastname' => &mt('Public'));
3804: }
1.295 www 3805: my $id=$uname.':'.$udom;
3806: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3807: if ($cached) {
3808: return %{$names};
3809: } else {
3810: my %loadnames=&Apache::lonnet::get('environment',
3811: ['firstname','middlename','lastname','generation','nickname'],
3812: $udom,$uname);
3813: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3814: return %loadnames;
3815: }
3816: }
1.61 www 3817:
1.542 raeburn 3818: # -------------------------------------------------------------------- getemails
1.648 raeburn 3819:
1.542 raeburn 3820: =pod
3821:
1.648 raeburn 3822: =item * &getemails($uname,$udom)
1.542 raeburn 3823:
3824: Gets a user's email information and returns it as a hash with keys:
3825: notification, critnotification, permanentemail
3826:
3827: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3828: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3829:
1.648 raeburn 3830:
1.542 raeburn 3831: =cut
3832:
1.648 raeburn 3833:
1.466 albertel 3834: sub getemails {
3835: my ($uname,$udom)=@_;
3836: if ($udom eq 'public' && $uname eq 'public') {
3837: return;
3838: }
1.467 www 3839: if (!$udom) { $udom=$env{'user.domain'}; }
3840: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3841: my $id=$uname.':'.$udom;
3842: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3843: if ($cached) {
3844: return %{$names};
3845: } else {
3846: my %loadnames=&Apache::lonnet::get('environment',
3847: ['notification','critnotification',
3848: 'permanentemail'],
3849: $udom,$uname);
3850: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3851: return %loadnames;
3852: }
3853: }
3854:
1.551 albertel 3855: sub flush_email_cache {
3856: my ($uname,$udom)=@_;
3857: if (!$udom) { $udom =$env{'user.domain'}; }
3858: if (!$uname) { $uname=$env{'user.name'}; }
3859: return if ($udom eq 'public' && $uname eq 'public');
3860: my $id=$uname.':'.$udom;
3861: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3862: }
3863:
1.728 raeburn 3864: # -------------------------------------------------------------------- getlangs
3865:
3866: =pod
3867:
3868: =item * &getlangs($uname,$udom)
3869:
3870: Gets a user's language preference and returns it as a hash with key:
3871: language.
3872:
3873: =cut
3874:
3875:
3876: sub getlangs {
3877: my ($uname,$udom) = @_;
3878: if (!$udom) { $udom =$env{'user.domain'}; }
3879: if (!$uname) { $uname=$env{'user.name'}; }
3880: my $id=$uname.':'.$udom;
3881: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3882: if ($cached) {
3883: return %{$langs};
3884: } else {
3885: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3886: $udom,$uname);
3887: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3888: return %loadlangs;
3889: }
3890: }
3891:
3892: sub flush_langs_cache {
3893: my ($uname,$udom)=@_;
3894: if (!$udom) { $udom =$env{'user.domain'}; }
3895: if (!$uname) { $uname=$env{'user.name'}; }
3896: return if ($udom eq 'public' && $uname eq 'public');
3897: my $id=$uname.':'.$udom;
3898: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3899: }
3900:
1.61 www 3901: # ------------------------------------------------------------------ Screenname
1.81 albertel 3902:
3903: =pod
3904:
1.648 raeburn 3905: =item * &screenname($uname,$udom)
1.81 albertel 3906:
3907: Gets a users screenname and returns it as a string
3908:
3909: =cut
1.61 www 3910:
3911: sub screenname {
3912: my ($uname,$udom)=@_;
1.258 albertel 3913: if ($uname eq $env{'user.name'} &&
3914: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3915: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3916: return $names{'screenname'};
1.62 www 3917: }
3918:
1.212 albertel 3919:
1.802 bisitz 3920: # ------------------------------------------------------------- Confirm Wrapper
3921: =pod
3922:
1.1142 raeburn 3923: =item * &confirmwrapper($message)
1.802 bisitz 3924:
3925: Wrap messages about completion of operation in box
3926:
3927: =cut
3928:
3929: sub confirmwrapper {
3930: my ($message)=@_;
3931: if ($message) {
3932: return "\n".'<div class="LC_confirm_box">'."\n"
3933: .$message."\n"
3934: .'</div>'."\n";
3935: } else {
3936: return $message;
3937: }
3938: }
3939:
1.62 www 3940: # ------------------------------------------------------------- Message Wrapper
3941:
3942: sub messagewrapper {
1.369 www 3943: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3944: return
1.441 albertel 3945: '<a href="/adm/email?compose=individual&'.
3946: 'recname='.$username.'&recdom='.$domain.
3947: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3948: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3949: }
1.802 bisitz 3950:
1.74 www 3951: # --------------------------------------------------------------- Notes Wrapper
3952:
3953: sub noteswrapper {
3954: my ($link,$un,$do)=@_;
3955: return
1.896 amueller 3956: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3957: }
1.802 bisitz 3958:
1.62 www 3959: # ------------------------------------------------------------- Aboutme Wrapper
3960:
3961: sub aboutmewrapper {
1.1070 raeburn 3962: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3963: if (!defined($username) && !defined($domain)) {
3964: return;
3965: }
1.1096 raeburn 3966: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3967: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3968: }
3969:
3970: # ------------------------------------------------------------ Syllabus Wrapper
3971:
3972: sub syllabuswrapper {
1.707 bisitz 3973: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3974: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3975: }
1.14 harris41 3976:
1.802 bisitz 3977: # -----------------------------------------------------------------------------
3978:
1.208 matthew 3979: sub track_student_link {
1.887 raeburn 3980: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3981: my $link ="/adm/trackstudent?";
1.208 matthew 3982: my $title = 'View recent activity';
3983: if (defined($sname) && $sname !~ /^\s*$/ &&
3984: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3985: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3986: $title .= ' of this student';
1.268 albertel 3987: }
1.208 matthew 3988: if (defined($target) && $target !~ /^\s*$/) {
3989: $target = qq{target="$target"};
3990: } else {
3991: $target = '';
3992: }
1.268 albertel 3993: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3994: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3995: $title = &mt($title);
3996: $linktext = &mt($linktext);
1.448 albertel 3997: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3998: &help_open_topic('View_recent_activity');
1.208 matthew 3999: }
4000:
1.781 raeburn 4001: sub slot_reservations_link {
4002: my ($linktext,$sname,$sdom,$target) = @_;
4003: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4004: my $title = 'View slot reservation history';
4005: if (defined($sname) && $sname !~ /^\s*$/ &&
4006: defined($sdom) && $sdom !~ /^\s*$/) {
4007: $link .= "&uname=$sname&udom=$sdom";
4008: $title .= ' of this student';
4009: }
4010: if (defined($target) && $target !~ /^\s*$/) {
4011: $target = qq{target="$target"};
4012: } else {
4013: $target = '';
4014: }
4015: $title = &mt($title);
4016: $linktext = &mt($linktext);
4017: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4018: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4019:
4020: }
4021:
1.508 www 4022: # ===================================================== Display a student photo
4023:
4024:
1.509 albertel 4025: sub student_image_tag {
1.508 www 4026: my ($domain,$user)=@_;
4027: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4028: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4029: return '<img src="'.$imgsrc.'" align="right" />';
4030: } else {
4031: return '';
4032: }
4033: }
4034:
1.112 bowersj2 4035: =pod
4036:
4037: =back
4038:
4039: =head1 Access .tab File Data
4040:
4041: =over 4
4042:
1.648 raeburn 4043: =item * &languageids()
1.112 bowersj2 4044:
4045: returns list of all language ids
4046:
4047: =cut
4048:
1.14 harris41 4049: sub languageids {
1.16 harris41 4050: return sort(keys(%language));
1.14 harris41 4051: }
4052:
1.112 bowersj2 4053: =pod
4054:
1.648 raeburn 4055: =item * &languagedescription()
1.112 bowersj2 4056:
4057: returns description of a specified language id
4058:
4059: =cut
4060:
1.14 harris41 4061: sub languagedescription {
1.125 www 4062: my $code=shift;
4063: return ($supported_language{$code}?'* ':'').
4064: $language{$code}.
1.126 www 4065: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4066: }
4067:
1.1048 foxr 4068: =pod
4069:
4070: =item * &plainlanguagedescription
4071:
4072: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4073: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4074:
4075: =cut
4076:
1.145 www 4077: sub plainlanguagedescription {
4078: my $code=shift;
4079: return $language{$code};
4080: }
4081:
1.1048 foxr 4082: =pod
4083:
4084: =item * &supportedlanguagecode
4085:
4086: Returns the supported language code (e.g. sptutf maps to pt) given a language
4087: code.
4088:
4089: =cut
4090:
1.145 www 4091: sub supportedlanguagecode {
4092: my $code=shift;
4093: return $supported_language{$code};
1.97 www 4094: }
4095:
1.112 bowersj2 4096: =pod
4097:
1.1048 foxr 4098: =item * &latexlanguage()
4099:
4100: Given a language key code returns the correspondnig language to use
4101: to select the correct hyphenation on LaTeX printouts. This is undef if there
4102: is no supported hyphenation for the language code.
4103:
4104: =cut
4105:
4106: sub latexlanguage {
4107: my $code = shift;
4108: return $latex_language{$code};
4109: }
4110:
4111: =pod
4112:
4113: =item * &latexhyphenation()
4114:
4115: Same as above but what's supplied is the language as it might be stored
4116: in the metadata.
4117:
4118: =cut
4119:
4120: sub latexhyphenation {
4121: my $key = shift;
4122: return $latex_language_bykey{$key};
4123: }
4124:
4125: =pod
4126:
1.648 raeburn 4127: =item * ©rightids()
1.112 bowersj2 4128:
4129: returns list of all copyrights
4130:
4131: =cut
4132:
4133: sub copyrightids {
4134: return sort(keys(%cprtag));
4135: }
4136:
4137: =pod
4138:
1.648 raeburn 4139: =item * ©rightdescription()
1.112 bowersj2 4140:
4141: returns description of a specified copyright id
4142:
4143: =cut
4144:
4145: sub copyrightdescription {
1.166 www 4146: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4147: }
1.197 matthew 4148:
4149: =pod
4150:
1.648 raeburn 4151: =item * &source_copyrightids()
1.192 taceyjo1 4152:
4153: returns list of all source copyrights
4154:
4155: =cut
4156:
4157: sub source_copyrightids {
4158: return sort(keys(%scprtag));
4159: }
4160:
4161: =pod
4162:
1.648 raeburn 4163: =item * &source_copyrightdescription()
1.192 taceyjo1 4164:
4165: returns description of a specified source copyright id
4166:
4167: =cut
4168:
4169: sub source_copyrightdescription {
4170: return &mt($scprtag{shift(@_)});
4171: }
1.112 bowersj2 4172:
4173: =pod
4174:
1.648 raeburn 4175: =item * &filecategories()
1.112 bowersj2 4176:
4177: returns list of all file categories
4178:
4179: =cut
4180:
4181: sub filecategories {
4182: return sort(keys(%category_extensions));
4183: }
4184:
4185: =pod
4186:
1.648 raeburn 4187: =item * &filecategorytypes()
1.112 bowersj2 4188:
4189: returns list of file types belonging to a given file
4190: category
4191:
4192: =cut
4193:
4194: sub filecategorytypes {
1.356 albertel 4195: my ($cat) = @_;
1.1248 raeburn 4196: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4197: return @{$category_extensions{lc($cat)}};
4198: } else {
4199: return ();
4200: }
1.112 bowersj2 4201: }
4202:
4203: =pod
4204:
1.648 raeburn 4205: =item * &fileembstyle()
1.112 bowersj2 4206:
4207: returns embedding style for a specified file type
4208:
4209: =cut
4210:
4211: sub fileembstyle {
4212: return $fe{lc(shift(@_))};
1.169 www 4213: }
4214:
1.351 www 4215: sub filemimetype {
4216: return $fm{lc(shift(@_))};
4217: }
4218:
1.169 www 4219:
4220: sub filecategoryselect {
4221: my ($name,$value)=@_;
1.189 matthew 4222: return &select_form($value,$name,
1.970 raeburn 4223: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4224: }
4225:
4226: =pod
4227:
1.648 raeburn 4228: =item * &filedescription()
1.112 bowersj2 4229:
4230: returns description for a specified file type
4231:
4232: =cut
4233:
4234: sub filedescription {
1.188 matthew 4235: my $file_description = $fd{lc(shift())};
4236: $file_description =~ s:([\[\]]):~$1:g;
4237: return &mt($file_description);
1.112 bowersj2 4238: }
4239:
4240: =pod
4241:
1.648 raeburn 4242: =item * &filedescriptionex()
1.112 bowersj2 4243:
4244: returns description for a specified file type with
4245: extra formatting
4246:
4247: =cut
4248:
4249: sub filedescriptionex {
4250: my $ex=shift;
1.188 matthew 4251: my $file_description = $fd{lc($ex)};
4252: $file_description =~ s:([\[\]]):~$1:g;
4253: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4254: }
4255:
4256: # End of .tab access
4257: =pod
4258:
4259: =back
4260:
4261: =cut
4262:
4263: # ------------------------------------------------------------------ File Types
4264: sub fileextensions {
4265: return sort(keys(%fe));
4266: }
4267:
1.97 www 4268: # ----------------------------------------------------------- Display Languages
4269: # returns a hash with all desired display languages
4270: #
4271:
4272: sub display_languages {
4273: my %languages=();
1.695 raeburn 4274: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4275: $languages{$lang}=1;
1.97 www 4276: }
4277: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4278: if ($env{'form.displaylanguage'}) {
1.356 albertel 4279: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4280: $languages{$lang}=1;
1.97 www 4281: }
4282: }
4283: return %languages;
1.14 harris41 4284: }
4285:
1.582 albertel 4286: sub languages {
4287: my ($possible_langs) = @_;
1.695 raeburn 4288: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4289: if (!ref($possible_langs)) {
4290: if( wantarray ) {
4291: return @preferred_langs;
4292: } else {
4293: return $preferred_langs[0];
4294: }
4295: }
4296: my %possibilities = map { $_ => 1 } (@$possible_langs);
4297: my @preferred_possibilities;
4298: foreach my $preferred_lang (@preferred_langs) {
4299: if (exists($possibilities{$preferred_lang})) {
4300: push(@preferred_possibilities, $preferred_lang);
4301: }
4302: }
4303: if( wantarray ) {
4304: return @preferred_possibilities;
4305: }
4306: return $preferred_possibilities[0];
4307: }
4308:
1.742 raeburn 4309: sub user_lang {
4310: my ($touname,$toudom,$fromcid) = @_;
4311: my @userlangs;
4312: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4313: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4314: $env{'course.'.$fromcid.'.languages'}));
4315: } else {
4316: my %langhash = &getlangs($touname,$toudom);
4317: if ($langhash{'languages'} ne '') {
4318: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4319: } else {
4320: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4321: if ($domdefs{'lang_def'} ne '') {
4322: @userlangs = ($domdefs{'lang_def'});
4323: }
4324: }
4325: }
4326: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4327: my $user_lh = Apache::localize->get_handle(@languages);
4328: return $user_lh;
4329: }
4330:
4331:
1.112 bowersj2 4332: ###############################################################
4333: ## Student Answer Attempts ##
4334: ###############################################################
4335:
4336: =pod
4337:
4338: =head1 Alternate Problem Views
4339:
4340: =over 4
4341:
1.648 raeburn 4342: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4343: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4344:
4345: Return string with previous attempt on problem. Arguments:
4346:
4347: =over 4
4348:
4349: =item * $symb: Problem, including path
4350:
4351: =item * $username: username of the desired student
4352:
4353: =item * $domain: domain of the desired student
1.14 harris41 4354:
1.112 bowersj2 4355: =item * $course: Course ID
1.14 harris41 4356:
1.112 bowersj2 4357: =item * $getattempt: Leave blank for all attempts, otherwise put
4358: something
1.14 harris41 4359:
1.112 bowersj2 4360: =item * $regexp: if string matches this regexp, the string will be
4361: sent to $gradesub
1.14 harris41 4362:
1.112 bowersj2 4363: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4364:
1.1199 raeburn 4365: =item * $usec: section of the desired student
4366:
4367: =item * $identifier: counter for student (multiple students one problem) or
4368: problem (one student; whole sequence).
4369:
1.112 bowersj2 4370: =back
1.14 harris41 4371:
1.112 bowersj2 4372: The output string is a table containing all desired attempts, if any.
1.16 harris41 4373:
1.112 bowersj2 4374: =cut
1.1 albertel 4375:
4376: sub get_previous_attempt {
1.1199 raeburn 4377: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4378: my $prevattempts='';
1.43 ng 4379: no strict 'refs';
1.1 albertel 4380: if ($symb) {
1.3 albertel 4381: my (%returnhash)=
4382: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4383: if ($returnhash{'version'}) {
4384: my %lasthash=();
4385: my $version;
4386: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4387: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4388: if ($key =~ /\.rawrndseed$/) {
4389: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4390: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4391: } else {
4392: $lasthash{$key}=$returnhash{$version.':'.$key};
4393: }
1.19 harris41 4394: }
1.1 albertel 4395: }
1.596 albertel 4396: $prevattempts=&start_data_table().&start_data_table_header_row();
4397: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4398: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4399: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4400: foreach my $key (sort(keys(%lasthash))) {
4401: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4402: if ($#parts > 0) {
1.31 albertel 4403: my $data=$parts[-1];
1.989 raeburn 4404: next if ($data eq 'foilorder');
1.31 albertel 4405: pop(@parts);
1.1010 www 4406: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4407: if ($data eq 'type') {
4408: unless ($showsurv) {
4409: my $id = join(',',@parts);
4410: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4411: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4412: $lasthidden{$ign.'.'.$id} = 1;
4413: }
1.945 raeburn 4414: }
1.1199 raeburn 4415: if ($identifier ne '') {
4416: my $id = join(',',@parts);
4417: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4418: $domain,$username,$usec,undef,$course) =~ /^no/) {
4419: $hidestatus{$ign.'.'.$id} = 1;
4420: }
4421: }
4422: } elsif ($data eq 'regrader') {
4423: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4424: my $id = join(',',@parts);
4425: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4426: }
1.1010 www 4427: }
1.31 albertel 4428: } else {
1.41 ng 4429: if ($#parts == 0) {
4430: $prevattempts.='<th>'.$parts[0].'</th>';
4431: } else {
4432: $prevattempts.='<th>'.$ign.'</th>';
4433: }
1.31 albertel 4434: }
1.16 harris41 4435: }
1.596 albertel 4436: $prevattempts.=&end_data_table_header_row();
1.40 ng 4437: if ($getattempt eq '') {
1.1199 raeburn 4438: my (%solved,%resets,%probstatus);
1.1200 raeburn 4439: if (($identifier ne '') && (keys(%regraded) > 0)) {
4440: for ($version=1;$version<=$returnhash{'version'};$version++) {
4441: foreach my $id (keys(%regraded)) {
4442: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4443: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4444: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4445: push(@{$resets{$id}},$version);
1.1199 raeburn 4446: }
4447: }
4448: }
1.1200 raeburn 4449: }
4450: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4451: my (@hidden,@unsolved);
1.945 raeburn 4452: if (%typeparts) {
4453: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4454: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4455: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4456: push(@hidden,$id);
1.1199 raeburn 4457: } elsif ($identifier ne '') {
4458: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4459: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4460: ($hidestatus{$id})) {
1.1200 raeburn 4461: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4462: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4463: push(@{$solved{$id}},$version);
4464: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4465: (ref($solved{$id}) eq 'ARRAY')) {
4466: my $skip;
4467: if (ref($resets{$id}) eq 'ARRAY') {
4468: foreach my $reset (@{$resets{$id}}) {
4469: if ($reset > $solved{$id}[-1]) {
4470: $skip=1;
4471: last;
4472: }
4473: }
4474: }
4475: unless ($skip) {
4476: my ($ign,$partslist) = split(/\./,$id,2);
4477: push(@unsolved,$partslist);
4478: }
4479: }
4480: }
1.945 raeburn 4481: }
4482: }
4483: }
4484: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4485: '<td>'.&mt('Transaction [_1]',$version);
4486: if (@unsolved) {
4487: $prevattempts .= '<span class="LC_nobreak"><label>'.
4488: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4489: &mt('Hide').'</label></span>';
4490: }
4491: $prevattempts .= '</td>';
1.945 raeburn 4492: if (@hidden) {
4493: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4494: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4495: my $hide;
4496: foreach my $id (@hidden) {
4497: if ($key =~ /^\Q$id\E/) {
4498: $hide = 1;
4499: last;
4500: }
4501: }
4502: if ($hide) {
4503: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4504: if (($data eq 'award') || ($data eq 'awarddetail')) {
4505: my $value = &format_previous_attempt_value($key,
4506: $returnhash{$version.':'.$key});
1.1173 kruse 4507: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4508: } else {
4509: $prevattempts.='<td> </td>';
4510: }
4511: } else {
4512: if ($key =~ /\./) {
1.1212 raeburn 4513: my $value = $returnhash{$version.':'.$key};
4514: if ($key =~ /\.rndseed$/) {
4515: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4516: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4517: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4518: }
4519: }
4520: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4521: ' </td>';
1.945 raeburn 4522: } else {
4523: $prevattempts.='<td> </td>';
4524: }
4525: }
4526: }
4527: } else {
4528: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4529: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4530: my $value = $returnhash{$version.':'.$key};
4531: if ($key =~ /\.rndseed$/) {
4532: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4533: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4534: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4535: }
4536: }
4537: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4538: ' </td>';
1.945 raeburn 4539: }
4540: }
4541: $prevattempts.=&end_data_table_row();
1.40 ng 4542: }
1.1 albertel 4543: }
1.945 raeburn 4544: my @currhidden = keys(%lasthidden);
1.596 albertel 4545: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4546: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4547: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4548: if (%typeparts) {
4549: my $hidden;
4550: foreach my $id (@currhidden) {
4551: if ($key =~ /^\Q$id\E/) {
4552: $hidden = 1;
4553: last;
4554: }
4555: }
4556: if ($hidden) {
4557: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4558: if (($data eq 'award') || ($data eq 'awarddetail')) {
4559: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4560: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4561: $value = &$gradesub($value);
4562: }
1.1173 kruse 4563: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4564: } else {
4565: $prevattempts.='<td> </td>';
4566: }
4567: } else {
4568: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4569: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4570: $value = &$gradesub($value);
4571: }
1.1173 kruse 4572: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4573: }
4574: } else {
4575: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4576: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4577: $value = &$gradesub($value);
4578: }
1.1173 kruse 4579: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4580: }
1.16 harris41 4581: }
1.596 albertel 4582: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4583: } else {
1.1305 raeburn 4584: my $msg;
4585: if ($symb =~ /ext\.tool$/) {
4586: $msg = &mt('No grade passed back.');
4587: } else {
4588: $msg = &mt('Nothing submitted - no attempts.');
4589: }
1.596 albertel 4590: $prevattempts=
4591: &start_data_table().&start_data_table_row().
1.1305 raeburn 4592: '<td>'.$msg.'</td>'.
1.596 albertel 4593: &end_data_table_row().&end_data_table();
1.1 albertel 4594: }
4595: } else {
1.596 albertel 4596: $prevattempts=
4597: &start_data_table().&start_data_table_row().
4598: '<td>'.&mt('No data.').'</td>'.
4599: &end_data_table_row().&end_data_table();
1.1 albertel 4600: }
1.10 albertel 4601: }
4602:
1.581 albertel 4603: sub format_previous_attempt_value {
4604: my ($key,$value) = @_;
1.1011 www 4605: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4606: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4607: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4608: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4609: } elsif ($key =~ /answerstring$/) {
4610: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4611: my @answer = %answers;
4612: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4613: my @anskeys = sort(keys(%answers));
4614: if (@anskeys == 1) {
4615: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4616: if ($answer =~ m{\0}) {
4617: $answer =~ s{\0}{,}g;
1.988 raeburn 4618: }
4619: my $tag_internal_answer_name = 'INTERNAL';
4620: if ($anskeys[0] eq $tag_internal_answer_name) {
4621: $value = $answer;
4622: } else {
4623: $value = $anskeys[0].'='.$answer;
4624: }
4625: } else {
4626: foreach my $ans (@anskeys) {
4627: my $answer = $answers{$ans};
1.1001 raeburn 4628: if ($answer =~ m{\0}) {
4629: $answer =~ s{\0}{,}g;
1.988 raeburn 4630: }
4631: $value .= $ans.'='.$answer.'<br />';;
4632: }
4633: }
1.581 albertel 4634: } else {
1.1173 kruse 4635: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4636: }
4637: return $value;
4638: }
4639:
4640:
1.107 albertel 4641: sub relative_to_absolute {
4642: my ($url,$output)=@_;
4643: my $parser=HTML::TokeParser->new(\$output);
4644: my $token;
4645: my $thisdir=$url;
4646: my @rlinks=();
4647: while ($token=$parser->get_token) {
4648: if ($token->[0] eq 'S') {
4649: if ($token->[1] eq 'a') {
4650: if ($token->[2]->{'href'}) {
4651: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4652: }
4653: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4654: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4655: } elsif ($token->[1] eq 'base') {
4656: $thisdir=$token->[2]->{'href'};
4657: }
4658: }
4659: }
4660: $thisdir=~s-/[^/]*$--;
1.356 albertel 4661: foreach my $link (@rlinks) {
1.726 raeburn 4662: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4663: ($link=~/^\//) ||
4664: ($link=~/^javascript:/i) ||
4665: ($link=~/^mailto:/i) ||
4666: ($link=~/^\#/)) {
4667: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4668: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4669: }
4670: }
4671: # -------------------------------------------------- Deal with Applet codebases
4672: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4673: return $output;
4674: }
4675:
1.112 bowersj2 4676: =pod
4677:
1.648 raeburn 4678: =item * &get_student_view()
1.112 bowersj2 4679:
4680: show a snapshot of what student was looking at
4681:
4682: =cut
4683:
1.10 albertel 4684: sub get_student_view {
1.186 albertel 4685: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4686: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4687: my (%form);
1.10 albertel 4688: my @elements=('symb','courseid','domain','username');
4689: foreach my $element (@elements) {
1.186 albertel 4690: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4691: }
1.186 albertel 4692: if (defined($moreenv)) {
4693: %form=(%form,%{$moreenv});
4694: }
1.236 albertel 4695: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4696: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 4697: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
4698: $feedurl =~ s{^/adm/wrapper}{};
4699: }
1.650 www 4700: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4701: $userview=~s/\<body[^\>]*\>//gi;
4702: $userview=~s/\<\/body\>//gi;
4703: $userview=~s/\<html\>//gi;
4704: $userview=~s/\<\/html\>//gi;
4705: $userview=~s/\<head\>//gi;
4706: $userview=~s/\<\/head\>//gi;
4707: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4708: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4709: if (wantarray) {
4710: return ($userview,$response);
4711: } else {
4712: return $userview;
4713: }
4714: }
4715:
4716: sub get_student_view_with_retries {
4717: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4718:
4719: my $ok = 0; # True if we got a good response.
4720: my $content;
4721: my $response;
4722:
4723: # Try to get the student_view done. within the retries count:
4724:
4725: do {
4726: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4727: $ok = $response->is_success;
4728: if (!$ok) {
4729: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4730: }
4731: $retries--;
4732: } while (!$ok && ($retries > 0));
4733:
4734: if (!$ok) {
4735: $content = ''; # On error return an empty content.
4736: }
1.651 www 4737: if (wantarray) {
4738: return ($content, $response);
4739: } else {
4740: return $content;
4741: }
1.11 albertel 4742: }
4743:
1.112 bowersj2 4744: =pod
4745:
1.648 raeburn 4746: =item * &get_student_answers()
1.112 bowersj2 4747:
4748: show a snapshot of how student was answering problem
4749:
4750: =cut
4751:
1.11 albertel 4752: sub get_student_answers {
1.100 sakharuk 4753: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4754: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4755: my (%moreenv);
1.11 albertel 4756: my @elements=('symb','courseid','domain','username');
4757: foreach my $element (@elements) {
1.186 albertel 4758: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4759: }
1.186 albertel 4760: $moreenv{'grade_target'}='answer';
4761: %moreenv=(%form,%moreenv);
1.497 raeburn 4762: $feedurl = &Apache::lonnet::clutter($feedurl);
4763: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4764: return $userview;
1.1 albertel 4765: }
1.116 albertel 4766:
4767: =pod
4768:
4769: =item * &submlink()
4770:
1.242 albertel 4771: Inputs: $text $uname $udom $symb $target
1.116 albertel 4772:
4773: Returns: A link to grades.pm such as to see the SUBM view of a student
4774:
4775: =cut
4776:
4777: ###############################################
4778: sub submlink {
1.242 albertel 4779: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4780: if (!($uname && $udom)) {
4781: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4782: &Apache::lonnet::whichuser($symb);
1.116 albertel 4783: if (!$symb) { $symb=$cursymb; }
4784: }
1.254 matthew 4785: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4786: $symb=&escape($symb);
1.960 bisitz 4787: if ($target) { $target=" target=\"$target\""; }
4788: return
4789: '<a href="/adm/grades?command=submission'.
4790: '&symb='.$symb.
4791: '&student='.$uname.
4792: '&userdom='.$udom.'"'.
4793: $target.'>'.$text.'</a>';
1.242 albertel 4794: }
4795: ##############################################
4796:
4797: =pod
4798:
4799: =item * &pgrdlink()
4800:
4801: Inputs: $text $uname $udom $symb $target
4802:
4803: Returns: A link to grades.pm such as to see the PGRD view of a student
4804:
4805: =cut
4806:
4807: ###############################################
4808: sub pgrdlink {
4809: my $link=&submlink(@_);
4810: $link=~s/(&command=submission)/$1&showgrading=yes/;
4811: return $link;
4812: }
4813: ##############################################
4814:
4815: =pod
4816:
4817: =item * &pprmlink()
4818:
4819: Inputs: $text $uname $udom $symb $target
4820:
4821: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4822: student and a specific resource
1.242 albertel 4823:
4824: =cut
4825:
4826: ###############################################
4827: sub pprmlink {
4828: my ($text,$uname,$udom,$symb,$target)=@_;
4829: if (!($uname && $udom)) {
4830: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4831: &Apache::lonnet::whichuser($symb);
1.242 albertel 4832: if (!$symb) { $symb=$cursymb; }
4833: }
1.254 matthew 4834: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4835: $symb=&escape($symb);
1.242 albertel 4836: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4837: return '<a href="/adm/parmset?command=set&'.
4838: 'symb='.$symb.'&uname='.$uname.
4839: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4840: }
4841: ##############################################
1.37 matthew 4842:
1.112 bowersj2 4843: =pod
4844:
4845: =back
4846:
4847: =cut
4848:
1.37 matthew 4849: ###############################################
1.51 www 4850:
4851:
4852: sub timehash {
1.687 raeburn 4853: my ($thistime) = @_;
4854: my $timezone = &Apache::lonlocal::gettimezone();
4855: my $dt = DateTime->from_epoch(epoch => $thistime)
4856: ->set_time_zone($timezone);
4857: my $wday = $dt->day_of_week();
4858: if ($wday == 7) { $wday = 0; }
4859: return ( 'second' => $dt->second(),
4860: 'minute' => $dt->minute(),
4861: 'hour' => $dt->hour(),
4862: 'day' => $dt->day_of_month(),
4863: 'month' => $dt->month(),
4864: 'year' => $dt->year(),
4865: 'weekday' => $wday,
4866: 'dayyear' => $dt->day_of_year(),
4867: 'dlsav' => $dt->is_dst() );
1.51 www 4868: }
4869:
1.370 www 4870: sub utc_string {
4871: my ($date)=@_;
1.371 www 4872: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4873: }
4874:
1.51 www 4875: sub maketime {
4876: my %th=@_;
1.687 raeburn 4877: my ($epoch_time,$timezone,$dt);
4878: $timezone = &Apache::lonlocal::gettimezone();
4879: eval {
4880: $dt = DateTime->new( year => $th{'year'},
4881: month => $th{'month'},
4882: day => $th{'day'},
4883: hour => $th{'hour'},
4884: minute => $th{'minute'},
4885: second => $th{'second'},
4886: time_zone => $timezone,
4887: );
4888: };
4889: if (!$@) {
4890: $epoch_time = $dt->epoch;
4891: if ($epoch_time) {
4892: return $epoch_time;
4893: }
4894: }
1.51 www 4895: return POSIX::mktime(
4896: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4897: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4898: }
4899:
4900: #########################################
1.51 www 4901:
4902: sub findallcourses {
1.482 raeburn 4903: my ($roles,$uname,$udom) = @_;
1.355 albertel 4904: my %roles;
4905: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4906: my %courses;
1.51 www 4907: my $now=time;
1.482 raeburn 4908: if (!defined($uname)) {
4909: $uname = $env{'user.name'};
4910: }
4911: if (!defined($udom)) {
4912: $udom = $env{'user.domain'};
4913: }
4914: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4915: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4916: if (!%roles) {
4917: %roles = (
4918: cc => 1,
1.907 raeburn 4919: co => 1,
1.482 raeburn 4920: in => 1,
4921: ep => 1,
4922: ta => 1,
4923: cr => 1,
4924: st => 1,
4925: );
4926: }
4927: foreach my $entry (keys(%roleshash)) {
4928: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4929: if ($trole =~ /^cr/) {
4930: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4931: } else {
4932: next if (!exists($roles{$trole}));
4933: }
4934: if ($tend) {
4935: next if ($tend < $now);
4936: }
4937: if ($tstart) {
4938: next if ($tstart > $now);
4939: }
1.1058 raeburn 4940: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4941: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4942: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4943: if ($secpart eq '') {
4944: ($cnum,$role) = split(/_/,$cnumpart);
4945: $sec = 'none';
1.1058 raeburn 4946: $value .= $cnum.'/';
1.482 raeburn 4947: } else {
4948: $cnum = $cnumpart;
4949: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4950: $value .= $cnum.'/'.$sec;
4951: }
4952: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4953: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4954: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4955: }
4956: } else {
4957: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4958: }
1.482 raeburn 4959: }
4960: } else {
4961: foreach my $key (keys(%env)) {
1.483 albertel 4962: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4963: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4964: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4965: next if ($role eq 'ca' || $role eq 'aa');
4966: next if (%roles && !exists($roles{$role}));
4967: my ($starttime,$endtime)=split(/\./,$env{$key});
4968: my $active=1;
4969: if ($starttime) {
4970: if ($now<$starttime) { $active=0; }
4971: }
4972: if ($endtime) {
4973: if ($now>$endtime) { $active=0; }
4974: }
4975: if ($active) {
1.1058 raeburn 4976: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4977: if ($sec eq '') {
4978: $sec = 'none';
1.1058 raeburn 4979: } else {
4980: $value .= $sec;
4981: }
4982: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4983: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4984: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4985: }
4986: } else {
4987: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4988: }
1.474 raeburn 4989: }
4990: }
1.51 www 4991: }
4992: }
1.474 raeburn 4993: return %courses;
1.51 www 4994: }
1.37 matthew 4995:
1.54 www 4996: ###############################################
1.474 raeburn 4997:
4998: sub blockcheck {
1.1189 raeburn 4999: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 5000:
1.1189 raeburn 5001: if (defined($udom) && defined($uname)) {
5002: # If uname and udom are for a course, check for blocks in the course.
5003: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5004: my ($startblock,$endblock,$triggerblock) =
5005: &get_blocks($setters,$activity,$udom,$uname,$url);
5006: return ($startblock,$endblock,$triggerblock);
5007: }
5008: } else {
1.490 raeburn 5009: $udom = $env{'user.domain'};
5010: $uname = $env{'user.name'};
5011: }
5012:
1.502 raeburn 5013: my $startblock = 0;
5014: my $endblock = 0;
1.1062 raeburn 5015: my $triggerblock = '';
1.482 raeburn 5016: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 5017:
1.490 raeburn 5018: # If uname is for a user, and activity is course-specific, i.e.,
5019: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5020:
1.490 raeburn 5021: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5022: $activity eq 'groups' || $activity eq 'printout' ||
5023: $activity eq 'reinit' || $activity eq 'alert') &&
1.1189 raeburn 5024: ($env{'request.course.id'})) {
1.490 raeburn 5025: foreach my $key (keys(%live_courses)) {
5026: if ($key ne $env{'request.course.id'}) {
5027: delete($live_courses{$key});
5028: }
5029: }
5030: }
5031:
5032: my $otheruser = 0;
5033: my %own_courses;
5034: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5035: # Resource belongs to user other than current user.
5036: $otheruser = 1;
5037: # Gather courses for current user
5038: %own_courses =
5039: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5040: }
5041:
5042: # Gather active course roles - course coordinator, instructor,
5043: # exam proctor, ta, student, or custom role.
1.474 raeburn 5044:
5045: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5046: my ($cdom,$cnum);
5047: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5048: $cdom = $env{'course.'.$course.'.domain'};
5049: $cnum = $env{'course.'.$course.'.num'};
5050: } else {
1.490 raeburn 5051: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5052: }
5053: my $no_ownblock = 0;
5054: my $no_userblock = 0;
1.533 raeburn 5055: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5056: # Check if current user has 'evb' priv for this
5057: if (defined($own_courses{$course})) {
5058: foreach my $sec (keys(%{$own_courses{$course}})) {
5059: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5060: if ($sec ne 'none') {
5061: $checkrole .= '/'.$sec;
5062: }
5063: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5064: $no_ownblock = 1;
5065: last;
5066: }
5067: }
5068: }
5069: # if they have 'evb' priv and are currently not playing student
5070: next if (($no_ownblock) &&
5071: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5072: }
1.474 raeburn 5073: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5074: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5075: if ($sec ne 'none') {
1.482 raeburn 5076: $checkrole .= '/'.$sec;
1.474 raeburn 5077: }
1.490 raeburn 5078: if ($otheruser) {
5079: # Resource belongs to user other than current user.
5080: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5081: my (%allroles,%userroles);
5082: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5083: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5084: my ($trole,$tdom,$tnum,$tsec);
5085: if ($entry =~ /^cr/) {
5086: ($trole,$tdom,$tnum,$tsec) =
5087: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5088: } else {
5089: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5090: }
5091: my ($spec,$area,$trest);
5092: $area = '/'.$tdom.'/'.$tnum;
5093: $trest = $tnum;
5094: if ($tsec ne '') {
5095: $area .= '/'.$tsec;
5096: $trest .= '/'.$tsec;
5097: }
5098: $spec = $trole.'.'.$area;
5099: if ($trole =~ /^cr/) {
5100: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5101: $tdom,$spec,$trest,$area);
5102: } else {
5103: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5104: $tdom,$spec,$trest,$area);
5105: }
5106: }
1.1276 raeburn 5107: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5108: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5109: if ($1) {
5110: $no_userblock = 1;
5111: last;
5112: }
1.486 raeburn 5113: }
5114: }
1.490 raeburn 5115: } else {
5116: # Resource belongs to current user
5117: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5118: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5119: $no_ownblock = 1;
5120: last;
5121: }
1.474 raeburn 5122: }
5123: }
5124: # if they have the evb priv and are currently not playing student
1.482 raeburn 5125: next if (($no_ownblock) &&
1.491 albertel 5126: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5127: next if ($no_userblock);
1.474 raeburn 5128:
1.1303 raeburn 5129: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5130: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5131:
1.1062 raeburn 5132: my ($start,$end,$trigger) =
5133: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5134: if (($start != 0) &&
5135: (($startblock == 0) || ($startblock > $start))) {
5136: $startblock = $start;
1.1062 raeburn 5137: if ($trigger ne '') {
5138: $triggerblock = $trigger;
5139: }
1.502 raeburn 5140: }
5141: if (($end != 0) &&
5142: (($endblock == 0) || ($endblock < $end))) {
5143: $endblock = $end;
1.1062 raeburn 5144: if ($trigger ne '') {
5145: $triggerblock = $trigger;
5146: }
1.502 raeburn 5147: }
1.490 raeburn 5148: }
1.1062 raeburn 5149: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5150: }
5151:
5152: sub get_blocks {
1.1062 raeburn 5153: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5154: my $startblock = 0;
5155: my $endblock = 0;
1.1062 raeburn 5156: my $triggerblock = '';
1.490 raeburn 5157: my $course = $cdom.'_'.$cnum;
5158: $setters->{$course} = {};
5159: $setters->{$course}{'staff'} = [];
5160: $setters->{$course}{'times'} = [];
1.1062 raeburn 5161: $setters->{$course}{'triggers'} = [];
5162: my (@blockers,%triggered);
5163: my $now = time;
5164: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5165: if ($activity eq 'docs') {
5166: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5167: foreach my $block (@blockers) {
5168: if ($block =~ /^firstaccess____(.+)$/) {
5169: my $item = $1;
5170: my $type = 'map';
5171: my $timersymb = $item;
5172: if ($item eq 'course') {
5173: $type = 'course';
5174: } elsif ($item =~ /___\d+___/) {
5175: $type = 'resource';
5176: } else {
5177: $timersymb = &Apache::lonnet::symbread($item);
5178: }
5179: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5180: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5181: $triggered{$block} = {
5182: start => $start,
5183: end => $end,
5184: type => $type,
5185: };
5186: }
5187: }
5188: } else {
5189: foreach my $block (keys(%commblocks)) {
5190: if ($block =~ m/^(\d+)____(\d+)$/) {
5191: my ($start,$end) = ($1,$2);
5192: if ($start <= time && $end >= time) {
5193: if (ref($commblocks{$block}) eq 'HASH') {
5194: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5195: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5196: unless(grep(/^\Q$block\E$/,@blockers)) {
5197: push(@blockers,$block);
5198: }
5199: }
5200: }
5201: }
5202: }
5203: } elsif ($block =~ /^firstaccess____(.+)$/) {
5204: my $item = $1;
5205: my $timersymb = $item;
5206: my $type = 'map';
5207: if ($item eq 'course') {
5208: $type = 'course';
5209: } elsif ($item =~ /___\d+___/) {
5210: $type = 'resource';
5211: } else {
5212: $timersymb = &Apache::lonnet::symbread($item);
5213: }
5214: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5215: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5216: if ($start && $end) {
5217: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5218: if (ref($commblocks{$block}) eq 'HASH') {
5219: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5220: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5221: unless(grep(/^\Q$block\E$/,@blockers)) {
5222: push(@blockers,$block);
5223: $triggered{$block} = {
5224: start => $start,
5225: end => $end,
5226: type => $type,
5227: };
5228: }
5229: }
5230: }
1.1062 raeburn 5231: }
5232: }
1.490 raeburn 5233: }
1.1062 raeburn 5234: }
5235: }
5236: }
5237: foreach my $blocker (@blockers) {
5238: my ($staff_name,$staff_dom,$title,$blocks) =
5239: &parse_block_record($commblocks{$blocker});
5240: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5241: my ($start,$end,$triggertype);
5242: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5243: ($start,$end) = ($1,$2);
5244: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5245: $start = $triggered{$blocker}{'start'};
5246: $end = $triggered{$blocker}{'end'};
5247: $triggertype = $triggered{$blocker}{'type'};
5248: }
5249: if ($start) {
5250: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5251: if ($triggertype) {
5252: push(@{$$setters{$course}{'triggers'}},$triggertype);
5253: } else {
5254: push(@{$$setters{$course}{'triggers'}},0);
5255: }
5256: if ( ($startblock == 0) || ($startblock > $start) ) {
5257: $startblock = $start;
5258: if ($triggertype) {
5259: $triggerblock = $blocker;
1.474 raeburn 5260: }
5261: }
1.1062 raeburn 5262: if ( ($endblock == 0) || ($endblock < $end) ) {
5263: $endblock = $end;
5264: if ($triggertype) {
5265: $triggerblock = $blocker;
5266: }
5267: }
1.474 raeburn 5268: }
5269: }
1.1062 raeburn 5270: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5271: }
5272:
5273: sub parse_block_record {
5274: my ($record) = @_;
5275: my ($setuname,$setudom,$title,$blocks);
5276: if (ref($record) eq 'HASH') {
5277: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5278: $title = &unescape($record->{'event'});
5279: $blocks = $record->{'blocks'};
5280: } else {
5281: my @data = split(/:/,$record,3);
5282: if (scalar(@data) eq 2) {
5283: $title = $data[1];
5284: ($setuname,$setudom) = split(/@/,$data[0]);
5285: } else {
5286: ($setuname,$setudom,$title) = @data;
5287: }
5288: $blocks = { 'com' => 'on' };
5289: }
5290: return ($setuname,$setudom,$title,$blocks);
5291: }
5292:
1.854 kalberla 5293: sub blocking_status {
1.1189 raeburn 5294: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5295: my %setters;
1.890 droeschl 5296:
1.1061 raeburn 5297: # check for active blocking
1.1062 raeburn 5298: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5299: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5300: my $blocked = 0;
5301: if ($startblock && $endblock) {
5302: $blocked = 1;
5303: }
1.890 droeschl 5304:
1.1061 raeburn 5305: # caller just wants to know whether a block is active
5306: if (!wantarray) { return $blocked; }
5307:
5308: # build a link to a popup window containing the details
5309: my $querystring = "?activity=$activity";
5310: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5311: if (($activity eq 'port') || ($activity eq 'passwd')) {
5312: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5313: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5314: } elsif ($activity eq 'docs') {
5315: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5316: }
1.1061 raeburn 5317:
5318: my $output .= <<'END_MYBLOCK';
5319: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5320: var options = "width=" + w + ",height=" + h + ",";
5321: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5322: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5323: var newWin = window.open(url, wdwName, options);
5324: newWin.focus();
5325: }
1.890 droeschl 5326: END_MYBLOCK
1.854 kalberla 5327:
1.1061 raeburn 5328: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5329:
1.1061 raeburn 5330: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5331: my $text = &mt('Communication Blocked');
1.1217 raeburn 5332: my $class = 'LC_comblock';
1.1062 raeburn 5333: if ($activity eq 'docs') {
5334: $text = &mt('Content Access Blocked');
1.1217 raeburn 5335: $class = '';
1.1063 raeburn 5336: } elsif ($activity eq 'printout') {
5337: $text = &mt('Printing Blocked');
1.1232 raeburn 5338: } elsif ($activity eq 'passwd') {
5339: $text = &mt('Password Changing Blocked');
1.1282 raeburn 5340: } elsif ($activity eq 'alert') {
5341: $text = &mt('Checking Critical Messages Blocked');
5342: } elsif ($activity eq 'reinit') {
5343: $text = &mt('Checking Course Update Blocked');
1.1062 raeburn 5344: }
1.1061 raeburn 5345: $output .= <<"END_BLOCK";
1.1217 raeburn 5346: <div class='$class'>
1.869 kalberla 5347: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5348: title='$text'>
5349: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5350: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5351: title='$text'>$text</a>
1.867 kalberla 5352: </div>
5353:
5354: END_BLOCK
1.474 raeburn 5355:
1.1061 raeburn 5356: return ($blocked, $output);
1.854 kalberla 5357: }
1.490 raeburn 5358:
1.60 matthew 5359: ###############################################
5360:
1.682 raeburn 5361: sub check_ip_acc {
1.1201 raeburn 5362: my ($acc,$clientip)=@_;
1.682 raeburn 5363: &Apache::lonxml::debug("acc is $acc");
5364: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5365: return 1;
5366: }
1.1219 raeburn 5367: my $allowed;
1.1252 raeburn 5368: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5369:
5370: my $name;
1.1219 raeburn 5371: my %access = (
5372: allowfrom => 1,
5373: denyfrom => 0,
5374: );
5375: my @allows;
5376: my @denies;
5377: foreach my $item (split(',',$acc)) {
5378: $item =~ s/^\s*//;
5379: $item =~ s/\s*$//;
5380: my $pattern;
5381: if ($item =~ /^\!(.+)$/) {
5382: push(@denies,$1);
5383: } else {
5384: push(@allows,$item);
5385: }
5386: }
5387: my $numdenies = scalar(@denies);
5388: my $numallows = scalar(@allows);
5389: my $count = 0;
5390: foreach my $pattern (@denies,@allows) {
5391: $count ++;
5392: my $acctype = 'allowfrom';
5393: if ($count <= $numdenies) {
5394: $acctype = 'denyfrom';
5395: }
1.682 raeburn 5396: if ($pattern =~ /\*$/) {
5397: #35.8.*
5398: $pattern=~s/\*//;
1.1219 raeburn 5399: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5400: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5401: #35.8.3.[34-56]
5402: my $low=$2;
5403: my $high=$3;
5404: $pattern=$1;
5405: if ($ip =~ /^\Q$pattern\E/) {
5406: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5407: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5408: }
5409: } elsif ($pattern =~ /^\*/) {
5410: #*.msu.edu
5411: $pattern=~s/\*//;
5412: if (!defined($name)) {
5413: use Socket;
5414: my $netaddr=inet_aton($ip);
5415: ($name)=gethostbyaddr($netaddr,AF_INET);
5416: }
1.1219 raeburn 5417: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5418: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5419: #127.0.0.1
1.1219 raeburn 5420: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5421: } else {
5422: #some.name.com
5423: if (!defined($name)) {
5424: use Socket;
5425: my $netaddr=inet_aton($ip);
5426: ($name)=gethostbyaddr($netaddr,AF_INET);
5427: }
1.1219 raeburn 5428: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5429: }
5430: if ($allowed =~ /^(0|1)$/) { last; }
5431: }
5432: if ($allowed eq '') {
5433: if ($numdenies && !$numallows) {
5434: $allowed = 1;
5435: } else {
5436: $allowed = 0;
1.682 raeburn 5437: }
5438: }
5439: return $allowed;
5440: }
5441:
5442: ###############################################
5443:
1.60 matthew 5444: =pod
5445:
1.112 bowersj2 5446: =head1 Domain Template Functions
5447:
5448: =over 4
5449:
5450: =item * &determinedomain()
1.60 matthew 5451:
5452: Inputs: $domain (usually will be undef)
5453:
1.63 www 5454: Returns: Determines which domain should be used for designs
1.60 matthew 5455:
5456: =cut
1.54 www 5457:
1.60 matthew 5458: ###############################################
1.63 www 5459: sub determinedomain {
5460: my $domain=shift;
1.531 albertel 5461: if (! $domain) {
1.60 matthew 5462: # Determine domain if we have not been given one
1.893 raeburn 5463: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5464: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5465: if ($env{'request.role.domain'}) {
5466: $domain=$env{'request.role.domain'};
1.60 matthew 5467: }
5468: }
1.63 www 5469: return $domain;
5470: }
5471: ###############################################
1.517 raeburn 5472:
1.518 albertel 5473: sub devalidate_domconfig_cache {
5474: my ($udom)=@_;
5475: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5476: }
5477:
5478: # ---------------------- Get domain configuration for a domain
5479: sub get_domainconf {
5480: my ($udom) = @_;
5481: my $cachetime=1800;
5482: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5483: if (defined($cached)) { return %{$result}; }
5484:
5485: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5486: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5487: my (%designhash,%legacy);
1.518 albertel 5488: if (keys(%domconfig) > 0) {
5489: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5490: if (keys(%{$domconfig{'login'}})) {
5491: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5492: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5493: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5494: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5495: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5496: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5497: if ($key eq 'loginvia') {
5498: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5499: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5500: $designhash{$udom.'.login.loginvia'} = $server;
5501: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5502:
5503: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5504: } else {
5505: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5506: }
1.948 raeburn 5507: }
1.1208 raeburn 5508: } elsif ($key eq 'headtag') {
5509: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5510: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5511: }
1.946 raeburn 5512: }
1.1208 raeburn 5513: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5514: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5515: }
1.946 raeburn 5516: }
5517: }
5518: }
5519: } else {
5520: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5521: $designhash{$udom.'.login.'.$key.'_'.$img} =
5522: $domconfig{'login'}{$key}{$img};
5523: }
1.699 raeburn 5524: }
5525: } else {
5526: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5527: }
1.632 raeburn 5528: }
5529: } else {
5530: $legacy{'login'} = 1;
1.518 albertel 5531: }
1.632 raeburn 5532: } else {
5533: $legacy{'login'} = 1;
1.518 albertel 5534: }
5535: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5536: if (keys(%{$domconfig{'rolecolors'}})) {
5537: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5538: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5539: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5540: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5541: }
1.518 albertel 5542: }
5543: }
1.632 raeburn 5544: } else {
5545: $legacy{'rolecolors'} = 1;
1.518 albertel 5546: }
1.632 raeburn 5547: } else {
5548: $legacy{'rolecolors'} = 1;
1.518 albertel 5549: }
1.948 raeburn 5550: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5551: if ($domconfig{'autoenroll'}{'co-owners'}) {
5552: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5553: }
5554: }
1.632 raeburn 5555: if (keys(%legacy) > 0) {
5556: my %legacyhash = &get_legacy_domconf($udom);
5557: foreach my $item (keys(%legacyhash)) {
5558: if ($item =~ /^\Q$udom\E\.login/) {
5559: if ($legacy{'login'}) {
5560: $designhash{$item} = $legacyhash{$item};
5561: }
5562: } else {
5563: if ($legacy{'rolecolors'}) {
5564: $designhash{$item} = $legacyhash{$item};
5565: }
1.518 albertel 5566: }
5567: }
5568: }
1.632 raeburn 5569: } else {
5570: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5571: }
5572: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5573: $cachetime);
5574: return %designhash;
5575: }
5576:
1.632 raeburn 5577: sub get_legacy_domconf {
5578: my ($udom) = @_;
5579: my %legacyhash;
5580: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5581: my $designfile = $designdir.'/'.$udom.'.tab';
5582: if (-e $designfile) {
5583: if ( open (my $fh,"<$designfile") ) {
5584: while (my $line = <$fh>) {
5585: next if ($line =~ /^\#/);
5586: chomp($line);
5587: my ($key,$val)=(split(/\=/,$line));
5588: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5589: }
5590: close($fh);
5591: }
5592: }
1.1026 raeburn 5593: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5594: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5595: }
5596: return %legacyhash;
5597: }
5598:
1.63 www 5599: =pod
5600:
1.112 bowersj2 5601: =item * &domainlogo()
1.63 www 5602:
5603: Inputs: $domain (usually will be undef)
5604:
5605: Returns: A link to a domain logo, if the domain logo exists.
5606: If the domain logo does not exist, a description of the domain.
5607:
5608: =cut
1.112 bowersj2 5609:
1.63 www 5610: ###############################################
5611: sub domainlogo {
1.517 raeburn 5612: my $domain = &determinedomain(shift);
1.518 albertel 5613: my %designhash = &get_domainconf($domain);
1.517 raeburn 5614: # See if there is a logo
5615: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5616: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5617: if ($imgsrc =~ m{^/(adm|res)/}) {
5618: if ($imgsrc =~ m{^/res/}) {
5619: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5620: &Apache::lonnet::repcopy($local_name);
5621: }
5622: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5623: }
5624: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5625: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5626: return &Apache::lonnet::domain($domain,'description');
1.59 www 5627: } else {
1.60 matthew 5628: return '';
1.59 www 5629: }
5630: }
1.63 www 5631: ##############################################
5632:
5633: =pod
5634:
1.112 bowersj2 5635: =item * &designparm()
1.63 www 5636:
5637: Inputs: $which parameter; $domain (usually will be undef)
5638:
5639: Returns: value of designparamter $which
5640:
5641: =cut
1.112 bowersj2 5642:
1.397 albertel 5643:
1.400 albertel 5644: ##############################################
1.397 albertel 5645: sub designparm {
5646: my ($which,$domain)=@_;
5647: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5648: return $env{'environment.color.'.$which};
1.96 www 5649: }
1.63 www 5650: $domain=&determinedomain($domain);
1.1016 raeburn 5651: my %domdesign;
5652: unless ($domain eq 'public') {
5653: %domdesign = &get_domainconf($domain);
5654: }
1.520 raeburn 5655: my $output;
1.517 raeburn 5656: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5657: $output = $domdesign{$domain.'.'.$which};
1.63 www 5658: } else {
1.520 raeburn 5659: $output = $defaultdesign{$which};
5660: }
5661: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5662: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5663: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5664: if ($output =~ m{^/res/}) {
5665: my $local_name = &Apache::lonnet::filelocation('',$output);
5666: &Apache::lonnet::repcopy($local_name);
5667: }
1.520 raeburn 5668: $output = &lonhttpdurl($output);
5669: }
1.63 www 5670: }
1.520 raeburn 5671: return $output;
1.63 www 5672: }
1.59 www 5673:
1.822 bisitz 5674: ##############################################
5675: =pod
5676:
1.832 bisitz 5677: =item * &authorspace()
5678:
1.1028 raeburn 5679: Inputs: $url (usually will be undef).
1.832 bisitz 5680:
1.1132 raeburn 5681: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5682: directory being viewed (or for which action is being taken).
5683: If $url is provided, and begins /priv/<domain>/<uname>
5684: the path will be that portion of the $context argument.
5685: Otherwise the path will be for the author space of the current
5686: user when the current role is author, or for that of the
5687: co-author/assistant co-author space when the current role
5688: is co-author or assistant co-author.
1.832 bisitz 5689:
5690: =cut
5691:
5692: sub authorspace {
1.1028 raeburn 5693: my ($url) = @_;
5694: if ($url ne '') {
5695: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5696: return $1;
5697: }
5698: }
1.832 bisitz 5699: my $caname = '';
1.1024 www 5700: my $cadom = '';
1.1028 raeburn 5701: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5702: ($cadom,$caname) =
1.832 bisitz 5703: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5704: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5705: $caname = $env{'user.name'};
1.1024 www 5706: $cadom = $env{'user.domain'};
1.832 bisitz 5707: }
1.1028 raeburn 5708: if (($caname ne '') && ($cadom ne '')) {
5709: return "/priv/$cadom/$caname/";
5710: }
5711: return;
1.832 bisitz 5712: }
5713:
5714: ##############################################
5715: =pod
5716:
1.822 bisitz 5717: =item * &head_subbox()
5718:
5719: Inputs: $content (contains HTML code with page functions, etc.)
5720:
5721: Returns: HTML div with $content
5722: To be included in page header
5723:
5724: =cut
5725:
5726: sub head_subbox {
5727: my ($content)=@_;
5728: my $output =
1.993 raeburn 5729: '<div class="LC_head_subbox">'
1.822 bisitz 5730: .$content
5731: .'</div>'
5732: }
5733:
5734: ##############################################
5735: =pod
5736:
5737: =item * &CSTR_pageheader()
5738:
1.1026 raeburn 5739: Input: (optional) filename from which breadcrumb trail is built.
5740: In most cases no input as needed, as $env{'request.filename'}
5741: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5742:
5743: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5744: To be included on Authoring Space pages
1.822 bisitz 5745:
5746: =cut
5747:
5748: sub CSTR_pageheader {
1.1026 raeburn 5749: my ($trailfile) = @_;
5750: if ($trailfile eq '') {
5751: $trailfile = $env{'request.filename'};
5752: }
5753:
5754: # this is for resources; directories have customtitle, and crumbs
5755: # and select recent are created in lonpubdir.pm
5756:
5757: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5758: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5759: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5760: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5761: $formaction =~ s{/+}{/}g;
1.822 bisitz 5762:
5763: my $parentpath = '';
5764: my $lastitem = '';
5765: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5766: $parentpath = $1;
5767: $lastitem = $2;
5768: } else {
5769: $lastitem = $thisdisfn;
5770: }
1.921 bisitz 5771:
1.1246 raeburn 5772: my ($crsauthor,$title);
5773: if (($env{'request.course.id'}) &&
5774: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5775: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5776: $crsauthor = 1;
5777: $title = &mt('Course Authoring Space');
5778: } else {
5779: $title = &mt('Authoring Space');
5780: }
5781:
1.921 bisitz 5782: my $output =
1.822 bisitz 5783: '<div>'
5784: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5785: .'<b>'.$title.'</b> '
1.822 bisitz 5786: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5787: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5788: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5789:
5790: if ($lastitem) {
5791: $output .=
5792: '<span class="LC_filename">'
5793: .$lastitem
5794: .'</span>';
5795: }
1.1245 raeburn 5796:
1.1246 raeburn 5797: if ($crsauthor) {
5798: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5799: } else {
5800: $output .=
5801: '<br />'
5802: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5803: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5804: .'</form>'
5805: .&Apache::lonmenu::constspaceform();
5806: }
5807: $output .= '</div>';
1.921 bisitz 5808:
5809: return $output;
1.822 bisitz 5810: }
5811:
1.60 matthew 5812: ###############################################
5813: ###############################################
5814:
5815: =pod
5816:
1.112 bowersj2 5817: =back
5818:
1.549 albertel 5819: =head1 HTML Helpers
1.112 bowersj2 5820:
5821: =over 4
5822:
5823: =item * &bodytag()
1.60 matthew 5824:
5825: Returns a uniform header for LON-CAPA web pages.
5826:
5827: Inputs:
5828:
1.112 bowersj2 5829: =over 4
5830:
5831: =item * $title, A title to be displayed on the page.
5832:
5833: =item * $function, the current role (can be undef).
5834:
5835: =item * $addentries, extra parameters for the <body> tag.
5836:
5837: =item * $bodyonly, if defined, only return the <body> tag.
5838:
5839: =item * $domain, if defined, force a given domain.
5840:
5841: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5842: text interface only)
1.60 matthew 5843:
1.814 bisitz 5844: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5845: navigational links
1.317 albertel 5846:
1.338 albertel 5847: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5848:
1.460 albertel 5849: =item * $args, optional argument valid values are
5850: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 5851: use_absolute -> for external resource or syllabus, this will
5852: contain https://<hostname> if server uses
5853: https (as per hosts.tab), but request is for http
5854: hostname -> hostname, from $r->hostname().
1.460 albertel 5855:
1.1096 raeburn 5856: =item * $advtoolsref, optional argument, ref to an array containing
5857: inlineremote items to be added in "Functions" menu below
5858: breadcrumbs.
5859:
1.112 bowersj2 5860: =back
5861:
1.60 matthew 5862: Returns: A uniform header for LON-CAPA web pages.
5863: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5864: If $bodyonly is undef or zero, an html string containing a <body> tag and
5865: other decorations will be returned.
5866:
5867: =cut
5868:
1.54 www 5869: sub bodytag {
1.831 bisitz 5870: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5871: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5872:
1.954 raeburn 5873: my $public;
5874: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5875: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5876: $public = 1;
5877: }
1.460 albertel 5878: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5879: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 5880: my $hostname = $args->{'hostname'};
1.339 albertel 5881:
1.183 matthew 5882: $function = &get_users_function() if (!$function);
1.339 albertel 5883: my $img = &designparm($function.'.img',$domain);
5884: my $font = &designparm($function.'.font',$domain);
5885: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5886:
1.803 bisitz 5887: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5888: 'bgcolor' => $pgbg,
1.339 albertel 5889: 'text' => $font,
5890: 'alink' => &designparm($function.'.alink',$domain),
5891: 'vlink' => &designparm($function.'.vlink',$domain),
5892: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5893: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5894:
1.63 www 5895: # role and realm
1.1178 raeburn 5896: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5897: if ($realm) {
5898: $realm = '/'.$realm;
5899: }
1.378 raeburn 5900: if ($role eq 'ca') {
1.479 albertel 5901: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5902: $realm = &plainname($rname,$rdom);
1.378 raeburn 5903: }
1.55 www 5904: # realm
1.258 albertel 5905: if ($env{'request.course.id'}) {
1.378 raeburn 5906: if ($env{'request.role'} !~ /^cr/) {
5907: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 5908: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 5909: if ($env{'request.role.desc'}) {
5910: $role = $env{'request.role.desc'};
5911: } else {
5912: $role = &mt('Helpdesk[_1]',' '.$2);
5913: }
1.1257 raeburn 5914: } else {
5915: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5916: }
1.898 raeburn 5917: if ($env{'request.course.sec'}) {
5918: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5919: }
1.359 albertel 5920: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5921: } else {
5922: $role = &Apache::lonnet::plaintext($role);
1.54 www 5923: }
1.433 albertel 5924:
1.359 albertel 5925: if (!$realm) { $realm=' '; }
1.330 albertel 5926:
1.438 albertel 5927: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5928:
1.101 www 5929: # construct main body tag
1.359 albertel 5930: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5931: &Apache::lontexconvert::init_math_support();
1.252 albertel 5932:
1.1131 raeburn 5933: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5934:
1.1130 raeburn 5935: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5936: return $bodytag;
1.1130 raeburn 5937: }
1.359 albertel 5938:
1.954 raeburn 5939: if ($public) {
1.433 albertel 5940: undef($role);
5941: }
1.359 albertel 5942:
1.762 bisitz 5943: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5944: #
5945: # Extra info if you are the DC
5946: my $dc_info = '';
5947: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5948: $env{'course.'.$env{'request.course.id'}.
5949: '.domain'}.'/'})) {
5950: my $cid = $env{'request.course.id'};
1.917 raeburn 5951: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5952: $dc_info =~ s/\s+$//;
1.359 albertel 5953: }
5954:
1.1237 raeburn 5955: my $crstype;
5956: if ($env{'request.course.id'}) {
5957: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5958: } elsif ($args->{'crstype'}) {
5959: $crstype = $args->{'crstype'};
5960: }
5961: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5962: undef($role);
5963: } else {
1.1242 raeburn 5964: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 5965: }
1.853 droeschl 5966:
1.903 droeschl 5967: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5968:
5969: # if ($env{'request.state'} eq 'construct') {
5970: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5971: # }
5972:
1.1130 raeburn 5973: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5974: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5975:
1.1237 raeburn 5976: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5977:
1.916 droeschl 5978: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5979: if ($dc_info) {
5980: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5981: }
1.1130 raeburn 5982: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5983: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5984: return $bodytag;
5985: }
1.894 droeschl 5986:
1.927 raeburn 5987: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5988: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5989: }
1.916 droeschl 5990:
1.1130 raeburn 5991: $bodytag .= $right;
1.852 droeschl 5992:
1.917 raeburn 5993: if ($dc_info) {
5994: $dc_info = &dc_courseid_toggle($dc_info);
5995: }
5996: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5997:
1.1169 raeburn 5998: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5999: if ($args->{'no_secondary_menu'}) {
6000: return $bodytag;
6001: }
1.1169 raeburn 6002: #don't show menus for public users
1.954 raeburn 6003: if (!$public){
1.1154 raeburn 6004: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 6005: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6006: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6007: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6008: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1274 raeburn 6009: $args->{'bread_crumbs'},'','',$hostname);
1.1096 raeburn 6010: } elsif ($forcereg) {
6011: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 6012: $args->{'group'},
1.1274 raeburn 6013: $args->{'hide_buttons'},
6014: $hostname);
1.1096 raeburn 6015: } else {
6016: $bodytag .=
6017: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6018: $forcereg,$args->{'group'},
6019: $args->{'bread_crumbs'},
1.1274 raeburn 6020: $advtoolsref,'',$hostname);
1.920 raeburn 6021: }
1.903 droeschl 6022: }else{
6023: # this is to seperate menu from content when there's no secondary
6024: # menu. Especially needed for public accessible ressources.
6025: $bodytag .= '<hr style="clear:both" />';
6026: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6027: }
1.903 droeschl 6028:
1.235 raeburn 6029: return $bodytag;
1.182 matthew 6030: }
6031:
1.917 raeburn 6032: sub dc_courseid_toggle {
6033: my ($dc_info) = @_;
1.980 raeburn 6034: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6035: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6036: &mt('(More ...)').'</a></span>'.
6037: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6038: }
6039:
1.330 albertel 6040: sub make_attr_string {
6041: my ($register,$attr_ref) = @_;
6042:
6043: if ($attr_ref && !ref($attr_ref)) {
6044: die("addentries Must be a hash ref ".
6045: join(':',caller(1))." ".
6046: join(':',caller(0))." ");
6047: }
6048:
6049: if ($register) {
1.339 albertel 6050: my ($on_load,$on_unload);
6051: foreach my $key (keys(%{$attr_ref})) {
6052: if (lc($key) eq 'onload') {
6053: $on_load.=$attr_ref->{$key}.';';
6054: delete($attr_ref->{$key});
6055:
6056: } elsif (lc($key) eq 'onunload') {
6057: $on_unload.=$attr_ref->{$key}.';';
6058: delete($attr_ref->{$key});
6059: }
6060: }
1.953 droeschl 6061: $attr_ref->{'onload'} = $on_load;
6062: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6063: }
1.339 albertel 6064:
1.330 albertel 6065: my $attr_string;
1.1159 raeburn 6066: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6067: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6068: }
6069: return $attr_string;
6070: }
6071:
6072:
1.182 matthew 6073: ###############################################
1.251 albertel 6074: ###############################################
6075:
6076: =pod
6077:
6078: =item * &endbodytag()
6079:
6080: Returns a uniform footer for LON-CAPA web pages.
6081:
1.635 raeburn 6082: Inputs: 1 - optional reference to an args hash
6083: If in the hash, key for noredirectlink has a value which evaluates to true,
6084: a 'Continue' link is not displayed if the page contains an
6085: internal redirect in the <head></head> section,
6086: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6087:
6088: =cut
6089:
6090: sub endbodytag {
1.635 raeburn 6091: my ($args) = @_;
1.1080 raeburn 6092: my $endbodytag;
6093: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6094: $endbodytag='</body>';
6095: }
1.315 albertel 6096: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6097: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6098: $endbodytag=
6099: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6100: &mt('Continue').'</a>'.
6101: $endbodytag;
6102: }
1.315 albertel 6103: }
1.251 albertel 6104: return $endbodytag;
6105: }
6106:
1.352 albertel 6107: =pod
6108:
6109: =item * &standard_css()
6110:
6111: Returns a style sheet
6112:
6113: Inputs: (all optional)
6114: domain -> force to color decorate a page for a specific
6115: domain
6116: function -> force usage of a specific rolish color scheme
6117: bgcolor -> override the default page bgcolor
6118:
6119: =cut
6120:
1.343 albertel 6121: sub standard_css {
1.345 albertel 6122: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6123: $function = &get_users_function() if (!$function);
6124: my $img = &designparm($function.'.img', $domain);
6125: my $tabbg = &designparm($function.'.tabbg', $domain);
6126: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6127: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6128: #second colour for later usage
1.345 albertel 6129: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6130: my $pgbg_or_bgcolor =
6131: $bgcolor ||
1.352 albertel 6132: &designparm($function.'.pgbg', $domain);
1.382 albertel 6133: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6134: my $alink = &designparm($function.'.alink', $domain);
6135: my $vlink = &designparm($function.'.vlink', $domain);
6136: my $link = &designparm($function.'.link', $domain);
6137:
1.602 albertel 6138: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6139: my $mono = 'monospace';
1.850 bisitz 6140: my $data_table_head = $sidebg;
6141: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6142: my $data_table_dark = '#E0E0E0';
1.470 banghart 6143: my $data_table_darker = '#CCCCCC';
1.349 albertel 6144: my $data_table_highlight = '#FFFF00';
1.352 albertel 6145: my $mail_new = '#FFBB77';
6146: my $mail_new_hover = '#DD9955';
6147: my $mail_read = '#BBBB77';
6148: my $mail_read_hover = '#999944';
6149: my $mail_replied = '#AAAA88';
6150: my $mail_replied_hover = '#888855';
6151: my $mail_other = '#99BBBB';
6152: my $mail_other_hover = '#669999';
1.391 albertel 6153: my $table_header = '#DDDDDD';
1.489 raeburn 6154: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6155: my $lg_border_color = '#C8C8C8';
1.952 onken 6156: my $button_hover = '#BF2317';
1.392 albertel 6157:
1.608 albertel 6158: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6159: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6160: : '0 3px 0 4px';
1.448 albertel 6161:
1.523 albertel 6162:
1.343 albertel 6163: return <<END;
1.947 droeschl 6164:
6165: /* needed for iframe to allow 100% height in FF */
6166: body, html {
6167: margin: 0;
6168: padding: 0 0.5%;
6169: height: 99%; /* to avoid scrollbars */
6170: }
6171:
1.795 www 6172: body {
1.911 bisitz 6173: font-family: $sans;
6174: line-height:130%;
6175: font-size:0.83em;
6176: color:$font;
1.795 www 6177: }
6178:
1.959 onken 6179: a:focus,
6180: a:focus img {
1.795 www 6181: color: red;
6182: }
1.698 harmsja 6183:
1.911 bisitz 6184: form, .inline {
6185: display: inline;
1.795 www 6186: }
1.721 harmsja 6187:
1.795 www 6188: .LC_right {
1.911 bisitz 6189: text-align:right;
1.795 www 6190: }
6191:
6192: .LC_middle {
1.911 bisitz 6193: vertical-align:middle;
1.795 www 6194: }
1.721 harmsja 6195:
1.1130 raeburn 6196: .LC_floatleft {
6197: float: left;
6198: }
6199:
6200: .LC_floatright {
6201: float: right;
6202: }
6203:
1.911 bisitz 6204: .LC_400Box {
6205: width:400px;
6206: }
1.721 harmsja 6207:
1.947 droeschl 6208: .LC_iframecontainer {
6209: width: 98%;
6210: margin: 0;
6211: position: fixed;
6212: top: 8.5em;
6213: bottom: 0;
6214: }
6215:
6216: .LC_iframecontainer iframe{
6217: border: none;
6218: width: 100%;
6219: height: 100%;
6220: }
6221:
1.778 bisitz 6222: .LC_filename {
6223: font-family: $mono;
6224: white-space:pre;
1.921 bisitz 6225: font-size: 120%;
1.778 bisitz 6226: }
6227:
6228: .LC_fileicon {
6229: border: none;
6230: height: 1.3em;
6231: vertical-align: text-bottom;
6232: margin-right: 0.3em;
6233: text-decoration:none;
6234: }
6235:
1.1008 www 6236: .LC_setting {
6237: text-decoration:underline;
6238: }
6239:
1.350 albertel 6240: .LC_error {
6241: color: red;
6242: }
1.795 www 6243:
1.1097 bisitz 6244: .LC_warning {
6245: color: darkorange;
6246: }
6247:
1.457 albertel 6248: .LC_diff_removed {
1.733 bisitz 6249: color: red;
1.394 albertel 6250: }
1.532 albertel 6251:
6252: .LC_info,
1.457 albertel 6253: .LC_success,
6254: .LC_diff_added {
1.350 albertel 6255: color: green;
6256: }
1.795 www 6257:
1.802 bisitz 6258: div.LC_confirm_box {
6259: background-color: #FAFAFA;
6260: border: 1px solid $lg_border_color;
6261: margin-right: 0;
6262: padding: 5px;
6263: }
6264:
6265: div.LC_confirm_box .LC_error img,
6266: div.LC_confirm_box .LC_success img {
6267: vertical-align: middle;
6268: }
6269:
1.1242 raeburn 6270: .LC_maxwidth {
6271: max-width: 100%;
6272: height: auto;
6273: }
6274:
1.1243 raeburn 6275: .LC_textsize_mobile {
6276: \@media only screen and (max-device-width: 480px) {
6277: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6278: }
6279: }
6280:
1.440 albertel 6281: .LC_icon {
1.771 droeschl 6282: border: none;
1.790 droeschl 6283: vertical-align: middle;
1.771 droeschl 6284: }
6285:
1.543 albertel 6286: .LC_docs_spacer {
6287: width: 25px;
6288: height: 1px;
1.771 droeschl 6289: border: none;
1.543 albertel 6290: }
1.346 albertel 6291:
1.532 albertel 6292: .LC_internal_info {
1.735 bisitz 6293: color: #999999;
1.532 albertel 6294: }
6295:
1.794 www 6296: .LC_discussion {
1.1050 www 6297: background: $data_table_dark;
1.911 bisitz 6298: border: 1px solid black;
6299: margin: 2px;
1.794 www 6300: }
6301:
6302: .LC_disc_action_left {
1.1050 www 6303: background: $sidebg;
1.911 bisitz 6304: text-align: left;
1.1050 www 6305: padding: 4px;
6306: margin: 2px;
1.794 www 6307: }
6308:
6309: .LC_disc_action_right {
1.1050 www 6310: background: $sidebg;
1.911 bisitz 6311: text-align: right;
1.1050 www 6312: padding: 4px;
6313: margin: 2px;
1.794 www 6314: }
6315:
6316: .LC_disc_new_item {
1.911 bisitz 6317: background: white;
6318: border: 2px solid red;
1.1050 www 6319: margin: 4px;
6320: padding: 4px;
1.794 www 6321: }
6322:
6323: .LC_disc_old_item {
1.911 bisitz 6324: background: white;
1.1050 www 6325: margin: 4px;
6326: padding: 4px;
1.794 www 6327: }
6328:
1.458 albertel 6329: table.LC_pastsubmission {
6330: border: 1px solid black;
6331: margin: 2px;
6332: }
6333:
1.924 bisitz 6334: table#LC_menubuttons {
1.345 albertel 6335: width: 100%;
6336: background: $pgbg;
1.392 albertel 6337: border: 2px;
1.402 albertel 6338: border-collapse: separate;
1.803 bisitz 6339: padding: 0;
1.345 albertel 6340: }
1.392 albertel 6341:
1.801 tempelho 6342: table#LC_title_bar a {
6343: color: $fontmenu;
6344: }
1.836 bisitz 6345:
1.807 droeschl 6346: table#LC_title_bar {
1.819 tempelho 6347: clear: both;
1.836 bisitz 6348: display: none;
1.807 droeschl 6349: }
6350:
1.795 www 6351: table#LC_title_bar,
1.933 droeschl 6352: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6353: table#LC_title_bar.LC_with_remote {
1.359 albertel 6354: width: 100%;
1.392 albertel 6355: border-color: $pgbg;
6356: border-style: solid;
6357: border-width: $border;
1.379 albertel 6358: background: $pgbg;
1.801 tempelho 6359: color: $fontmenu;
1.392 albertel 6360: border-collapse: collapse;
1.803 bisitz 6361: padding: 0;
1.819 tempelho 6362: margin: 0;
1.359 albertel 6363: }
1.795 www 6364:
1.933 droeschl 6365: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6366: margin: 0;
6367: padding: 0;
1.933 droeschl 6368: position: relative;
6369: list-style: none;
1.913 droeschl 6370: }
1.933 droeschl 6371: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6372: display: inline;
6373: }
1.933 droeschl 6374:
6375: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6376: padding: 0;
1.933 droeschl 6377: margin: 0;
6378: float: left;
1.913 droeschl 6379: }
1.933 droeschl 6380: .LC_breadcrumb_tools_tools {
6381: padding: 0;
6382: margin: 0;
1.913 droeschl 6383: float: right;
6384: }
6385:
1.1240 raeburn 6386: .LC_placement_prog {
6387: padding-right: 20px;
6388: font-weight: bold;
6389: font-size: 90%;
6390: }
6391:
1.359 albertel 6392: table#LC_title_bar td {
6393: background: $tabbg;
6394: }
1.795 www 6395:
1.911 bisitz 6396: table#LC_menubuttons img {
1.803 bisitz 6397: border: none;
1.346 albertel 6398: }
1.795 www 6399:
1.842 droeschl 6400: .LC_breadcrumbs_component {
1.911 bisitz 6401: float: right;
6402: margin: 0 1em;
1.357 albertel 6403: }
1.842 droeschl 6404: .LC_breadcrumbs_component img {
1.911 bisitz 6405: vertical-align: middle;
1.777 tempelho 6406: }
1.795 www 6407:
1.1243 raeburn 6408: .LC_breadcrumbs_hoverable {
6409: background: $sidebg;
6410: }
6411:
1.383 albertel 6412: td.LC_table_cell_checkbox {
6413: text-align: center;
6414: }
1.795 www 6415:
6416: .LC_fontsize_small {
1.911 bisitz 6417: font-size: 70%;
1.705 tempelho 6418: }
6419:
1.844 bisitz 6420: #LC_breadcrumbs {
1.911 bisitz 6421: clear:both;
6422: background: $sidebg;
6423: border-bottom: 1px solid $lg_border_color;
6424: line-height: 2.5em;
1.933 droeschl 6425: overflow: hidden;
1.911 bisitz 6426: margin: 0;
6427: padding: 0;
1.995 raeburn 6428: text-align: left;
1.819 tempelho 6429: }
1.862 bisitz 6430:
1.1098 bisitz 6431: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6432: clear:both;
6433: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6434: border: 1px solid $sidebg;
1.1098 bisitz 6435: margin: 0 0 10px 0;
1.966 bisitz 6436: padding: 3px;
1.995 raeburn 6437: text-align: left;
1.822 bisitz 6438: }
6439:
1.795 www 6440: .LC_fontsize_medium {
1.911 bisitz 6441: font-size: 85%;
1.705 tempelho 6442: }
6443:
1.795 www 6444: .LC_fontsize_large {
1.911 bisitz 6445: font-size: 120%;
1.705 tempelho 6446: }
6447:
1.346 albertel 6448: .LC_menubuttons_inline_text {
6449: color: $font;
1.698 harmsja 6450: font-size: 90%;
1.701 harmsja 6451: padding-left:3px;
1.346 albertel 6452: }
6453:
1.934 droeschl 6454: .LC_menubuttons_inline_text img{
6455: vertical-align: middle;
6456: }
6457:
1.1051 www 6458: li.LC_menubuttons_inline_text img {
1.951 onken 6459: cursor:pointer;
1.1002 droeschl 6460: text-decoration: none;
1.951 onken 6461: }
6462:
1.526 www 6463: .LC_menubuttons_link {
6464: text-decoration: none;
6465: }
1.795 www 6466:
1.522 albertel 6467: .LC_menubuttons_category {
1.521 www 6468: color: $font;
1.526 www 6469: background: $pgbg;
1.521 www 6470: font-size: larger;
6471: font-weight: bold;
6472: }
6473:
1.346 albertel 6474: td.LC_menubuttons_text {
1.911 bisitz 6475: color: $font;
1.346 albertel 6476: }
1.706 harmsja 6477:
1.346 albertel 6478: .LC_current_location {
6479: background: $tabbg;
6480: }
1.795 www 6481:
1.1286 raeburn 6482: td.LC_zero_height {
6483: line-height: 0;
6484: cellpadding: 0;
6485: }
6486:
1.938 bisitz 6487: table.LC_data_table {
1.347 albertel 6488: border: 1px solid #000000;
1.402 albertel 6489: border-collapse: separate;
1.426 albertel 6490: border-spacing: 1px;
1.610 albertel 6491: background: $pgbg;
1.347 albertel 6492: }
1.795 www 6493:
1.422 albertel 6494: .LC_data_table_dense {
6495: font-size: small;
6496: }
1.795 www 6497:
1.507 raeburn 6498: table.LC_nested_outer {
6499: border: 1px solid #000000;
1.589 raeburn 6500: border-collapse: collapse;
1.803 bisitz 6501: border-spacing: 0;
1.507 raeburn 6502: width: 100%;
6503: }
1.795 www 6504:
1.879 raeburn 6505: table.LC_innerpickbox,
1.507 raeburn 6506: table.LC_nested {
1.803 bisitz 6507: border: none;
1.589 raeburn 6508: border-collapse: collapse;
1.803 bisitz 6509: border-spacing: 0;
1.507 raeburn 6510: width: 100%;
6511: }
1.795 www 6512:
1.911 bisitz 6513: table.LC_data_table tr th,
6514: table.LC_calendar tr th,
1.879 raeburn 6515: table.LC_prior_tries tr th,
6516: table.LC_innerpickbox tr th {
1.349 albertel 6517: font-weight: bold;
6518: background-color: $data_table_head;
1.801 tempelho 6519: color:$fontmenu;
1.701 harmsja 6520: font-size:90%;
1.347 albertel 6521: }
1.795 www 6522:
1.879 raeburn 6523: table.LC_innerpickbox tr th,
6524: table.LC_innerpickbox tr td {
6525: vertical-align: top;
6526: }
6527:
1.711 raeburn 6528: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6529: background-color: #CCCCCC;
1.711 raeburn 6530: font-weight: bold;
6531: text-align: left;
6532: }
1.795 www 6533:
1.912 bisitz 6534: table.LC_data_table tr.LC_odd_row > td {
6535: background-color: $data_table_light;
6536: padding: 2px;
6537: vertical-align: top;
6538: }
6539:
1.809 bisitz 6540: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6541: background-color: $data_table_light;
1.912 bisitz 6542: vertical-align: top;
6543: }
6544:
6545: table.LC_data_table tr.LC_even_row > td {
6546: background-color: $data_table_dark;
1.425 albertel 6547: padding: 2px;
1.900 bisitz 6548: vertical-align: top;
1.347 albertel 6549: }
1.795 www 6550:
1.809 bisitz 6551: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6552: background-color: $data_table_dark;
1.900 bisitz 6553: vertical-align: top;
1.347 albertel 6554: }
1.795 www 6555:
1.425 albertel 6556: table.LC_data_table tr.LC_data_table_highlight td {
6557: background-color: $data_table_darker;
6558: }
1.795 www 6559:
1.639 raeburn 6560: table.LC_data_table tr td.LC_leftcol_header {
6561: background-color: $data_table_head;
6562: font-weight: bold;
6563: }
1.795 www 6564:
1.451 albertel 6565: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6566: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6567: font-weight: bold;
6568: font-style: italic;
6569: text-align: center;
6570: padding: 8px;
1.347 albertel 6571: }
1.795 www 6572:
1.1114 raeburn 6573: table.LC_data_table tr.LC_empty_row td,
6574: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6575: background-color: $sidebg;
6576: }
6577:
6578: table.LC_nested tr.LC_empty_row td {
6579: background-color: #FFFFFF;
6580: }
6581:
1.890 droeschl 6582: table.LC_caption {
6583: }
6584:
1.507 raeburn 6585: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6586: padding: 4ex
6587: }
1.795 www 6588:
1.507 raeburn 6589: table.LC_nested_outer tr th {
6590: font-weight: bold;
1.801 tempelho 6591: color:$fontmenu;
1.507 raeburn 6592: background-color: $data_table_head;
1.701 harmsja 6593: font-size: small;
1.507 raeburn 6594: border-bottom: 1px solid #000000;
6595: }
1.795 www 6596:
1.507 raeburn 6597: table.LC_nested_outer tr td.LC_subheader {
6598: background-color: $data_table_head;
6599: font-weight: bold;
6600: font-size: small;
6601: border-bottom: 1px solid #000000;
6602: text-align: right;
1.451 albertel 6603: }
1.795 www 6604:
1.507 raeburn 6605: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6606: background-color: #CCCCCC;
1.451 albertel 6607: font-weight: bold;
6608: font-size: small;
1.507 raeburn 6609: text-align: center;
6610: }
1.795 www 6611:
1.589 raeburn 6612: table.LC_nested tr.LC_info_row td.LC_left_item,
6613: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6614: text-align: left;
1.451 albertel 6615: }
1.795 www 6616:
1.507 raeburn 6617: table.LC_nested td {
1.735 bisitz 6618: background-color: #FFFFFF;
1.451 albertel 6619: font-size: small;
1.507 raeburn 6620: }
1.795 www 6621:
1.507 raeburn 6622: table.LC_nested_outer tr th.LC_right_item,
6623: table.LC_nested tr.LC_info_row td.LC_right_item,
6624: table.LC_nested tr.LC_odd_row td.LC_right_item,
6625: table.LC_nested tr td.LC_right_item {
1.451 albertel 6626: text-align: right;
6627: }
6628:
1.507 raeburn 6629: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6630: background-color: #EEEEEE;
1.451 albertel 6631: }
6632:
1.473 raeburn 6633: table.LC_createuser {
6634: }
6635:
6636: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6637: font-size: small;
1.473 raeburn 6638: }
6639:
6640: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6641: background-color: #CCCCCC;
1.473 raeburn 6642: font-weight: bold;
6643: text-align: center;
6644: }
6645:
1.349 albertel 6646: table.LC_calendar {
6647: border: 1px solid #000000;
6648: border-collapse: collapse;
1.917 raeburn 6649: width: 98%;
1.349 albertel 6650: }
1.795 www 6651:
1.349 albertel 6652: table.LC_calendar_pickdate {
6653: font-size: xx-small;
6654: }
1.795 www 6655:
1.349 albertel 6656: table.LC_calendar tr td {
6657: border: 1px solid #000000;
6658: vertical-align: top;
1.917 raeburn 6659: width: 14%;
1.349 albertel 6660: }
1.795 www 6661:
1.349 albertel 6662: table.LC_calendar tr td.LC_calendar_day_empty {
6663: background-color: $data_table_dark;
6664: }
1.795 www 6665:
1.779 bisitz 6666: table.LC_calendar tr td.LC_calendar_day_current {
6667: background-color: $data_table_highlight;
1.777 tempelho 6668: }
1.795 www 6669:
1.938 bisitz 6670: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6671: background-color: $mail_new;
6672: }
1.795 www 6673:
1.938 bisitz 6674: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6675: background-color: $mail_new_hover;
6676: }
1.795 www 6677:
1.938 bisitz 6678: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6679: background-color: $mail_read;
6680: }
1.795 www 6681:
1.938 bisitz 6682: /*
6683: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6684: background-color: $mail_read_hover;
6685: }
1.938 bisitz 6686: */
1.795 www 6687:
1.938 bisitz 6688: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6689: background-color: $mail_replied;
6690: }
1.795 www 6691:
1.938 bisitz 6692: /*
6693: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6694: background-color: $mail_replied_hover;
6695: }
1.938 bisitz 6696: */
1.795 www 6697:
1.938 bisitz 6698: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6699: background-color: $mail_other;
6700: }
1.795 www 6701:
1.938 bisitz 6702: /*
6703: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6704: background-color: $mail_other_hover;
6705: }
1.938 bisitz 6706: */
1.494 raeburn 6707:
1.777 tempelho 6708: table.LC_data_table tr > td.LC_browser_file,
6709: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6710: background: #AAEE77;
1.389 albertel 6711: }
1.795 www 6712:
1.777 tempelho 6713: table.LC_data_table tr > td.LC_browser_file_locked,
6714: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6715: background: #FFAA99;
1.387 albertel 6716: }
1.795 www 6717:
1.777 tempelho 6718: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6719: background: #888888;
1.779 bisitz 6720: }
1.795 www 6721:
1.777 tempelho 6722: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6723: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6724: background: #F8F866;
1.777 tempelho 6725: }
1.795 www 6726:
1.696 bisitz 6727: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6728: background: #E0E8FF;
1.387 albertel 6729: }
1.696 bisitz 6730:
1.707 bisitz 6731: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6732: /* background: #77FF77; */
1.707 bisitz 6733: }
1.795 www 6734:
1.707 bisitz 6735: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6736: border-right: 8px solid #FFFF77;
1.707 bisitz 6737: }
1.795 www 6738:
1.707 bisitz 6739: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6740: border-right: 8px solid #FFAA77;
1.707 bisitz 6741: }
1.795 www 6742:
1.707 bisitz 6743: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6744: border-right: 8px solid #FF7777;
1.707 bisitz 6745: }
1.795 www 6746:
1.707 bisitz 6747: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6748: border-right: 8px solid #AAFF77;
1.707 bisitz 6749: }
1.795 www 6750:
1.707 bisitz 6751: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6752: border-right: 8px solid #11CC55;
1.707 bisitz 6753: }
6754:
1.388 albertel 6755: span.LC_current_location {
1.701 harmsja 6756: font-size:larger;
1.388 albertel 6757: background: $pgbg;
6758: }
1.387 albertel 6759:
1.1029 www 6760: span.LC_current_nav_location {
6761: font-weight:bold;
6762: background: $sidebg;
6763: }
6764:
1.395 albertel 6765: span.LC_parm_menu_item {
6766: font-size: larger;
6767: }
1.795 www 6768:
1.395 albertel 6769: span.LC_parm_scope_all {
6770: color: red;
6771: }
1.795 www 6772:
1.395 albertel 6773: span.LC_parm_scope_folder {
6774: color: green;
6775: }
1.795 www 6776:
1.395 albertel 6777: span.LC_parm_scope_resource {
6778: color: orange;
6779: }
1.795 www 6780:
1.395 albertel 6781: span.LC_parm_part {
6782: color: blue;
6783: }
1.795 www 6784:
1.911 bisitz 6785: span.LC_parm_folder,
6786: span.LC_parm_symb {
1.395 albertel 6787: font-size: x-small;
6788: font-family: $mono;
6789: color: #AAAAAA;
6790: }
6791:
1.977 bisitz 6792: ul.LC_parm_parmlist li {
6793: display: inline-block;
6794: padding: 0.3em 0.8em;
6795: vertical-align: top;
6796: width: 150px;
6797: border-top:1px solid $lg_border_color;
6798: }
6799:
1.795 www 6800: td.LC_parm_overview_level_menu,
6801: td.LC_parm_overview_map_menu,
6802: td.LC_parm_overview_parm_selectors,
6803: td.LC_parm_overview_restrictions {
1.396 albertel 6804: border: 1px solid black;
6805: border-collapse: collapse;
6806: }
1.795 www 6807:
1.1285 raeburn 6808: span.LC_parm_recursive,
6809: td.LC_parm_recursive {
6810: font-weight: bold;
6811: font-size: smaller;
6812: }
6813:
1.396 albertel 6814: table.LC_parm_overview_restrictions td {
6815: border-width: 1px 4px 1px 4px;
6816: border-style: solid;
6817: border-color: $pgbg;
6818: text-align: center;
6819: }
1.795 www 6820:
1.396 albertel 6821: table.LC_parm_overview_restrictions th {
6822: background: $tabbg;
6823: border-width: 1px 4px 1px 4px;
6824: border-style: solid;
6825: border-color: $pgbg;
6826: }
1.795 www 6827:
1.398 albertel 6828: table#LC_helpmenu {
1.803 bisitz 6829: border: none;
1.398 albertel 6830: height: 55px;
1.803 bisitz 6831: border-spacing: 0;
1.398 albertel 6832: }
6833:
6834: table#LC_helpmenu fieldset legend {
6835: font-size: larger;
6836: }
1.795 www 6837:
1.397 albertel 6838: table#LC_helpmenu_links {
6839: width: 100%;
6840: border: 1px solid black;
6841: background: $pgbg;
1.803 bisitz 6842: padding: 0;
1.397 albertel 6843: border-spacing: 1px;
6844: }
1.795 www 6845:
1.397 albertel 6846: table#LC_helpmenu_links tr td {
6847: padding: 1px;
6848: background: $tabbg;
1.399 albertel 6849: text-align: center;
6850: font-weight: bold;
1.397 albertel 6851: }
1.396 albertel 6852:
1.795 www 6853: table#LC_helpmenu_links a:link,
6854: table#LC_helpmenu_links a:visited,
1.397 albertel 6855: table#LC_helpmenu_links a:active {
6856: text-decoration: none;
6857: color: $font;
6858: }
1.795 www 6859:
1.397 albertel 6860: table#LC_helpmenu_links a:hover {
6861: text-decoration: underline;
6862: color: $vlink;
6863: }
1.396 albertel 6864:
1.417 albertel 6865: .LC_chrt_popup_exists {
6866: border: 1px solid #339933;
6867: margin: -1px;
6868: }
1.795 www 6869:
1.417 albertel 6870: .LC_chrt_popup_up {
6871: border: 1px solid yellow;
6872: margin: -1px;
6873: }
1.795 www 6874:
1.417 albertel 6875: .LC_chrt_popup {
6876: border: 1px solid #8888FF;
6877: background: #CCCCFF;
6878: }
1.795 www 6879:
1.421 albertel 6880: table.LC_pick_box {
6881: border-collapse: separate;
6882: background: white;
6883: border: 1px solid black;
6884: border-spacing: 1px;
6885: }
1.795 www 6886:
1.421 albertel 6887: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6888: background: $sidebg;
1.421 albertel 6889: font-weight: bold;
1.900 bisitz 6890: text-align: left;
1.740 bisitz 6891: vertical-align: top;
1.421 albertel 6892: width: 184px;
6893: padding: 8px;
6894: }
1.795 www 6895:
1.579 raeburn 6896: table.LC_pick_box td.LC_pick_box_value {
6897: text-align: left;
6898: padding: 8px;
6899: }
1.795 www 6900:
1.579 raeburn 6901: table.LC_pick_box td.LC_pick_box_select {
6902: text-align: left;
6903: padding: 8px;
6904: }
1.795 www 6905:
1.424 albertel 6906: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6907: padding: 0;
1.421 albertel 6908: height: 1px;
6909: background: black;
6910: }
1.795 www 6911:
1.421 albertel 6912: table.LC_pick_box td.LC_pick_box_submit {
6913: text-align: right;
6914: }
1.795 www 6915:
1.579 raeburn 6916: table.LC_pick_box td.LC_evenrow_value {
6917: text-align: left;
6918: padding: 8px;
6919: background-color: $data_table_light;
6920: }
1.795 www 6921:
1.579 raeburn 6922: table.LC_pick_box td.LC_oddrow_value {
6923: text-align: left;
6924: padding: 8px;
6925: background-color: $data_table_light;
6926: }
1.795 www 6927:
1.579 raeburn 6928: span.LC_helpform_receipt_cat {
6929: font-weight: bold;
6930: }
1.795 www 6931:
1.424 albertel 6932: table.LC_group_priv_box {
6933: background: white;
6934: border: 1px solid black;
6935: border-spacing: 1px;
6936: }
1.795 www 6937:
1.424 albertel 6938: table.LC_group_priv_box td.LC_pick_box_title {
6939: background: $tabbg;
6940: font-weight: bold;
6941: text-align: right;
6942: width: 184px;
6943: }
1.795 www 6944:
1.424 albertel 6945: table.LC_group_priv_box td.LC_groups_fixed {
6946: background: $data_table_light;
6947: text-align: center;
6948: }
1.795 www 6949:
1.424 albertel 6950: table.LC_group_priv_box td.LC_groups_optional {
6951: background: $data_table_dark;
6952: text-align: center;
6953: }
1.795 www 6954:
1.424 albertel 6955: table.LC_group_priv_box td.LC_groups_functionality {
6956: background: $data_table_darker;
6957: text-align: center;
6958: font-weight: bold;
6959: }
1.795 www 6960:
1.424 albertel 6961: table.LC_group_priv td {
6962: text-align: left;
1.803 bisitz 6963: padding: 0;
1.424 albertel 6964: }
6965:
6966: .LC_navbuttons {
6967: margin: 2ex 0ex 2ex 0ex;
6968: }
1.795 www 6969:
1.423 albertel 6970: .LC_topic_bar {
6971: font-weight: bold;
6972: background: $tabbg;
1.918 wenzelju 6973: margin: 1em 0em 1em 2em;
1.805 bisitz 6974: padding: 3px;
1.918 wenzelju 6975: font-size: 1.2em;
1.423 albertel 6976: }
1.795 www 6977:
1.423 albertel 6978: .LC_topic_bar span {
1.918 wenzelju 6979: left: 0.5em;
6980: position: absolute;
1.423 albertel 6981: vertical-align: middle;
1.918 wenzelju 6982: font-size: 1.2em;
1.423 albertel 6983: }
1.795 www 6984:
1.423 albertel 6985: table.LC_course_group_status {
6986: margin: 20px;
6987: }
1.795 www 6988:
1.423 albertel 6989: table.LC_status_selector td {
6990: vertical-align: top;
6991: text-align: center;
1.424 albertel 6992: padding: 4px;
6993: }
1.795 www 6994:
1.599 albertel 6995: div.LC_feedback_link {
1.616 albertel 6996: clear: both;
1.829 kalberla 6997: background: $sidebg;
1.779 bisitz 6998: width: 100%;
1.829 kalberla 6999: padding-bottom: 10px;
7000: border: 1px $tabbg solid;
1.833 kalberla 7001: height: 22px;
7002: line-height: 22px;
7003: padding-top: 5px;
7004: }
7005:
7006: div.LC_feedback_link img {
7007: height: 22px;
1.867 kalberla 7008: vertical-align:middle;
1.829 kalberla 7009: }
7010:
1.911 bisitz 7011: div.LC_feedback_link a {
1.829 kalberla 7012: text-decoration: none;
1.489 raeburn 7013: }
1.795 www 7014:
1.867 kalberla 7015: div.LC_comblock {
1.911 bisitz 7016: display:inline;
1.867 kalberla 7017: color:$font;
7018: font-size:90%;
7019: }
7020:
7021: div.LC_feedback_link div.LC_comblock {
7022: padding-left:5px;
7023: }
7024:
7025: div.LC_feedback_link div.LC_comblock a {
7026: color:$font;
7027: }
7028:
1.489 raeburn 7029: span.LC_feedback_link {
1.858 bisitz 7030: /* background: $feedback_link_bg; */
1.599 albertel 7031: font-size: larger;
7032: }
1.795 www 7033:
1.599 albertel 7034: span.LC_message_link {
1.858 bisitz 7035: /* background: $feedback_link_bg; */
1.599 albertel 7036: font-size: larger;
7037: position: absolute;
7038: right: 1em;
1.489 raeburn 7039: }
1.421 albertel 7040:
1.515 albertel 7041: table.LC_prior_tries {
1.524 albertel 7042: border: 1px solid #000000;
7043: border-collapse: separate;
7044: border-spacing: 1px;
1.515 albertel 7045: }
1.523 albertel 7046:
1.515 albertel 7047: table.LC_prior_tries td {
1.524 albertel 7048: padding: 2px;
1.515 albertel 7049: }
1.523 albertel 7050:
7051: .LC_answer_correct {
1.795 www 7052: background: lightgreen;
7053: color: darkgreen;
7054: padding: 6px;
1.523 albertel 7055: }
1.795 www 7056:
1.523 albertel 7057: .LC_answer_charged_try {
1.797 www 7058: background: #FFAAAA;
1.795 www 7059: color: darkred;
7060: padding: 6px;
1.523 albertel 7061: }
1.795 www 7062:
1.779 bisitz 7063: .LC_answer_not_charged_try,
1.523 albertel 7064: .LC_answer_no_grade,
7065: .LC_answer_late {
1.795 www 7066: background: lightyellow;
1.523 albertel 7067: color: black;
1.795 www 7068: padding: 6px;
1.523 albertel 7069: }
1.795 www 7070:
1.523 albertel 7071: .LC_answer_previous {
1.795 www 7072: background: lightblue;
7073: color: darkblue;
7074: padding: 6px;
1.523 albertel 7075: }
1.795 www 7076:
1.779 bisitz 7077: .LC_answer_no_message {
1.777 tempelho 7078: background: #FFFFFF;
7079: color: black;
1.795 www 7080: padding: 6px;
1.779 bisitz 7081: }
1.795 www 7082:
1.779 bisitz 7083: .LC_answer_unknown {
7084: background: orange;
7085: color: black;
1.795 www 7086: padding: 6px;
1.777 tempelho 7087: }
1.795 www 7088:
1.529 albertel 7089: span.LC_prior_numerical,
7090: span.LC_prior_string,
7091: span.LC_prior_custom,
7092: span.LC_prior_reaction,
7093: span.LC_prior_math {
1.925 bisitz 7094: font-family: $mono;
1.523 albertel 7095: white-space: pre;
7096: }
7097:
1.525 albertel 7098: span.LC_prior_string {
1.925 bisitz 7099: font-family: $mono;
1.525 albertel 7100: white-space: pre;
7101: }
7102:
1.523 albertel 7103: table.LC_prior_option {
7104: width: 100%;
7105: border-collapse: collapse;
7106: }
1.795 www 7107:
1.911 bisitz 7108: table.LC_prior_rank,
1.795 www 7109: table.LC_prior_match {
1.528 albertel 7110: border-collapse: collapse;
7111: }
1.795 www 7112:
1.528 albertel 7113: table.LC_prior_option tr td,
7114: table.LC_prior_rank tr td,
7115: table.LC_prior_match tr td {
1.524 albertel 7116: border: 1px solid #000000;
1.515 albertel 7117: }
7118:
1.855 bisitz 7119: .LC_nobreak {
1.544 albertel 7120: white-space: nowrap;
1.519 raeburn 7121: }
7122:
1.576 raeburn 7123: span.LC_cusr_emph {
7124: font-style: italic;
7125: }
7126:
1.633 raeburn 7127: span.LC_cusr_subheading {
7128: font-weight: normal;
7129: font-size: 85%;
7130: }
7131:
1.861 bisitz 7132: div.LC_docs_entry_move {
1.859 bisitz 7133: border: 1px solid #BBBBBB;
1.545 albertel 7134: background: #DDDDDD;
1.861 bisitz 7135: width: 22px;
1.859 bisitz 7136: padding: 1px;
7137: margin: 0;
1.545 albertel 7138: }
7139:
1.861 bisitz 7140: table.LC_data_table tr > td.LC_docs_entry_commands,
7141: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7142: font-size: x-small;
7143: }
1.795 www 7144:
1.861 bisitz 7145: .LC_docs_entry_parameter {
7146: white-space: nowrap;
7147: }
7148:
1.544 albertel 7149: .LC_docs_copy {
1.545 albertel 7150: color: #000099;
1.544 albertel 7151: }
1.795 www 7152:
1.544 albertel 7153: .LC_docs_cut {
1.545 albertel 7154: color: #550044;
1.544 albertel 7155: }
1.795 www 7156:
1.544 albertel 7157: .LC_docs_rename {
1.545 albertel 7158: color: #009900;
1.544 albertel 7159: }
1.795 www 7160:
1.544 albertel 7161: .LC_docs_remove {
1.545 albertel 7162: color: #990000;
7163: }
7164:
1.1284 raeburn 7165: .LC_docs_alias {
7166: color: #440055;
7167: }
7168:
1.1286 raeburn 7169: .LC_domprefs_email,
1.1284 raeburn 7170: .LC_docs_alias_name,
1.547 albertel 7171: .LC_docs_reinit_warn,
7172: .LC_docs_ext_edit {
7173: font-size: x-small;
7174: }
7175:
1.545 albertel 7176: table.LC_docs_adddocs td,
7177: table.LC_docs_adddocs th {
7178: border: 1px solid #BBBBBB;
7179: padding: 4px;
7180: background: #DDDDDD;
1.543 albertel 7181: }
7182:
1.584 albertel 7183: table.LC_sty_begin {
7184: background: #BBFFBB;
7185: }
1.795 www 7186:
1.584 albertel 7187: table.LC_sty_end {
7188: background: #FFBBBB;
7189: }
7190:
1.589 raeburn 7191: table.LC_double_column {
1.803 bisitz 7192: border-width: 0;
1.589 raeburn 7193: border-collapse: collapse;
7194: width: 100%;
7195: padding: 2px;
7196: }
7197:
7198: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7199: top: 2px;
1.589 raeburn 7200: left: 2px;
7201: width: 47%;
7202: vertical-align: top;
7203: }
7204:
7205: table.LC_double_column tr td.LC_right_col {
7206: top: 2px;
1.779 bisitz 7207: right: 2px;
1.589 raeburn 7208: width: 47%;
7209: vertical-align: top;
7210: }
7211:
1.591 raeburn 7212: div.LC_left_float {
7213: float: left;
7214: padding-right: 5%;
1.597 albertel 7215: padding-bottom: 4px;
1.591 raeburn 7216: }
7217:
7218: div.LC_clear_float_header {
1.597 albertel 7219: padding-bottom: 2px;
1.591 raeburn 7220: }
7221:
7222: div.LC_clear_float_footer {
1.597 albertel 7223: padding-top: 10px;
1.591 raeburn 7224: clear: both;
7225: }
7226:
1.597 albertel 7227: div.LC_grade_show_user {
1.941 bisitz 7228: /* border-left: 5px solid $sidebg; */
7229: border-top: 5px solid #000000;
7230: margin: 50px 0 0 0;
1.936 bisitz 7231: padding: 15px 0 5px 10px;
1.597 albertel 7232: }
1.795 www 7233:
1.936 bisitz 7234: div.LC_grade_show_user_odd_row {
1.941 bisitz 7235: /* border-left: 5px solid #000000; */
7236: }
7237:
7238: div.LC_grade_show_user div.LC_Box {
7239: margin-right: 50px;
1.597 albertel 7240: }
7241:
7242: div.LC_grade_submissions,
7243: div.LC_grade_message_center,
1.936 bisitz 7244: div.LC_grade_info_links {
1.597 albertel 7245: margin: 5px;
7246: width: 99%;
7247: background: #FFFFFF;
7248: }
1.795 www 7249:
1.597 albertel 7250: div.LC_grade_submissions_header,
1.936 bisitz 7251: div.LC_grade_message_center_header {
1.705 tempelho 7252: font-weight: bold;
7253: font-size: large;
1.597 albertel 7254: }
1.795 www 7255:
1.597 albertel 7256: div.LC_grade_submissions_body,
1.936 bisitz 7257: div.LC_grade_message_center_body {
1.597 albertel 7258: border: 1px solid black;
7259: width: 99%;
7260: background: #FFFFFF;
7261: }
1.795 www 7262:
1.613 albertel 7263: table.LC_scantron_action {
7264: width: 100%;
7265: }
1.795 www 7266:
1.613 albertel 7267: table.LC_scantron_action tr th {
1.698 harmsja 7268: font-weight:bold;
7269: font-style:normal;
1.613 albertel 7270: }
1.795 www 7271:
1.779 bisitz 7272: .LC_edit_problem_header,
1.614 albertel 7273: div.LC_edit_problem_footer {
1.705 tempelho 7274: font-weight: normal;
7275: font-size: medium;
1.602 albertel 7276: margin: 2px;
1.1060 bisitz 7277: background-color: $sidebg;
1.600 albertel 7278: }
1.795 www 7279:
1.600 albertel 7280: div.LC_edit_problem_header,
1.602 albertel 7281: div.LC_edit_problem_header div,
1.614 albertel 7282: div.LC_edit_problem_footer,
7283: div.LC_edit_problem_footer div,
1.602 albertel 7284: div.LC_edit_problem_editxml_header,
7285: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7286: z-index: 100;
1.600 albertel 7287: }
1.795 www 7288:
1.600 albertel 7289: div.LC_edit_problem_header_title {
1.705 tempelho 7290: font-weight: bold;
7291: font-size: larger;
1.602 albertel 7292: background: $tabbg;
7293: padding: 3px;
1.1060 bisitz 7294: margin: 0 0 5px 0;
1.602 albertel 7295: }
1.795 www 7296:
1.602 albertel 7297: table.LC_edit_problem_header_title {
7298: width: 100%;
1.600 albertel 7299: background: $tabbg;
1.602 albertel 7300: }
7301:
1.1205 golterma 7302: div.LC_edit_actionbar {
7303: background-color: $sidebg;
1.1218 droeschl 7304: margin: 0;
7305: padding: 0;
7306: line-height: 200%;
1.602 albertel 7307: }
1.795 www 7308:
1.1218 droeschl 7309: div.LC_edit_actionbar div{
7310: padding: 0;
7311: margin: 0;
7312: display: inline-block;
1.600 albertel 7313: }
1.795 www 7314:
1.1124 bisitz 7315: .LC_edit_opt {
7316: padding-left: 1em;
7317: white-space: nowrap;
7318: }
7319:
1.1152 golterma 7320: .LC_edit_problem_latexhelper{
7321: text-align: right;
7322: }
7323:
7324: #LC_edit_problem_colorful div{
7325: margin-left: 40px;
7326: }
7327:
1.1205 golterma 7328: #LC_edit_problem_codemirror div{
7329: margin-left: 0px;
7330: }
7331:
1.911 bisitz 7332: img.stift {
1.803 bisitz 7333: border-width: 0;
7334: vertical-align: middle;
1.677 riegler 7335: }
1.680 riegler 7336:
1.923 bisitz 7337: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7338: vertical-align: top;
1.777 tempelho 7339: }
1.795 www 7340:
1.716 raeburn 7341: div.LC_createcourse {
1.911 bisitz 7342: margin: 10px 10px 10px 10px;
1.716 raeburn 7343: }
7344:
1.917 raeburn 7345: .LC_dccid {
1.1130 raeburn 7346: float: right;
1.917 raeburn 7347: margin: 0.2em 0 0 0;
7348: padding: 0;
7349: font-size: 90%;
7350: display:none;
7351: }
7352:
1.897 wenzelju 7353: ol.LC_primary_menu a:hover,
1.721 harmsja 7354: ol#LC_MenuBreadcrumbs a:hover,
7355: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7356: ul#LC_secondary_menu a:hover,
1.721 harmsja 7357: .LC_FormSectionClearButton input:hover
1.795 www 7358: ul.LC_TabContent li:hover a {
1.952 onken 7359: color:$button_hover;
1.911 bisitz 7360: text-decoration:none;
1.693 droeschl 7361: }
7362:
1.779 bisitz 7363: h1 {
1.911 bisitz 7364: padding: 0;
7365: line-height:130%;
1.693 droeschl 7366: }
1.698 harmsja 7367:
1.911 bisitz 7368: h2,
7369: h3,
7370: h4,
7371: h5,
7372: h6 {
7373: margin: 5px 0 5px 0;
7374: padding: 0;
7375: line-height:130%;
1.693 droeschl 7376: }
1.795 www 7377:
7378: .LC_hcell {
1.911 bisitz 7379: padding:3px 15px 3px 15px;
7380: margin: 0;
7381: background-color:$tabbg;
7382: color:$fontmenu;
7383: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7384: }
1.795 www 7385:
1.840 bisitz 7386: .LC_Box > .LC_hcell {
1.911 bisitz 7387: margin: 0 -10px 10px -10px;
1.835 bisitz 7388: }
7389:
1.721 harmsja 7390: .LC_noBorder {
1.911 bisitz 7391: border: 0;
1.698 harmsja 7392: }
1.693 droeschl 7393:
1.721 harmsja 7394: .LC_FormSectionClearButton input {
1.911 bisitz 7395: background-color:transparent;
7396: border: none;
7397: cursor:pointer;
7398: text-decoration:underline;
1.693 droeschl 7399: }
1.763 bisitz 7400:
7401: .LC_help_open_topic {
1.911 bisitz 7402: color: #FFFFFF;
7403: background-color: #EEEEFF;
7404: margin: 1px;
7405: padding: 4px;
7406: border: 1px solid #000033;
7407: white-space: nowrap;
7408: /* vertical-align: middle; */
1.759 neumanie 7409: }
1.693 droeschl 7410:
1.911 bisitz 7411: dl,
7412: ul,
7413: div,
7414: fieldset {
7415: margin: 10px 10px 10px 0;
7416: /* overflow: hidden; */
1.693 droeschl 7417: }
1.795 www 7418:
1.1211 raeburn 7419: article.geogebraweb div {
7420: margin: 0;
7421: }
7422:
1.838 bisitz 7423: fieldset > legend {
1.911 bisitz 7424: font-weight: bold;
7425: padding: 0 5px 0 5px;
1.838 bisitz 7426: }
7427:
1.813 bisitz 7428: #LC_nav_bar {
1.911 bisitz 7429: float: left;
1.995 raeburn 7430: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7431: margin: 0 0 2px 0;
1.807 droeschl 7432: }
7433:
1.916 droeschl 7434: #LC_realm {
7435: margin: 0.2em 0 0 0;
7436: padding: 0;
7437: font-weight: bold;
7438: text-align: center;
1.995 raeburn 7439: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7440: }
7441:
1.911 bisitz 7442: #LC_nav_bar em {
7443: font-weight: bold;
7444: font-style: normal;
1.807 droeschl 7445: }
7446:
1.897 wenzelju 7447: ol.LC_primary_menu {
1.934 droeschl 7448: margin: 0;
1.1076 raeburn 7449: padding: 0;
1.807 droeschl 7450: }
7451:
1.852 droeschl 7452: ol#LC_PathBreadcrumbs {
1.911 bisitz 7453: margin: 0;
1.693 droeschl 7454: }
7455:
1.897 wenzelju 7456: ol.LC_primary_menu li {
1.1076 raeburn 7457: color: RGB(80, 80, 80);
7458: vertical-align: middle;
7459: text-align: left;
7460: list-style: none;
1.1205 golterma 7461: position: relative;
1.1076 raeburn 7462: float: left;
1.1205 golterma 7463: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7464: line-height: 1.5em;
1.1076 raeburn 7465: }
7466:
1.1205 golterma 7467: ol.LC_primary_menu li a,
7468: ol.LC_primary_menu li p {
1.1076 raeburn 7469: display: block;
7470: margin: 0;
7471: padding: 0 5px 0 10px;
7472: text-decoration: none;
7473: }
7474:
1.1205 golterma 7475: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7476: display: inline-block;
7477: width: 95%;
7478: text-align: left;
7479: }
7480:
7481: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7482: display: inline-block;
7483: width: 5%;
7484: float: right;
7485: text-align: right;
7486: font-size: 70%;
7487: }
7488:
7489: ol.LC_primary_menu ul {
1.1076 raeburn 7490: display: none;
1.1205 golterma 7491: width: 15em;
1.1076 raeburn 7492: background-color: $data_table_light;
1.1205 golterma 7493: position: absolute;
7494: top: 100%;
1.1076 raeburn 7495: }
7496:
1.1205 golterma 7497: ol.LC_primary_menu ul ul {
7498: left: 100%;
7499: top: 0;
7500: }
7501:
7502: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7503: display: block;
7504: position: absolute;
7505: margin: 0;
7506: padding: 0;
1.1078 raeburn 7507: z-index: 2;
1.1076 raeburn 7508: }
7509:
7510: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7511: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7512: font-size: 90%;
1.911 bisitz 7513: vertical-align: top;
1.1076 raeburn 7514: float: none;
1.1079 raeburn 7515: border-left: 1px solid black;
7516: border-right: 1px solid black;
1.1205 golterma 7517: /* A dark bottom border to visualize different menu options;
7518: overwritten in the create_submenu routine for the last border-bottom of the menu */
7519: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7520: }
7521:
1.1205 golterma 7522: ol.LC_primary_menu li li p:hover {
7523: color:$button_hover;
7524: text-decoration:none;
7525: background-color:$data_table_dark;
1.1076 raeburn 7526: }
7527:
7528: ol.LC_primary_menu li li a:hover {
7529: color:$button_hover;
7530: background-color:$data_table_dark;
1.693 droeschl 7531: }
7532:
1.1205 golterma 7533: /* Font-size equal to the size of the predecessors*/
7534: ol.LC_primary_menu li:hover li li {
7535: font-size: 100%;
7536: }
7537:
1.897 wenzelju 7538: ol.LC_primary_menu li img {
1.911 bisitz 7539: vertical-align: bottom;
1.934 droeschl 7540: height: 1.1em;
1.1077 raeburn 7541: margin: 0.2em 0 0 0;
1.693 droeschl 7542: }
7543:
1.897 wenzelju 7544: ol.LC_primary_menu a {
1.911 bisitz 7545: color: RGB(80, 80, 80);
7546: text-decoration: none;
1.693 droeschl 7547: }
1.795 www 7548:
1.949 droeschl 7549: ol.LC_primary_menu a.LC_new_message {
7550: font-weight:bold;
7551: color: darkred;
7552: }
7553:
1.975 raeburn 7554: ol.LC_docs_parameters {
7555: margin-left: 0;
7556: padding: 0;
7557: list-style: none;
7558: }
7559:
7560: ol.LC_docs_parameters li {
7561: margin: 0;
7562: padding-right: 20px;
7563: display: inline;
7564: }
7565:
1.976 raeburn 7566: ol.LC_docs_parameters li:before {
7567: content: "\\002022 \\0020";
7568: }
7569:
7570: li.LC_docs_parameters_title {
7571: font-weight: bold;
7572: }
7573:
7574: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7575: content: "";
7576: }
7577:
1.897 wenzelju 7578: ul#LC_secondary_menu {
1.1107 raeburn 7579: clear: right;
1.911 bisitz 7580: color: $fontmenu;
7581: background: $tabbg;
7582: list-style: none;
7583: padding: 0;
7584: margin: 0;
7585: width: 100%;
1.995 raeburn 7586: text-align: left;
1.1107 raeburn 7587: float: left;
1.808 droeschl 7588: }
7589:
1.897 wenzelju 7590: ul#LC_secondary_menu li {
1.911 bisitz 7591: font-weight: bold;
7592: line-height: 1.8em;
1.1107 raeburn 7593: border-right: 1px solid black;
7594: float: left;
7595: }
7596:
7597: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7598: background-color: $data_table_light;
7599: }
7600:
7601: ul#LC_secondary_menu li a {
1.911 bisitz 7602: padding: 0 0.8em;
1.1107 raeburn 7603: }
7604:
7605: ul#LC_secondary_menu li ul {
7606: display: none;
7607: }
7608:
7609: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7610: display: block;
7611: position: absolute;
7612: margin: 0;
7613: padding: 0;
7614: list-style:none;
7615: float: none;
7616: background-color: $data_table_light;
7617: z-index: 2;
7618: margin-left: -1px;
7619: }
7620:
7621: ul#LC_secondary_menu li ul li {
7622: font-size: 90%;
7623: vertical-align: top;
7624: border-left: 1px solid black;
1.911 bisitz 7625: border-right: 1px solid black;
1.1119 raeburn 7626: background-color: $data_table_light;
1.1107 raeburn 7627: list-style:none;
7628: float: none;
7629: }
7630:
7631: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7632: background-color: $data_table_dark;
1.807 droeschl 7633: }
7634:
1.847 tempelho 7635: ul.LC_TabContent {
1.911 bisitz 7636: display:block;
7637: background: $sidebg;
7638: border-bottom: solid 1px $lg_border_color;
7639: list-style:none;
1.1020 raeburn 7640: margin: -1px -10px 0 -10px;
1.911 bisitz 7641: padding: 0;
1.693 droeschl 7642: }
7643:
1.795 www 7644: ul.LC_TabContent li,
7645: ul.LC_TabContentBigger li {
1.911 bisitz 7646: float:left;
1.741 harmsja 7647: }
1.795 www 7648:
1.897 wenzelju 7649: ul#LC_secondary_menu li a {
1.911 bisitz 7650: color: $fontmenu;
7651: text-decoration: none;
1.693 droeschl 7652: }
1.795 www 7653:
1.721 harmsja 7654: ul.LC_TabContent {
1.952 onken 7655: min-height:20px;
1.721 harmsja 7656: }
1.795 www 7657:
7658: ul.LC_TabContent li {
1.911 bisitz 7659: vertical-align:middle;
1.959 onken 7660: padding: 0 16px 0 10px;
1.911 bisitz 7661: background-color:$tabbg;
7662: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7663: border-left: solid 1px $font;
1.721 harmsja 7664: }
1.795 www 7665:
1.847 tempelho 7666: ul.LC_TabContent .right {
1.911 bisitz 7667: float:right;
1.847 tempelho 7668: }
7669:
1.911 bisitz 7670: ul.LC_TabContent li a,
7671: ul.LC_TabContent li {
7672: color:rgb(47,47,47);
7673: text-decoration:none;
7674: font-size:95%;
7675: font-weight:bold;
1.952 onken 7676: min-height:20px;
7677: }
7678:
1.959 onken 7679: ul.LC_TabContent li a:hover,
7680: ul.LC_TabContent li a:focus {
1.952 onken 7681: color: $button_hover;
1.959 onken 7682: background:none;
7683: outline:none;
1.952 onken 7684: }
7685:
7686: ul.LC_TabContent li:hover {
7687: color: $button_hover;
7688: cursor:pointer;
1.721 harmsja 7689: }
1.795 www 7690:
1.911 bisitz 7691: ul.LC_TabContent li.active {
1.952 onken 7692: color: $font;
1.911 bisitz 7693: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7694: border-bottom:solid 1px #FFFFFF;
7695: cursor: default;
1.744 ehlerst 7696: }
1.795 www 7697:
1.959 onken 7698: ul.LC_TabContent li.active a {
7699: color:$font;
7700: background:#FFFFFF;
7701: outline: none;
7702: }
1.1047 raeburn 7703:
7704: ul.LC_TabContent li.goback {
7705: float: left;
7706: border-left: none;
7707: }
7708:
1.870 tempelho 7709: #maincoursedoc {
1.911 bisitz 7710: clear:both;
1.870 tempelho 7711: }
7712:
7713: ul.LC_TabContentBigger {
1.911 bisitz 7714: display:block;
7715: list-style:none;
7716: padding: 0;
1.870 tempelho 7717: }
7718:
1.795 www 7719: ul.LC_TabContentBigger li {
1.911 bisitz 7720: vertical-align:bottom;
7721: height: 30px;
7722: font-size:110%;
7723: font-weight:bold;
7724: color: #737373;
1.841 tempelho 7725: }
7726:
1.957 onken 7727: ul.LC_TabContentBigger li.active {
7728: position: relative;
7729: top: 1px;
7730: }
7731:
1.870 tempelho 7732: ul.LC_TabContentBigger li a {
1.911 bisitz 7733: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7734: height: 30px;
7735: line-height: 30px;
7736: text-align: center;
7737: display: block;
7738: text-decoration: none;
1.958 onken 7739: outline: none;
1.741 harmsja 7740: }
1.795 www 7741:
1.870 tempelho 7742: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7743: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7744: color:$font;
1.744 ehlerst 7745: }
1.795 www 7746:
1.870 tempelho 7747: ul.LC_TabContentBigger li b {
1.911 bisitz 7748: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7749: display: block;
7750: float: left;
7751: padding: 0 30px;
1.957 onken 7752: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7753: }
7754:
1.956 onken 7755: ul.LC_TabContentBigger li:hover b {
7756: color:$button_hover;
7757: }
7758:
1.870 tempelho 7759: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7760: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7761: color:$font;
1.957 onken 7762: border: 0;
1.741 harmsja 7763: }
1.693 droeschl 7764:
1.870 tempelho 7765:
1.862 bisitz 7766: ul.LC_CourseBreadcrumbs {
7767: background: $sidebg;
1.1020 raeburn 7768: height: 2em;
1.862 bisitz 7769: padding-left: 10px;
1.1020 raeburn 7770: margin: 0;
1.862 bisitz 7771: list-style-position: inside;
7772: }
7773:
1.911 bisitz 7774: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7775: ol#LC_PathBreadcrumbs {
1.911 bisitz 7776: padding-left: 10px;
7777: margin: 0;
1.933 droeschl 7778: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7779: }
7780:
1.911 bisitz 7781: ol#LC_MenuBreadcrumbs li,
7782: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7783: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7784: display: inline;
1.933 droeschl 7785: white-space: normal;
1.693 droeschl 7786: }
7787:
1.823 bisitz 7788: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7789: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7790: text-decoration: none;
7791: font-size:90%;
1.693 droeschl 7792: }
1.795 www 7793:
1.969 droeschl 7794: ol#LC_MenuBreadcrumbs h1 {
7795: display: inline;
7796: font-size: 90%;
7797: line-height: 2.5em;
7798: margin: 0;
7799: padding: 0;
7800: }
7801:
1.795 www 7802: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7803: text-decoration:none;
7804: font-size:100%;
7805: font-weight:bold;
1.693 droeschl 7806: }
1.795 www 7807:
1.840 bisitz 7808: .LC_Box {
1.911 bisitz 7809: border: solid 1px $lg_border_color;
7810: padding: 0 10px 10px 10px;
1.746 neumanie 7811: }
1.795 www 7812:
1.1020 raeburn 7813: .LC_DocsBox {
7814: border: solid 1px $lg_border_color;
7815: padding: 0 0 10px 10px;
7816: }
7817:
1.795 www 7818: .LC_AboutMe_Image {
1.911 bisitz 7819: float:left;
7820: margin-right:10px;
1.747 neumanie 7821: }
1.795 www 7822:
7823: .LC_Clear_AboutMe_Image {
1.911 bisitz 7824: clear:left;
1.747 neumanie 7825: }
1.795 www 7826:
1.721 harmsja 7827: dl.LC_ListStyleClean dt {
1.911 bisitz 7828: padding-right: 5px;
7829: display: table-header-group;
1.693 droeschl 7830: }
7831:
1.721 harmsja 7832: dl.LC_ListStyleClean dd {
1.911 bisitz 7833: display: table-row;
1.693 droeschl 7834: }
7835:
1.721 harmsja 7836: .LC_ListStyleClean,
7837: .LC_ListStyleSimple,
7838: .LC_ListStyleNormal,
1.795 www 7839: .LC_ListStyleSpecial {
1.911 bisitz 7840: /* display:block; */
7841: list-style-position: inside;
7842: list-style-type: none;
7843: overflow: hidden;
7844: padding: 0;
1.693 droeschl 7845: }
7846:
1.721 harmsja 7847: .LC_ListStyleSimple li,
7848: .LC_ListStyleSimple dd,
7849: .LC_ListStyleNormal li,
7850: .LC_ListStyleNormal dd,
7851: .LC_ListStyleSpecial li,
1.795 www 7852: .LC_ListStyleSpecial dd {
1.911 bisitz 7853: margin: 0;
7854: padding: 5px 5px 5px 10px;
7855: clear: both;
1.693 droeschl 7856: }
7857:
1.721 harmsja 7858: .LC_ListStyleClean li,
7859: .LC_ListStyleClean dd {
1.911 bisitz 7860: padding-top: 0;
7861: padding-bottom: 0;
1.693 droeschl 7862: }
7863:
1.721 harmsja 7864: .LC_ListStyleSimple dd,
1.795 www 7865: .LC_ListStyleSimple li {
1.911 bisitz 7866: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7867: }
7868:
1.721 harmsja 7869: .LC_ListStyleSpecial li,
7870: .LC_ListStyleSpecial dd {
1.911 bisitz 7871: list-style-type: none;
7872: background-color: RGB(220, 220, 220);
7873: margin-bottom: 4px;
1.693 droeschl 7874: }
7875:
1.721 harmsja 7876: table.LC_SimpleTable {
1.911 bisitz 7877: margin:5px;
7878: border:solid 1px $lg_border_color;
1.795 www 7879: }
1.693 droeschl 7880:
1.721 harmsja 7881: table.LC_SimpleTable tr {
1.911 bisitz 7882: padding: 0;
7883: border:solid 1px $lg_border_color;
1.693 droeschl 7884: }
1.795 www 7885:
7886: table.LC_SimpleTable thead {
1.911 bisitz 7887: background:rgb(220,220,220);
1.693 droeschl 7888: }
7889:
1.721 harmsja 7890: div.LC_columnSection {
1.911 bisitz 7891: display: block;
7892: clear: both;
7893: overflow: hidden;
7894: margin: 0;
1.693 droeschl 7895: }
7896:
1.721 harmsja 7897: div.LC_columnSection>* {
1.911 bisitz 7898: float: left;
7899: margin: 10px 20px 10px 0;
7900: overflow:hidden;
1.693 droeschl 7901: }
1.721 harmsja 7902:
1.795 www 7903: table em {
1.911 bisitz 7904: font-weight: bold;
7905: font-style: normal;
1.748 schulted 7906: }
1.795 www 7907:
1.779 bisitz 7908: table.LC_tableBrowseRes,
1.795 www 7909: table.LC_tableOfContent {
1.911 bisitz 7910: border:none;
7911: border-spacing: 1px;
7912: padding: 3px;
7913: background-color: #FFFFFF;
7914: font-size: 90%;
1.753 droeschl 7915: }
1.789 droeschl 7916:
1.911 bisitz 7917: table.LC_tableOfContent {
7918: border-collapse: collapse;
1.789 droeschl 7919: }
7920:
1.771 droeschl 7921: table.LC_tableBrowseRes a,
1.768 schulted 7922: table.LC_tableOfContent a {
1.911 bisitz 7923: background-color: transparent;
7924: text-decoration: none;
1.753 droeschl 7925: }
7926:
1.795 www 7927: table.LC_tableOfContent img {
1.911 bisitz 7928: border: none;
7929: height: 1.3em;
7930: vertical-align: text-bottom;
7931: margin-right: 0.3em;
1.753 droeschl 7932: }
1.757 schulted 7933:
1.795 www 7934: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7935: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7936: }
7937:
1.795 www 7938: a#LC_content_toolbar_everything {
1.911 bisitz 7939: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7940: }
7941:
1.795 www 7942: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7943: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7944: }
7945:
1.795 www 7946: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7947: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7948: }
7949:
1.795 www 7950: a#LC_content_toolbar_changefolder {
1.911 bisitz 7951: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7952: }
7953:
1.795 www 7954: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7955: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7956: }
7957:
1.1043 raeburn 7958: a#LC_content_toolbar_edittoplevel {
7959: background-image:url(/res/adm/pages/edittoplevel.gif);
7960: }
7961:
1.795 www 7962: ul#LC_toolbar li a:hover {
1.911 bisitz 7963: background-position: bottom center;
1.757 schulted 7964: }
7965:
1.795 www 7966: ul#LC_toolbar {
1.911 bisitz 7967: padding: 0;
7968: margin: 2px;
7969: list-style:none;
7970: position:relative;
7971: background-color:white;
1.1082 raeburn 7972: overflow: auto;
1.757 schulted 7973: }
7974:
1.795 www 7975: ul#LC_toolbar li {
1.911 bisitz 7976: border:1px solid white;
7977: padding: 0;
7978: margin: 0;
7979: float: left;
7980: display:inline;
7981: vertical-align:middle;
1.1082 raeburn 7982: white-space: nowrap;
1.911 bisitz 7983: }
1.757 schulted 7984:
1.783 amueller 7985:
1.795 www 7986: a.LC_toolbarItem {
1.911 bisitz 7987: display:block;
7988: padding: 0;
7989: margin: 0;
7990: height: 32px;
7991: width: 32px;
7992: color:white;
7993: border: none;
7994: background-repeat:no-repeat;
7995: background-color:transparent;
1.757 schulted 7996: }
7997:
1.915 droeschl 7998: ul.LC_funclist {
7999: margin: 0;
8000: padding: 0.5em 1em 0.5em 0;
8001: }
8002:
1.933 droeschl 8003: ul.LC_funclist > li:first-child {
8004: font-weight:bold;
8005: margin-left:0.8em;
8006: }
8007:
1.915 droeschl 8008: ul.LC_funclist + ul.LC_funclist {
8009: /*
8010: left border as a seperator if we have more than
8011: one list
8012: */
8013: border-left: 1px solid $sidebg;
8014: /*
8015: this hides the left border behind the border of the
8016: outer box if element is wrapped to the next 'line'
8017: */
8018: margin-left: -1px;
8019: }
8020:
1.843 bisitz 8021: ul.LC_funclist li {
1.915 droeschl 8022: display: inline;
1.782 bisitz 8023: white-space: nowrap;
1.915 droeschl 8024: margin: 0 0 0 25px;
8025: line-height: 150%;
1.782 bisitz 8026: }
8027:
1.974 wenzelju 8028: .LC_hidden {
8029: display: none;
8030: }
8031:
1.1030 www 8032: .LCmodal-overlay {
8033: position:fixed;
8034: top:0;
8035: right:0;
8036: bottom:0;
8037: left:0;
8038: height:100%;
8039: width:100%;
8040: margin:0;
8041: padding:0;
8042: background:#999;
8043: opacity:.75;
8044: filter: alpha(opacity=75);
8045: -moz-opacity: 0.75;
8046: z-index:101;
8047: }
8048:
8049: * html .LCmodal-overlay {
8050: position: absolute;
8051: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8052: }
8053:
8054: .LCmodal-window {
8055: position:fixed;
8056: top:50%;
8057: left:50%;
8058: margin:0;
8059: padding:0;
8060: z-index:102;
8061: }
8062:
8063: * html .LCmodal-window {
8064: position:absolute;
8065: }
8066:
8067: .LCclose-window {
8068: position:absolute;
8069: width:32px;
8070: height:32px;
8071: right:8px;
8072: top:8px;
8073: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8074: text-indent:-99999px;
8075: overflow:hidden;
8076: cursor:pointer;
8077: }
8078:
1.1100 raeburn 8079: /*
1.1231 damieng 8080: styles used for response display
8081: */
8082: div.LC_radiofoil, div.LC_rankfoil {
8083: margin: .5em 0em .5em 0em;
8084: }
8085: table.LC_itemgroup {
8086: margin-top: 1em;
8087: }
8088:
8089: /*
1.1100 raeburn 8090: styles used by TTH when "Default set of options to pass to tth/m
8091: when converting TeX" in course settings has been set
8092:
8093: option passed: -t
8094:
8095: */
8096:
8097: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8098: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8099: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8100: td div.norm {line-height:normal;}
8101:
8102: /*
8103: option passed -y3
8104: */
8105:
8106: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8107: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8108: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8109:
1.1230 damieng 8110: /*
8111: sections with roles, for content only
8112: */
8113: section[class^="role-"] {
8114: padding-left: 10px;
8115: padding-right: 5px;
8116: margin-top: 8px;
8117: margin-bottom: 8px;
8118: border: 1px solid #2A4;
8119: border-radius: 5px;
8120: box-shadow: 0px 1px 1px #BBB;
8121: }
8122: section[class^="role-"]>h1 {
8123: position: relative;
8124: margin: 0px;
8125: padding-top: 10px;
8126: padding-left: 40px;
8127: }
8128: section[class^="role-"]>h1:before {
8129: position: absolute;
8130: left: -5px;
8131: top: 5px;
8132: }
8133: section.role-activity>h1:before {
8134: content:url('/adm/daxe/images/section_icons/activity.png');
8135: }
8136: section.role-advice>h1:before {
8137: content:url('/adm/daxe/images/section_icons/advice.png');
8138: }
8139: section.role-bibliography>h1:before {
8140: content:url('/adm/daxe/images/section_icons/bibliography.png');
8141: }
8142: section.role-citation>h1:before {
8143: content:url('/adm/daxe/images/section_icons/citation.png');
8144: }
8145: section.role-conclusion>h1:before {
8146: content:url('/adm/daxe/images/section_icons/conclusion.png');
8147: }
8148: section.role-definition>h1:before {
8149: content:url('/adm/daxe/images/section_icons/definition.png');
8150: }
8151: section.role-demonstration>h1:before {
8152: content:url('/adm/daxe/images/section_icons/demonstration.png');
8153: }
8154: section.role-example>h1:before {
8155: content:url('/adm/daxe/images/section_icons/example.png');
8156: }
8157: section.role-explanation>h1:before {
8158: content:url('/adm/daxe/images/section_icons/explanation.png');
8159: }
8160: section.role-introduction>h1:before {
8161: content:url('/adm/daxe/images/section_icons/introduction.png');
8162: }
8163: section.role-method>h1:before {
8164: content:url('/adm/daxe/images/section_icons/method.png');
8165: }
8166: section.role-more_information>h1:before {
8167: content:url('/adm/daxe/images/section_icons/more_information.png');
8168: }
8169: section.role-objectives>h1:before {
8170: content:url('/adm/daxe/images/section_icons/objectives.png');
8171: }
8172: section.role-prerequisites>h1:before {
8173: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8174: }
8175: section.role-remark>h1:before {
8176: content:url('/adm/daxe/images/section_icons/remark.png');
8177: }
8178: section.role-reminder>h1:before {
8179: content:url('/adm/daxe/images/section_icons/reminder.png');
8180: }
8181: section.role-summary>h1:before {
8182: content:url('/adm/daxe/images/section_icons/summary.png');
8183: }
8184: section.role-syntax>h1:before {
8185: content:url('/adm/daxe/images/section_icons/syntax.png');
8186: }
8187: section.role-warning>h1:before {
8188: content:url('/adm/daxe/images/section_icons/warning.png');
8189: }
8190:
1.1269 raeburn 8191: #LC_minitab_header {
8192: float:left;
8193: width:100%;
8194: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8195: font-size:93%;
8196: line-height:normal;
8197: margin: 0.5em 0 0.5em 0;
8198: }
8199: #LC_minitab_header ul {
8200: margin:0;
8201: padding:10px 10px 0;
8202: list-style:none;
8203: }
8204: #LC_minitab_header li {
8205: float:left;
8206: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8207: margin:0;
8208: padding:0 0 0 9px;
8209: }
8210: #LC_minitab_header a {
8211: display:block;
8212: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8213: padding:5px 15px 4px 6px;
8214: }
8215: #LC_minitab_header #LC_current_minitab {
8216: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8217: }
8218: #LC_minitab_header #LC_current_minitab a {
8219: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8220: padding-bottom:5px;
8221: }
8222:
8223:
1.343 albertel 8224: END
8225: }
8226:
1.306 albertel 8227: =pod
8228:
8229: =item * &headtag()
8230:
8231: Returns a uniform footer for LON-CAPA web pages.
8232:
1.307 albertel 8233: Inputs: $title - optional title for the head
8234: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8235: $args - optional arguments
1.319 albertel 8236: force_register - if is true call registerurl so the remote is
8237: informed
1.415 albertel 8238: redirect -> array ref of
8239: 1- seconds before redirect occurs
8240: 2- url to redirect to
8241: 3- whether the side effect should occur
1.315 albertel 8242: (side effect of setting
8243: $env{'internal.head.redirect'} to the url
8244: redirected too)
1.352 albertel 8245: domain -> force to color decorate a page for a specific
8246: domain
8247: function -> force usage of a specific rolish color scheme
8248: bgcolor -> override the default page bgcolor
1.460 albertel 8249: no_auto_mt_title
8250: -> prevent &mt()ing the title arg
1.464 albertel 8251:
1.306 albertel 8252: =cut
8253:
8254: sub headtag {
1.313 albertel 8255: my ($title,$head_extra,$args) = @_;
1.306 albertel 8256:
1.363 albertel 8257: my $function = $args->{'function'} || &get_users_function();
8258: my $domain = $args->{'domain'} || &determinedomain();
8259: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8260: my $httphost = $args->{'use_absolute'};
1.418 albertel 8261: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8262: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8263: #time(),
1.418 albertel 8264: $env{'environment.color.timestamp'},
1.363 albertel 8265: $function,$domain,$bgcolor);
8266:
1.369 www 8267: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8268:
1.308 albertel 8269: my $result =
8270: '<head>'.
1.1160 raeburn 8271: &font_settings($args);
1.319 albertel 8272:
1.1188 raeburn 8273: my $inhibitprint;
8274: if ($args->{'print_suppress'}) {
8275: $inhibitprint = &print_suppression();
8276: }
1.1064 raeburn 8277:
1.461 albertel 8278: if (!$args->{'frameset'}) {
8279: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8280: }
1.962 droeschl 8281: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8282: $result .= Apache::lonxml::display_title();
1.319 albertel 8283: }
1.436 albertel 8284: if (!$args->{'no_nav_bar'}
8285: && !$args->{'only_body'}
8286: && !$args->{'frameset'}) {
1.1154 raeburn 8287: $result .= &help_menu_js($httphost);
1.1032 www 8288: $result.=&modal_window();
1.1038 www 8289: $result.=&togglebox_script();
1.1034 www 8290: $result.=&wishlist_window();
1.1041 www 8291: $result.=&LCprogressbarUpdate_script();
1.1034 www 8292: } else {
8293: if ($args->{'add_modal'}) {
8294: $result.=&modal_window();
8295: }
8296: if ($args->{'add_wishlist'}) {
8297: $result.=&wishlist_window();
8298: }
1.1038 www 8299: if ($args->{'add_togglebox'}) {
8300: $result.=&togglebox_script();
8301: }
1.1041 www 8302: if ($args->{'add_progressbar'}) {
8303: $result.=&LCprogressbarUpdate_script();
8304: }
1.436 albertel 8305: }
1.314 albertel 8306: if (ref($args->{'redirect'})) {
1.414 albertel 8307: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8308: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8309: if (!$inhibit_continue) {
8310: $env{'internal.head.redirect'} = $url;
8311: }
1.313 albertel 8312: $result.=<<ADDMETA
8313: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8314: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8315: ADDMETA
1.1210 raeburn 8316: } else {
8317: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8318: my $requrl = $env{'request.uri'};
8319: if ($requrl eq '') {
8320: $requrl = $ENV{'REQUEST_URI'};
8321: $requrl =~ s/\?.+$//;
8322: }
8323: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8324: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8325: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8326: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8327: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8328: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
8329: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8330: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8331: if ($domdefs{'offloadnow'}{$lonhost}) {
8332: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8333: if (($newserver) && ($newserver ne $lonhost)) {
8334: my $numsec = 5;
8335: my $timeout = $numsec * 1000;
8336: my ($newurl,$locknum,%locks,$msg);
8337: if ($env{'request.role.adv'}) {
8338: ($locknum,%locks) = &Apache::lonnet::get_locks();
8339: }
8340: my $disable_submit = 0;
8341: if ($requrl =~ /$LONCAPA::assess_re/) {
8342: $disable_submit = 1;
8343: }
8344: if ($locknum) {
8345: my @lockinfo = sort(values(%locks));
8346: $msg = &mt('Once the following tasks are complete: ')."\\n".
8347: join(", ",sort(values(%locks)))."\\n".
8348: &mt('your session will be transferred to a different server, after you click "Roles".');
8349: } else {
8350: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8351: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
8352: }
8353: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8354: $newurl = '/adm/switchserver?otherserver='.$newserver;
8355: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8356: $newurl .= '&role='.$env{'request.role'};
8357: }
8358: if ($env{'request.symb'}) {
8359: $newurl .= '&symb='.$env{'request.symb'};
8360: } else {
8361: $newurl .= '&origurl='.$requrl;
8362: }
8363: }
1.1222 damieng 8364: &js_escape(\$msg);
1.1210 raeburn 8365: $result.=<<OFFLOAD
8366: <meta http-equiv="pragma" content="no-cache" />
8367: <script type="text/javascript">
1.1215 raeburn 8368: // <![CDATA[
1.1210 raeburn 8369: function LC_Offload_Now() {
8370: var dest = "$newurl";
8371: if (dest != '') {
8372: window.location.href="$newurl";
8373: }
8374: }
1.1214 raeburn 8375: \$(document).ready(function () {
8376: window.alert('$msg');
8377: if ($disable_submit) {
1.1210 raeburn 8378: \$(".LC_hwk_submit").prop("disabled", true);
8379: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8380: }
8381: setTimeout('LC_Offload_Now()', $timeout);
8382: });
1.1215 raeburn 8383: // ]]>
1.1210 raeburn 8384: </script>
8385: OFFLOAD
8386: }
8387: }
8388: }
8389: }
8390: }
8391: }
1.313 albertel 8392: }
1.306 albertel 8393: if (!defined($title)) {
8394: $title = 'The LearningOnline Network with CAPA';
8395: }
1.460 albertel 8396: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8397: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8398: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8399: if (!$args->{'frameset'}) {
8400: $result .= ' /';
8401: }
8402: $result .= '>'
1.1064 raeburn 8403: .$inhibitprint
1.414 albertel 8404: .$head_extra;
1.1242 raeburn 8405: my $clientmobile;
8406: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8407: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8408: } else {
8409: $clientmobile = $env{'browser.mobile'};
8410: }
8411: if ($clientmobile) {
1.1137 raeburn 8412: $result .= '
8413: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8414: <meta name="apple-mobile-web-app-capable" content="yes" />';
8415: }
1.1278 raeburn 8416: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8417: return $result.'</head>';
1.306 albertel 8418: }
8419:
8420: =pod
8421:
1.340 albertel 8422: =item * &font_settings()
8423:
8424: Returns neccessary <meta> to set the proper encoding
8425:
1.1160 raeburn 8426: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8427:
8428: =cut
8429:
8430: sub font_settings {
1.1160 raeburn 8431: my ($args) = @_;
1.340 albertel 8432: my $headerstring='';
1.1160 raeburn 8433: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8434: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8435: $headerstring.=
8436: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8437: if (!$args->{'frameset'}) {
8438: $headerstring.= ' /';
8439: }
8440: $headerstring .= '>'."\n";
1.340 albertel 8441: }
8442: return $headerstring;
8443: }
8444:
1.341 albertel 8445: =pod
8446:
1.1064 raeburn 8447: =item * &print_suppression()
8448:
8449: In course context returns css which causes the body to be blank when media="print",
8450: if printout generation is unavailable for the current resource.
8451:
8452: This could be because:
8453:
8454: (a) printstartdate is in the future
8455:
8456: (b) printenddate is in the past
8457:
8458: (c) there is an active exam block with "printout"
8459: functionality blocked
8460:
8461: Users with pav, pfo or evb privileges are exempt.
8462:
8463: Inputs: none
8464:
8465: =cut
8466:
8467:
8468: sub print_suppression {
8469: my $noprint;
8470: if ($env{'request.course.id'}) {
8471: my $scope = $env{'request.course.id'};
8472: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8473: (&Apache::lonnet::allowed('pfo',$scope))) {
8474: return;
8475: }
8476: if ($env{'request.course.sec'} ne '') {
8477: $scope .= "/$env{'request.course.sec'}";
8478: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8479: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8480: return;
1.1064 raeburn 8481: }
8482: }
8483: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8484: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8485: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8486: if ($blocked) {
8487: my $checkrole = "cm./$cdom/$cnum";
8488: if ($env{'request.course.sec'} ne '') {
8489: $checkrole .= "/$env{'request.course.sec'}";
8490: }
8491: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8492: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8493: $noprint = 1;
8494: }
8495: }
8496: unless ($noprint) {
8497: my $symb = &Apache::lonnet::symbread();
8498: if ($symb ne '') {
8499: my $navmap = Apache::lonnavmaps::navmap->new();
8500: if (ref($navmap)) {
8501: my $res = $navmap->getBySymb($symb);
8502: if (ref($res)) {
8503: if (!$res->resprintable()) {
8504: $noprint = 1;
8505: }
8506: }
8507: }
8508: }
8509: }
8510: if ($noprint) {
8511: return <<"ENDSTYLE";
8512: <style type="text/css" media="print">
8513: body { display:none }
8514: </style>
8515: ENDSTYLE
8516: }
8517: }
8518: return;
8519: }
8520:
8521: =pod
8522:
1.341 albertel 8523: =item * &xml_begin()
8524:
8525: Returns the needed doctype and <html>
8526:
8527: Inputs: none
8528:
8529: =cut
8530:
8531: sub xml_begin {
1.1168 raeburn 8532: my ($is_frameset) = @_;
1.341 albertel 8533: my $output='';
8534:
8535: if ($env{'browser.mathml'}) {
8536: $output='<?xml version="1.0"?>'
8537: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8538: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8539:
8540: # .'<!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">] >'
8541: .'<!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">'
8542: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8543: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8544: } elsif ($is_frameset) {
8545: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8546: '<html>'."\n";
1.341 albertel 8547: } else {
1.1168 raeburn 8548: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8549: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8550: }
8551: return $output;
8552: }
1.340 albertel 8553:
8554: =pod
8555:
1.306 albertel 8556: =item * &start_page()
8557:
8558: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8559:
1.648 raeburn 8560: Inputs:
8561:
8562: =over 4
8563:
8564: $title - optional title for the page
8565:
8566: $head_extra - optional extra HTML to incude inside the <head>
8567:
8568: $args - additional optional args supported are:
8569:
8570: =over 8
8571:
8572: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8573: arg on
1.814 bisitz 8574: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8575: add_entries -> additional attributes to add to the <body>
8576: domain -> force to color decorate a page for a
1.317 albertel 8577: specific domain
1.648 raeburn 8578: function -> force usage of a specific rolish color
1.317 albertel 8579: scheme
1.648 raeburn 8580: redirect -> see &headtag()
8581: bgcolor -> override the default page bg color
8582: js_ready -> return a string ready for being used in
1.317 albertel 8583: a javascript writeln
1.648 raeburn 8584: html_encode -> return a string ready for being used in
1.320 albertel 8585: a html attribute
1.648 raeburn 8586: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8587: $forcereg arg
1.648 raeburn 8588: frameset -> if true will start with a <frameset>
1.330 albertel 8589: rather than <body>
1.648 raeburn 8590: skip_phases -> hash ref of
1.338 albertel 8591: head -> skip the <html><head> generation
8592: body -> skip all <body> generation
1.648 raeburn 8593: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8594: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8595: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 8596: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8597: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 8598: group -> includes the current group, if page is for a
1.1274 raeburn 8599: specific group
8600: use_absolute -> for request for external resource or syllabus, this
8601: will contain https://<hostname> if server uses
8602: https (as per hosts.tab), but request is for http
8603: hostname -> hostname, originally from $r->hostname(), (optional).
1.361 albertel 8604:
1.648 raeburn 8605: =back
1.460 albertel 8606:
1.648 raeburn 8607: =back
1.562 albertel 8608:
1.306 albertel 8609: =cut
8610:
8611: sub start_page {
1.309 albertel 8612: my ($title,$head_extra,$args) = @_;
1.318 albertel 8613: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8614:
1.315 albertel 8615: $env{'internal.start_page'}++;
1.1096 raeburn 8616: my ($result,@advtools);
1.964 droeschl 8617:
1.338 albertel 8618: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8619: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8620: }
8621:
8622: if (! exists($args->{'skip_phases'}{'body'}) ) {
8623: if ($args->{'frameset'}) {
8624: my $attr_string = &make_attr_string($args->{'force_register'},
8625: $args->{'add_entries'});
8626: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8627: } else {
8628: $result .=
8629: &bodytag($title,
8630: $args->{'function'}, $args->{'add_entries'},
8631: $args->{'only_body'}, $args->{'domain'},
8632: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8633: $args->{'bgcolor'}, $args,
8634: \@advtools);
1.831 bisitz 8635: }
1.330 albertel 8636: }
1.338 albertel 8637:
1.315 albertel 8638: if ($args->{'js_ready'}) {
1.713 kaisler 8639: $result = &js_ready($result);
1.315 albertel 8640: }
1.320 albertel 8641: if ($args->{'html_encode'}) {
1.713 kaisler 8642: $result = &html_encode($result);
8643: }
8644:
1.813 bisitz 8645: # Preparation for new and consistent functionlist at top of screen
8646: # if ($args->{'functionlist'}) {
8647: # $result .= &build_functionlist();
8648: #}
8649:
1.964 droeschl 8650: # Don't add anything more if only_body wanted or in const space
8651: return $result if $args->{'only_body'}
8652: || $env{'request.state'} eq 'construct';
1.813 bisitz 8653:
8654: #Breadcrumbs
1.758 kaisler 8655: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8656: &Apache::lonhtmlcommon::clear_breadcrumbs();
8657: #if any br links exists, add them to the breadcrumbs
8658: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8659: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8660: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8661: }
8662: }
1.1096 raeburn 8663: # if @advtools array contains items add then to the breadcrumbs
8664: if (@advtools > 0) {
8665: &Apache::lonmenu::advtools_crumbs(@advtools);
8666: }
1.1272 raeburn 8667: my $menulink;
8668: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8669: if ((exists($args->{'bread_crumbs_nomenu'})) ||
8670: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
8671: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
8672: (!$env{'request.role.adv'}))) {
8673: $menulink = 0;
8674: } else {
8675: undef($menulink);
8676: }
1.758 kaisler 8677: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8678: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 8679: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 8680: } else {
1.1272 raeburn 8681: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8682: }
1.320 albertel 8683: }
1.315 albertel 8684: return $result;
1.306 albertel 8685: }
8686:
8687: sub end_page {
1.315 albertel 8688: my ($args) = @_;
8689: $env{'internal.end_page'}++;
1.330 albertel 8690: my $result;
1.335 albertel 8691: if ($args->{'discussion'}) {
8692: my ($target,$parser);
8693: if (ref($args->{'discussion'})) {
8694: ($target,$parser) =($args->{'discussion'}{'target'},
8695: $args->{'discussion'}{'parser'});
8696: }
8697: $result .= &Apache::lonxml::xmlend($target,$parser);
8698: }
1.330 albertel 8699: if ($args->{'frameset'}) {
8700: $result .= '</frameset>';
8701: } else {
1.635 raeburn 8702: $result .= &endbodytag($args);
1.330 albertel 8703: }
1.1080 raeburn 8704: unless ($args->{'notbody'}) {
8705: $result .= "\n</html>";
8706: }
1.330 albertel 8707:
1.315 albertel 8708: if ($args->{'js_ready'}) {
1.317 albertel 8709: $result = &js_ready($result);
1.315 albertel 8710: }
1.335 albertel 8711:
1.320 albertel 8712: if ($args->{'html_encode'}) {
8713: $result = &html_encode($result);
8714: }
1.335 albertel 8715:
1.315 albertel 8716: return $result;
8717: }
8718:
1.1034 www 8719: sub wishlist_window {
8720: return(<<'ENDWISHLIST');
1.1046 raeburn 8721: <script type="text/javascript">
1.1034 www 8722: // <![CDATA[
8723: // <!-- BEGIN LON-CAPA Internal
8724: function set_wishlistlink(title, path) {
8725: if (!title) {
8726: title = document.title;
8727: title = title.replace(/^LON-CAPA /,'');
8728: }
1.1175 raeburn 8729: title = encodeURIComponent(title);
1.1203 raeburn 8730: title = title.replace("'","\\\'");
1.1034 www 8731: if (!path) {
8732: path = location.pathname;
8733: }
1.1175 raeburn 8734: path = encodeURIComponent(path);
1.1203 raeburn 8735: path = path.replace("'","\\\'");
1.1034 www 8736: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8737: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8738: }
8739: // END LON-CAPA Internal -->
8740: // ]]>
8741: </script>
8742: ENDWISHLIST
8743: }
8744:
1.1030 www 8745: sub modal_window {
8746: return(<<'ENDMODAL');
1.1046 raeburn 8747: <script type="text/javascript">
1.1030 www 8748: // <![CDATA[
8749: // <!-- BEGIN LON-CAPA Internal
8750: var modalWindow = {
8751: parent:"body",
8752: windowId:null,
8753: content:null,
8754: width:null,
8755: height:null,
8756: close:function()
8757: {
8758: $(".LCmodal-window").remove();
8759: $(".LCmodal-overlay").remove();
8760: },
8761: open:function()
8762: {
8763: var modal = "";
8764: modal += "<div class=\"LCmodal-overlay\"></div>";
8765: 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;\">";
8766: modal += this.content;
8767: modal += "</div>";
8768:
8769: $(this.parent).append(modal);
8770:
8771: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8772: $(".LCclose-window").click(function(){modalWindow.close();});
8773: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8774: }
8775: };
1.1140 raeburn 8776: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8777: {
1.1266 raeburn 8778: source = source.replace(/'/g,"'");
1.1030 www 8779: modalWindow.windowId = "myModal";
8780: modalWindow.width = width;
8781: modalWindow.height = height;
1.1196 raeburn 8782: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8783: modalWindow.open();
1.1208 raeburn 8784: };
1.1030 www 8785: // END LON-CAPA Internal -->
8786: // ]]>
8787: </script>
8788: ENDMODAL
8789: }
8790:
8791: sub modal_link {
1.1140 raeburn 8792: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8793: unless ($width) { $width=480; }
8794: unless ($height) { $height=400; }
1.1031 www 8795: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8796: unless ($transparency) { $transparency='true'; }
8797:
1.1074 raeburn 8798: my $target_attr;
8799: if (defined($target)) {
8800: $target_attr = 'target="'.$target.'"';
8801: }
8802: return <<"ENDLINK";
1.1140 raeburn 8803: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8804: $linktext</a>
8805: ENDLINK
1.1030 www 8806: }
8807:
1.1032 www 8808: sub modal_adhoc_script {
8809: my ($funcname,$width,$height,$content)=@_;
8810: return (<<ENDADHOC);
1.1046 raeburn 8811: <script type="text/javascript">
1.1032 www 8812: // <![CDATA[
8813: var $funcname = function()
8814: {
8815: modalWindow.windowId = "myModal";
8816: modalWindow.width = $width;
8817: modalWindow.height = $height;
8818: modalWindow.content = '$content';
8819: modalWindow.open();
8820: };
8821: // ]]>
8822: </script>
8823: ENDADHOC
8824: }
8825:
1.1041 www 8826: sub modal_adhoc_inner {
8827: my ($funcname,$width,$height,$content)=@_;
8828: my $innerwidth=$width-20;
8829: $content=&js_ready(
1.1140 raeburn 8830: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8831: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8832: $content.
1.1041 www 8833: &end_scrollbox().
1.1140 raeburn 8834: &end_page()
1.1041 www 8835: );
8836: return &modal_adhoc_script($funcname,$width,$height,$content);
8837: }
8838:
8839: sub modal_adhoc_window {
8840: my ($funcname,$width,$height,$content,$linktext)=@_;
8841: return &modal_adhoc_inner($funcname,$width,$height,$content).
8842: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8843: }
8844:
8845: sub modal_adhoc_launch {
8846: my ($funcname,$width,$height,$content)=@_;
8847: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8848: <script type="text/javascript">
8849: // <![CDATA[
8850: $funcname();
8851: // ]]>
8852: </script>
8853: ENDLAUNCH
8854: }
8855:
8856: sub modal_adhoc_close {
8857: return (<<ENDCLOSE);
8858: <script type="text/javascript">
8859: // <![CDATA[
8860: modalWindow.close();
8861: // ]]>
8862: </script>
8863: ENDCLOSE
8864: }
8865:
1.1038 www 8866: sub togglebox_script {
8867: return(<<ENDTOGGLE);
8868: <script type="text/javascript">
8869: // <![CDATA[
8870: function LCtoggleDisplay(id,hidetext,showtext) {
8871: link = document.getElementById(id + "link").childNodes[0];
8872: with (document.getElementById(id).style) {
8873: if (display == "none" ) {
8874: display = "inline";
8875: link.nodeValue = hidetext;
8876: } else {
8877: display = "none";
8878: link.nodeValue = showtext;
8879: }
8880: }
8881: }
8882: // ]]>
8883: </script>
8884: ENDTOGGLE
8885: }
8886:
1.1039 www 8887: sub start_togglebox {
8888: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8889: unless ($heading) { $heading=''; } else { $heading.=' '; }
8890: unless ($showtext) { $showtext=&mt('show'); }
8891: unless ($hidetext) { $hidetext=&mt('hide'); }
8892: unless ($headerbg) { $headerbg='#FFFFFF'; }
8893: return &start_data_table().
8894: &start_data_table_header_row().
8895: '<td bgcolor="'.$headerbg.'">'.$heading.
8896: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8897: $showtext.'\')">'.$showtext.'</a>]</td>'.
8898: &end_data_table_header_row().
8899: '<tr id="'.$id.'" style="display:none""><td>';
8900: }
8901:
8902: sub end_togglebox {
8903: return '</td></tr>'.&end_data_table();
8904: }
8905:
1.1041 www 8906: sub LCprogressbar_script {
1.1302 raeburn 8907: my ($id,$number_to_do)=@_;
8908: if ($number_to_do) {
8909: return(<<ENDPROGRESS);
1.1041 www 8910: <script type="text/javascript">
8911: // <![CDATA[
1.1045 www 8912: \$('#progressbar$id').progressbar({
1.1041 www 8913: value: 0,
8914: change: function(event, ui) {
8915: var newVal = \$(this).progressbar('option', 'value');
8916: \$('.pblabel', this).text(LCprogressTxt);
8917: }
8918: });
8919: // ]]>
8920: </script>
8921: ENDPROGRESS
1.1302 raeburn 8922: } else {
8923: return(<<ENDPROGRESS);
8924: <script type="text/javascript">
8925: // <![CDATA[
8926: \$('#progressbar$id').progressbar({
8927: value: false,
8928: create: function(event, ui) {
8929: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
8930: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
8931: }
8932: });
8933: // ]]>
8934: </script>
8935: ENDPROGRESS
8936: }
1.1041 www 8937: }
8938:
8939: sub LCprogressbarUpdate_script {
8940: return(<<ENDPROGRESSUPDATE);
8941: <style type="text/css">
8942: .ui-progressbar { position:relative; }
1.1302 raeburn 8943: .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
1.1041 www 8944: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8945: </style>
8946: <script type="text/javascript">
8947: // <![CDATA[
1.1045 www 8948: var LCprogressTxt='---';
8949:
1.1302 raeburn 8950: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 8951: LCprogressTxt=progresstext;
1.1302 raeburn 8952: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
8953: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
8954: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 8955: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
8956: } else {
8957: \$('#progressbar'+id).progressbar('value',percent);
8958: }
1.1041 www 8959: }
8960: // ]]>
8961: </script>
8962: ENDPROGRESSUPDATE
8963: }
8964:
1.1042 www 8965: my $LClastpercent;
1.1045 www 8966: my $LCidcnt;
8967: my $LCcurrentid;
1.1042 www 8968:
1.1041 www 8969: sub LCprogressbar {
1.1302 raeburn 8970: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 8971: $LClastpercent=0;
1.1045 www 8972: $LCidcnt++;
8973: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 8974: my ($starting,$content);
8975: if ($number_to_do) {
8976: $starting=&mt('Starting');
8977: $content=(<<ENDPROGBAR);
8978: $preamble
1.1045 www 8979: <div id="progressbar$LCcurrentid">
1.1041 www 8980: <span class="pblabel">$starting</span>
8981: </div>
8982: ENDPROGBAR
1.1302 raeburn 8983: } else {
8984: $starting=&mt('Loading...');
8985: $LClastpercent='false';
8986: $content=(<<ENDPROGBAR);
8987: $preamble
8988: <div id="progressbar$LCcurrentid">
8989: <div class="progress-label">$starting</div>
8990: </div>
8991: ENDPROGBAR
8992: }
8993: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 8994: }
8995:
8996: sub LCprogressbarUpdate {
1.1302 raeburn 8997: my ($r,$val,$text,$number_to_do)=@_;
8998: if ($number_to_do) {
8999: unless ($val) {
9000: if ($LClastpercent) {
9001: $val=$LClastpercent;
9002: } else {
9003: $val=0;
9004: }
9005: }
9006: if ($val<0) { $val=0; }
9007: if ($val>100) { $val=0; }
9008: $LClastpercent=$val;
9009: unless ($text) { $text=$val.'%'; }
9010: } else {
9011: $val = 'false';
1.1042 www 9012: }
1.1041 www 9013: $text=&js_ready($text);
1.1044 www 9014: &r_print($r,<<ENDUPDATE);
1.1041 www 9015: <script type="text/javascript">
9016: // <![CDATA[
1.1302 raeburn 9017: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9018: // ]]>
9019: </script>
9020: ENDUPDATE
1.1035 www 9021: }
9022:
1.1042 www 9023: sub LCprogressbarClose {
9024: my ($r)=@_;
9025: $LClastpercent=0;
1.1044 www 9026: &r_print($r,<<ENDCLOSE);
1.1042 www 9027: <script type="text/javascript">
9028: // <![CDATA[
1.1045 www 9029: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9030: // ]]>
9031: </script>
9032: ENDCLOSE
1.1044 www 9033: }
9034:
9035: sub r_print {
9036: my ($r,$to_print)=@_;
9037: if ($r) {
9038: $r->print($to_print);
9039: $r->rflush();
9040: } else {
9041: print($to_print);
9042: }
1.1042 www 9043: }
9044:
1.320 albertel 9045: sub html_encode {
9046: my ($result) = @_;
9047:
1.322 albertel 9048: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9049:
9050: return $result;
9051: }
1.1044 www 9052:
1.317 albertel 9053: sub js_ready {
9054: my ($result) = @_;
9055:
1.323 albertel 9056: $result =~ s/[\n\r]/ /xmsg;
9057: $result =~ s/\\/\\\\/xmsg;
9058: $result =~ s/'/\\'/xmsg;
1.372 albertel 9059: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9060:
9061: return $result;
9062: }
9063:
1.315 albertel 9064: sub validate_page {
9065: if ( exists($env{'internal.start_page'})
1.316 albertel 9066: && $env{'internal.start_page'} > 1) {
9067: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9068: $env{'internal.start_page'}.' '.
1.316 albertel 9069: $ENV{'request.filename'});
1.315 albertel 9070: }
9071: if ( exists($env{'internal.end_page'})
1.316 albertel 9072: && $env{'internal.end_page'} > 1) {
9073: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9074: $env{'internal.end_page'}.' '.
1.316 albertel 9075: $env{'request.filename'});
1.315 albertel 9076: }
9077: if ( exists($env{'internal.start_page'})
9078: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9079: &Apache::lonnet::logthis('start_page called without end_page '.
9080: $env{'request.filename'});
1.315 albertel 9081: }
9082: if ( ! exists($env{'internal.start_page'})
9083: && exists($env{'internal.end_page'})) {
1.316 albertel 9084: &Apache::lonnet::logthis('end_page called without start_page'.
9085: $env{'request.filename'});
1.315 albertel 9086: }
1.306 albertel 9087: }
1.315 albertel 9088:
1.996 www 9089:
9090: sub start_scrollbox {
1.1140 raeburn 9091: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9092: unless ($outerwidth) { $outerwidth='520px'; }
9093: unless ($width) { $width='500px'; }
9094: unless ($height) { $height='200px'; }
1.1075 raeburn 9095: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9096: if ($id ne '') {
1.1140 raeburn 9097: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9098: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9099: }
1.1075 raeburn 9100: if ($bgcolor ne '') {
9101: $tdcol = "background-color: $bgcolor;";
9102: }
1.1137 raeburn 9103: my $nicescroll_js;
9104: if ($env{'browser.mobile'}) {
1.1140 raeburn 9105: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9106: }
9107: return <<"END";
9108: $nicescroll_js
9109:
9110: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9111: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9112: END
9113: }
9114:
9115: sub end_scrollbox {
9116: return '</div></td></tr></table>';
9117: }
9118:
9119: sub nicescroll_javascript {
9120: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9121: my %options;
9122: if (ref($cursor) eq 'HASH') {
9123: %options = %{$cursor};
9124: }
9125: unless ($options{'railalign'} =~ /^left|right$/) {
9126: $options{'railalign'} = 'left';
9127: }
9128: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9129: my $function = &get_users_function();
9130: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9131: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9132: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9133: }
1.1140 raeburn 9134: }
9135: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9136: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9137: $options{'cursoropacity'}='1.0';
9138: }
1.1140 raeburn 9139: } else {
9140: $options{'cursoropacity'}='1.0';
9141: }
9142: if ($options{'cursorfixedheight'} eq 'none') {
9143: delete($options{'cursorfixedheight'});
9144: } else {
9145: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9146: }
9147: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9148: delete($options{'railoffset'});
9149: }
9150: my @niceoptions;
9151: while (my($key,$value) = each(%options)) {
9152: if ($value =~ /^\{.+\}$/) {
9153: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9154: } else {
1.1140 raeburn 9155: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9156: }
1.1140 raeburn 9157: }
9158: my $nicescroll_js = '
1.1137 raeburn 9159: $(document).ready(
1.1140 raeburn 9160: function() {
9161: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9162: }
1.1137 raeburn 9163: );
9164: ';
1.1140 raeburn 9165: if ($framecheck) {
9166: $nicescroll_js .= '
9167: function expand_div(caller) {
9168: if (top === self) {
9169: document.getElementById("'.$id.'").style.width = "auto";
9170: document.getElementById("'.$id.'").style.height = "auto";
9171: } else {
9172: try {
9173: if (parent.frames) {
9174: if (parent.frames.length > 1) {
9175: var framesrc = parent.frames[1].location.href;
9176: var currsrc = framesrc.replace(/\#.*$/,"");
9177: if ((caller == "search") || (currsrc == "'.$location.'")) {
9178: document.getElementById("'.$id.'").style.width = "auto";
9179: document.getElementById("'.$id.'").style.height = "auto";
9180: }
9181: }
9182: }
9183: } catch (e) {
9184: return;
9185: }
1.1137 raeburn 9186: }
1.1140 raeburn 9187: return;
1.996 www 9188: }
1.1140 raeburn 9189: ';
9190: }
9191: if ($needjsready) {
9192: $nicescroll_js = '
9193: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9194: } else {
9195: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9196: }
9197: return $nicescroll_js;
1.996 www 9198: }
9199:
1.318 albertel 9200: sub simple_error_page {
1.1150 bisitz 9201: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 9202: my %displayargs;
1.1151 raeburn 9203: if (ref($args) eq 'HASH') {
9204: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 9205: if ($args->{'only_body'}) {
9206: $displayargs{'only_body'} = 1;
9207: }
9208: if ($args->{'no_nav_bar'}) {
9209: $displayargs{'no_nav_bar'} = 1;
9210: }
1.1151 raeburn 9211: } else {
9212: $msg = &mt($msg);
9213: }
1.1150 bisitz 9214:
1.318 albertel 9215: my $page =
1.1304 raeburn 9216: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 9217: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9218: &Apache::loncommon::end_page();
9219: if (ref($r)) {
9220: $r->print($page);
1.327 albertel 9221: return;
1.318 albertel 9222: }
9223: return $page;
9224: }
1.347 albertel 9225:
9226: {
1.610 albertel 9227: my @row_count;
1.961 onken 9228:
9229: sub start_data_table_count {
9230: unshift(@row_count, 0);
9231: return;
9232: }
9233:
9234: sub end_data_table_count {
9235: shift(@row_count);
9236: return;
9237: }
9238:
1.347 albertel 9239: sub start_data_table {
1.1018 raeburn 9240: my ($add_class,$id) = @_;
1.422 albertel 9241: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9242: my $table_id;
9243: if (defined($id)) {
9244: $table_id = ' id="'.$id.'"';
9245: }
1.961 onken 9246: &start_data_table_count();
1.1018 raeburn 9247: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9248: }
9249:
9250: sub end_data_table {
1.961 onken 9251: &end_data_table_count();
1.389 albertel 9252: return '</table>'."\n";;
1.347 albertel 9253: }
9254:
9255: sub start_data_table_row {
1.974 wenzelju 9256: my ($add_class, $id) = @_;
1.610 albertel 9257: $row_count[0]++;
9258: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9259: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9260: $id = (' id="'.$id.'"') unless ($id eq '');
9261: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9262: }
1.471 banghart 9263:
9264: sub continue_data_table_row {
1.974 wenzelju 9265: my ($add_class, $id) = @_;
1.610 albertel 9266: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9267: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9268: $id = (' id="'.$id.'"') unless ($id eq '');
9269: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9270: }
1.347 albertel 9271:
9272: sub end_data_table_row {
1.389 albertel 9273: return '</tr>'."\n";;
1.347 albertel 9274: }
1.367 www 9275:
1.421 albertel 9276: sub start_data_table_empty_row {
1.707 bisitz 9277: # $row_count[0]++;
1.421 albertel 9278: return '<tr class="LC_empty_row" >'."\n";;
9279: }
9280:
9281: sub end_data_table_empty_row {
9282: return '</tr>'."\n";;
9283: }
9284:
1.367 www 9285: sub start_data_table_header_row {
1.389 albertel 9286: return '<tr class="LC_header_row">'."\n";;
1.367 www 9287: }
9288:
9289: sub end_data_table_header_row {
1.389 albertel 9290: return '</tr>'."\n";;
1.367 www 9291: }
1.890 droeschl 9292:
9293: sub data_table_caption {
9294: my $caption = shift;
9295: return "<caption class=\"LC_caption\">$caption</caption>";
9296: }
1.347 albertel 9297: }
9298:
1.548 albertel 9299: =pod
9300:
9301: =item * &inhibit_menu_check($arg)
9302:
9303: Checks for a inhibitmenu state and generates output to preserve it
9304:
9305: Inputs: $arg - can be any of
9306: - undef - in which case the return value is a string
9307: to add into arguments list of a uri
9308: - 'input' - in which case the return value is a HTML
9309: <form> <input> field of type hidden to
9310: preserve the value
9311: - a url - in which case the return value is the url with
9312: the neccesary cgi args added to preserve the
9313: inhibitmenu state
9314: - a ref to a url - no return value, but the string is
9315: updated to include the neccessary cgi
9316: args to preserve the inhibitmenu state
9317:
9318: =cut
9319:
9320: sub inhibit_menu_check {
9321: my ($arg) = @_;
9322: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9323: if ($arg eq 'input') {
9324: if ($env{'form.inhibitmenu'}) {
9325: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9326: } else {
9327: return
9328: }
9329: }
9330: if ($env{'form.inhibitmenu'}) {
9331: if (ref($arg)) {
9332: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9333: } elsif ($arg eq '') {
9334: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9335: } else {
9336: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9337: }
9338: }
9339: if (!ref($arg)) {
9340: return $arg;
9341: }
9342: }
9343:
1.251 albertel 9344: ###############################################
1.182 matthew 9345:
9346: =pod
9347:
1.549 albertel 9348: =back
9349:
9350: =head1 User Information Routines
9351:
9352: =over 4
9353:
1.405 albertel 9354: =item * &get_users_function()
1.182 matthew 9355:
9356: Used by &bodytag to determine the current users primary role.
9357: Returns either 'student','coordinator','admin', or 'author'.
9358:
9359: =cut
9360:
9361: ###############################################
9362: sub get_users_function {
1.815 tempelho 9363: my $function = 'norole';
1.818 tempelho 9364: if ($env{'request.role'}=~/^(st)/) {
9365: $function='student';
9366: }
1.907 raeburn 9367: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9368: $function='coordinator';
9369: }
1.258 albertel 9370: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9371: $function='admin';
9372: }
1.826 bisitz 9373: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9374: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9375: $function='author';
9376: }
9377: return $function;
1.54 www 9378: }
1.99 www 9379:
9380: ###############################################
9381:
1.233 raeburn 9382: =pod
9383:
1.821 raeburn 9384: =item * &show_course()
9385:
9386: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9387: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9388:
9389: Inputs:
9390: None
9391:
9392: Outputs:
9393: Scalar: 1 if 'Course' to be used, 0 otherwise.
9394:
9395: =cut
9396:
9397: ###############################################
9398: sub show_course {
9399: my $course = !$env{'user.adv'};
9400: if (!$env{'user.adv'}) {
9401: foreach my $env (keys(%env)) {
9402: next if ($env !~ m/^user\.priv\./);
9403: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9404: $course = 0;
9405: last;
9406: }
9407: }
9408: }
9409: return $course;
9410: }
9411:
9412: ###############################################
9413:
9414: =pod
9415:
1.542 raeburn 9416: =item * &check_user_status()
1.274 raeburn 9417:
9418: Determines current status of supplied role for a
9419: specific user. Roles can be active, previous or future.
9420:
9421: Inputs:
9422: user's domain, user's username, course's domain,
1.375 raeburn 9423: course's number, optional section ID.
1.274 raeburn 9424:
9425: Outputs:
9426: role status: active, previous or future.
9427:
9428: =cut
9429:
9430: sub check_user_status {
1.412 raeburn 9431: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9432: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9433: my @uroles = keys(%userinfo);
1.274 raeburn 9434: my $srchstr;
9435: my $active_chk = 'none';
1.412 raeburn 9436: my $now = time;
1.274 raeburn 9437: if (@uroles > 0) {
1.908 raeburn 9438: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9439: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9440: } else {
1.412 raeburn 9441: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9442: }
9443: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9444: my $role_end = 0;
9445: my $role_start = 0;
9446: $active_chk = 'active';
1.412 raeburn 9447: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9448: $role_end = $1;
9449: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9450: $role_start = $1;
1.274 raeburn 9451: }
9452: }
9453: if ($role_start > 0) {
1.412 raeburn 9454: if ($now < $role_start) {
1.274 raeburn 9455: $active_chk = 'future';
9456: }
9457: }
9458: if ($role_end > 0) {
1.412 raeburn 9459: if ($now > $role_end) {
1.274 raeburn 9460: $active_chk = 'previous';
9461: }
9462: }
9463: }
9464: }
9465: return $active_chk;
9466: }
9467:
9468: ###############################################
9469:
9470: =pod
9471:
1.405 albertel 9472: =item * &get_sections()
1.233 raeburn 9473:
9474: Determines all the sections for a course including
9475: sections with students and sections containing other roles.
1.419 raeburn 9476: Incoming parameters:
9477:
9478: 1. domain
9479: 2. course number
9480: 3. reference to array containing roles for which sections should
9481: be gathered (optional).
9482: 4. reference to array containing status types for which sections
9483: should be gathered (optional).
9484:
9485: If the third argument is undefined, sections are gathered for any role.
9486: If the fourth argument is undefined, sections are gathered for any status.
9487: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9488:
1.374 raeburn 9489: Returns section hash (keys are section IDs, values are
9490: number of users in each section), subject to the
1.419 raeburn 9491: optional roles filter, optional status filter
1.233 raeburn 9492:
9493: =cut
9494:
9495: ###############################################
9496: sub get_sections {
1.419 raeburn 9497: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9498: if (!defined($cdom) || !defined($cnum)) {
9499: my $cid = $env{'request.course.id'};
9500:
9501: return if (!defined($cid));
9502:
9503: $cdom = $env{'course.'.$cid.'.domain'};
9504: $cnum = $env{'course.'.$cid.'.num'};
9505: }
9506:
9507: my %sectioncount;
1.419 raeburn 9508: my $now = time;
1.240 albertel 9509:
1.1118 raeburn 9510: my $check_students = 1;
9511: my $only_students = 0;
9512: if (ref($possible_roles) eq 'ARRAY') {
9513: if (grep(/^st$/,@{$possible_roles})) {
9514: if (@{$possible_roles} == 1) {
9515: $only_students = 1;
9516: }
9517: } else {
9518: $check_students = 0;
9519: }
9520: }
9521:
9522: if ($check_students) {
1.276 albertel 9523: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9524: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9525: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9526: my $start_index = &Apache::loncoursedata::CL_START();
9527: my $end_index = &Apache::loncoursedata::CL_END();
9528: my $status;
1.366 albertel 9529: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9530: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9531: $data->[$status_index],
9532: $data->[$start_index],
9533: $data->[$end_index]);
9534: if ($stu_status eq 'Active') {
9535: $status = 'active';
9536: } elsif ($end < $now) {
9537: $status = 'previous';
9538: } elsif ($start > $now) {
9539: $status = 'future';
9540: }
9541: if ($section ne '-1' && $section !~ /^\s*$/) {
9542: if ((!defined($possible_status)) || (($status ne '') &&
9543: (grep/^\Q$status\E$/,@{$possible_status}))) {
9544: $sectioncount{$section}++;
9545: }
1.240 albertel 9546: }
9547: }
9548: }
1.1118 raeburn 9549: if ($only_students) {
9550: return %sectioncount;
9551: }
1.240 albertel 9552: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9553: foreach my $user (sort(keys(%courseroles))) {
9554: if ($user !~ /^(\w{2})/) { next; }
9555: my ($role) = ($user =~ /^(\w{2})/);
9556: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9557: my ($section,$status);
1.240 albertel 9558: if ($role eq 'cr' &&
9559: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9560: $section=$1;
9561: }
9562: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9563: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9564: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9565: if ($end == -1 && $start == -1) {
9566: next; #deleted role
9567: }
9568: if (!defined($possible_status)) {
9569: $sectioncount{$section}++;
9570: } else {
9571: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9572: $status = 'active';
9573: } elsif ($end < $now) {
9574: $status = 'future';
9575: } elsif ($start > $now) {
9576: $status = 'previous';
9577: }
9578: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9579: $sectioncount{$section}++;
9580: }
9581: }
1.233 raeburn 9582: }
1.366 albertel 9583: return %sectioncount;
1.233 raeburn 9584: }
9585:
1.274 raeburn 9586: ###############################################
1.294 raeburn 9587:
9588: =pod
1.405 albertel 9589:
9590: =item * &get_course_users()
9591:
1.275 raeburn 9592: Retrieves usernames:domains for users in the specified course
9593: with specific role(s), and access status.
9594:
9595: Incoming parameters:
1.277 albertel 9596: 1. course domain
9597: 2. course number
9598: 3. access status: users must have - either active,
1.275 raeburn 9599: previous, future, or all.
1.277 albertel 9600: 4. reference to array of permissible roles
1.288 raeburn 9601: 5. reference to array of section restrictions (optional)
9602: 6. reference to results object (hash of hashes).
9603: 7. reference to optional userdata hash
1.609 raeburn 9604: 8. reference to optional statushash
1.630 raeburn 9605: 9. flag if privileged users (except those set to unhide in
9606: course settings) should be excluded
1.609 raeburn 9607: Keys of top level results hash are roles.
1.275 raeburn 9608: Keys of inner hashes are username:domain, with
9609: values set to access type.
1.288 raeburn 9610: Optional userdata hash returns an array with arguments in the
9611: same order as loncoursedata::get_classlist() for student data.
9612:
1.609 raeburn 9613: Optional statushash returns
9614:
1.288 raeburn 9615: Entries for end, start, section and status are blank because
9616: of the possibility of multiple values for non-student roles.
9617:
1.275 raeburn 9618: =cut
1.405 albertel 9619:
1.275 raeburn 9620: ###############################################
1.405 albertel 9621:
1.275 raeburn 9622: sub get_course_users {
1.630 raeburn 9623: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9624: my %idx = ();
1.419 raeburn 9625: my %seclists;
1.288 raeburn 9626:
9627: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9628: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9629: $idx{end} = &Apache::loncoursedata::CL_END();
9630: $idx{start} = &Apache::loncoursedata::CL_START();
9631: $idx{id} = &Apache::loncoursedata::CL_ID();
9632: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9633: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9634: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9635:
1.290 albertel 9636: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9637: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9638: my $now = time;
1.277 albertel 9639: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9640: my $match = 0;
1.412 raeburn 9641: my $secmatch = 0;
1.419 raeburn 9642: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9643: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9644: if ($section eq '') {
9645: $section = 'none';
9646: }
1.291 albertel 9647: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9648: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9649: $secmatch = 1;
9650: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9651: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9652: $secmatch = 1;
9653: }
9654: } else {
1.419 raeburn 9655: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9656: $secmatch = 1;
9657: }
1.290 albertel 9658: }
1.412 raeburn 9659: if (!$secmatch) {
9660: next;
9661: }
1.419 raeburn 9662: }
1.275 raeburn 9663: if (defined($$types{'active'})) {
1.288 raeburn 9664: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9665: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9666: $match = 1;
1.275 raeburn 9667: }
9668: }
9669: if (defined($$types{'previous'})) {
1.609 raeburn 9670: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9671: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9672: $match = 1;
1.275 raeburn 9673: }
9674: }
9675: if (defined($$types{'future'})) {
1.609 raeburn 9676: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9677: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9678: $match = 1;
1.275 raeburn 9679: }
9680: }
1.609 raeburn 9681: if ($match) {
9682: push(@{$seclists{$student}},$section);
9683: if (ref($userdata) eq 'HASH') {
9684: $$userdata{$student} = $$classlist{$student};
9685: }
9686: if (ref($statushash) eq 'HASH') {
9687: $statushash->{$student}{'st'}{$section} = $status;
9688: }
1.288 raeburn 9689: }
1.275 raeburn 9690: }
9691: }
1.412 raeburn 9692: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9693: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9694: my $now = time;
1.609 raeburn 9695: my %displaystatus = ( previous => 'Expired',
9696: active => 'Active',
9697: future => 'Future',
9698: );
1.1121 raeburn 9699: my (%nothide,@possdoms);
1.630 raeburn 9700: if ($hidepriv) {
9701: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9702: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9703: if ($user !~ /:/) {
9704: $nothide{join(':',split(/[\@]/,$user))}=1;
9705: } else {
9706: $nothide{$user} = 1;
9707: }
9708: }
1.1121 raeburn 9709: my @possdoms = ($cdom);
9710: if ($coursehash{'checkforpriv'}) {
9711: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9712: }
1.630 raeburn 9713: }
1.439 raeburn 9714: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9715: my $match = 0;
1.412 raeburn 9716: my $secmatch = 0;
1.439 raeburn 9717: my $status;
1.412 raeburn 9718: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9719: $user =~ s/:$//;
1.439 raeburn 9720: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9721: if ($end == -1 || $start == -1) {
9722: next;
9723: }
9724: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9725: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9726: my ($uname,$udom) = split(/:/,$user);
9727: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9728: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9729: $secmatch = 1;
9730: } elsif ($usec eq '') {
1.420 albertel 9731: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9732: $secmatch = 1;
9733: }
9734: } else {
9735: if (grep(/^\Q$usec\E$/,@{$sections})) {
9736: $secmatch = 1;
9737: }
9738: }
9739: if (!$secmatch) {
9740: next;
9741: }
1.288 raeburn 9742: }
1.419 raeburn 9743: if ($usec eq '') {
9744: $usec = 'none';
9745: }
1.275 raeburn 9746: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9747: if ($hidepriv) {
1.1121 raeburn 9748: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9749: (!$nothide{$uname.':'.$udom})) {
9750: next;
9751: }
9752: }
1.503 raeburn 9753: if ($end > 0 && $end < $now) {
1.439 raeburn 9754: $status = 'previous';
9755: } elsif ($start > $now) {
9756: $status = 'future';
9757: } else {
9758: $status = 'active';
9759: }
1.277 albertel 9760: foreach my $type (keys(%{$types})) {
1.275 raeburn 9761: if ($status eq $type) {
1.420 albertel 9762: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9763: push(@{$$users{$role}{$user}},$type);
9764: }
1.288 raeburn 9765: $match = 1;
9766: }
9767: }
1.419 raeburn 9768: if (($match) && (ref($userdata) eq 'HASH')) {
9769: if (!exists($$userdata{$uname.':'.$udom})) {
9770: &get_user_info($udom,$uname,\%idx,$userdata);
9771: }
1.420 albertel 9772: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9773: push(@{$seclists{$uname.':'.$udom}},$usec);
9774: }
1.609 raeburn 9775: if (ref($statushash) eq 'HASH') {
9776: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9777: }
1.275 raeburn 9778: }
9779: }
9780: }
9781: }
1.290 albertel 9782: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9783: if ((defined($cdom)) && (defined($cnum))) {
9784: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9785: if ( defined($csettings{'internal.courseowner'}) ) {
9786: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9787: next if ($owner eq '');
9788: my ($ownername,$ownerdom);
9789: if ($owner =~ /^([^:]+):([^:]+)$/) {
9790: $ownername = $1;
9791: $ownerdom = $2;
9792: } else {
9793: $ownername = $owner;
9794: $ownerdom = $cdom;
9795: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9796: }
9797: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9798: if (defined($userdata) &&
1.609 raeburn 9799: !exists($$userdata{$owner})) {
9800: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9801: if (!grep(/^none$/,@{$seclists{$owner}})) {
9802: push(@{$seclists{$owner}},'none');
9803: }
9804: if (ref($statushash) eq 'HASH') {
9805: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9806: }
1.290 albertel 9807: }
1.279 raeburn 9808: }
9809: }
9810: }
1.419 raeburn 9811: foreach my $user (keys(%seclists)) {
9812: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9813: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9814: }
1.275 raeburn 9815: }
9816: return;
9817: }
9818:
1.288 raeburn 9819: sub get_user_info {
9820: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9821: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9822: &plainname($uname,$udom,'lastname');
1.291 albertel 9823: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9824: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9825: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9826: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9827: return;
9828: }
1.275 raeburn 9829:
1.472 raeburn 9830: ###############################################
9831:
9832: =pod
9833:
9834: =item * &get_user_quota()
9835:
1.1134 raeburn 9836: Retrieves quota assigned for storage of user files.
9837: Default is to report quota for portfolio files.
1.472 raeburn 9838:
9839: Incoming parameters:
9840: 1. user's username
9841: 2. user's domain
1.1134 raeburn 9842: 3. quota name - portfolio, author, or course
1.1136 raeburn 9843: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9844: 4. crstype - official, unofficial, textbook, placement or community,
9845: if quota name is course
1.472 raeburn 9846:
9847: Returns:
1.1163 raeburn 9848: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9849: 2. (Optional) Type of setting: custom or default
9850: (individually assigned or default for user's
9851: institutional status).
9852: 3. (Optional) - User's institutional status (e.g., faculty, staff
9853: or student - types as defined in localenroll::inst_usertypes
9854: for user's domain, which determines default quota for user.
9855: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9856:
9857: If a value has been stored in the user's environment,
1.536 raeburn 9858: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9859: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9860:
9861: =cut
9862:
9863: ###############################################
9864:
9865:
9866: sub get_user_quota {
1.1136 raeburn 9867: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9868: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9869: if (!defined($udom)) {
9870: $udom = $env{'user.domain'};
9871: }
9872: if (!defined($uname)) {
9873: $uname = $env{'user.name'};
9874: }
9875: if (($udom eq '' || $uname eq '') ||
9876: ($udom eq 'public') && ($uname eq 'public')) {
9877: $quota = 0;
1.536 raeburn 9878: $quotatype = 'default';
9879: $defquota = 0;
1.472 raeburn 9880: } else {
1.536 raeburn 9881: my $inststatus;
1.1134 raeburn 9882: if ($quotaname eq 'course') {
9883: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9884: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9885: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9886: } else {
9887: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9888: $quota = $cenv{'internal.uploadquota'};
9889: }
1.536 raeburn 9890: } else {
1.1134 raeburn 9891: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9892: if ($quotaname eq 'author') {
9893: $quota = $env{'environment.authorquota'};
9894: } else {
9895: $quota = $env{'environment.portfolioquota'};
9896: }
9897: $inststatus = $env{'environment.inststatus'};
9898: } else {
9899: my %userenv =
9900: &Apache::lonnet::get('environment',['portfolioquota',
9901: 'authorquota','inststatus'],$udom,$uname);
9902: my ($tmp) = keys(%userenv);
9903: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9904: if ($quotaname eq 'author') {
9905: $quota = $userenv{'authorquota'};
9906: } else {
9907: $quota = $userenv{'portfolioquota'};
9908: }
9909: $inststatus = $userenv{'inststatus'};
9910: } else {
9911: undef(%userenv);
9912: }
9913: }
9914: }
9915: if ($quota eq '' || wantarray) {
9916: if ($quotaname eq 'course') {
9917: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9918: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9919: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9920: ($crstype eq 'placement')) {
1.1136 raeburn 9921: $defquota = $domdefs{$crstype.'quota'};
9922: }
9923: if ($defquota eq '') {
9924: $defquota = 500;
9925: }
1.1134 raeburn 9926: } else {
9927: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9928: }
9929: if ($quota eq '') {
9930: $quota = $defquota;
9931: $quotatype = 'default';
9932: } else {
9933: $quotatype = 'custom';
9934: }
1.472 raeburn 9935: }
9936: }
1.536 raeburn 9937: if (wantarray) {
9938: return ($quota,$quotatype,$settingstatus,$defquota);
9939: } else {
9940: return $quota;
9941: }
1.472 raeburn 9942: }
9943:
9944: ###############################################
9945:
9946: =pod
9947:
9948: =item * &default_quota()
9949:
1.536 raeburn 9950: Retrieves default quota assigned for storage of user portfolio files,
9951: given an (optional) user's institutional status.
1.472 raeburn 9952:
9953: Incoming parameters:
1.1142 raeburn 9954:
1.472 raeburn 9955: 1. domain
1.536 raeburn 9956: 2. (Optional) institutional status(es). This is a : separated list of
9957: status types (e.g., faculty, staff, student etc.)
9958: which apply to the user for whom the default is being retrieved.
9959: If the institutional status string in undefined, the domain
1.1134 raeburn 9960: default quota will be returned.
9961: 3. quota name - portfolio, author, or course
9962: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9963:
9964: Returns:
1.1142 raeburn 9965:
1.1163 raeburn 9966: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9967: 2. (Optional) institutional type which determined the value of the
9968: default quota.
1.472 raeburn 9969:
9970: If a value has been stored in the domain's configuration db,
9971: it will return that, otherwise it returns 20 (for backwards
9972: compatibility with domains which have not set up a configuration
1.1163 raeburn 9973: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9974:
1.536 raeburn 9975: If the user's status includes multiple types (e.g., staff and student),
9976: the largest default quota which applies to the user determines the
9977: default quota returned.
9978:
1.472 raeburn 9979: =cut
9980:
9981: ###############################################
9982:
9983:
9984: sub default_quota {
1.1134 raeburn 9985: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9986: my ($defquota,$settingstatus);
9987: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9988: ['quotas'],$udom);
1.1134 raeburn 9989: my $key = 'defaultquota';
9990: if ($quotaname eq 'author') {
9991: $key = 'authorquota';
9992: }
1.622 raeburn 9993: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9994: if ($inststatus ne '') {
1.765 raeburn 9995: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9996: foreach my $item (@statuses) {
1.1134 raeburn 9997: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9998: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9999: if ($defquota eq '') {
1.1134 raeburn 10000: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10001: $settingstatus = $item;
1.1134 raeburn 10002: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10003: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10004: $settingstatus = $item;
10005: }
10006: }
1.1134 raeburn 10007: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10008: if ($quotahash{'quotas'}{$item} ne '') {
10009: if ($defquota eq '') {
10010: $defquota = $quotahash{'quotas'}{$item};
10011: $settingstatus = $item;
10012: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10013: $defquota = $quotahash{'quotas'}{$item};
10014: $settingstatus = $item;
10015: }
1.536 raeburn 10016: }
10017: }
10018: }
10019: }
10020: if ($defquota eq '') {
1.1134 raeburn 10021: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10022: $defquota = $quotahash{'quotas'}{$key}{'default'};
10023: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10024: $defquota = $quotahash{'quotas'}{'default'};
10025: }
1.536 raeburn 10026: $settingstatus = 'default';
1.1139 raeburn 10027: if ($defquota eq '') {
10028: if ($quotaname eq 'author') {
10029: $defquota = 500;
10030: }
10031: }
1.536 raeburn 10032: }
10033: } else {
10034: $settingstatus = 'default';
1.1134 raeburn 10035: if ($quotaname eq 'author') {
10036: $defquota = 500;
10037: } else {
10038: $defquota = 20;
10039: }
1.536 raeburn 10040: }
10041: if (wantarray) {
10042: return ($defquota,$settingstatus);
1.472 raeburn 10043: } else {
1.536 raeburn 10044: return $defquota;
1.472 raeburn 10045: }
10046: }
10047:
1.1135 raeburn 10048: ###############################################
10049:
10050: =pod
10051:
1.1136 raeburn 10052: =item * &excess_filesize_warning()
1.1135 raeburn 10053:
10054: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10055: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10056: space to be exceeded.
1.1136 raeburn 10057:
10058: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 10059: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10060:
1.1165 raeburn 10061: Inputs: 7
1.1136 raeburn 10062: 1. username or coursenum
1.1135 raeburn 10063: 2. domain
1.1136 raeburn 10064: 3. context ('author' or 'course')
1.1135 raeburn 10065: 4. filename of file for which action is being requested
10066: 5. filesize (kB) of file
10067: 6. action being taken: copy or upload.
1.1237 raeburn 10068: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10069:
10070: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10071: otherwise return null.
10072:
10073: =back
1.1135 raeburn 10074:
10075: =cut
10076:
1.1136 raeburn 10077: sub excess_filesize_warning {
1.1165 raeburn 10078: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10079: my $current_disk_usage = 0;
1.1165 raeburn 10080: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10081: if ($context eq 'author') {
10082: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10083: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10084: } else {
10085: foreach my $subdir ('docs','supplemental') {
10086: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10087: }
10088: }
1.1135 raeburn 10089: $disk_quota = int($disk_quota * 1000);
10090: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10091: return '<p class="LC_warning">'.
1.1135 raeburn 10092: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10093: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10094: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10095: $disk_quota,$current_disk_usage).
10096: '</p>';
10097: }
10098: return;
10099: }
10100:
10101: ###############################################
10102:
10103:
1.1136 raeburn 10104:
10105:
1.384 raeburn 10106: sub get_secgrprole_info {
10107: my ($cdom,$cnum,$needroles,$type) = @_;
10108: my %sections_count = &get_sections($cdom,$cnum);
10109: my @sections = (sort {$a <=> $b} keys(%sections_count));
10110: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10111: my @groups = sort(keys(%curr_groups));
10112: my $allroles = [];
10113: my $rolehash;
10114: my $accesshash = {
10115: active => 'Currently has access',
10116: future => 'Will have future access',
10117: previous => 'Previously had access',
10118: };
10119: if ($needroles) {
10120: $rolehash = {'all' => 'all'};
1.385 albertel 10121: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10122: if (&Apache::lonnet::error(%user_roles)) {
10123: undef(%user_roles);
10124: }
10125: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10126: my ($role)=split(/\:/,$item,2);
10127: if ($role eq 'cr') { next; }
10128: if ($role =~ /^cr/) {
10129: $$rolehash{$role} = (split('/',$role))[3];
10130: } else {
10131: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10132: }
10133: }
10134: foreach my $key (sort(keys(%{$rolehash}))) {
10135: push(@{$allroles},$key);
10136: }
10137: push (@{$allroles},'st');
10138: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10139: }
10140: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10141: }
10142:
1.555 raeburn 10143: sub user_picker {
1.1279 raeburn 10144: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10145: my $currdom = $dom;
1.1253 raeburn 10146: my @alldoms = &Apache::lonnet::all_domains();
10147: if (@alldoms == 1) {
10148: my %domsrch = &Apache::lonnet::get_dom('configuration',
10149: ['directorysrch'],$alldoms[0]);
10150: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10151: my $showdom = $domdesc;
10152: if ($showdom eq '') {
10153: $showdom = $dom;
10154: }
10155: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10156: if ((!$domsrch{'directorysrch'}{'available'}) &&
10157: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10158: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10159: }
10160: }
10161: }
1.555 raeburn 10162: my %curr_selected = (
10163: srchin => 'dom',
1.580 raeburn 10164: srchby => 'lastname',
1.555 raeburn 10165: );
10166: my $srchterm;
1.625 raeburn 10167: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10168: if ($srch->{'srchby'} ne '') {
10169: $curr_selected{'srchby'} = $srch->{'srchby'};
10170: }
10171: if ($srch->{'srchin'} ne '') {
10172: $curr_selected{'srchin'} = $srch->{'srchin'};
10173: }
10174: if ($srch->{'srchtype'} ne '') {
10175: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10176: }
10177: if ($srch->{'srchdomain'} ne '') {
10178: $currdom = $srch->{'srchdomain'};
10179: }
10180: $srchterm = $srch->{'srchterm'};
10181: }
1.1222 damieng 10182: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10183: 'usr' => 'Search criteria',
1.563 raeburn 10184: 'doma' => 'Domain/institution to search',
1.558 albertel 10185: 'uname' => 'username',
10186: 'lastname' => 'last name',
1.555 raeburn 10187: 'lastfirst' => 'last name, first name',
1.558 albertel 10188: 'crs' => 'in this course',
1.576 raeburn 10189: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10190: 'alc' => 'all LON-CAPA',
1.573 raeburn 10191: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10192: 'exact' => 'is',
10193: 'contains' => 'contains',
1.569 raeburn 10194: 'begins' => 'begins with',
1.1222 damieng 10195: );
10196: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10197: 'youm' => "You must include some text to search for.",
10198: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10199: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10200: 'yomc' => "You must choose a domain when using an institutional directory search.",
10201: 'ymcd' => "You must choose a domain when using a domain search.",
10202: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10203: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10204: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10205: );
1.1222 damieng 10206: &html_escape(\%html_lt);
10207: &js_escape(\%js_lt);
1.1255 raeburn 10208: my $domform;
1.1277 raeburn 10209: my $allow_blank = 1;
1.1255 raeburn 10210: if ($fixeddom) {
1.1277 raeburn 10211: $allow_blank = 0;
10212: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 10213: } else {
1.1287 raeburn 10214: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 10215: my ($trusted,$untrusted);
1.1287 raeburn 10216: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 10217: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 10218: } elsif ($context eq 'author') {
1.1288 raeburn 10219: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 10220: } elsif ($context eq 'domain') {
1.1288 raeburn 10221: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 10222: }
1.1288 raeburn 10223: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 10224: }
1.563 raeburn 10225: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10226:
10227: my @srchins = ('crs','dom','alc','instd');
10228:
10229: foreach my $option (@srchins) {
10230: # FIXME 'alc' option unavailable until
10231: # loncreateuser::print_user_query_page()
10232: # has been completed.
10233: next if ($option eq 'alc');
1.880 raeburn 10234: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10235: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 10236: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10237: if ($curr_selected{'srchin'} eq $option) {
10238: $srchinsel .= '
1.1222 damieng 10239: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10240: } else {
10241: $srchinsel .= '
1.1222 damieng 10242: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10243: }
1.555 raeburn 10244: }
1.563 raeburn 10245: $srchinsel .= "\n </select>\n";
1.555 raeburn 10246:
10247: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10248: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10249: if ($curr_selected{'srchby'} eq $option) {
10250: $srchbysel .= '
1.1222 damieng 10251: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10252: } else {
10253: $srchbysel .= '
1.1222 damieng 10254: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10255: }
10256: }
10257: $srchbysel .= "\n </select>\n";
10258:
10259: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10260: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10261: if ($curr_selected{'srchtype'} eq $option) {
10262: $srchtypesel .= '
1.1222 damieng 10263: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10264: } else {
10265: $srchtypesel .= '
1.1222 damieng 10266: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10267: }
10268: }
10269: $srchtypesel .= "\n </select>\n";
10270:
1.558 albertel 10271: my ($newuserscript,$new_user_create);
1.994 raeburn 10272: my $context_dom = $env{'request.role.domain'};
10273: if ($context eq 'requestcrs') {
10274: if ($env{'form.coursedom'} ne '') {
10275: $context_dom = $env{'form.coursedom'};
10276: }
10277: }
1.556 raeburn 10278: if ($forcenewuser) {
1.576 raeburn 10279: if (ref($srch) eq 'HASH') {
1.994 raeburn 10280: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10281: if ($cancreate) {
10282: $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>';
10283: } else {
1.799 bisitz 10284: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10285: my %usertypetext = (
10286: official => 'institutional',
10287: unofficial => 'non-institutional',
10288: );
1.799 bisitz 10289: $new_user_create = '<p class="LC_warning">'
10290: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10291: .' '
10292: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10293: ,'<a href="'.$helplink.'">','</a>')
10294: .'</p><br />';
1.627 raeburn 10295: }
1.576 raeburn 10296: }
10297: }
10298:
1.556 raeburn 10299: $newuserscript = <<"ENDSCRIPT";
10300:
1.570 raeburn 10301: function setSearch(createnew,callingForm) {
1.556 raeburn 10302: if (createnew == 1) {
1.570 raeburn 10303: for (var i=0; i<callingForm.srchby.length; i++) {
10304: if (callingForm.srchby.options[i].value == 'uname') {
10305: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10306: }
10307: }
1.570 raeburn 10308: for (var i=0; i<callingForm.srchin.length; i++) {
10309: if ( callingForm.srchin.options[i].value == 'dom') {
10310: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10311: }
10312: }
1.570 raeburn 10313: for (var i=0; i<callingForm.srchtype.length; i++) {
10314: if (callingForm.srchtype.options[i].value == 'exact') {
10315: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10316: }
10317: }
1.570 raeburn 10318: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10319: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10320: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10321: }
10322: }
10323: }
10324: }
10325: ENDSCRIPT
1.558 albertel 10326:
1.556 raeburn 10327: }
10328:
1.555 raeburn 10329: my $output = <<"END_BLOCK";
1.556 raeburn 10330: <script type="text/javascript">
1.824 bisitz 10331: // <![CDATA[
1.570 raeburn 10332: function validateEntry(callingForm) {
1.558 albertel 10333:
1.556 raeburn 10334: var checkok = 1;
1.558 albertel 10335: var srchin;
1.570 raeburn 10336: for (var i=0; i<callingForm.srchin.length; i++) {
10337: if ( callingForm.srchin[i].checked ) {
10338: srchin = callingForm.srchin[i].value;
1.558 albertel 10339: }
10340: }
10341:
1.570 raeburn 10342: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10343: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10344: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10345: var srchterm = callingForm.srchterm.value;
10346: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10347: var msg = "";
10348:
10349: if (srchterm == "") {
10350: checkok = 0;
1.1222 damieng 10351: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10352: }
10353:
1.569 raeburn 10354: if (srchtype== 'begins') {
10355: if (srchterm.length < 2) {
10356: checkok = 0;
1.1222 damieng 10357: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10358: }
10359: }
10360:
1.556 raeburn 10361: if (srchtype== 'contains') {
10362: if (srchterm.length < 3) {
10363: checkok = 0;
1.1222 damieng 10364: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10365: }
10366: }
10367: if (srchin == 'instd') {
10368: if (srchdomain == '') {
10369: checkok = 0;
1.1222 damieng 10370: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10371: }
10372: }
10373: if (srchin == 'dom') {
10374: if (srchdomain == '') {
10375: checkok = 0;
1.1222 damieng 10376: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10377: }
10378: }
10379: if (srchby == 'lastfirst') {
10380: if (srchterm.indexOf(",") == -1) {
10381: checkok = 0;
1.1222 damieng 10382: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10383: }
10384: if (srchterm.indexOf(",") == srchterm.length -1) {
10385: checkok = 0;
1.1222 damieng 10386: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10387: }
10388: }
10389: if (checkok == 0) {
1.1222 damieng 10390: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10391: return;
10392: }
10393: if (checkok == 1) {
1.570 raeburn 10394: callingForm.submit();
1.556 raeburn 10395: }
10396: }
10397:
10398: $newuserscript
10399:
1.824 bisitz 10400: // ]]>
1.556 raeburn 10401: </script>
1.558 albertel 10402:
10403: $new_user_create
10404:
1.555 raeburn 10405: END_BLOCK
1.558 albertel 10406:
1.876 raeburn 10407: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10408: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10409: $domform.
10410: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10411: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10412: $srchbysel.
10413: $srchtypesel.
10414: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10415: $srchinsel.
10416: &Apache::lonhtmlcommon::row_closure(1).
10417: &Apache::lonhtmlcommon::end_pick_box().
10418: '<br />';
1.1253 raeburn 10419: return ($output,1);
1.555 raeburn 10420: }
10421:
1.612 raeburn 10422: sub user_rule_check {
1.615 raeburn 10423: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10424: my ($response,%inst_response);
1.612 raeburn 10425: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10426: if (keys(%{$usershash}) > 1) {
10427: my (%by_username,%by_id,%userdoms);
10428: my $checkid;
10429: if (ref($checks) eq 'HASH') {
10430: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10431: $checkid = 1;
10432: }
10433: }
10434: foreach my $user (keys(%{$usershash})) {
10435: my ($uname,$udom) = split(/:/,$user);
10436: if ($checkid) {
10437: if (ref($usershash->{$user}) eq 'HASH') {
10438: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10439: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10440: $userdoms{$udom} = 1;
1.1227 raeburn 10441: if (ref($inst_results) eq 'HASH') {
10442: $inst_results->{$uname.':'.$udom} = {};
10443: }
1.1226 raeburn 10444: }
10445: }
10446: } else {
10447: $by_username{$udom}{$uname} = 1;
10448: $userdoms{$udom} = 1;
1.1227 raeburn 10449: if (ref($inst_results) eq 'HASH') {
10450: $inst_results->{$uname.':'.$udom} = {};
10451: }
1.1226 raeburn 10452: }
10453: }
10454: foreach my $udom (keys(%userdoms)) {
10455: if (!$got_rules->{$udom}) {
10456: my %domconfig = &Apache::lonnet::get_dom('configuration',
10457: ['usercreation'],$udom);
10458: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10459: foreach my $item ('username','id') {
10460: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10461: $$curr_rules{$udom}{$item} =
10462: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10463: }
10464: }
10465: }
10466: $got_rules->{$udom} = 1;
10467: }
1.612 raeburn 10468: }
1.1226 raeburn 10469: if ($checkid) {
10470: foreach my $udom (keys(%by_id)) {
10471: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10472: if ($outcome eq 'ok') {
1.1227 raeburn 10473: foreach my $id (keys(%{$by_id{$udom}})) {
10474: my $uname = $by_id{$udom}{$id};
10475: $inst_response{$uname.':'.$udom} = $outcome;
10476: }
1.1226 raeburn 10477: if (ref($results) eq 'HASH') {
10478: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10479: if (exists($inst_response{$uname.':'.$udom})) {
10480: $inst_response{$uname.':'.$udom} = $outcome;
10481: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10482: }
1.1226 raeburn 10483: }
10484: }
10485: }
1.612 raeburn 10486: }
1.615 raeburn 10487: } else {
1.1226 raeburn 10488: foreach my $udom (keys(%by_username)) {
10489: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10490: if ($outcome eq 'ok') {
1.1227 raeburn 10491: foreach my $uname (keys(%{$by_username{$udom}})) {
10492: $inst_response{$uname.':'.$udom} = $outcome;
10493: }
1.1226 raeburn 10494: if (ref($results) eq 'HASH') {
10495: foreach my $uname (keys(%{$results})) {
10496: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10497: }
10498: }
10499: }
10500: }
1.612 raeburn 10501: }
1.1226 raeburn 10502: } elsif (keys(%{$usershash}) == 1) {
10503: my $user = (keys(%{$usershash}))[0];
10504: my ($uname,$udom) = split(/:/,$user);
10505: if (($udom ne '') && ($uname ne '')) {
10506: if (ref($usershash->{$user}) eq 'HASH') {
10507: if (ref($checks) eq 'HASH') {
10508: if (defined($checks->{'username'})) {
10509: ($inst_response{$user},%{$inst_results->{$user}}) =
10510: &Apache::lonnet::get_instuser($udom,$uname);
10511: } elsif (defined($checks->{'id'})) {
10512: if ($usershash->{$user}->{'id'} ne '') {
10513: ($inst_response{$user},%{$inst_results->{$user}}) =
10514: &Apache::lonnet::get_instuser($udom,undef,
10515: $usershash->{$user}->{'id'});
10516: } else {
10517: ($inst_response{$user},%{$inst_results->{$user}}) =
10518: &Apache::lonnet::get_instuser($udom,$uname);
10519: }
1.585 raeburn 10520: }
1.1226 raeburn 10521: } else {
10522: ($inst_response{$user},%{$inst_results->{$user}}) =
10523: &Apache::lonnet::get_instuser($udom,$uname);
10524: return;
10525: }
10526: if (!$got_rules->{$udom}) {
10527: my %domconfig = &Apache::lonnet::get_dom('configuration',
10528: ['usercreation'],$udom);
10529: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10530: foreach my $item ('username','id') {
10531: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10532: $$curr_rules{$udom}{$item} =
10533: $domconfig{'usercreation'}{$item.'_rule'};
10534: }
10535: }
10536: }
10537: $got_rules->{$udom} = 1;
1.585 raeburn 10538: }
10539: }
1.1226 raeburn 10540: } else {
10541: return;
10542: }
10543: } else {
10544: return;
10545: }
10546: foreach my $user (keys(%{$usershash})) {
10547: my ($uname,$udom) = split(/:/,$user);
10548: next if (($udom eq '') || ($uname eq ''));
10549: my $id;
1.1227 raeburn 10550: if (ref($inst_results) eq 'HASH') {
10551: if (ref($inst_results->{$user}) eq 'HASH') {
10552: $id = $inst_results->{$user}->{'id'};
10553: }
10554: }
10555: if ($id eq '') {
10556: if (ref($usershash->{$user})) {
10557: $id = $usershash->{$user}->{'id'};
10558: }
1.585 raeburn 10559: }
1.612 raeburn 10560: foreach my $item (keys(%{$checks})) {
10561: if (ref($$curr_rules{$udom}) eq 'HASH') {
10562: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10563: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10564: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10565: $$curr_rules{$udom}{$item});
1.612 raeburn 10566: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10567: if ($rule_check{$rule}) {
10568: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10569: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10570: if (ref($inst_results) eq 'HASH') {
10571: if (ref($inst_results->{$user}) eq 'HASH') {
10572: if (keys(%{$inst_results->{$user}}) == 0) {
10573: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10574: } elsif ($item eq 'id') {
10575: if ($inst_results->{$user}->{'id'} eq '') {
10576: $$alerts{$item}{$udom}{$uname} = 1;
10577: }
1.615 raeburn 10578: }
1.612 raeburn 10579: }
10580: }
1.615 raeburn 10581: }
10582: last;
1.585 raeburn 10583: }
10584: }
10585: }
10586: }
10587: }
10588: }
10589: }
10590: }
1.612 raeburn 10591: return;
10592: }
10593:
10594: sub user_rule_formats {
10595: my ($domain,$domdesc,$curr_rules,$check) = @_;
10596: my %text = (
10597: 'username' => 'Usernames',
10598: 'id' => 'IDs',
10599: );
10600: my $output;
10601: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10602: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10603: if (@{$ruleorder} > 0) {
1.1102 raeburn 10604: $output = '<br />'.
10605: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10606: '<span class="LC_cusr_emph">','</span>',$domdesc).
10607: ' <ul>';
1.612 raeburn 10608: foreach my $rule (@{$ruleorder}) {
10609: if (ref($curr_rules) eq 'ARRAY') {
10610: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10611: if (ref($rules->{$rule}) eq 'HASH') {
10612: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10613: $rules->{$rule}{'desc'}.'</li>';
10614: }
10615: }
10616: }
10617: }
10618: $output .= '</ul>';
10619: }
10620: }
10621: return $output;
10622: }
10623:
10624: sub instrule_disallow_msg {
1.615 raeburn 10625: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10626: my $response;
10627: my %text = (
10628: item => 'username',
10629: items => 'usernames',
10630: match => 'matches',
10631: do => 'does',
10632: action => 'a username',
10633: one => 'one',
10634: );
10635: if ($count > 1) {
10636: $text{'item'} = 'usernames';
10637: $text{'match'} ='match';
10638: $text{'do'} = 'do';
10639: $text{'action'} = 'usernames',
10640: $text{'one'} = 'ones';
10641: }
10642: if ($checkitem eq 'id') {
10643: $text{'items'} = 'IDs';
10644: $text{'item'} = 'ID';
10645: $text{'action'} = 'an ID';
1.615 raeburn 10646: if ($count > 1) {
10647: $text{'item'} = 'IDs';
10648: $text{'action'} = 'IDs';
10649: }
1.612 raeburn 10650: }
1.674 bisitz 10651: $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 10652: if ($mode eq 'upload') {
10653: if ($checkitem eq 'username') {
10654: $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'}.");
10655: } elsif ($checkitem eq 'id') {
1.674 bisitz 10656: $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 10657: }
1.669 raeburn 10658: } elsif ($mode eq 'selfcreate') {
10659: if ($checkitem eq 'id') {
10660: $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.");
10661: }
1.615 raeburn 10662: } else {
10663: if ($checkitem eq 'username') {
10664: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10665: } elsif ($checkitem eq 'id') {
10666: $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.");
10667: }
1.612 raeburn 10668: }
10669: return $response;
1.585 raeburn 10670: }
10671:
1.624 raeburn 10672: sub personal_data_fieldtitles {
10673: my %fieldtitles = &Apache::lonlocal::texthash (
10674: id => 'Student/Employee ID',
10675: permanentemail => 'E-mail address',
10676: lastname => 'Last Name',
10677: firstname => 'First Name',
10678: middlename => 'Middle Name',
10679: generation => 'Generation',
10680: gen => 'Generation',
1.765 raeburn 10681: inststatus => 'Affiliation',
1.624 raeburn 10682: );
10683: return %fieldtitles;
10684: }
10685:
1.642 raeburn 10686: sub sorted_inst_types {
10687: my ($dom) = @_;
1.1185 raeburn 10688: my ($usertypes,$order);
10689: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10690: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10691: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10692: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10693: } else {
10694: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10695: }
1.642 raeburn 10696: my $othertitle = &mt('All users');
10697: if ($env{'request.course.id'}) {
1.668 raeburn 10698: $othertitle = &mt('Any users');
1.642 raeburn 10699: }
10700: my @types;
10701: if (ref($order) eq 'ARRAY') {
10702: @types = @{$order};
10703: }
10704: if (@types == 0) {
10705: if (ref($usertypes) eq 'HASH') {
10706: @types = sort(keys(%{$usertypes}));
10707: }
10708: }
10709: if (keys(%{$usertypes}) > 0) {
10710: $othertitle = &mt('Other users');
10711: }
10712: return ($othertitle,$usertypes,\@types);
10713: }
10714:
1.645 raeburn 10715: sub get_institutional_codes {
10716: my ($settings,$allcourses,$LC_code) = @_;
10717: # Get complete list of course sections to update
10718: my @currsections = ();
10719: my @currxlists = ();
10720: my $coursecode = $$settings{'internal.coursecode'};
10721:
10722: if ($$settings{'internal.sectionnums'} ne '') {
10723: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10724: }
10725:
10726: if ($$settings{'internal.crosslistings'} ne '') {
10727: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10728: }
10729:
10730: if (@currxlists > 0) {
10731: foreach (@currxlists) {
10732: if (m/^([^:]+):(\w*)$/) {
10733: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 10734: push(@{$allcourses},$1);
1.645 raeburn 10735: $$LC_code{$1} = $2;
10736: }
10737: }
10738: }
10739: }
10740:
10741: if (@currsections > 0) {
10742: foreach (@currsections) {
10743: if (m/^(\w+):(\w*)$/) {
10744: my $sec = $coursecode.$1;
10745: my $lc_sec = $2;
10746: unless (grep/^$sec$/,@{$allcourses}) {
1.1263 raeburn 10747: push(@{$allcourses},$sec);
1.645 raeburn 10748: $$LC_code{$sec} = $lc_sec;
10749: }
10750: }
10751: }
10752: }
10753: return;
10754: }
10755:
1.971 raeburn 10756: sub get_standard_codeitems {
10757: return ('Year','Semester','Department','Number','Section');
10758: }
10759:
1.112 bowersj2 10760: =pod
10761:
1.780 raeburn 10762: =head1 Slot Helpers
10763:
10764: =over 4
10765:
10766: =item * sorted_slots()
10767:
1.1040 raeburn 10768: Sorts an array of slot names in order of an optional sort key,
10769: default sort is by slot start time (earliest first).
1.780 raeburn 10770:
10771: Inputs:
10772:
10773: =over 4
10774:
10775: slotsarr - Reference to array of unsorted slot names.
10776:
10777: slots - Reference to hash of hash, where outer hash keys are slot names.
10778:
1.1040 raeburn 10779: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10780:
1.549 albertel 10781: =back
10782:
1.780 raeburn 10783: Returns:
10784:
10785: =over 4
10786:
1.1040 raeburn 10787: sorted - An array of slot names sorted by a specified sort key
10788: (default sort key is start time of the slot).
1.780 raeburn 10789:
10790: =back
10791:
10792: =cut
10793:
10794:
10795: sub sorted_slots {
1.1040 raeburn 10796: my ($slotsarr,$slots,$sortkey) = @_;
10797: if ($sortkey eq '') {
10798: $sortkey = 'starttime';
10799: }
1.780 raeburn 10800: my @sorted;
10801: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10802: @sorted =
10803: sort {
10804: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10805: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10806: }
10807: if (ref($slots->{$a})) { return -1;}
10808: if (ref($slots->{$b})) { return 1;}
10809: return 0;
10810: } @{$slotsarr};
10811: }
10812: return @sorted;
10813: }
10814:
1.1040 raeburn 10815: =pod
10816:
10817: =item * get_future_slots()
10818:
10819: Inputs:
10820:
10821: =over 4
10822:
10823: cnum - course number
10824:
10825: cdom - course domain
10826:
10827: now - current UNIX time
10828:
10829: symb - optional symb
10830:
10831: =back
10832:
10833: Returns:
10834:
10835: =over 4
10836:
10837: sorted_reservable - ref to array of student_schedulable slots currently
10838: reservable, ordered by end date of reservation period.
10839:
10840: reservable_now - ref to hash of student_schedulable slots currently
10841: reservable.
10842:
10843: Keys in inner hash are:
10844: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10845: (b) endreserve: end date of reservation period.
10846: (c) uniqueperiod: start,end dates when slot is to be uniquely
10847: selected.
1.1040 raeburn 10848:
10849: sorted_future - ref to array of student_schedulable slots reservable in
10850: the future, ordered by start date of reservation period.
10851:
10852: future_reservable - ref to hash of student_schedulable slots reservable
10853: in the future.
10854:
10855: Keys in inner hash are:
10856: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10857: (b) startreserve: start date of reservation period.
10858: (c) uniqueperiod: start,end dates when slot is to be uniquely
10859: selected.
1.1040 raeburn 10860:
10861: =back
10862:
10863: =cut
10864:
10865: sub get_future_slots {
10866: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10867: my $map;
10868: if ($symb) {
10869: ($map) = &Apache::lonnet::decode_symb($symb);
10870: }
1.1040 raeburn 10871: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10872: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10873: foreach my $slot (keys(%slots)) {
10874: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10875: if ($symb) {
1.1229 raeburn 10876: if ($slots{$slot}->{'symb'} ne '') {
10877: my $canuse;
10878: my %oksymbs;
10879: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10880: map { $oksymbs{$_} = 1; } @slotsymbs;
10881: if ($oksymbs{$symb}) {
10882: $canuse = 1;
10883: } else {
10884: foreach my $item (@slotsymbs) {
10885: if ($item =~ /\.(page|sequence)$/) {
10886: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10887: if (($map ne '') && ($map eq $sloturl)) {
10888: $canuse = 1;
10889: last;
10890: }
10891: }
10892: }
10893: }
10894: next unless ($canuse);
10895: }
1.1040 raeburn 10896: }
10897: if (($slots{$slot}->{'starttime'} > $now) &&
10898: ($slots{$slot}->{'endtime'} > $now)) {
10899: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10900: my $userallowed = 0;
10901: if ($slots{$slot}->{'allowedsections'}) {
10902: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10903: if (!defined($env{'request.role.sec'})
10904: && grep(/^No section assigned$/,@allowed_sec)) {
10905: $userallowed=1;
10906: } else {
10907: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10908: $userallowed=1;
10909: }
10910: }
10911: unless ($userallowed) {
10912: if (defined($env{'request.course.groups'})) {
10913: my @groups = split(/:/,$env{'request.course.groups'});
10914: foreach my $group (@groups) {
10915: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10916: $userallowed=1;
10917: last;
10918: }
10919: }
10920: }
10921: }
10922: }
10923: if ($slots{$slot}->{'allowedusers'}) {
10924: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10925: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10926: if (grep(/^\Q$user\E$/,@allowed_users)) {
10927: $userallowed = 1;
10928: }
10929: }
10930: next unless($userallowed);
10931: }
10932: my $startreserve = $slots{$slot}->{'startreserve'};
10933: my $endreserve = $slots{$slot}->{'endreserve'};
10934: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 10935: my $uniqueperiod;
10936: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10937: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10938: }
1.1040 raeburn 10939: if (($startreserve < $now) &&
10940: (!$endreserve || $endreserve > $now)) {
10941: my $lastres = $endreserve;
10942: if (!$lastres) {
10943: $lastres = $slots{$slot}->{'starttime'};
10944: }
10945: $reservable_now{$slot} = {
10946: symb => $symb,
1.1250 raeburn 10947: endreserve => $lastres,
10948: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10949: };
10950: } elsif (($startreserve > $now) &&
10951: (!$endreserve || $endreserve > $startreserve)) {
10952: $future_reservable{$slot} = {
10953: symb => $symb,
1.1250 raeburn 10954: startreserve => $startreserve,
10955: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10956: };
10957: }
10958: }
10959: }
10960: my @unsorted_reservable = keys(%reservable_now);
10961: if (@unsorted_reservable > 0) {
10962: @sorted_reservable =
10963: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10964: }
10965: my @unsorted_future = keys(%future_reservable);
10966: if (@unsorted_future > 0) {
10967: @sorted_future =
10968: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10969: }
10970: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10971: }
1.780 raeburn 10972:
10973: =pod
10974:
1.1057 foxr 10975: =back
10976:
1.549 albertel 10977: =head1 HTTP Helpers
10978:
10979: =over 4
10980:
1.648 raeburn 10981: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10982:
1.258 albertel 10983: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10984: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10985: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10986:
10987: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10988: $possible_names is an ref to an array of form element names. As an example:
10989: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10990: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10991:
10992: =cut
1.1 albertel 10993:
1.6 albertel 10994: sub get_unprocessed_cgi {
1.25 albertel 10995: my ($query,$possible_names)= @_;
1.26 matthew 10996: # $Apache::lonxml::debug=1;
1.356 albertel 10997: foreach my $pair (split(/&/,$query)) {
10998: my ($name, $value) = split(/=/,$pair);
1.369 www 10999: $name = &unescape($name);
1.25 albertel 11000: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11001: $value =~ tr/+/ /;
11002: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11003: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11004: }
1.16 harris41 11005: }
1.6 albertel 11006: }
11007:
1.112 bowersj2 11008: =pod
11009:
1.648 raeburn 11010: =item * &cacheheader()
1.112 bowersj2 11011:
11012: returns cache-controlling header code
11013:
11014: =cut
11015:
1.7 albertel 11016: sub cacheheader {
1.258 albertel 11017: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11018: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11019: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11020: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11021: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11022: return $output;
1.7 albertel 11023: }
11024:
1.112 bowersj2 11025: =pod
11026:
1.648 raeburn 11027: =item * &no_cache($r)
1.112 bowersj2 11028:
11029: specifies header code to not have cache
11030:
11031: =cut
11032:
1.9 albertel 11033: sub no_cache {
1.216 albertel 11034: my ($r) = @_;
11035: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11036: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11037: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11038: $r->no_cache(1);
11039: $r->header_out("Expires" => $date);
11040: $r->header_out("Pragma" => "no-cache");
1.123 www 11041: }
11042:
11043: sub content_type {
1.181 albertel 11044: my ($r,$type,$charset) = @_;
1.299 foxr 11045: if ($r) {
11046: # Note that printout.pl calls this with undef for $r.
11047: &no_cache($r);
11048: }
1.258 albertel 11049: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11050: unless ($charset) {
11051: $charset=&Apache::lonlocal::current_encoding;
11052: }
11053: if ($charset) { $type.='; charset='.$charset; }
11054: if ($r) {
11055: $r->content_type($type);
11056: } else {
11057: print("Content-type: $type\n\n");
11058: }
1.9 albertel 11059: }
1.25 albertel 11060:
1.112 bowersj2 11061: =pod
11062:
1.648 raeburn 11063: =item * &add_to_env($name,$value)
1.112 bowersj2 11064:
1.258 albertel 11065: adds $name to the %env hash with value
1.112 bowersj2 11066: $value, if $name already exists, the entry is converted to an array
11067: reference and $value is added to the array.
11068:
11069: =cut
11070:
1.25 albertel 11071: sub add_to_env {
11072: my ($name,$value)=@_;
1.258 albertel 11073: if (defined($env{$name})) {
11074: if (ref($env{$name})) {
1.25 albertel 11075: #already have multiple values
1.258 albertel 11076: push(@{ $env{$name} },$value);
1.25 albertel 11077: } else {
11078: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11079: my $first=$env{$name};
11080: undef($env{$name});
11081: push(@{ $env{$name} },$first,$value);
1.25 albertel 11082: }
11083: } else {
1.258 albertel 11084: $env{$name}=$value;
1.25 albertel 11085: }
1.31 albertel 11086: }
1.149 albertel 11087:
11088: =pod
11089:
1.648 raeburn 11090: =item * &get_env_multiple($name)
1.149 albertel 11091:
1.258 albertel 11092: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11093: values may be defined and end up as an array ref.
11094:
11095: returns an array of values
11096:
11097: =cut
11098:
11099: sub get_env_multiple {
11100: my ($name) = @_;
11101: my @values;
1.258 albertel 11102: if (defined($env{$name})) {
1.149 albertel 11103: # exists is it an array
1.258 albertel 11104: if (ref($env{$name})) {
11105: @values=@{ $env{$name} };
1.149 albertel 11106: } else {
1.258 albertel 11107: $values[0]=$env{$name};
1.149 albertel 11108: }
11109: }
11110: return(@values);
11111: }
11112:
1.1249 damieng 11113: # Looks at given dependencies, and returns something depending on the context.
11114: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11115: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11116: # For all other contexts, returns ($output, $counter, $numpathchg).
11117: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11118: # $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.
11119: # $numpathchg: integer with the number of cleaned up dependency paths.
11120: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11121: # \%mapping: hash reference clean path -> original path for all dependencies.
11122: # @param {string} actionurl - The path to the handler, indicative of the context.
11123: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11124: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11125: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11126: # @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)
11127: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11128: sub ask_for_embedded_content {
1.1249 damieng 11129: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11130: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11131: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11132: %currsubfile,%unused,$rem);
1.1071 raeburn 11133: my $counter = 0;
11134: my $numnew = 0;
1.987 raeburn 11135: my $numremref = 0;
11136: my $numinvalid = 0;
11137: my $numpathchg = 0;
11138: my $numexisting = 0;
1.1071 raeburn 11139: my $numunused = 0;
11140: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11141: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11142: my $heading = &mt('Upload embedded files');
11143: my $buttontext = &mt('Upload');
11144:
1.1249 damieng 11145: # fills these variables based on the context:
11146: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11147: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11148: if ($env{'request.course.id'}) {
1.1123 raeburn 11149: if ($actionurl eq '/adm/dependencies') {
11150: $navmap = Apache::lonnavmaps::navmap->new();
11151: }
11152: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11153: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11154: }
1.1123 raeburn 11155: if (($actionurl eq '/adm/portfolio') ||
11156: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11157: my $current_path='/';
11158: if ($env{'form.currentpath'}) {
11159: $current_path = $env{'form.currentpath'};
11160: }
11161: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11162: $udom = $cdom;
11163: $uname = $cnum;
1.984 raeburn 11164: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11165: } else {
11166: $udom = $env{'user.domain'};
11167: $uname = $env{'user.name'};
11168: $url = '/userfiles/portfolio';
11169: }
1.987 raeburn 11170: $toplevel = $url.'/';
1.984 raeburn 11171: $url .= $current_path;
11172: $getpropath = 1;
1.987 raeburn 11173: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11174: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11175: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11176: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11177: $toplevel = $url;
1.984 raeburn 11178: if ($rest ne '') {
1.987 raeburn 11179: $url .= $rest;
11180: }
11181: } elsif ($actionurl eq '/adm/coursedocs') {
11182: if (ref($args) eq 'HASH') {
1.1071 raeburn 11183: $url = $args->{'docs_url'};
11184: $toplevel = $url;
1.1084 raeburn 11185: if ($args->{'context'} eq 'paste') {
11186: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11187: ($path) =
11188: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11189: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11190: $fileloc =~ s{^/}{};
11191: }
1.1071 raeburn 11192: }
1.1084 raeburn 11193: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 11194: if ($env{'request.course.id'} ne '') {
11195: if (ref($args) eq 'HASH') {
11196: $url = $args->{'docs_url'};
11197: $title = $args->{'docs_title'};
1.1126 raeburn 11198: $toplevel = $url;
11199: unless ($toplevel =~ m{^/}) {
11200: $toplevel = "/$url";
11201: }
1.1085 raeburn 11202: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11203: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11204: $path = $1;
11205: } else {
11206: ($path) =
11207: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11208: }
1.1195 raeburn 11209: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11210: $fileloc = $toplevel;
11211: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11212: my ($udom,$uname,$fname) =
11213: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11214: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11215: } else {
11216: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11217: }
1.1071 raeburn 11218: $fileloc =~ s{^/}{};
11219: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11220: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11221: }
1.987 raeburn 11222: }
1.1123 raeburn 11223: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11224: $udom = $cdom;
11225: $uname = $cnum;
11226: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11227: $toplevel = $url;
11228: $path = $url;
11229: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11230: $fileloc =~ s{^/}{};
1.987 raeburn 11231: }
1.1249 damieng 11232:
11233: # parses the dependency paths to get some info
11234: # fills $newfiles, $mapping, $subdependencies, $dependencies
11235: # $newfiles: hash URL -> 1 for new files or external URLs
11236: # (will be completed later)
11237: # $mapping:
11238: # for external URLs: external URL -> external URL
11239: # for relative paths: clean path -> original path
11240: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11241: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11242: foreach my $file (keys(%{$allfiles})) {
11243: my $embed_file;
11244: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11245: $embed_file = $1;
11246: } else {
11247: $embed_file = $file;
11248: }
1.1158 raeburn 11249: my ($absolutepath,$cleaned_file);
11250: if ($embed_file =~ m{^\w+://}) {
11251: $cleaned_file = $embed_file;
1.1147 raeburn 11252: $newfiles{$cleaned_file} = 1;
11253: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11254: } else {
1.1158 raeburn 11255: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11256: if ($embed_file =~ m{^/}) {
11257: $absolutepath = $embed_file;
11258: }
1.1147 raeburn 11259: if ($cleaned_file =~ m{/}) {
11260: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11261: $path = &check_for_traversal($path,$url,$toplevel);
11262: my $item = $fname;
11263: if ($path ne '') {
11264: $item = $path.'/'.$fname;
11265: $subdependencies{$path}{$fname} = 1;
11266: } else {
11267: $dependencies{$item} = 1;
11268: }
11269: if ($absolutepath) {
11270: $mapping{$item} = $absolutepath;
11271: } else {
11272: $mapping{$item} = $embed_file;
11273: }
11274: } else {
11275: $dependencies{$embed_file} = 1;
11276: if ($absolutepath) {
1.1147 raeburn 11277: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11278: } else {
1.1147 raeburn 11279: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11280: }
11281: }
1.984 raeburn 11282: }
11283: }
1.1249 damieng 11284:
11285: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11286: # and lists
11287: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11288: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11289: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11290: # the path had to be cleaned up
11291: # $existing: hash clean path -> 1 if the file exists
11292: # $numexisting: number of keys in $existing
11293: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11294: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11295: # dependency subdirectories that are
11296: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11297: my $dirptr = 16384;
1.984 raeburn 11298: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11299: $currsubfile{$path} = {};
1.1123 raeburn 11300: if (($actionurl eq '/adm/portfolio') ||
11301: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11302: my ($sublistref,$listerror) =
11303: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11304: if (ref($sublistref) eq 'ARRAY') {
11305: foreach my $line (@{$sublistref}) {
11306: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11307: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11308: }
1.984 raeburn 11309: }
1.987 raeburn 11310: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11311: if (opendir(my $dir,$url.'/'.$path)) {
11312: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11313: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11314: }
1.1084 raeburn 11315: } elsif (($actionurl eq '/adm/dependencies') ||
11316: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11317: ($args->{'context'} eq 'paste')) ||
11318: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11319: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11320: my $dir;
11321: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11322: $dir = $fileloc;
11323: } else {
11324: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11325: }
1.1071 raeburn 11326: if ($dir ne '') {
11327: my ($sublistref,$listerror) =
11328: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11329: if (ref($sublistref) eq 'ARRAY') {
11330: foreach my $line (@{$sublistref}) {
11331: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11332: undef,$mtime)=split(/\&/,$line,12);
11333: unless (($testdir&$dirptr) ||
11334: ($file_name =~ /^\.\.?$/)) {
11335: $currsubfile{$path}{$file_name} = [$size,$mtime];
11336: }
11337: }
11338: }
11339: }
1.984 raeburn 11340: }
11341: }
11342: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11343: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11344: my $item = $path.'/'.$file;
11345: unless ($mapping{$item} eq $item) {
11346: $pathchanges{$item} = 1;
11347: }
11348: $existing{$item} = 1;
11349: $numexisting ++;
11350: } else {
11351: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11352: }
11353: }
1.1071 raeburn 11354: if ($actionurl eq '/adm/dependencies') {
11355: foreach my $path (keys(%currsubfile)) {
11356: if (ref($currsubfile{$path}) eq 'HASH') {
11357: foreach my $file (keys(%{$currsubfile{$path}})) {
11358: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11359: next if (($rem ne '') &&
11360: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11361: (ref($navmap) &&
11362: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11363: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11364: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11365: $unused{$path.'/'.$file} = 1;
11366: }
11367: }
11368: }
11369: }
11370: }
1.984 raeburn 11371: }
1.1249 damieng 11372:
11373: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11374: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11375: my %currfile;
1.1123 raeburn 11376: if (($actionurl eq '/adm/portfolio') ||
11377: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11378: my ($dirlistref,$listerror) =
11379: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11380: if (ref($dirlistref) eq 'ARRAY') {
11381: foreach my $line (@{$dirlistref}) {
11382: my ($file_name,$rest) = split(/\&/,$line,2);
11383: $currfile{$file_name} = 1;
11384: }
1.984 raeburn 11385: }
1.987 raeburn 11386: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11387: if (opendir(my $dir,$url)) {
1.987 raeburn 11388: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11389: map {$currfile{$_} = 1;} @dir_list;
11390: }
1.1084 raeburn 11391: } elsif (($actionurl eq '/adm/dependencies') ||
11392: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11393: ($args->{'context'} eq 'paste')) ||
11394: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11395: if ($env{'request.course.id'} ne '') {
11396: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11397: if ($dir ne '') {
11398: my ($dirlistref,$listerror) =
11399: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11400: if (ref($dirlistref) eq 'ARRAY') {
11401: foreach my $line (@{$dirlistref}) {
11402: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11403: $size,undef,$mtime)=split(/\&/,$line,12);
11404: unless (($testdir&$dirptr) ||
11405: ($file_name =~ /^\.\.?$/)) {
11406: $currfile{$file_name} = [$size,$mtime];
11407: }
11408: }
11409: }
11410: }
11411: }
1.984 raeburn 11412: }
1.1249 damieng 11413: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11414: # are not in subdirectories, using $currfile
1.984 raeburn 11415: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11416: if (exists($currfile{$file})) {
1.987 raeburn 11417: unless ($mapping{$file} eq $file) {
11418: $pathchanges{$file} = 1;
11419: }
11420: $existing{$file} = 1;
11421: $numexisting ++;
11422: } else {
1.984 raeburn 11423: $newfiles{$file} = 1;
11424: }
11425: }
1.1071 raeburn 11426: foreach my $file (keys(%currfile)) {
11427: unless (($file eq $filename) ||
11428: ($file eq $filename.'.bak') ||
11429: ($dependencies{$file})) {
1.1085 raeburn 11430: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11431: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11432: next if (($rem ne '') &&
11433: (($env{"httpref.$rem".$file} ne '') ||
11434: (ref($navmap) &&
11435: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11436: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11437: ($navmap->getResourceByUrl($rem.$1)))))));
11438: }
1.1085 raeburn 11439: }
1.1071 raeburn 11440: $unused{$file} = 1;
11441: }
11442: }
1.1249 damieng 11443:
11444: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11445: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11446: ($args->{'context'} eq 'paste')) {
11447: $counter = scalar(keys(%existing));
11448: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11449: return ($output,$counter,$numpathchg,\%existing);
11450: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11451: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11452: $counter = scalar(keys(%existing));
11453: $numpathchg = scalar(keys(%pathchanges));
11454: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11455: }
1.1249 damieng 11456:
11457: # returns HTML otherwise, with dependency results and to ask for more uploads
11458:
11459: # $upload_output: missing dependencies (with upload form)
11460: # $modify_output: uploaded dependencies (in use)
11461: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11462: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11463: if ($actionurl eq '/adm/dependencies') {
11464: next if ($embed_file =~ m{^\w+://});
11465: }
1.660 raeburn 11466: $upload_output .= &start_data_table_row().
1.1123 raeburn 11467: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11468: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11469: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11470: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11471: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11472: }
1.1123 raeburn 11473: $upload_output .= '</td>';
1.1071 raeburn 11474: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11475: $upload_output.='<td align="right">'.
11476: '<span class="LC_info LC_fontsize_medium">'.
11477: &mt("URL points to web address").'</span>';
1.987 raeburn 11478: $numremref++;
1.660 raeburn 11479: } elsif ($args->{'error_on_invalid_names'}
11480: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11481: $upload_output.='<td align="right"><span class="LC_warning">'.
11482: &mt('Invalid characters').'</span>';
1.987 raeburn 11483: $numinvalid++;
1.660 raeburn 11484: } else {
1.1123 raeburn 11485: $upload_output .= '<td>'.
11486: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11487: $embed_file,\%mapping,
1.1071 raeburn 11488: $allfiles,$codebase,'upload');
11489: $counter ++;
11490: $numnew ++;
1.987 raeburn 11491: }
11492: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11493: }
11494: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11495: if ($actionurl eq '/adm/dependencies') {
11496: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11497: $modify_output .= &start_data_table_row().
11498: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11499: '<img src="'.&icon($embed_file).'" border="0" />'.
11500: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11501: '<td>'.$size.'</td>'.
11502: '<td>'.$mtime.'</td>'.
11503: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11504: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11505: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11506: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11507: &embedded_file_element('upload_embedded',$counter,
11508: $embed_file,\%mapping,
11509: $allfiles,$codebase,'modify').
11510: '</div></td>'.
11511: &end_data_table_row()."\n";
11512: $counter ++;
11513: } else {
11514: $upload_output .= &start_data_table_row().
1.1123 raeburn 11515: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11516: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11517: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11518: &Apache::loncommon::end_data_table_row()."\n";
11519: }
11520: }
11521: my $delidx = $counter;
11522: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11523: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11524: $delete_output .= &start_data_table_row().
11525: '<td><img src="'.&icon($oldfile).'" />'.
11526: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11527: '<td>'.$size.'</td>'.
11528: '<td>'.$mtime.'</td>'.
11529: '<td><label><input type="checkbox" name="del_upload_dep" '.
11530: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11531: &embedded_file_element('upload_embedded',$delidx,
11532: $oldfile,\%mapping,$allfiles,
11533: $codebase,'delete').'</td>'.
11534: &end_data_table_row()."\n";
11535: $numunused ++;
11536: $delidx ++;
1.987 raeburn 11537: }
11538: if ($upload_output) {
11539: $upload_output = &start_data_table().
11540: $upload_output.
11541: &end_data_table()."\n";
11542: }
1.1071 raeburn 11543: if ($modify_output) {
11544: $modify_output = &start_data_table().
11545: &start_data_table_header_row().
11546: '<th>'.&mt('File').'</th>'.
11547: '<th>'.&mt('Size (KB)').'</th>'.
11548: '<th>'.&mt('Modified').'</th>'.
11549: '<th>'.&mt('Upload replacement?').'</th>'.
11550: &end_data_table_header_row().
11551: $modify_output.
11552: &end_data_table()."\n";
11553: }
11554: if ($delete_output) {
11555: $delete_output = &start_data_table().
11556: &start_data_table_header_row().
11557: '<th>'.&mt('File').'</th>'.
11558: '<th>'.&mt('Size (KB)').'</th>'.
11559: '<th>'.&mt('Modified').'</th>'.
11560: '<th>'.&mt('Delete?').'</th>'.
11561: &end_data_table_header_row().
11562: $delete_output.
11563: &end_data_table()."\n";
11564: }
1.987 raeburn 11565: my $applies = 0;
11566: if ($numremref) {
11567: $applies ++;
11568: }
11569: if ($numinvalid) {
11570: $applies ++;
11571: }
11572: if ($numexisting) {
11573: $applies ++;
11574: }
1.1071 raeburn 11575: if ($counter || $numunused) {
1.987 raeburn 11576: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11577: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11578: $state.'<h3>'.$heading.'</h3>';
11579: if ($actionurl eq '/adm/dependencies') {
11580: if ($numnew) {
11581: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11582: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11583: $upload_output.'<br />'."\n";
11584: }
11585: if ($numexisting) {
11586: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11587: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11588: $modify_output.'<br />'."\n";
11589: $buttontext = &mt('Save changes');
11590: }
11591: if ($numunused) {
11592: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11593: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11594: $delete_output.'<br />'."\n";
11595: $buttontext = &mt('Save changes');
11596: }
11597: } else {
11598: $output .= $upload_output.'<br />'."\n";
11599: }
11600: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11601: $counter.'" />'."\n";
11602: if ($actionurl eq '/adm/dependencies') {
11603: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11604: $numnew.'" />'."\n";
11605: } elsif ($actionurl eq '') {
1.987 raeburn 11606: $output .= '<input type="hidden" name="phase" value="three" />';
11607: }
11608: } elsif ($applies) {
11609: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11610: if ($applies > 1) {
11611: $output .=
1.1123 raeburn 11612: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11613: if ($numremref) {
11614: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11615: }
11616: if ($numinvalid) {
11617: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11618: }
11619: if ($numexisting) {
11620: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11621: }
11622: $output .= '</ul><br />';
11623: } elsif ($numremref) {
11624: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11625: } elsif ($numinvalid) {
11626: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11627: } elsif ($numexisting) {
11628: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11629: }
11630: $output .= $upload_output.'<br />';
11631: }
11632: my ($pathchange_output,$chgcount);
1.1071 raeburn 11633: $chgcount = $counter;
1.987 raeburn 11634: if (keys(%pathchanges) > 0) {
11635: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11636: if ($counter) {
1.987 raeburn 11637: $output .= &embedded_file_element('pathchange',$chgcount,
11638: $embed_file,\%mapping,
1.1071 raeburn 11639: $allfiles,$codebase,'change');
1.987 raeburn 11640: } else {
11641: $pathchange_output .=
11642: &start_data_table_row().
11643: '<td><input type ="checkbox" name="namechange" value="'.
11644: $chgcount.'" checked="checked" /></td>'.
11645: '<td>'.$mapping{$embed_file}.'</td>'.
11646: '<td>'.$embed_file.
11647: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11648: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11649: '</td>'.&end_data_table_row();
1.660 raeburn 11650: }
1.987 raeburn 11651: $numpathchg ++;
11652: $chgcount ++;
1.660 raeburn 11653: }
11654: }
1.1127 raeburn 11655: if (($counter) || ($numunused)) {
1.987 raeburn 11656: if ($numpathchg) {
11657: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11658: $numpathchg.'" />'."\n";
11659: }
11660: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11661: ($actionurl eq '/adm/imsimport')) {
11662: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11663: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11664: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11665: } elsif ($actionurl eq '/adm/dependencies') {
11666: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11667: }
1.1123 raeburn 11668: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11669: } elsif ($numpathchg) {
11670: my %pathchange = ();
11671: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11672: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11673: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11674: }
1.987 raeburn 11675: }
1.1071 raeburn 11676: return ($output,$counter,$numpathchg);
1.987 raeburn 11677: }
11678:
1.1147 raeburn 11679: =pod
11680:
11681: =item * clean_path($name)
11682:
11683: Performs clean-up of directories, subdirectories and filename in an
11684: embedded object, referenced in an HTML file which is being uploaded
11685: to a course or portfolio, where
11686: "Upload embedded images/multimedia files if HTML file" checkbox was
11687: checked.
11688:
11689: Clean-up is similar to replacements in lonnet::clean_filename()
11690: except each / between sub-directory and next level is preserved.
11691:
11692: =cut
11693:
11694: sub clean_path {
11695: my ($embed_file) = @_;
11696: $embed_file =~s{^/+}{};
11697: my @contents;
11698: if ($embed_file =~ m{/}) {
11699: @contents = split(/\//,$embed_file);
11700: } else {
11701: @contents = ($embed_file);
11702: }
11703: my $lastidx = scalar(@contents)-1;
11704: for (my $i=0; $i<=$lastidx; $i++) {
11705: $contents[$i]=~s{\\}{/}g;
11706: $contents[$i]=~s/\s+/\_/g;
11707: $contents[$i]=~s{[^/\w\.\-]}{}g;
11708: if ($i == $lastidx) {
11709: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11710: }
11711: }
11712: if ($lastidx > 0) {
11713: return join('/',@contents);
11714: } else {
11715: return $contents[0];
11716: }
11717: }
11718:
1.987 raeburn 11719: sub embedded_file_element {
1.1071 raeburn 11720: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11721: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11722: (ref($codebase) eq 'HASH'));
11723: my $output;
1.1071 raeburn 11724: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11725: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11726: }
11727: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11728: &escape($embed_file).'" />';
11729: unless (($context eq 'upload_embedded') &&
11730: ($mapping->{$embed_file} eq $embed_file)) {
11731: $output .='
11732: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11733: }
11734: my $attrib;
11735: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11736: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11737: }
11738: $output .=
11739: "\n\t\t".
11740: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11741: $attrib.'" />';
11742: if (exists($codebase->{$mapping->{$embed_file}})) {
11743: $output .=
11744: "\n\t\t".
11745: '<input name="codebase_'.$num.'" type="hidden" value="'.
11746: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11747: }
1.987 raeburn 11748: return $output;
1.660 raeburn 11749: }
11750:
1.1071 raeburn 11751: sub get_dependency_details {
11752: my ($currfile,$currsubfile,$embed_file) = @_;
11753: my ($size,$mtime,$showsize,$showmtime);
11754: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11755: if ($embed_file =~ m{/}) {
11756: my ($path,$fname) = split(/\//,$embed_file);
11757: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11758: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11759: }
11760: } else {
11761: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11762: ($size,$mtime) = @{$currfile->{$embed_file}};
11763: }
11764: }
11765: $showsize = $size/1024.0;
11766: $showsize = sprintf("%.1f",$showsize);
11767: if ($mtime > 0) {
11768: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11769: }
11770: }
11771: return ($showsize,$showmtime);
11772: }
11773:
11774: sub ask_embedded_js {
11775: return <<"END";
11776: <script type="text/javascript"">
11777: // <![CDATA[
11778: function toggleBrowse(counter) {
11779: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11780: var fileid = document.getElementById('embedded_item_'+counter);
11781: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11782: if (chkboxid.checked == true) {
11783: uploaddivid.style.display='block';
11784: } else {
11785: uploaddivid.style.display='none';
11786: fileid.value = '';
11787: }
11788: }
11789: // ]]>
11790: </script>
11791:
11792: END
11793: }
11794:
1.661 raeburn 11795: sub upload_embedded {
11796: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11797: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11798: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11799: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11800: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11801: my $orig_uploaded_filename =
11802: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11803: foreach my $type ('orig','ref','attrib','codebase') {
11804: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11805: $env{'form.embedded_'.$type.'_'.$i} =
11806: &unescape($env{'form.embedded_'.$type.'_'.$i});
11807: }
11808: }
1.661 raeburn 11809: my ($path,$fname) =
11810: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11811: # no path, whole string is fname
11812: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11813: $fname = &Apache::lonnet::clean_filename($fname);
11814: # See if there is anything left
11815: next if ($fname eq '');
11816:
11817: # Check if file already exists as a file or directory.
11818: my ($state,$msg);
11819: if ($context eq 'portfolio') {
11820: my $port_path = $dirpath;
11821: if ($group ne '') {
11822: $port_path = "groups/$group/$port_path";
11823: }
1.987 raeburn 11824: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11825: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11826: $dir_root,$port_path,$disk_quota,
11827: $current_disk_usage,$uname,$udom);
11828: if ($state eq 'will_exceed_quota'
1.984 raeburn 11829: || $state eq 'file_locked') {
1.661 raeburn 11830: $output .= $msg;
11831: next;
11832: }
11833: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11834: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11835: if ($state eq 'exists') {
11836: $output .= $msg;
11837: next;
11838: }
11839: }
11840: # Check if extension is valid
11841: if (($fname =~ /\.(\w+)$/) &&
11842: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11843: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11844: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11845: next;
11846: } elsif (($fname =~ /\.(\w+)$/) &&
11847: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11848: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11849: next;
11850: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11851: $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 11852: next;
11853: }
11854: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11855: my $subdir = $path;
11856: $subdir =~ s{/+$}{};
1.661 raeburn 11857: if ($context eq 'portfolio') {
1.984 raeburn 11858: my $result;
11859: if ($state eq 'existingfile') {
11860: $result=
11861: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11862: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11863: } else {
1.984 raeburn 11864: $result=
11865: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11866: $dirpath.
1.1123 raeburn 11867: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11868: if ($result !~ m|^/uploaded/|) {
11869: $output .= '<span class="LC_error">'
11870: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11871: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11872: .'</span><br />';
11873: next;
11874: } else {
1.987 raeburn 11875: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11876: $path.$fname.'</span>').'<br />';
1.984 raeburn 11877: }
1.661 raeburn 11878: }
1.1123 raeburn 11879: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11880: my $extendedsubdir = $dirpath.'/'.$subdir;
11881: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11882: my $result =
1.1126 raeburn 11883: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11884: if ($result !~ m|^/uploaded/|) {
11885: $output .= '<span class="LC_error">'
11886: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11887: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11888: .'</span><br />';
11889: next;
11890: } else {
11891: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11892: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11893: if ($context eq 'syllabus') {
11894: &Apache::lonnet::make_public_indefinitely($result);
11895: }
1.987 raeburn 11896: }
1.661 raeburn 11897: } else {
11898: # Save the file
11899: my $target = $env{'form.embedded_item_'.$i};
11900: my $fullpath = $dir_root.$dirpath.'/'.$path;
11901: my $dest = $fullpath.$fname;
11902: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11903: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11904: my $count;
11905: my $filepath = $dir_root;
1.1027 raeburn 11906: foreach my $subdir (@parts) {
11907: $filepath .= "/$subdir";
11908: if (!-e $filepath) {
1.661 raeburn 11909: mkdir($filepath,0770);
11910: }
11911: }
11912: my $fh;
11913: if (!open($fh,'>'.$dest)) {
11914: &Apache::lonnet::logthis('Failed to create '.$dest);
11915: $output .= '<span class="LC_error">'.
1.1071 raeburn 11916: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11917: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11918: '</span><br />';
11919: } else {
11920: if (!print $fh $env{'form.embedded_item_'.$i}) {
11921: &Apache::lonnet::logthis('Failed to write to '.$dest);
11922: $output .= '<span class="LC_error">'.
1.1071 raeburn 11923: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11924: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11925: '</span><br />';
11926: } else {
1.987 raeburn 11927: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11928: $url.'</span>').'<br />';
11929: unless ($context eq 'testbank') {
11930: $footer .= &mt('View embedded file: [_1]',
11931: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11932: }
11933: }
11934: close($fh);
11935: }
11936: }
11937: if ($env{'form.embedded_ref_'.$i}) {
11938: $pathchange{$i} = 1;
11939: }
11940: }
11941: if ($output) {
11942: $output = '<p>'.$output.'</p>';
11943: }
11944: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11945: $returnflag = 'ok';
1.1071 raeburn 11946: my $numpathchgs = scalar(keys(%pathchange));
11947: if ($numpathchgs > 0) {
1.987 raeburn 11948: if ($context eq 'portfolio') {
11949: $output .= '<p>'.&mt('or').'</p>';
11950: } elsif ($context eq 'testbank') {
1.1071 raeburn 11951: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11952: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11953: $returnflag = 'modify_orightml';
11954: }
11955: }
1.1071 raeburn 11956: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11957: }
11958:
11959: sub modify_html_form {
11960: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11961: my $end = 0;
11962: my $modifyform;
11963: if ($context eq 'upload_embedded') {
11964: return unless (ref($pathchange) eq 'HASH');
11965: if ($env{'form.number_embedded_items'}) {
11966: $end += $env{'form.number_embedded_items'};
11967: }
11968: if ($env{'form.number_pathchange_items'}) {
11969: $end += $env{'form.number_pathchange_items'};
11970: }
11971: if ($end) {
11972: for (my $i=0; $i<$end; $i++) {
11973: if ($i < $env{'form.number_embedded_items'}) {
11974: next unless($pathchange->{$i});
11975: }
11976: $modifyform .=
11977: &start_data_table_row().
11978: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11979: 'checked="checked" /></td>'.
11980: '<td>'.$env{'form.embedded_ref_'.$i}.
11981: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11982: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11983: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11984: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11985: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11986: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11987: '<td>'.$env{'form.embedded_orig_'.$i}.
11988: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11989: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11990: &end_data_table_row();
1.1071 raeburn 11991: }
1.987 raeburn 11992: }
11993: } else {
11994: $modifyform = $pathchgtable;
11995: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11996: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11997: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11998: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11999: }
12000: }
12001: if ($modifyform) {
1.1071 raeburn 12002: if ($actionurl eq '/adm/dependencies') {
12003: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12004: }
1.987 raeburn 12005: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12006: '<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".
12007: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12008: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12009: '</ol></p>'."\n".'<p>'.
12010: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12011: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12012: &start_data_table()."\n".
12013: &start_data_table_header_row().
12014: '<th>'.&mt('Change?').'</th>'.
12015: '<th>'.&mt('Current reference').'</th>'.
12016: '<th>'.&mt('Required reference').'</th>'.
12017: &end_data_table_header_row()."\n".
12018: $modifyform.
12019: &end_data_table().'<br />'."\n".$hiddenstate.
12020: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12021: '</form>'."\n";
12022: }
12023: return;
12024: }
12025:
12026: sub modify_html_refs {
1.1123 raeburn 12027: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12028: my $container;
12029: if ($context eq 'portfolio') {
12030: $container = $env{'form.container'};
12031: } elsif ($context eq 'coursedoc') {
12032: $container = $env{'form.primaryurl'};
1.1071 raeburn 12033: } elsif ($context eq 'manage_dependencies') {
12034: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12035: $container = "/$container";
1.1123 raeburn 12036: } elsif ($context eq 'syllabus') {
12037: $container = $url;
1.987 raeburn 12038: } else {
1.1027 raeburn 12039: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12040: }
12041: my (%allfiles,%codebase,$output,$content);
12042: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 12043: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12044: if (wantarray) {
12045: return ('',0,0);
12046: } else {
12047: return;
12048: }
12049: }
12050: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12051: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12052: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12053: if (wantarray) {
12054: return ('',0,0);
12055: } else {
12056: return;
12057: }
12058: }
1.987 raeburn 12059: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12060: if ($content eq '-1') {
12061: if (wantarray) {
12062: return ('',0,0);
12063: } else {
12064: return;
12065: }
12066: }
1.987 raeburn 12067: } else {
1.1071 raeburn 12068: unless ($container =~ /^\Q$dir_root\E/) {
12069: if (wantarray) {
12070: return ('',0,0);
12071: } else {
12072: return;
12073: }
12074: }
1.987 raeburn 12075: if (open(my $fh,"<$container")) {
12076: $content = join('', <$fh>);
12077: close($fh);
12078: } else {
1.1071 raeburn 12079: if (wantarray) {
12080: return ('',0,0);
12081: } else {
12082: return;
12083: }
1.987 raeburn 12084: }
12085: }
12086: my ($count,$codebasecount) = (0,0);
12087: my $mm = new File::MMagic;
12088: my $mime_type = $mm->checktype_contents($content);
12089: if ($mime_type eq 'text/html') {
12090: my $parse_result =
12091: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12092: \%codebase,\$content);
12093: if ($parse_result eq 'ok') {
12094: foreach my $i (@changes) {
12095: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12096: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12097: if ($allfiles{$ref}) {
12098: my $newname = $orig;
12099: my ($attrib_regexp,$codebase);
1.1006 raeburn 12100: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12101: if ($attrib_regexp =~ /:/) {
12102: $attrib_regexp =~ s/\:/|/g;
12103: }
12104: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12105: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12106: $count += $numchg;
1.1123 raeburn 12107: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12108: delete($allfiles{$ref});
1.987 raeburn 12109: }
12110: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12111: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12112: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12113: $codebasecount ++;
12114: }
12115: }
12116: }
1.1123 raeburn 12117: my $skiprewrites;
1.987 raeburn 12118: if ($count || $codebasecount) {
12119: my $saveresult;
1.1071 raeburn 12120: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12121: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12122: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12123: if ($url eq $container) {
12124: my ($fname) = ($container =~ m{/([^/]+)$});
12125: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12126: $count,'<span class="LC_filename">'.
1.1071 raeburn 12127: $fname.'</span>').'</p>';
1.987 raeburn 12128: } else {
12129: $output = '<p class="LC_error">'.
12130: &mt('Error: update failed for: [_1].',
12131: '<span class="LC_filename">'.
12132: $container.'</span>').'</p>';
12133: }
1.1123 raeburn 12134: if ($context eq 'syllabus') {
12135: unless ($saveresult eq 'ok') {
12136: $skiprewrites = 1;
12137: }
12138: }
1.987 raeburn 12139: } else {
12140: if (open(my $fh,">$container")) {
12141: print $fh $content;
12142: close($fh);
12143: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12144: $count,'<span class="LC_filename">'.
12145: $container.'</span>').'</p>';
1.661 raeburn 12146: } else {
1.987 raeburn 12147: $output = '<p class="LC_error">'.
12148: &mt('Error: could not update [_1].',
12149: '<span class="LC_filename">'.
12150: $container.'</span>').'</p>';
1.661 raeburn 12151: }
12152: }
12153: }
1.1123 raeburn 12154: if (($context eq 'syllabus') && (!$skiprewrites)) {
12155: my ($actionurl,$state);
12156: $actionurl = "/public/$udom/$uname/syllabus";
12157: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12158: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12159: \%codebase,
12160: {'context' => 'rewrites',
12161: 'ignore_remote_references' => 1,});
12162: if (ref($mapping) eq 'HASH') {
12163: my $rewrites = 0;
12164: foreach my $key (keys(%{$mapping})) {
12165: next if ($key =~ m{^https?://});
12166: my $ref = $mapping->{$key};
12167: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12168: my $attrib;
12169: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12170: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12171: }
12172: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12173: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12174: $rewrites += $numchg;
12175: }
12176: }
12177: if ($rewrites) {
12178: my $saveresult;
12179: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12180: if ($url eq $container) {
12181: my ($fname) = ($container =~ m{/([^/]+)$});
12182: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12183: $count,'<span class="LC_filename">'.
12184: $fname.'</span>').'</p>';
12185: } else {
12186: $output .= '<p class="LC_error">'.
12187: &mt('Error: could not update links in [_1].',
12188: '<span class="LC_filename">'.
12189: $container.'</span>').'</p>';
12190:
12191: }
12192: }
12193: }
12194: }
1.987 raeburn 12195: } else {
12196: &logthis('Failed to parse '.$container.
12197: ' to modify references: '.$parse_result);
1.661 raeburn 12198: }
12199: }
1.1071 raeburn 12200: if (wantarray) {
12201: return ($output,$count,$codebasecount);
12202: } else {
12203: return $output;
12204: }
1.661 raeburn 12205: }
12206:
12207: sub check_for_existing {
12208: my ($path,$fname,$element) = @_;
12209: my ($state,$msg);
12210: if (-d $path.'/'.$fname) {
12211: $state = 'exists';
12212: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12213: } elsif (-e $path.'/'.$fname) {
12214: $state = 'exists';
12215: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12216: }
12217: if ($state eq 'exists') {
12218: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12219: }
12220: return ($state,$msg);
12221: }
12222:
12223: sub check_for_upload {
12224: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12225: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12226: my $filesize = length($env{'form.'.$element});
12227: if (!$filesize) {
12228: my $msg = '<span class="LC_error">'.
12229: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12230: '<span class="LC_filename">'.$fname.'</span>',
12231: $filesize).'<br />'.
1.1007 raeburn 12232: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12233: '</span>';
12234: return ('zero_bytes',$msg);
12235: }
12236: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12237: my $getpropath = 1;
1.1021 raeburn 12238: my ($dirlistref,$listerror) =
12239: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12240: my $found_file = 0;
12241: my $locked_file = 0;
1.991 raeburn 12242: my @lockers;
12243: my $navmap;
12244: if ($env{'request.course.id'}) {
12245: $navmap = Apache::lonnavmaps::navmap->new();
12246: }
1.1021 raeburn 12247: if (ref($dirlistref) eq 'ARRAY') {
12248: foreach my $line (@{$dirlistref}) {
12249: my ($file_name,$rest)=split(/\&/,$line,2);
12250: if ($file_name eq $fname){
12251: $file_name = $path.$file_name;
12252: if ($group ne '') {
12253: $file_name = $group.$file_name;
12254: }
12255: $found_file = 1;
12256: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12257: foreach my $lock (@lockers) {
12258: if (ref($lock) eq 'ARRAY') {
12259: my ($symb,$crsid) = @{$lock};
12260: if ($crsid eq $env{'request.course.id'}) {
12261: if (ref($navmap)) {
12262: my $res = $navmap->getBySymb($symb);
12263: foreach my $part (@{$res->parts()}) {
12264: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12265: unless (($slot_status == $res->RESERVED) ||
12266: ($slot_status == $res->RESERVED_LOCATION)) {
12267: $locked_file = 1;
12268: }
1.991 raeburn 12269: }
1.1021 raeburn 12270: } else {
12271: $locked_file = 1;
1.991 raeburn 12272: }
12273: } else {
12274: $locked_file = 1;
12275: }
12276: }
1.1021 raeburn 12277: }
12278: } else {
12279: my @info = split(/\&/,$rest);
12280: my $currsize = $info[6]/1000;
12281: if ($currsize < $filesize) {
12282: my $extra = $filesize - $currsize;
12283: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12284: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12285: &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 12286: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12287: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12288: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12289: return ('will_exceed_quota',$msg);
12290: }
1.984 raeburn 12291: }
12292: }
1.661 raeburn 12293: }
12294: }
12295: }
12296: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12297: my $msg = '<p class="LC_warning">'.
12298: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12299: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12300: return ('will_exceed_quota',$msg);
12301: } elsif ($found_file) {
12302: if ($locked_file) {
1.1179 bisitz 12303: my $msg = '<p class="LC_warning">';
1.661 raeburn 12304: $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 12305: $msg .= '</p>';
1.661 raeburn 12306: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12307: return ('file_locked',$msg);
12308: } else {
1.1179 bisitz 12309: my $msg = '<p class="LC_error">';
1.984 raeburn 12310: $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 12311: $msg .= '</p>';
1.984 raeburn 12312: return ('existingfile',$msg);
1.661 raeburn 12313: }
12314: }
12315: }
12316:
1.987 raeburn 12317: sub check_for_traversal {
12318: my ($path,$url,$toplevel) = @_;
12319: my @parts=split(/\//,$path);
12320: my $cleanpath;
12321: my $fullpath = $url;
12322: for (my $i=0;$i<@parts;$i++) {
12323: next if ($parts[$i] eq '.');
12324: if ($parts[$i] eq '..') {
12325: $fullpath =~ s{([^/]+/)$}{};
12326: } else {
12327: $fullpath .= $parts[$i].'/';
12328: }
12329: }
12330: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12331: $cleanpath = $1;
12332: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12333: my $curr_toprel = $1;
12334: my @parts = split(/\//,$curr_toprel);
12335: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12336: my @urlparts = split(/\//,$url_toprel);
12337: my $doubledots;
12338: my $startdiff = -1;
12339: for (my $i=0; $i<@urlparts; $i++) {
12340: if ($startdiff == -1) {
12341: unless ($urlparts[$i] eq $parts[$i]) {
12342: $startdiff = $i;
12343: $doubledots .= '../';
12344: }
12345: } else {
12346: $doubledots .= '../';
12347: }
12348: }
12349: if ($startdiff > -1) {
12350: $cleanpath = $doubledots;
12351: for (my $i=$startdiff; $i<@parts; $i++) {
12352: $cleanpath .= $parts[$i].'/';
12353: }
12354: }
12355: }
12356: $cleanpath =~ s{(/)$}{};
12357: return $cleanpath;
12358: }
1.31 albertel 12359:
1.1053 raeburn 12360: sub is_archive_file {
12361: my ($mimetype) = @_;
12362: if (($mimetype eq 'application/octet-stream') ||
12363: ($mimetype eq 'application/x-stuffit') ||
12364: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12365: return 1;
12366: }
12367: return;
12368: }
12369:
12370: sub decompress_form {
1.1065 raeburn 12371: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12372: my %lt = &Apache::lonlocal::texthash (
12373: this => 'This file is an archive file.',
1.1067 raeburn 12374: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12375: itsc => 'Its contents are as follows:',
1.1053 raeburn 12376: youm => 'You may wish to extract its contents.',
12377: extr => 'Extract contents',
1.1067 raeburn 12378: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12379: proa => 'Process automatically?',
1.1053 raeburn 12380: yes => 'Yes',
12381: no => 'No',
1.1067 raeburn 12382: fold => 'Title for folder containing movie',
12383: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12384: );
1.1065 raeburn 12385: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12386: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12387: my $info = &list_archive_contents($fileloc,\@paths);
12388: if (@paths) {
12389: foreach my $path (@paths) {
12390: $path =~ s{^/}{};
1.1067 raeburn 12391: if ($path =~ m{^([^/]+)/$}) {
12392: $topdir = $1;
12393: }
1.1065 raeburn 12394: if ($path =~ m{^([^/]+)/}) {
12395: $toplevel{$1} = $path;
12396: } else {
12397: $toplevel{$path} = $path;
12398: }
12399: }
12400: }
1.1067 raeburn 12401: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12402: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12403: "$topdir/media/",
12404: "$topdir/media/$topdir.mp4",
12405: "$topdir/media/FirstFrame.png",
12406: "$topdir/media/player.swf",
12407: "$topdir/media/swfobject.js",
12408: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12409: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12410: "$topdir/$topdir.mp4",
12411: "$topdir/$topdir\_config.xml",
12412: "$topdir/$topdir\_controller.swf",
12413: "$topdir/$topdir\_embed.css",
12414: "$topdir/$topdir\_First_Frame.png",
12415: "$topdir/$topdir\_player.html",
12416: "$topdir/$topdir\_Thumbnails.png",
12417: "$topdir/playerProductInstall.swf",
12418: "$topdir/scripts/",
12419: "$topdir/scripts/config_xml.js",
12420: "$topdir/scripts/handlebars.js",
12421: "$topdir/scripts/jquery-1.7.1.min.js",
12422: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12423: "$topdir/scripts/modernizr.js",
12424: "$topdir/scripts/player-min.js",
12425: "$topdir/scripts/swfobject.js",
12426: "$topdir/skins/",
12427: "$topdir/skins/configuration_express.xml",
12428: "$topdir/skins/express_show/",
12429: "$topdir/skins/express_show/player-min.css",
12430: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12431: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12432: "$topdir/$topdir.mp4",
12433: "$topdir/$topdir\_config.xml",
12434: "$topdir/$topdir\_controller.swf",
12435: "$topdir/$topdir\_embed.css",
12436: "$topdir/$topdir\_First_Frame.png",
12437: "$topdir/$topdir\_player.html",
12438: "$topdir/$topdir\_Thumbnails.png",
12439: "$topdir/playerProductInstall.swf",
12440: "$topdir/scripts/",
12441: "$topdir/scripts/config_xml.js",
12442: "$topdir/scripts/techsmith-smart-player.min.js",
12443: "$topdir/skins/",
12444: "$topdir/skins/configuration_express.xml",
12445: "$topdir/skins/express_show/",
12446: "$topdir/skins/express_show/spritesheet.min.css",
12447: "$topdir/skins/express_show/spritesheet.png",
12448: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12449: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12450: if (@diffs == 0) {
1.1164 raeburn 12451: $is_camtasia = 6;
12452: } else {
1.1197 raeburn 12453: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12454: if (@diffs == 0) {
12455: $is_camtasia = 8;
1.1197 raeburn 12456: } else {
12457: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12458: if (@diffs == 0) {
12459: $is_camtasia = 8;
12460: }
1.1164 raeburn 12461: }
1.1067 raeburn 12462: }
12463: }
12464: my $output;
12465: if ($is_camtasia) {
12466: $output = <<"ENDCAM";
12467: <script type="text/javascript" language="Javascript">
12468: // <![CDATA[
12469:
12470: function camtasiaToggle() {
12471: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12472: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12473: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12474: document.getElementById('camtasia_titles').style.display='block';
12475: } else {
12476: document.getElementById('camtasia_titles').style.display='none';
12477: }
12478: }
12479: }
12480: return;
12481: }
12482:
12483: // ]]>
12484: </script>
12485: <p>$lt{'camt'}</p>
12486: ENDCAM
1.1065 raeburn 12487: } else {
1.1067 raeburn 12488: $output = '<p>'.$lt{'this'};
12489: if ($info eq '') {
12490: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12491: } else {
12492: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12493: '<div><pre>'.$info.'</pre></div>';
12494: }
1.1065 raeburn 12495: }
1.1067 raeburn 12496: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12497: my $duplicates;
12498: my $num = 0;
12499: if (ref($dirlist) eq 'ARRAY') {
12500: foreach my $item (@{$dirlist}) {
12501: if (ref($item) eq 'ARRAY') {
12502: if (exists($toplevel{$item->[0]})) {
12503: $duplicates .=
12504: &start_data_table_row().
12505: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12506: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12507: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12508: 'value="1" />'.&mt('Yes').'</label>'.
12509: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12510: '<td>'.$item->[0].'</td>';
12511: if ($item->[2]) {
12512: $duplicates .= '<td>'.&mt('Directory').'</td>';
12513: } else {
12514: $duplicates .= '<td>'.&mt('File').'</td>';
12515: }
12516: $duplicates .= '<td>'.$item->[3].'</td>'.
12517: '<td>'.
12518: &Apache::lonlocal::locallocaltime($item->[4]).
12519: '</td>'.
12520: &end_data_table_row();
12521: $num ++;
12522: }
12523: }
12524: }
12525: }
12526: my $itemcount;
12527: if (@paths > 0) {
12528: $itemcount = scalar(@paths);
12529: } else {
12530: $itemcount = 1;
12531: }
1.1067 raeburn 12532: if ($is_camtasia) {
12533: $output .= $lt{'auto'}.'<br />'.
12534: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12535: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12536: $lt{'yes'}.'</label> <label>'.
12537: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12538: $lt{'no'}.'</label></span><br />'.
12539: '<div id="camtasia_titles" style="display:block">'.
12540: &Apache::lonhtmlcommon::start_pick_box().
12541: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12542: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12543: &Apache::lonhtmlcommon::row_closure().
12544: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12545: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12546: &Apache::lonhtmlcommon::row_closure(1).
12547: &Apache::lonhtmlcommon::end_pick_box().
12548: '</div>';
12549: }
1.1065 raeburn 12550: $output .=
12551: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12552: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12553: "\n";
1.1065 raeburn 12554: if ($duplicates ne '') {
12555: $output .= '<p><span class="LC_warning">'.
12556: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12557: &start_data_table().
12558: &start_data_table_header_row().
12559: '<th>'.&mt('Overwrite?').'</th>'.
12560: '<th>'.&mt('Name').'</th>'.
12561: '<th>'.&mt('Type').'</th>'.
12562: '<th>'.&mt('Size').'</th>'.
12563: '<th>'.&mt('Last modified').'</th>'.
12564: &end_data_table_header_row().
12565: $duplicates.
12566: &end_data_table().
12567: '</p>';
12568: }
1.1067 raeburn 12569: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12570: if (ref($hiddenelements) eq 'HASH') {
12571: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12572: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12573: }
12574: }
12575: $output .= <<"END";
1.1067 raeburn 12576: <br />
1.1053 raeburn 12577: <input type="submit" name="decompress" value="$lt{'extr'}" />
12578: </form>
12579: $noextract
12580: END
12581: return $output;
12582: }
12583:
1.1065 raeburn 12584: sub decompression_utility {
12585: my ($program) = @_;
12586: my @utilities = ('tar','gunzip','bunzip2','unzip');
12587: my $location;
12588: if (grep(/^\Q$program\E$/,@utilities)) {
12589: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12590: '/usr/sbin/') {
12591: if (-x $dir.$program) {
12592: $location = $dir.$program;
12593: last;
12594: }
12595: }
12596: }
12597: return $location;
12598: }
12599:
12600: sub list_archive_contents {
12601: my ($file,$pathsref) = @_;
12602: my (@cmd,$output);
12603: my $needsregexp;
12604: if ($file =~ /\.zip$/) {
12605: @cmd = (&decompression_utility('unzip'),"-l");
12606: $needsregexp = 1;
12607: } elsif (($file =~ m/\.tar\.gz$/) ||
12608: ($file =~ /\.tgz$/)) {
12609: @cmd = (&decompression_utility('tar'),"-ztf");
12610: } elsif ($file =~ /\.tar\.bz2$/) {
12611: @cmd = (&decompression_utility('tar'),"-jtf");
12612: } elsif ($file =~ m|\.tar$|) {
12613: @cmd = (&decompression_utility('tar'),"-tf");
12614: }
12615: if (@cmd) {
12616: undef($!);
12617: undef($@);
12618: if (open(my $fh,"-|", @cmd, $file)) {
12619: while (my $line = <$fh>) {
12620: $output .= $line;
12621: chomp($line);
12622: my $item;
12623: if ($needsregexp) {
12624: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12625: } else {
12626: $item = $line;
12627: }
12628: if ($item ne '') {
12629: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12630: push(@{$pathsref},$item);
12631: }
12632: }
12633: }
12634: close($fh);
12635: }
12636: }
12637: return $output;
12638: }
12639:
1.1053 raeburn 12640: sub decompress_uploaded_file {
12641: my ($file,$dir) = @_;
12642: &Apache::lonnet::appenv({'cgi.file' => $file});
12643: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12644: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12645: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12646: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12647: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12648: my $decompressed = $env{'cgi.decompressed'};
12649: &Apache::lonnet::delenv('cgi.file');
12650: &Apache::lonnet::delenv('cgi.dir');
12651: &Apache::lonnet::delenv('cgi.decompressed');
12652: return ($decompressed,$result);
12653: }
12654:
1.1055 raeburn 12655: sub process_decompression {
12656: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 12657: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12658: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12659: &mt('Unexpected file path.').'</p>'."\n";
12660: }
12661: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12662: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12663: &mt('Unexpected course context.').'</p>'."\n";
12664: }
1.1293 raeburn 12665: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 12666: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12667: &mt('Filename contained unexpected characters.').'</p>'."\n";
12668: }
1.1055 raeburn 12669: my ($dir,$error,$warning,$output);
1.1180 raeburn 12670: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12671: $error = &mt('Filename not a supported archive file type.').
12672: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12673: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12674: } else {
12675: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12676: if ($docuhome eq 'no_host') {
12677: $error = &mt('Could not determine home server for course.');
12678: } else {
12679: my @ids=&Apache::lonnet::current_machine_ids();
12680: my $currdir = "$dir_root/$destination";
12681: if (grep(/^\Q$docuhome\E$/,@ids)) {
12682: $dir = &LONCAPA::propath($docudom,$docuname).
12683: "$dir_root/$destination";
12684: } else {
12685: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12686: "$dir_root/$docudom/$docuname/$destination";
12687: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12688: $error = &mt('Archive file not found.');
12689: }
12690: }
1.1065 raeburn 12691: my (@to_overwrite,@to_skip);
12692: if ($env{'form.archive_overwrite_total'} > 0) {
12693: my $total = $env{'form.archive_overwrite_total'};
12694: for (my $i=0; $i<$total; $i++) {
12695: if ($env{'form.archive_overwrite_'.$i} == 1) {
12696: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12697: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12698: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12699: }
12700: }
12701: }
12702: my $numskip = scalar(@to_skip);
1.1292 raeburn 12703: my $numoverwrite = scalar(@to_overwrite);
12704: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12705: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12706: } elsif ($dir eq '') {
1.1055 raeburn 12707: $error = &mt('Directory containing archive file unavailable.');
12708: } elsif (!$error) {
1.1065 raeburn 12709: my ($decompressed,$display);
1.1292 raeburn 12710: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12711: my $tempdir = time.'_'.$$.int(rand(10000));
12712: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 12713: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12714: ($decompressed,$display) =
12715: &decompress_uploaded_file($file,"$dir/$tempdir");
12716: foreach my $item (@to_skip) {
12717: if (($item ne '') && ($item !~ /\.\./)) {
12718: if (-f "$dir/$tempdir/$item") {
12719: unlink("$dir/$tempdir/$item");
12720: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 12721: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 12722: }
12723: }
12724: }
12725: foreach my $item (@to_overwrite) {
12726: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
12727: if (($item ne '') && ($item !~ /\.\./)) {
12728: if (-f "$dir/$item") {
12729: unlink("$dir/$item");
12730: } elsif (-d "$dir/$item") {
1.1300 raeburn 12731: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 12732: }
12733: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
12734: }
1.1065 raeburn 12735: }
12736: }
1.1292 raeburn 12737: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 12738: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 12739: }
1.1065 raeburn 12740: }
12741: } else {
12742: ($decompressed,$display) =
12743: &decompress_uploaded_file($file,$dir);
12744: }
1.1055 raeburn 12745: if ($decompressed eq 'ok') {
1.1065 raeburn 12746: $output = '<p class="LC_info">'.
12747: &mt('Files extracted successfully from archive.').
12748: '</p>'."\n";
1.1055 raeburn 12749: my ($warning,$result,@contents);
12750: my ($newdirlistref,$newlisterror) =
12751: &Apache::lonnet::dirlist($currdir,$docudom,
12752: $docuname,1);
12753: my (%is_dir,%changes,@newitems);
12754: my $dirptr = 16384;
1.1065 raeburn 12755: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12756: foreach my $dir_line (@{$newdirlistref}) {
12757: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 12758: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 12759: push(@newitems,$item);
12760: if ($dirptr&$testdir) {
12761: $is_dir{$item} = 1;
12762: }
12763: $changes{$item} = 1;
12764: }
12765: }
12766: }
12767: if (keys(%changes) > 0) {
12768: foreach my $item (sort(@newitems)) {
12769: if ($changes{$item}) {
12770: push(@contents,$item);
12771: }
12772: }
12773: }
12774: if (@contents > 0) {
1.1067 raeburn 12775: my $wantform;
12776: unless ($env{'form.autoextract_camtasia'}) {
12777: $wantform = 1;
12778: }
1.1056 raeburn 12779: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12780: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12781: $currdir,\%is_dir,
12782: \%children,\%parent,
1.1056 raeburn 12783: \@contents,\%dirorder,
12784: \%titles,$wantform);
1.1055 raeburn 12785: if ($datatable ne '') {
12786: $output .= &archive_options_form('decompressed',$datatable,
12787: $count,$hiddenelem);
1.1065 raeburn 12788: my $startcount = 6;
1.1055 raeburn 12789: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12790: \%titles,\%children);
1.1055 raeburn 12791: }
1.1067 raeburn 12792: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12793: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12794: my %displayed;
12795: my $total = 1;
12796: $env{'form.archive_directory'} = [];
12797: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12798: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12799: $path =~ s{/$}{};
12800: my $item;
12801: if ($path ne '') {
12802: $item = "$path/$titles{$i}";
12803: } else {
12804: $item = $titles{$i};
12805: }
12806: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12807: if ($item eq $contents[0]) {
12808: push(@{$env{'form.archive_directory'}},$i);
12809: $env{'form.archive_'.$i} = 'display';
12810: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12811: $displayed{'folder'} = $i;
1.1164 raeburn 12812: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12813: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12814: $env{'form.archive_'.$i} = 'display';
12815: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12816: $displayed{'web'} = $i;
12817: } else {
1.1164 raeburn 12818: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12819: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12820: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12821: push(@{$env{'form.archive_directory'}},$i);
12822: }
12823: $env{'form.archive_'.$i} = 'dependency';
12824: }
12825: $total ++;
12826: }
12827: for (my $i=1; $i<$total; $i++) {
12828: next if ($i == $displayed{'web'});
12829: next if ($i == $displayed{'folder'});
12830: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12831: }
12832: $env{'form.phase'} = 'decompress_cleanup';
12833: $env{'form.archivedelete'} = 1;
12834: $env{'form.archive_count'} = $total-1;
12835: $output .=
12836: &process_extracted_files('coursedocs',$docudom,
12837: $docuname,$destination,
12838: $dir_root,$hiddenelem);
12839: }
1.1055 raeburn 12840: } else {
12841: $warning = &mt('No new items extracted from archive file.');
12842: }
12843: } else {
12844: $output = $display;
12845: $error = &mt('An error occurred during extraction from the archive file.');
12846: }
12847: }
12848: }
12849: }
12850: if ($error) {
12851: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12852: $error.'</p>'."\n";
12853: }
12854: if ($warning) {
12855: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12856: }
12857: return $output;
12858: }
12859:
12860: sub get_extracted {
1.1056 raeburn 12861: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12862: $titles,$wantform) = @_;
1.1055 raeburn 12863: my $count = 0;
12864: my $depth = 0;
12865: my $datatable;
1.1056 raeburn 12866: my @hierarchy;
1.1055 raeburn 12867: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12868: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12869: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12870: foreach my $item (@{$contents}) {
12871: $count ++;
1.1056 raeburn 12872: @{$dirorder->{$count}} = @hierarchy;
12873: $titles->{$count} = $item;
1.1055 raeburn 12874: &archive_hierarchy($depth,$count,$parent,$children);
12875: if ($wantform) {
12876: $datatable .= &archive_row($is_dir->{$item},$item,
12877: $currdir,$depth,$count);
12878: }
12879: if ($is_dir->{$item}) {
12880: $depth ++;
1.1056 raeburn 12881: push(@hierarchy,$count);
12882: $parent->{$depth} = $count;
1.1055 raeburn 12883: $datatable .=
12884: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12885: \$depth,\$count,\@hierarchy,$dirorder,
12886: $children,$parent,$titles,$wantform);
1.1055 raeburn 12887: $depth --;
1.1056 raeburn 12888: pop(@hierarchy);
1.1055 raeburn 12889: }
12890: }
12891: return ($count,$datatable);
12892: }
12893:
12894: sub recurse_extracted_archive {
1.1056 raeburn 12895: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12896: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12897: my $result='';
1.1056 raeburn 12898: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12899: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12900: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12901: return $result;
12902: }
12903: my $dirptr = 16384;
12904: my ($newdirlistref,$newlisterror) =
12905: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12906: if (ref($newdirlistref) eq 'ARRAY') {
12907: foreach my $dir_line (@{$newdirlistref}) {
12908: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12909: unless ($item =~ /^\.+$/) {
12910: $$count ++;
1.1056 raeburn 12911: @{$dirorder->{$$count}} = @{$hierarchy};
12912: $titles->{$$count} = $item;
1.1055 raeburn 12913: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12914:
1.1055 raeburn 12915: my $is_dir;
12916: if ($dirptr&$testdir) {
12917: $is_dir = 1;
12918: }
12919: if ($wantform) {
12920: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12921: }
12922: if ($is_dir) {
12923: $$depth ++;
1.1056 raeburn 12924: push(@{$hierarchy},$$count);
12925: $parent->{$$depth} = $$count;
1.1055 raeburn 12926: $result .=
12927: &recurse_extracted_archive("$currdir/$item",$docudom,
12928: $docuname,$depth,$count,
1.1056 raeburn 12929: $hierarchy,$dirorder,$children,
12930: $parent,$titles,$wantform);
1.1055 raeburn 12931: $$depth --;
1.1056 raeburn 12932: pop(@{$hierarchy});
1.1055 raeburn 12933: }
12934: }
12935: }
12936: }
12937: return $result;
12938: }
12939:
12940: sub archive_hierarchy {
12941: my ($depth,$count,$parent,$children) =@_;
12942: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12943: if (exists($parent->{$depth})) {
12944: $children->{$parent->{$depth}} .= $count.':';
12945: }
12946: }
12947: return;
12948: }
12949:
12950: sub archive_row {
12951: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12952: my ($name) = ($item =~ m{([^/]+)$});
12953: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12954: 'display' => 'Add as file',
1.1055 raeburn 12955: 'dependency' => 'Include as dependency',
12956: 'discard' => 'Discard',
12957: );
12958: if ($is_dir) {
1.1059 raeburn 12959: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12960: }
1.1056 raeburn 12961: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12962: my $offset = 0;
1.1055 raeburn 12963: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12964: $offset ++;
1.1065 raeburn 12965: if ($action ne 'display') {
12966: $offset ++;
12967: }
1.1055 raeburn 12968: $output .= '<td><span class="LC_nobreak">'.
12969: '<label><input type="radio" name="archive_'.$count.
12970: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12971: my $text = $choices{$action};
12972: if ($is_dir) {
12973: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12974: if ($action eq 'display') {
1.1059 raeburn 12975: $text = &mt('Add as folder');
1.1055 raeburn 12976: }
1.1056 raeburn 12977: } else {
12978: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12979:
12980: }
12981: $output .= ' /> '.$choices{$action}.'</label></span>';
12982: if ($action eq 'dependency') {
12983: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12984: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12985: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12986: '<option value=""></option>'."\n".
12987: '</select>'."\n".
12988: '</div>';
1.1059 raeburn 12989: } elsif ($action eq 'display') {
12990: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12991: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12992: '</div>';
1.1055 raeburn 12993: }
1.1056 raeburn 12994: $output .= '</td>';
1.1055 raeburn 12995: }
12996: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12997: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12998: for (my $i=0; $i<$depth; $i++) {
12999: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13000: }
13001: if ($is_dir) {
13002: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13003: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13004: } else {
13005: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13006: }
13007: $output .= ' '.$name.'</td>'."\n".
13008: &end_data_table_row();
13009: return $output;
13010: }
13011:
13012: sub archive_options_form {
1.1065 raeburn 13013: my ($form,$display,$count,$hiddenelem) = @_;
13014: my %lt = &Apache::lonlocal::texthash(
13015: perm => 'Permanently remove archive file?',
13016: hows => 'How should each extracted item be incorporated in the course?',
13017: cont => 'Content actions for all',
13018: addf => 'Add as folder/file',
13019: incd => 'Include as dependency for a displayed file',
13020: disc => 'Discard',
13021: no => 'No',
13022: yes => 'Yes',
13023: save => 'Save',
13024: );
13025: my $output = <<"END";
13026: <form name="$form" method="post" action="">
13027: <p><span class="LC_nobreak">$lt{'perm'}
13028: <label>
13029: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13030: </label>
13031:
13032: <label>
13033: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13034: </span>
13035: </p>
13036: <input type="hidden" name="phase" value="decompress_cleanup" />
13037: <br />$lt{'hows'}
13038: <div class="LC_columnSection">
13039: <fieldset>
13040: <legend>$lt{'cont'}</legend>
13041: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13042: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13043: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13044: </fieldset>
13045: </div>
13046: END
13047: return $output.
1.1055 raeburn 13048: &start_data_table()."\n".
1.1065 raeburn 13049: $display."\n".
1.1055 raeburn 13050: &end_data_table()."\n".
13051: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13052: $hiddenelem.
1.1065 raeburn 13053: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13054: '</form>';
13055: }
13056:
13057: sub archive_javascript {
1.1056 raeburn 13058: my ($startcount,$numitems,$titles,$children) = @_;
13059: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13060: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13061: my $scripttag = <<START;
13062: <script type="text/javascript">
13063: // <![CDATA[
13064:
13065: function checkAll(form,prefix) {
13066: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13067: for (var i=0; i < form.elements.length; i++) {
13068: var id = form.elements[i].id;
13069: if ((id != '') && (id != undefined)) {
13070: if (idstr.test(id)) {
13071: if (form.elements[i].type == 'radio') {
13072: form.elements[i].checked = true;
1.1056 raeburn 13073: var nostart = i-$startcount;
1.1059 raeburn 13074: var offset = nostart%7;
13075: var count = (nostart-offset)/7;
1.1056 raeburn 13076: dependencyCheck(form,count,offset);
1.1055 raeburn 13077: }
13078: }
13079: }
13080: }
13081: }
13082:
13083: function propagateCheck(form,count) {
13084: if (count > 0) {
1.1059 raeburn 13085: var startelement = $startcount + ((count-1) * 7);
13086: for (var j=1; j<6; j++) {
13087: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13088: var item = startelement + j;
13089: if (form.elements[item].type == 'radio') {
13090: if (form.elements[item].checked) {
13091: containerCheck(form,count,j);
13092: break;
13093: }
1.1055 raeburn 13094: }
13095: }
13096: }
13097: }
13098: }
13099:
13100: numitems = $numitems
1.1056 raeburn 13101: var titles = new Array(numitems);
13102: var parents = new Array(numitems);
1.1055 raeburn 13103: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13104: parents[i] = new Array;
1.1055 raeburn 13105: }
1.1059 raeburn 13106: var maintitle = '$maintitle';
1.1055 raeburn 13107:
13108: START
13109:
1.1056 raeburn 13110: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13111: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13112: for (my $i=0; $i<@contents; $i ++) {
13113: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13114: }
13115: }
13116:
1.1056 raeburn 13117: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13118: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13119: }
13120:
1.1055 raeburn 13121: $scripttag .= <<END;
13122:
13123: function containerCheck(form,count,offset) {
13124: if (count > 0) {
1.1056 raeburn 13125: dependencyCheck(form,count,offset);
1.1059 raeburn 13126: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13127: form.elements[item].checked = true;
13128: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13129: if (parents[count].length > 0) {
13130: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13131: containerCheck(form,parents[count][j],offset);
13132: }
13133: }
13134: }
13135: }
13136: }
13137:
13138: function dependencyCheck(form,count,offset) {
13139: if (count > 0) {
1.1059 raeburn 13140: var chosen = (offset+$startcount)+7*(count-1);
13141: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13142: var currtype = form.elements[depitem].type;
13143: if (form.elements[chosen].value == 'dependency') {
13144: document.getElementById('arc_depon_'+count).style.display='block';
13145: form.elements[depitem].options.length = 0;
13146: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13147: for (var i=1; i<=numitems; i++) {
13148: if (i == count) {
13149: continue;
13150: }
1.1059 raeburn 13151: var startelement = $startcount + (i-1) * 7;
13152: for (var j=1; j<6; j++) {
13153: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13154: var item = startelement + j;
13155: if (form.elements[item].type == 'radio') {
13156: if (form.elements[item].checked) {
13157: if (form.elements[item].value == 'display') {
13158: var n = form.elements[depitem].options.length;
13159: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13160: }
13161: }
13162: }
13163: }
13164: }
13165: }
13166: } else {
13167: document.getElementById('arc_depon_'+count).style.display='none';
13168: form.elements[depitem].options.length = 0;
13169: form.elements[depitem].options[0] = new Option('Select','',true,true);
13170: }
1.1059 raeburn 13171: titleCheck(form,count,offset);
1.1056 raeburn 13172: }
13173: }
13174:
13175: function propagateSelect(form,count,offset) {
13176: if (count > 0) {
1.1065 raeburn 13177: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13178: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13179: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13180: if (parents[count].length > 0) {
13181: for (var j=0; j<parents[count].length; j++) {
13182: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13183: }
13184: }
13185: }
13186: }
13187: }
1.1056 raeburn 13188:
13189: function containerSelect(form,count,offset,picked) {
13190: if (count > 0) {
1.1065 raeburn 13191: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13192: if (form.elements[item].type == 'radio') {
13193: if (form.elements[item].value == 'dependency') {
13194: if (form.elements[item+1].type == 'select-one') {
13195: for (var i=0; i<form.elements[item+1].options.length; i++) {
13196: if (form.elements[item+1].options[i].value == picked) {
13197: form.elements[item+1].selectedIndex = i;
13198: break;
13199: }
13200: }
13201: }
13202: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13203: if (parents[count].length > 0) {
13204: for (var j=0; j<parents[count].length; j++) {
13205: containerSelect(form,parents[count][j],offset,picked);
13206: }
13207: }
13208: }
13209: }
13210: }
13211: }
13212: }
13213:
1.1059 raeburn 13214: function titleCheck(form,count,offset) {
13215: if (count > 0) {
13216: var chosen = (offset+$startcount)+7*(count-1);
13217: var depitem = $startcount + ((count-1) * 7) + 2;
13218: var currtype = form.elements[depitem].type;
13219: if (form.elements[chosen].value == 'display') {
13220: document.getElementById('arc_title_'+count).style.display='block';
13221: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13222: document.getElementById('archive_title_'+count).value=maintitle;
13223: }
13224: } else {
13225: document.getElementById('arc_title_'+count).style.display='none';
13226: if (currtype == 'text') {
13227: document.getElementById('archive_title_'+count).value='';
13228: }
13229: }
13230: }
13231: return;
13232: }
13233:
1.1055 raeburn 13234: // ]]>
13235: </script>
13236: END
13237: return $scripttag;
13238: }
13239:
13240: sub process_extracted_files {
1.1067 raeburn 13241: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13242: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 13243: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 13244: my @ids=&Apache::lonnet::current_machine_ids();
13245: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13246: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13247: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13248: if (grep(/^\Q$docuhome\E$/,@ids)) {
13249: $prefix = &LONCAPA::propath($docudom,$docuname);
13250: $pathtocheck = "$dir_root/$destination";
13251: $dir = $dir_root;
13252: $ishome = 1;
13253: } else {
13254: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13255: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 13256: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 13257: }
13258: my $currdir = "$dir_root/$destination";
13259: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13260: if ($env{'form.folderpath'}) {
13261: my @items = split('&',$env{'form.folderpath'});
13262: $folders{'0'} = $items[-2];
1.1099 raeburn 13263: if ($env{'form.folderpath'} =~ /\:1$/) {
13264: $containers{'0'}='page';
13265: } else {
13266: $containers{'0'}='sequence';
13267: }
1.1055 raeburn 13268: }
13269: my @archdirs = &get_env_multiple('form.archive_directory');
13270: if ($numitems) {
13271: for (my $i=1; $i<=$numitems; $i++) {
13272: my $path = $env{'form.archive_content_'.$i};
13273: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13274: my $item = $1;
13275: $toplevelitems{$item} = $i;
13276: if (grep(/^\Q$i\E$/,@archdirs)) {
13277: $is_dir{$item} = 1;
13278: }
13279: }
13280: }
13281: }
1.1067 raeburn 13282: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13283: if (keys(%toplevelitems) > 0) {
13284: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13285: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13286: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13287: }
1.1066 raeburn 13288: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13289: if ($numitems) {
13290: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13291: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13292: my $path = $env{'form.archive_content_'.$i};
13293: if ($path =~ /^\Q$pathtocheck\E/) {
13294: if ($env{'form.archive_'.$i} eq 'discard') {
13295: if ($prefix ne '' && $path ne '') {
13296: if (-e $prefix.$path) {
1.1066 raeburn 13297: if ((@archdirs > 0) &&
13298: (grep(/^\Q$i\E$/,@archdirs))) {
13299: $todeletedir{$prefix.$path} = 1;
13300: } else {
13301: $todelete{$prefix.$path} = 1;
13302: }
1.1055 raeburn 13303: }
13304: }
13305: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13306: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13307: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13308: $docstitle = $env{'form.archive_title_'.$i};
13309: if ($docstitle eq '') {
13310: $docstitle = $title;
13311: }
1.1055 raeburn 13312: $outer = 0;
1.1056 raeburn 13313: if (ref($dirorder{$i}) eq 'ARRAY') {
13314: if (@{$dirorder{$i}} > 0) {
13315: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13316: if ($env{'form.archive_'.$item} eq 'display') {
13317: $outer = $item;
13318: last;
13319: }
13320: }
13321: }
13322: }
13323: my ($errtext,$fatal) =
13324: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13325: '/'.$folders{$outer}.'.'.
13326: $containers{$outer});
13327: next if ($fatal);
13328: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13329: if ($context eq 'coursedocs') {
1.1056 raeburn 13330: $mapinner{$i} = time;
1.1055 raeburn 13331: $folders{$i} = 'default_'.$mapinner{$i};
13332: $containers{$i} = 'sequence';
13333: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13334: $folders{$i}.'.'.$containers{$i};
13335: my $newidx = &LONCAPA::map::getresidx();
13336: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13337: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13338: push(@LONCAPA::map::order,$newidx);
13339: my ($outtext,$errtext) =
13340: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13341: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13342: '.'.$containers{$outer},1,1);
1.1056 raeburn 13343: $newseqid{$i} = $newidx;
1.1067 raeburn 13344: unless ($errtext) {
1.1294 raeburn 13345: $result .= '<li>'.&mt('Folder: [_1] added to course',
13346: &HTML::Entities::encode($docstitle,'<>&"')).
13347: '</li>'."\n";
1.1067 raeburn 13348: }
1.1055 raeburn 13349: }
13350: } else {
13351: if ($context eq 'coursedocs') {
13352: my $newidx=&LONCAPA::map::getresidx();
13353: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13354: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13355: $title;
1.1294 raeburn 13356: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
13357: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13358: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13359: }
13360: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13361: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13362: }
13363: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13364: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
13365: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
13366: unless ($ishome) {
13367: my $fetch = "$newdest{$i}/$title";
13368: $fetch =~ s/^\Q$prefix$dir\E//;
13369: $prompttofetch{$fetch} = 1;
13370: }
1.1292 raeburn 13371: }
1.1067 raeburn 13372: }
1.1294 raeburn 13373: $LONCAPA::map::resources[$newidx]=
13374: $docstitle.':'.$url.':false:normal:res';
13375: push(@LONCAPA::map::order, $newidx);
13376: my ($outtext,$errtext)=
13377: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13378: $docuname.'/'.$folders{$outer}.
13379: '.'.$containers{$outer},1,1);
13380: unless ($errtext) {
13381: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13382: $result .= '<li>'.&mt('File: [_1] added to course',
13383: &HTML::Entities::encode($docstitle,'<>&"')).
13384: '</li>'."\n";
13385: }
1.1067 raeburn 13386: }
1.1294 raeburn 13387: } else {
13388: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13389: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 13390: }
1.1055 raeburn 13391: }
13392: }
1.1086 raeburn 13393: }
13394: } else {
1.1294 raeburn 13395: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13396: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 13397: }
13398: }
13399: for (my $i=1; $i<=$numitems; $i++) {
13400: next unless ($env{'form.archive_'.$i} eq 'dependency');
13401: my $path = $env{'form.archive_content_'.$i};
13402: if ($path =~ /^\Q$pathtocheck\E/) {
13403: my ($title) = ($path =~ m{/([^/]+)$});
13404: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13405: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13406: if (ref($dirorder{$i}) eq 'ARRAY') {
13407: my ($itemidx,$fullpath,$relpath);
13408: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13409: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13410: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13411: if ($dirorder{$i}->[$j] eq $container) {
13412: $itemidx = $j;
1.1056 raeburn 13413: }
13414: }
1.1086 raeburn 13415: }
13416: if ($itemidx eq '') {
13417: $itemidx = 0;
13418: }
13419: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13420: if ($mapinner{$referrer{$i}}) {
13421: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13422: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13423: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13424: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13425: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13426: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13427: if (!-e $fullpath) {
13428: mkdir($fullpath,0755);
1.1056 raeburn 13429: }
13430: }
1.1086 raeburn 13431: } else {
13432: last;
1.1056 raeburn 13433: }
1.1086 raeburn 13434: }
13435: }
13436: } elsif ($newdest{$referrer{$i}}) {
13437: $fullpath = $newdest{$referrer{$i}};
13438: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13439: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13440: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13441: last;
13442: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13443: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13444: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13445: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13446: if (!-e $fullpath) {
13447: mkdir($fullpath,0755);
1.1056 raeburn 13448: }
13449: }
1.1086 raeburn 13450: } else {
13451: last;
1.1056 raeburn 13452: }
1.1055 raeburn 13453: }
13454: }
1.1086 raeburn 13455: if ($fullpath ne '') {
13456: if (-e "$prefix$path") {
1.1292 raeburn 13457: unless (rename("$prefix$path","$fullpath/$title")) {
13458: $warning .= &mt('Failed to rename dependency').'<br />';
13459: }
1.1086 raeburn 13460: }
13461: if (-e "$fullpath/$title") {
13462: my $showpath;
13463: if ($relpath ne '') {
13464: $showpath = "$relpath/$title";
13465: } else {
13466: $showpath = "/$title";
13467: }
1.1294 raeburn 13468: $result .= '<li>'.&mt('[_1] included as a dependency',
13469: &HTML::Entities::encode($showpath,'<>&"')).
13470: '</li>'."\n";
1.1292 raeburn 13471: unless ($ishome) {
13472: my $fetch = "$fullpath/$title";
13473: $fetch =~ s/^\Q$prefix$dir\E//;
13474: $prompttofetch{$fetch} = 1;
13475: }
1.1086 raeburn 13476: }
13477: }
1.1055 raeburn 13478: }
1.1086 raeburn 13479: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13480: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 13481: &HTML::Entities::encode($path,'<>&"'),
13482: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13483: '<br />';
1.1055 raeburn 13484: }
13485: } else {
1.1294 raeburn 13486: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 13487: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13488: }
13489: }
13490: if (keys(%todelete)) {
13491: foreach my $key (keys(%todelete)) {
13492: unlink($key);
1.1066 raeburn 13493: }
13494: }
13495: if (keys(%todeletedir)) {
13496: foreach my $key (keys(%todeletedir)) {
13497: rmdir($key);
13498: }
13499: }
13500: foreach my $dir (sort(keys(%is_dir))) {
13501: if (($pathtocheck ne '') && ($dir ne '')) {
13502: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13503: }
13504: }
1.1067 raeburn 13505: if ($result ne '') {
13506: $output .= '<ul>'."\n".
13507: $result."\n".
13508: '</ul>';
13509: }
13510: unless ($ishome) {
13511: my $replicationfail;
13512: foreach my $item (keys(%prompttofetch)) {
13513: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13514: unless ($fetchresult eq 'ok') {
13515: $replicationfail .= '<li>'.$item.'</li>'."\n";
13516: }
13517: }
13518: if ($replicationfail) {
13519: $output .= '<p class="LC_error">'.
13520: &mt('Course home server failed to retrieve:').'<ul>'.
13521: $replicationfail.
13522: '</ul></p>';
13523: }
13524: }
1.1055 raeburn 13525: } else {
13526: $warning = &mt('No items found in archive.');
13527: }
13528: if ($error) {
13529: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13530: $error.'</p>'."\n";
13531: }
13532: if ($warning) {
13533: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13534: }
13535: return $output;
13536: }
13537:
1.1066 raeburn 13538: sub cleanup_empty_dirs {
13539: my ($path) = @_;
13540: if (($path ne '') && (-d $path)) {
13541: if (opendir(my $dirh,$path)) {
13542: my @dircontents = grep(!/^\./,readdir($dirh));
13543: my $numitems = 0;
13544: foreach my $item (@dircontents) {
13545: if (-d "$path/$item") {
1.1111 raeburn 13546: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13547: if (-e "$path/$item") {
13548: $numitems ++;
13549: }
13550: } else {
13551: $numitems ++;
13552: }
13553: }
13554: if ($numitems == 0) {
13555: rmdir($path);
13556: }
13557: closedir($dirh);
13558: }
13559: }
13560: return;
13561: }
13562:
1.41 ng 13563: =pod
1.45 matthew 13564:
1.1162 raeburn 13565: =item * &get_folder_hierarchy()
1.1068 raeburn 13566:
13567: Provides hierarchy of names of folders/sub-folders containing the current
13568: item,
13569:
13570: Inputs: 3
13571: - $navmap - navmaps object
13572:
13573: - $map - url for map (either the trigger itself, or map containing
13574: the resource, which is the trigger).
13575:
13576: - $showitem - 1 => show title for map itself; 0 => do not show.
13577:
13578: Outputs: 1 @pathitems - array of folder/subfolder names.
13579:
13580: =cut
13581:
13582: sub get_folder_hierarchy {
13583: my ($navmap,$map,$showitem) = @_;
13584: my @pathitems;
13585: if (ref($navmap)) {
13586: my $mapres = $navmap->getResourceByUrl($map);
13587: if (ref($mapres)) {
13588: my $pcslist = $mapres->map_hierarchy();
13589: if ($pcslist ne '') {
13590: my @pcs = split(/,/,$pcslist);
13591: foreach my $pc (@pcs) {
13592: if ($pc == 1) {
1.1129 raeburn 13593: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13594: } else {
13595: my $res = $navmap->getByMapPc($pc);
13596: if (ref($res)) {
13597: my $title = $res->compTitle();
13598: $title =~ s/\W+/_/g;
13599: if ($title ne '') {
13600: push(@pathitems,$title);
13601: }
13602: }
13603: }
13604: }
13605: }
1.1071 raeburn 13606: if ($showitem) {
13607: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13608: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13609: } else {
13610: my $maptitle = $mapres->compTitle();
13611: $maptitle =~ s/\W+/_/g;
13612: if ($maptitle ne '') {
13613: push(@pathitems,$maptitle);
13614: }
1.1068 raeburn 13615: }
13616: }
13617: }
13618: }
13619: return @pathitems;
13620: }
13621:
13622: =pod
13623:
1.1015 raeburn 13624: =item * &get_turnedin_filepath()
13625:
13626: Determines path in a user's portfolio file for storage of files uploaded
13627: to a specific essayresponse or dropbox item.
13628:
13629: Inputs: 3 required + 1 optional.
13630: $symb is symb for resource, $uname and $udom are for current user (required).
13631: $caller is optional (can be "submission", if routine is called when storing
13632: an upoaded file when "Submit Answer" button was pressed).
13633:
13634: Returns array containing $path and $multiresp.
13635: $path is path in portfolio. $multiresp is 1 if this resource contains more
13636: than one file upload item. Callers of routine should append partid as a
13637: subdirectory to $path in cases where $multiresp is 1.
13638:
13639: Called by: homework/essayresponse.pm and homework/structuretags.pm
13640:
13641: =cut
13642:
13643: sub get_turnedin_filepath {
13644: my ($symb,$uname,$udom,$caller) = @_;
13645: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13646: my $turnindir;
13647: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13648: $turnindir = $userhash{'turnindir'};
13649: my ($path,$multiresp);
13650: if ($turnindir eq '') {
13651: if ($caller eq 'submission') {
13652: $turnindir = &mt('turned in');
13653: $turnindir =~ s/\W+/_/g;
13654: my %newhash = (
13655: 'turnindir' => $turnindir,
13656: );
13657: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13658: }
13659: }
13660: if ($turnindir ne '') {
13661: $path = '/'.$turnindir.'/';
13662: my ($multipart,$turnin,@pathitems);
13663: my $navmap = Apache::lonnavmaps::navmap->new();
13664: if (defined($navmap)) {
13665: my $mapres = $navmap->getResourceByUrl($map);
13666: if (ref($mapres)) {
13667: my $pcslist = $mapres->map_hierarchy();
13668: if ($pcslist ne '') {
13669: foreach my $pc (split(/,/,$pcslist)) {
13670: my $res = $navmap->getByMapPc($pc);
13671: if (ref($res)) {
13672: my $title = $res->compTitle();
13673: $title =~ s/\W+/_/g;
13674: if ($title ne '') {
1.1149 raeburn 13675: if (($pc > 1) && (length($title) > 12)) {
13676: $title = substr($title,0,12);
13677: }
1.1015 raeburn 13678: push(@pathitems,$title);
13679: }
13680: }
13681: }
13682: }
13683: my $maptitle = $mapres->compTitle();
13684: $maptitle =~ s/\W+/_/g;
13685: if ($maptitle ne '') {
1.1149 raeburn 13686: if (length($maptitle) > 12) {
13687: $maptitle = substr($maptitle,0,12);
13688: }
1.1015 raeburn 13689: push(@pathitems,$maptitle);
13690: }
13691: unless ($env{'request.state'} eq 'construct') {
13692: my $res = $navmap->getBySymb($symb);
13693: if (ref($res)) {
13694: my $partlist = $res->parts();
13695: my $totaluploads = 0;
13696: if (ref($partlist) eq 'ARRAY') {
13697: foreach my $part (@{$partlist}) {
13698: my @types = $res->responseType($part);
13699: my @ids = $res->responseIds($part);
13700: for (my $i=0; $i < scalar(@ids); $i++) {
13701: if ($types[$i] eq 'essay') {
13702: my $partid = $part.'_'.$ids[$i];
13703: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13704: $totaluploads ++;
13705: }
13706: }
13707: }
13708: }
13709: if ($totaluploads > 1) {
13710: $multiresp = 1;
13711: }
13712: }
13713: }
13714: }
13715: } else {
13716: return;
13717: }
13718: } else {
13719: return;
13720: }
13721: my $restitle=&Apache::lonnet::gettitle($symb);
13722: $restitle =~ s/\W+/_/g;
13723: if ($restitle eq '') {
13724: $restitle = ($resurl =~ m{/[^/]+$});
13725: if ($restitle eq '') {
13726: $restitle = time;
13727: }
13728: }
1.1149 raeburn 13729: if (length($restitle) > 12) {
13730: $restitle = substr($restitle,0,12);
13731: }
1.1015 raeburn 13732: push(@pathitems,$restitle);
13733: $path .= join('/',@pathitems);
13734: }
13735: return ($path,$multiresp);
13736: }
13737:
13738: =pod
13739:
1.464 albertel 13740: =back
1.41 ng 13741:
1.112 bowersj2 13742: =head1 CSV Upload/Handling functions
1.38 albertel 13743:
1.41 ng 13744: =over 4
13745:
1.648 raeburn 13746: =item * &upfile_store($r)
1.41 ng 13747:
13748: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13749: needs $env{'form.upfile'}
1.41 ng 13750: returns $datatoken to be put into hidden field
13751:
13752: =cut
1.31 albertel 13753:
13754: sub upfile_store {
13755: my $r=shift;
1.258 albertel 13756: $env{'form.upfile'}=~s/\r/\n/gs;
13757: $env{'form.upfile'}=~s/\f/\n/gs;
13758: $env{'form.upfile'}=~s/\n+/\n/gs;
13759: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13760:
1.1299 raeburn 13761: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
13762: '_enroll_'.$env{'request.course.id'}.'_'.
13763: time.'_'.$$);
13764: return if ($datatoken eq '');
13765:
1.31 albertel 13766: {
1.158 raeburn 13767: my $datafile = $r->dir_config('lonDaemons').
13768: '/tmp/'.$datatoken.'.tmp';
13769: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13770: print $fh $env{'form.upfile'};
1.158 raeburn 13771: close($fh);
13772: }
1.31 albertel 13773: }
13774: return $datatoken;
13775: }
13776:
1.56 matthew 13777: =pod
13778:
1.1290 raeburn 13779: =item * &load_tmp_file($r,$datatoken)
1.41 ng 13780:
13781: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 13782: $datatoken is the name to assign to the temporary file.
1.258 albertel 13783: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13784:
13785: =cut
1.31 albertel 13786:
13787: sub load_tmp_file {
1.1290 raeburn 13788: my ($r,$datatoken) = @_;
13789: return if ($datatoken eq '');
1.31 albertel 13790: my @studentdata=();
13791: {
1.158 raeburn 13792: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 13793: '/tmp/'.$datatoken.'.tmp';
1.158 raeburn 13794: if ( open(my $fh,"<$studentfile") ) {
13795: @studentdata=<$fh>;
13796: close($fh);
13797: }
1.31 albertel 13798: }
1.258 albertel 13799: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13800: }
13801:
1.1290 raeburn 13802: sub valid_datatoken {
13803: my ($datatoken) = @_;
1.1291 raeburn 13804: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {
1.1290 raeburn 13805: return $datatoken;
13806: }
13807: return;
13808: }
13809:
1.56 matthew 13810: =pod
13811:
1.648 raeburn 13812: =item * &upfile_record_sep()
1.41 ng 13813:
13814: Separate uploaded file into records
13815: returns array of records,
1.258 albertel 13816: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13817:
13818: =cut
1.31 albertel 13819:
13820: sub upfile_record_sep {
1.258 albertel 13821: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13822: } else {
1.248 albertel 13823: my @records;
1.258 albertel 13824: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13825: if ($line=~/^\s*$/) { next; }
13826: push(@records,$line);
13827: }
13828: return @records;
1.31 albertel 13829: }
13830: }
13831:
1.56 matthew 13832: =pod
13833:
1.648 raeburn 13834: =item * &record_sep($record)
1.41 ng 13835:
1.258 albertel 13836: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13837:
13838: =cut
13839:
1.263 www 13840: sub takeleft {
13841: my $index=shift;
13842: return substr('0000'.$index,-4,4);
13843: }
13844:
1.31 albertel 13845: sub record_sep {
13846: my $record=shift;
13847: my %components=();
1.258 albertel 13848: if ($env{'form.upfiletype'} eq 'xml') {
13849: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13850: my $i=0;
1.356 albertel 13851: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13852: $field=~s/^(\"|\')//;
13853: $field=~s/(\"|\')$//;
1.263 www 13854: $components{&takeleft($i)}=$field;
1.31 albertel 13855: $i++;
13856: }
1.258 albertel 13857: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13858: my $i=0;
1.356 albertel 13859: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13860: $field=~s/^(\"|\')//;
13861: $field=~s/(\"|\')$//;
1.263 www 13862: $components{&takeleft($i)}=$field;
1.31 albertel 13863: $i++;
13864: }
13865: } else {
1.561 www 13866: my $separator=',';
1.480 banghart 13867: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13868: $separator=';';
1.480 banghart 13869: }
1.31 albertel 13870: my $i=0;
1.561 www 13871: # the character we are looking for to indicate the end of a quote or a record
13872: my $looking_for=$separator;
13873: # do not add the characters to the fields
13874: my $ignore=0;
13875: # we just encountered a separator (or the beginning of the record)
13876: my $just_found_separator=1;
13877: # store the field we are working on here
13878: my $field='';
13879: # work our way through all characters in record
13880: foreach my $character ($record=~/(.)/g) {
13881: if ($character eq $looking_for) {
13882: if ($character ne $separator) {
13883: # Found the end of a quote, again looking for separator
13884: $looking_for=$separator;
13885: $ignore=1;
13886: } else {
13887: # Found a separator, store away what we got
13888: $components{&takeleft($i)}=$field;
13889: $i++;
13890: $just_found_separator=1;
13891: $ignore=0;
13892: $field='';
13893: }
13894: next;
13895: }
13896: # single or double quotation marks after a separator indicate beginning of a quote
13897: # we are now looking for the end of the quote and need to ignore separators
13898: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13899: $looking_for=$character;
13900: next;
13901: }
13902: # ignore would be true after we reached the end of a quote
13903: if ($ignore) { next; }
13904: if (($just_found_separator) && ($character=~/\s/)) { next; }
13905: $field.=$character;
13906: $just_found_separator=0;
1.31 albertel 13907: }
1.561 www 13908: # catch the very last entry, since we never encountered the separator
13909: $components{&takeleft($i)}=$field;
1.31 albertel 13910: }
13911: return %components;
13912: }
13913:
1.144 matthew 13914: ######################################################
13915: ######################################################
13916:
1.56 matthew 13917: =pod
13918:
1.648 raeburn 13919: =item * &upfile_select_html()
1.41 ng 13920:
1.144 matthew 13921: Return HTML code to select a file from the users machine and specify
13922: the file type.
1.41 ng 13923:
13924: =cut
13925:
1.144 matthew 13926: ######################################################
13927: ######################################################
1.31 albertel 13928: sub upfile_select_html {
1.144 matthew 13929: my %Types = (
13930: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13931: semisv => &mt('Semicolon separated values'),
1.144 matthew 13932: space => &mt('Space separated'),
13933: tab => &mt('Tabulator separated'),
13934: # xml => &mt('HTML/XML'),
13935: );
13936: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13937: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13938: foreach my $type (sort(keys(%Types))) {
13939: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13940: }
13941: $Str .= "</select>\n";
13942: return $Str;
1.31 albertel 13943: }
13944:
1.301 albertel 13945: sub get_samples {
13946: my ($records,$toget) = @_;
13947: my @samples=({});
13948: my $got=0;
13949: foreach my $rec (@$records) {
13950: my %temp = &record_sep($rec);
13951: if (! grep(/\S/, values(%temp))) { next; }
13952: if (%temp) {
13953: $samples[$got]=\%temp;
13954: $got++;
13955: if ($got == $toget) { last; }
13956: }
13957: }
13958: return \@samples;
13959: }
13960:
1.144 matthew 13961: ######################################################
13962: ######################################################
13963:
1.56 matthew 13964: =pod
13965:
1.648 raeburn 13966: =item * &csv_print_samples($r,$records)
1.41 ng 13967:
13968: Prints a table of sample values from each column uploaded $r is an
13969: Apache Request ref, $records is an arrayref from
13970: &Apache::loncommon::upfile_record_sep
13971:
13972: =cut
13973:
1.144 matthew 13974: ######################################################
13975: ######################################################
1.31 albertel 13976: sub csv_print_samples {
13977: my ($r,$records) = @_;
1.662 bisitz 13978: my $samples = &get_samples($records,5);
1.301 albertel 13979:
1.594 raeburn 13980: $r->print(&mt('Samples').'<br />'.&start_data_table().
13981: &start_data_table_header_row());
1.356 albertel 13982: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13983: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13984: $r->print(&end_data_table_header_row());
1.301 albertel 13985: foreach my $hash (@$samples) {
1.594 raeburn 13986: $r->print(&start_data_table_row());
1.356 albertel 13987: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13988: $r->print('<td>');
1.356 albertel 13989: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13990: $r->print('</td>');
13991: }
1.594 raeburn 13992: $r->print(&end_data_table_row());
1.31 albertel 13993: }
1.594 raeburn 13994: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13995: }
13996:
1.144 matthew 13997: ######################################################
13998: ######################################################
13999:
1.56 matthew 14000: =pod
14001:
1.648 raeburn 14002: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14003:
14004: Prints a table to create associations between values and table columns.
1.144 matthew 14005:
1.41 ng 14006: $r is an Apache Request ref,
14007: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14008: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14009:
14010: =cut
14011:
1.144 matthew 14012: ######################################################
14013: ######################################################
1.31 albertel 14014: sub csv_print_select_table {
14015: my ($r,$records,$d) = @_;
1.301 albertel 14016: my $i=0;
14017: my $samples = &get_samples($records,1);
1.144 matthew 14018: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14019: &start_data_table().&start_data_table_header_row().
1.144 matthew 14020: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14021: '<th>'.&mt('Column').'</th>'.
14022: &end_data_table_header_row()."\n");
1.356 albertel 14023: foreach my $array_ref (@$d) {
14024: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14025: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14026:
1.875 bisitz 14027: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14028: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14029: $r->print('<option value="none"></option>');
1.356 albertel 14030: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14031: $r->print('<option value="'.$sample.'"'.
14032: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14033: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14034: }
1.594 raeburn 14035: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14036: $i++;
14037: }
1.594 raeburn 14038: $r->print(&end_data_table());
1.31 albertel 14039: $i--;
14040: return $i;
14041: }
1.56 matthew 14042:
1.144 matthew 14043: ######################################################
14044: ######################################################
14045:
1.56 matthew 14046: =pod
1.31 albertel 14047:
1.648 raeburn 14048: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14049:
14050: Prints a table of sample values from the upload and can make associate samples to internal names.
14051:
14052: $r is an Apache Request ref,
14053: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14054: $d is an array of 2 element arrays (internal name, displayed name)
14055:
14056: =cut
14057:
1.144 matthew 14058: ######################################################
14059: ######################################################
1.31 albertel 14060: sub csv_samples_select_table {
14061: my ($r,$records,$d) = @_;
14062: my $i=0;
1.144 matthew 14063: #
1.662 bisitz 14064: my $max_samples = 5;
14065: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14066: $r->print(&start_data_table().
14067: &start_data_table_header_row().'<th>'.
14068: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14069: &end_data_table_header_row());
1.301 albertel 14070:
14071: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14072: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14073: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14074: foreach my $option (@$d) {
14075: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14076: $r->print('<option value="'.$value.'"'.
1.253 albertel 14077: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14078: $display.'</option>');
1.31 albertel 14079: }
14080: $r->print('</select></td><td>');
1.662 bisitz 14081: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14082: if (defined($samples->[$line]{$key})) {
14083: $r->print($samples->[$line]{$key}."<br />\n");
14084: }
14085: }
1.594 raeburn 14086: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14087: $i++;
14088: }
1.594 raeburn 14089: $r->print(&end_data_table());
1.31 albertel 14090: $i--;
14091: return($i);
1.115 matthew 14092: }
14093:
1.144 matthew 14094: ######################################################
14095: ######################################################
14096:
1.115 matthew 14097: =pod
14098:
1.648 raeburn 14099: =item * &clean_excel_name($name)
1.115 matthew 14100:
14101: Returns a replacement for $name which does not contain any illegal characters.
14102:
14103: =cut
14104:
1.144 matthew 14105: ######################################################
14106: ######################################################
1.115 matthew 14107: sub clean_excel_name {
14108: my ($name) = @_;
14109: $name =~ s/[:\*\?\/\\]//g;
14110: if (length($name) > 31) {
14111: $name = substr($name,0,31);
14112: }
14113: return $name;
1.25 albertel 14114: }
1.84 albertel 14115:
1.85 albertel 14116: =pod
14117:
1.648 raeburn 14118: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14119:
14120: Returns either 1 or undef
14121:
14122: 1 if the part is to be hidden, undef if it is to be shown
14123:
14124: Arguments are:
14125:
14126: $id the id of the part to be checked
14127: $symb, optional the symb of the resource to check
14128: $udom, optional the domain of the user to check for
14129: $uname, optional the username of the user to check for
14130:
14131: =cut
1.84 albertel 14132:
14133: sub check_if_partid_hidden {
14134: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14135: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14136: $symb,$udom,$uname);
1.141 albertel 14137: my $truth=1;
14138: #if the string starts with !, then the list is the list to show not hide
14139: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14140: my @hiddenlist=split(/,/,$hiddenparts);
14141: foreach my $checkid (@hiddenlist) {
1.141 albertel 14142: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14143: }
1.141 albertel 14144: return !$truth;
1.84 albertel 14145: }
1.127 matthew 14146:
1.138 matthew 14147:
14148: ############################################################
14149: ############################################################
14150:
14151: =pod
14152:
1.157 matthew 14153: =back
14154:
1.138 matthew 14155: =head1 cgi-bin script and graphing routines
14156:
1.157 matthew 14157: =over 4
14158:
1.648 raeburn 14159: =item * &get_cgi_id()
1.138 matthew 14160:
14161: Inputs: none
14162:
14163: Returns an id which can be used to pass environment variables
14164: to various cgi-bin scripts. These environment variables will
14165: be removed from the users environment after a given time by
14166: the routine &Apache::lonnet::transfer_profile_to_env.
14167:
14168: =cut
14169:
14170: ############################################################
14171: ############################################################
1.152 albertel 14172: my $uniq=0;
1.136 matthew 14173: sub get_cgi_id {
1.154 albertel 14174: $uniq=($uniq+1)%100000;
1.280 albertel 14175: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14176: }
14177:
1.127 matthew 14178: ############################################################
14179: ############################################################
14180:
14181: =pod
14182:
1.648 raeburn 14183: =item * &DrawBarGraph()
1.127 matthew 14184:
1.138 matthew 14185: Facilitates the plotting of data in a (stacked) bar graph.
14186: Puts plot definition data into the users environment in order for
14187: graph.png to plot it. Returns an <img> tag for the plot.
14188: The bars on the plot are labeled '1','2',...,'n'.
14189:
14190: Inputs:
14191:
14192: =over 4
14193:
14194: =item $Title: string, the title of the plot
14195:
14196: =item $xlabel: string, text describing the X-axis of the plot
14197:
14198: =item $ylabel: string, text describing the Y-axis of the plot
14199:
14200: =item $Max: scalar, the maximum Y value to use in the plot
14201: If $Max is < any data point, the graph will not be rendered.
14202:
1.140 matthew 14203: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14204: they are plotted. If undefined, default values will be used.
14205:
1.178 matthew 14206: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14207:
1.138 matthew 14208: =item @Values: An array of array references. Each array reference holds data
14209: to be plotted in a stacked bar chart.
14210:
1.239 matthew 14211: =item If the final element of @Values is a hash reference the key/value
14212: pairs will be added to the graph definition.
14213:
1.138 matthew 14214: =back
14215:
14216: Returns:
14217:
14218: An <img> tag which references graph.png and the appropriate identifying
14219: information for the plot.
14220:
1.127 matthew 14221: =cut
14222:
14223: ############################################################
14224: ############################################################
1.134 matthew 14225: sub DrawBarGraph {
1.178 matthew 14226: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14227: #
14228: if (! defined($colors)) {
14229: $colors = ['#33ff00',
14230: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14231: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14232: ];
14233: }
1.228 matthew 14234: my $extra_settings = {};
14235: if (ref($Values[-1]) eq 'HASH') {
14236: $extra_settings = pop(@Values);
14237: }
1.127 matthew 14238: #
1.136 matthew 14239: my $identifier = &get_cgi_id();
14240: my $id = 'cgi.'.$identifier;
1.129 matthew 14241: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14242: return '';
14243: }
1.225 matthew 14244: #
14245: my @Labels;
14246: if (defined($labels)) {
14247: @Labels = @$labels;
14248: } else {
14249: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 14250: push(@Labels,$i+1);
1.225 matthew 14251: }
14252: }
14253: #
1.129 matthew 14254: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14255: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14256: my %ValuesHash;
14257: my $NumSets=1;
14258: foreach my $array (@Values) {
14259: next if (! ref($array));
1.136 matthew 14260: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14261: join(',',@$array);
1.129 matthew 14262: }
1.127 matthew 14263: #
1.136 matthew 14264: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14265: if ($NumBars < 3) {
14266: $width = 120+$NumBars*32;
1.220 matthew 14267: $xskip = 1;
1.225 matthew 14268: $bar_width = 30;
14269: } elsif ($NumBars < 5) {
14270: $width = 120+$NumBars*20;
14271: $xskip = 1;
14272: $bar_width = 20;
1.220 matthew 14273: } elsif ($NumBars < 10) {
1.136 matthew 14274: $width = 120+$NumBars*15;
14275: $xskip = 1;
14276: $bar_width = 15;
14277: } elsif ($NumBars <= 25) {
14278: $width = 120+$NumBars*11;
14279: $xskip = 5;
14280: $bar_width = 8;
14281: } elsif ($NumBars <= 50) {
14282: $width = 120+$NumBars*8;
14283: $xskip = 5;
14284: $bar_width = 4;
14285: } else {
14286: $width = 120+$NumBars*8;
14287: $xskip = 5;
14288: $bar_width = 4;
14289: }
14290: #
1.137 matthew 14291: $Max = 1 if ($Max < 1);
14292: if ( int($Max) < $Max ) {
14293: $Max++;
14294: $Max = int($Max);
14295: }
1.127 matthew 14296: $Title = '' if (! defined($Title));
14297: $xlabel = '' if (! defined($xlabel));
14298: $ylabel = '' if (! defined($ylabel));
1.369 www 14299: $ValuesHash{$id.'.title'} = &escape($Title);
14300: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14301: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14302: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14303: $ValuesHash{$id.'.NumBars'} = $NumBars;
14304: $ValuesHash{$id.'.NumSets'} = $NumSets;
14305: $ValuesHash{$id.'.PlotType'} = 'bar';
14306: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14307: $ValuesHash{$id.'.height'} = $height;
14308: $ValuesHash{$id.'.width'} = $width;
14309: $ValuesHash{$id.'.xskip'} = $xskip;
14310: $ValuesHash{$id.'.bar_width'} = $bar_width;
14311: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14312: #
1.228 matthew 14313: # Deal with other parameters
14314: while (my ($key,$value) = each(%$extra_settings)) {
14315: $ValuesHash{$id.'.'.$key} = $value;
14316: }
14317: #
1.646 raeburn 14318: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14319: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14320: }
14321:
14322: ############################################################
14323: ############################################################
14324:
14325: =pod
14326:
1.648 raeburn 14327: =item * &DrawXYGraph()
1.137 matthew 14328:
1.138 matthew 14329: Facilitates the plotting of data in an XY graph.
14330: Puts plot definition data into the users environment in order for
14331: graph.png to plot it. Returns an <img> tag for the plot.
14332:
14333: Inputs:
14334:
14335: =over 4
14336:
14337: =item $Title: string, the title of the plot
14338:
14339: =item $xlabel: string, text describing the X-axis of the plot
14340:
14341: =item $ylabel: string, text describing the Y-axis of the plot
14342:
14343: =item $Max: scalar, the maximum Y value to use in the plot
14344: If $Max is < any data point, the graph will not be rendered.
14345:
14346: =item $colors: Array ref containing the hex color codes for the data to be
14347: plotted in. If undefined, default values will be used.
14348:
14349: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14350:
14351: =item $Ydata: Array ref containing Array refs.
1.185 www 14352: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14353:
14354: =item %Values: hash indicating or overriding any default values which are
14355: passed to graph.png.
14356: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14357:
14358: =back
14359:
14360: Returns:
14361:
14362: An <img> tag which references graph.png and the appropriate identifying
14363: information for the plot.
14364:
1.137 matthew 14365: =cut
14366:
14367: ############################################################
14368: ############################################################
14369: sub DrawXYGraph {
14370: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14371: #
14372: # Create the identifier for the graph
14373: my $identifier = &get_cgi_id();
14374: my $id = 'cgi.'.$identifier;
14375: #
14376: $Title = '' if (! defined($Title));
14377: $xlabel = '' if (! defined($xlabel));
14378: $ylabel = '' if (! defined($ylabel));
14379: my %ValuesHash =
14380: (
1.369 www 14381: $id.'.title' => &escape($Title),
14382: $id.'.xlabel' => &escape($xlabel),
14383: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14384: $id.'.y_max_value'=> $Max,
14385: $id.'.labels' => join(',',@$Xlabels),
14386: $id.'.PlotType' => 'XY',
14387: );
14388: #
14389: if (defined($colors) && ref($colors) eq 'ARRAY') {
14390: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14391: }
14392: #
14393: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14394: return '';
14395: }
14396: my $NumSets=1;
1.138 matthew 14397: foreach my $array (@{$Ydata}){
1.137 matthew 14398: next if (! ref($array));
14399: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14400: }
1.138 matthew 14401: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14402: #
14403: # Deal with other parameters
14404: while (my ($key,$value) = each(%Values)) {
14405: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14406: }
14407: #
1.646 raeburn 14408: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14409: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14410: }
14411:
14412: ############################################################
14413: ############################################################
14414:
14415: =pod
14416:
1.648 raeburn 14417: =item * &DrawXYYGraph()
1.138 matthew 14418:
14419: Facilitates the plotting of data in an XY graph with two Y axes.
14420: Puts plot definition data into the users environment in order for
14421: graph.png to plot it. Returns an <img> tag for the plot.
14422:
14423: Inputs:
14424:
14425: =over 4
14426:
14427: =item $Title: string, the title of the plot
14428:
14429: =item $xlabel: string, text describing the X-axis of the plot
14430:
14431: =item $ylabel: string, text describing the Y-axis of the plot
14432:
14433: =item $colors: Array ref containing the hex color codes for the data to be
14434: plotted in. If undefined, default values will be used.
14435:
14436: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14437:
14438: =item $Ydata1: The first data set
14439:
14440: =item $Min1: The minimum value of the left Y-axis
14441:
14442: =item $Max1: The maximum value of the left Y-axis
14443:
14444: =item $Ydata2: The second data set
14445:
14446: =item $Min2: The minimum value of the right Y-axis
14447:
14448: =item $Max2: The maximum value of the left Y-axis
14449:
14450: =item %Values: hash indicating or overriding any default values which are
14451: passed to graph.png.
14452: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14453:
14454: =back
14455:
14456: Returns:
14457:
14458: An <img> tag which references graph.png and the appropriate identifying
14459: information for the plot.
1.136 matthew 14460:
14461: =cut
14462:
14463: ############################################################
14464: ############################################################
1.137 matthew 14465: sub DrawXYYGraph {
14466: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14467: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14468: #
14469: # Create the identifier for the graph
14470: my $identifier = &get_cgi_id();
14471: my $id = 'cgi.'.$identifier;
14472: #
14473: $Title = '' if (! defined($Title));
14474: $xlabel = '' if (! defined($xlabel));
14475: $ylabel = '' if (! defined($ylabel));
14476: my %ValuesHash =
14477: (
1.369 www 14478: $id.'.title' => &escape($Title),
14479: $id.'.xlabel' => &escape($xlabel),
14480: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14481: $id.'.labels' => join(',',@$Xlabels),
14482: $id.'.PlotType' => 'XY',
14483: $id.'.NumSets' => 2,
1.137 matthew 14484: $id.'.two_axes' => 1,
14485: $id.'.y1_max_value' => $Max1,
14486: $id.'.y1_min_value' => $Min1,
14487: $id.'.y2_max_value' => $Max2,
14488: $id.'.y2_min_value' => $Min2,
1.136 matthew 14489: );
14490: #
1.137 matthew 14491: if (defined($colors) && ref($colors) eq 'ARRAY') {
14492: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14493: }
14494: #
14495: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14496: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14497: return '';
14498: }
14499: my $NumSets=1;
1.137 matthew 14500: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14501: next if (! ref($array));
14502: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14503: }
14504: #
14505: # Deal with other parameters
14506: while (my ($key,$value) = each(%Values)) {
14507: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14508: }
14509: #
1.646 raeburn 14510: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14511: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14512: }
14513:
14514: ############################################################
14515: ############################################################
14516:
14517: =pod
14518:
1.157 matthew 14519: =back
14520:
1.139 matthew 14521: =head1 Statistics helper routines?
14522:
14523: Bad place for them but what the hell.
14524:
1.157 matthew 14525: =over 4
14526:
1.648 raeburn 14527: =item * &chartlink()
1.139 matthew 14528:
14529: Returns a link to the chart for a specific student.
14530:
14531: Inputs:
14532:
14533: =over 4
14534:
14535: =item $linktext: The text of the link
14536:
14537: =item $sname: The students username
14538:
14539: =item $sdomain: The students domain
14540:
14541: =back
14542:
1.157 matthew 14543: =back
14544:
1.139 matthew 14545: =cut
14546:
14547: ############################################################
14548: ############################################################
14549: sub chartlink {
14550: my ($linktext, $sname, $sdomain) = @_;
14551: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14552: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14553: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14554: '">'.$linktext.'</a>';
1.153 matthew 14555: }
14556:
14557: #######################################################
14558: #######################################################
14559:
14560: =pod
14561:
14562: =head1 Course Environment Routines
1.157 matthew 14563:
14564: =over 4
1.153 matthew 14565:
1.648 raeburn 14566: =item * &restore_course_settings()
1.153 matthew 14567:
1.648 raeburn 14568: =item * &store_course_settings()
1.153 matthew 14569:
14570: Restores/Store indicated form parameters from the course environment.
14571: Will not overwrite existing values of the form parameters.
14572:
14573: Inputs:
14574: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14575:
14576: a hash ref describing the data to be stored. For example:
14577:
14578: %Save_Parameters = ('Status' => 'scalar',
14579: 'chartoutputmode' => 'scalar',
14580: 'chartoutputdata' => 'scalar',
14581: 'Section' => 'array',
1.373 raeburn 14582: 'Group' => 'array',
1.153 matthew 14583: 'StudentData' => 'array',
14584: 'Maps' => 'array');
14585:
14586: Returns: both routines return nothing
14587:
1.631 raeburn 14588: =back
14589:
1.153 matthew 14590: =cut
14591:
14592: #######################################################
14593: #######################################################
14594: sub store_course_settings {
1.496 albertel 14595: return &store_settings($env{'request.course.id'},@_);
14596: }
14597:
14598: sub store_settings {
1.153 matthew 14599: # save to the environment
14600: # appenv the same items, just to be safe
1.300 albertel 14601: my $udom = $env{'user.domain'};
14602: my $uname = $env{'user.name'};
1.496 albertel 14603: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14604: my %SaveHash;
14605: my %AppHash;
14606: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14607: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14608: my $envname = 'environment.'.$basename;
1.258 albertel 14609: if (exists($env{'form.'.$setting})) {
1.153 matthew 14610: # Save this value away
14611: if ($type eq 'scalar' &&
1.258 albertel 14612: (! exists($env{$envname}) ||
14613: $env{$envname} ne $env{'form.'.$setting})) {
14614: $SaveHash{$basename} = $env{'form.'.$setting};
14615: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14616: } elsif ($type eq 'array') {
14617: my $stored_form;
1.258 albertel 14618: if (ref($env{'form.'.$setting})) {
1.153 matthew 14619: $stored_form = join(',',
14620: map {
1.369 www 14621: &escape($_);
1.258 albertel 14622: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14623: } else {
14624: $stored_form =
1.369 www 14625: &escape($env{'form.'.$setting});
1.153 matthew 14626: }
14627: # Determine if the array contents are the same.
1.258 albertel 14628: if ($stored_form ne $env{$envname}) {
1.153 matthew 14629: $SaveHash{$basename} = $stored_form;
14630: $AppHash{$envname} = $stored_form;
14631: }
14632: }
14633: }
14634: }
14635: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14636: $udom,$uname);
1.153 matthew 14637: if ($put_result !~ /^(ok|delayed)/) {
14638: &Apache::lonnet::logthis('unable to save form parameters, '.
14639: 'got error:'.$put_result);
14640: }
14641: # Make sure these settings stick around in this session, too
1.646 raeburn 14642: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14643: return;
14644: }
14645:
14646: sub restore_course_settings {
1.499 albertel 14647: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14648: }
14649:
14650: sub restore_settings {
14651: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14652: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14653: next if (exists($env{'form.'.$setting}));
1.496 albertel 14654: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14655: '.'.$setting;
1.258 albertel 14656: if (exists($env{$envname})) {
1.153 matthew 14657: if ($type eq 'scalar') {
1.258 albertel 14658: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14659: } elsif ($type eq 'array') {
1.258 albertel 14660: $env{'form.'.$setting} = [
1.153 matthew 14661: map {
1.369 www 14662: &unescape($_);
1.258 albertel 14663: } split(',',$env{$envname})
1.153 matthew 14664: ];
14665: }
14666: }
14667: }
1.127 matthew 14668: }
14669:
1.618 raeburn 14670: #######################################################
14671: #######################################################
14672:
14673: =pod
14674:
14675: =head1 Domain E-mail Routines
14676:
14677: =over 4
14678:
1.648 raeburn 14679: =item * &build_recipient_list()
1.618 raeburn 14680:
1.1144 raeburn 14681: Build recipient lists for following types of e-mail:
1.766 raeburn 14682: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14683: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14684: module change checking, student/employee ID conflict checks, as
14685: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14686: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14687:
14688: Inputs:
1.619 raeburn 14689: defmail (scalar - email address of default recipient),
1.1144 raeburn 14690: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14691: requestsmail, updatesmail, or idconflictsmail).
14692:
1.619 raeburn 14693: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14694:
1.619 raeburn 14695: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 14696: i.e., predates configuration by DC via domainprefs.pm
14697:
14698: $requname username of requester (if mailing type is helpdeskmail)
14699:
14700: $requdom domain of requester (if mailing type is helpdeskmail)
14701:
14702: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14703:
1.618 raeburn 14704:
1.655 raeburn 14705: Returns: comma separated list of addresses to which to send e-mail.
14706:
14707: =back
1.618 raeburn 14708:
14709: =cut
14710:
14711: ############################################################
14712: ############################################################
14713: sub build_recipient_list {
1.1297 raeburn 14714: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14715: my @recipients;
1.1270 raeburn 14716: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14717: my %domconfig =
1.1270 raeburn 14718: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14719: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14720: if (exists($domconfig{'contacts'}{$mailing})) {
14721: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14722: my @contacts = ('adminemail','supportemail');
14723: foreach my $item (@contacts) {
14724: if ($domconfig{'contacts'}{$mailing}{$item}) {
14725: my $addr = $domconfig{'contacts'}{$item};
14726: if (!grep(/^\Q$addr\E$/,@recipients)) {
14727: push(@recipients,$addr);
14728: }
1.619 raeburn 14729: }
1.1270 raeburn 14730: }
14731: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14732: if ($mailing eq 'helpdeskmail') {
14733: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14734: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14735: my @ok_bccs;
14736: foreach my $bcc (@bccs) {
14737: $bcc =~ s/^\s+//g;
14738: $bcc =~ s/\s+$//g;
14739: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14740: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14741: push(@ok_bccs,$bcc);
14742: }
14743: }
14744: }
14745: if (@ok_bccs > 0) {
14746: $allbcc = join(', ',@ok_bccs);
14747: }
14748: }
14749: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14750: }
14751: }
1.766 raeburn 14752: } elsif ($origmail ne '') {
1.1270 raeburn 14753: $lastresort = $origmail;
1.618 raeburn 14754: }
1.1297 raeburn 14755: if ($mailing eq 'helpdeskmail') {
14756: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
14757: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
14758: my ($inststatus,$inststatus_checked);
14759: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
14760: ($env{'user.domain'} ne 'public')) {
14761: $inststatus_checked = 1;
14762: $inststatus = $env{'environment.inststatus'};
14763: }
14764: unless ($inststatus_checked) {
14765: if (($requname ne '') && ($requdom ne '')) {
14766: if (($requname =~ /^$match_username$/) &&
14767: ($requdom =~ /^$match_domain$/) &&
14768: (&Apache::lonnet::domain($requdom))) {
14769: my $requhome = &Apache::lonnet::homeserver($requname,
14770: $requdom);
14771: unless ($requhome eq 'no_host') {
14772: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
14773: $inststatus = $userenv{'inststatus'};
14774: $inststatus_checked = 1;
14775: }
14776: }
14777: }
14778: }
14779: unless ($inststatus_checked) {
14780: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
14781: my %srch = (srchby => 'email',
14782: srchdomain => $defdom,
14783: srchterm => $reqemail,
14784: srchtype => 'exact');
14785: my %srch_results = &Apache::lonnet::usersearch(\%srch);
14786: foreach my $uname (keys(%srch_results)) {
14787: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14788: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14789: $inststatus_checked = 1;
14790: last;
14791: }
14792: }
14793: unless ($inststatus_checked) {
14794: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
14795: if ($dirsrchres eq 'ok') {
14796: foreach my $uname (keys(%srch_results)) {
14797: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14798: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14799: $inststatus_checked = 1;
14800: last;
14801: }
14802: }
14803: }
14804: }
14805: }
14806: }
14807: if ($inststatus ne '') {
14808: foreach my $status (split(/\:/,$inststatus)) {
14809: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
14810: my @contacts = ('adminemail','supportemail');
14811: foreach my $item (@contacts) {
14812: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
14813: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
14814: if (!grep(/^\Q$addr\E$/,@recipients)) {
14815: push(@recipients,$addr);
14816: }
14817: }
14818: }
14819: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
14820: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
14821: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
14822: my @ok_bccs;
14823: foreach my $bcc (@bccs) {
14824: $bcc =~ s/^\s+//g;
14825: $bcc =~ s/\s+$//g;
14826: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14827: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14828: push(@ok_bccs,$bcc);
14829: }
14830: }
14831: }
14832: if (@ok_bccs > 0) {
14833: $allbcc = join(', ',@ok_bccs);
14834: }
14835: }
14836: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
14837: last;
14838: }
14839: }
14840: }
14841: }
14842: }
1.619 raeburn 14843: } elsif ($origmail ne '') {
1.1270 raeburn 14844: $lastresort = $origmail;
14845: }
1.1297 raeburn 14846: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 14847: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
14848: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
14849: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
14850: my %what = (
14851: perlvar => 1,
14852: );
14853: my $primary = &Apache::lonnet::domain($defdom,'primary');
14854: if ($primary) {
14855: my $gotaddr;
14856: my ($result,$returnhash) =
14857: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
14858: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
14859: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
14860: $lastresort = $returnhash->{'lonSupportEMail'};
14861: $gotaddr = 1;
14862: }
14863: }
14864: unless ($gotaddr) {
14865: my $uintdom = &Apache::lonnet::internet_dom($primary);
14866: my $intdom = &Apache::lonnet::internet_dom($lonhost);
14867: unless ($uintdom eq $intdom) {
14868: my %domconfig =
14869: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
14870: if (ref($domconfig{'contacts'}) eq 'HASH') {
14871: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
14872: my @contacts = ('adminemail','supportemail');
14873: foreach my $item (@contacts) {
14874: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
14875: my $addr = $domconfig{'contacts'}{$item};
14876: if (!grep(/^\Q$addr\E$/,@recipients)) {
14877: push(@recipients,$addr);
14878: }
14879: }
14880: }
14881: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
14882: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
14883: }
14884: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
14885: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
14886: my @ok_bccs;
14887: foreach my $bcc (@bccs) {
14888: $bcc =~ s/^\s+//g;
14889: $bcc =~ s/\s+$//g;
14890: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14891: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14892: push(@ok_bccs,$bcc);
14893: }
14894: }
14895: }
14896: if (@ok_bccs > 0) {
14897: $allbcc = join(', ',@ok_bccs);
14898: }
14899: }
14900: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
14901: }
14902: }
14903: }
14904: }
14905: }
14906: }
1.618 raeburn 14907: }
1.688 raeburn 14908: if (defined($defmail)) {
14909: if ($defmail ne '') {
14910: push(@recipients,$defmail);
14911: }
1.618 raeburn 14912: }
14913: if ($otheremails) {
1.619 raeburn 14914: my @others;
14915: if ($otheremails =~ /,/) {
14916: @others = split(/,/,$otheremails);
1.618 raeburn 14917: } else {
1.619 raeburn 14918: push(@others,$otheremails);
14919: }
14920: foreach my $addr (@others) {
14921: if (!grep(/^\Q$addr\E$/,@recipients)) {
14922: push(@recipients,$addr);
14923: }
1.618 raeburn 14924: }
14925: }
1.1298 raeburn 14926: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 14927: if ((!@recipients) && ($lastresort ne '')) {
14928: push(@recipients,$lastresort);
14929: }
14930: } elsif ($lastresort ne '') {
14931: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
14932: push(@recipients,$lastresort);
14933: }
14934: }
1.1271 raeburn 14935: my $recipientlist = join(',',@recipients);
1.1270 raeburn 14936: if (wantarray) {
14937: return ($recipientlist,$allbcc,$addtext);
14938: } else {
14939: return $recipientlist;
14940: }
1.618 raeburn 14941: }
14942:
1.127 matthew 14943: ############################################################
14944: ############################################################
1.154 albertel 14945:
1.655 raeburn 14946: =pod
14947:
1.1224 musolffc 14948: =over 4
14949:
1.1223 musolffc 14950: =item * &mime_email()
14951:
14952: Sends an email with a possible attachment
14953:
14954: Inputs:
14955:
14956: =over 4
14957:
14958: from - Sender's email address
14959:
14960: to - Email address of recipient
14961:
14962: subject - Subject of email
14963:
14964: body - Body of email
14965:
14966: cc_string - Carbon copy email address
14967:
14968: bcc - Blind carbon copy email address
14969:
14970: type - File type of attachment
14971:
14972: attachment_path - Path of file to be attached
14973:
14974: file_name - Name of file to be attached
14975:
14976: attachment_text - The body of an attachment of type "TEXT"
14977:
14978: =back
14979:
14980: =back
14981:
14982: =cut
14983:
14984: ############################################################
14985: ############################################################
14986:
14987: sub mime_email {
14988: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14989: $file_name, $attachment_text) = @_;
14990: my $msg = MIME::Lite->new(
14991: From => $from,
14992: To => $to,
14993: Subject => $subject,
14994: Type =>'TEXT',
14995: Data => $body,
14996: );
14997: if ($cc_string ne '') {
14998: $msg->add("Cc" => $cc_string);
14999: }
15000: if ($bcc ne '') {
15001: $msg->add("Bcc" => $bcc);
15002: }
15003: $msg->attr("content-type" => "text/plain");
15004: $msg->attr("content-type.charset" => "UTF-8");
15005: # Attach file if given
15006: if ($attachment_path) {
15007: unless ($file_name) {
15008: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15009: }
15010: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15011: $msg->attach(Type => $type,
15012: Path => $attachment_path,
15013: Filename => $file_name
15014: );
15015: # Otherwise attach text if given
15016: } elsif ($attachment_text) {
15017: $msg->attach(Type => 'TEXT',
15018: Data => $attachment_text);
15019: }
15020: # Send it
15021: $msg->send('sendmail');
15022: }
15023:
15024: ############################################################
15025: ############################################################
15026:
15027: =pod
15028:
1.655 raeburn 15029: =head1 Course Catalog Routines
15030:
15031: =over 4
15032:
15033: =item * &gather_categories()
15034:
15035: Converts category definitions - keys of categories hash stored in
15036: coursecategories in configuration.db on the primary library server in a
15037: domain - to an array. Also generates javascript and idx hash used to
15038: generate Domain Coordinator interface for editing Course Categories.
15039:
15040: Inputs:
1.663 raeburn 15041:
1.655 raeburn 15042: categories (reference to hash of category definitions).
1.663 raeburn 15043:
1.655 raeburn 15044: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15045: categories and subcategories).
1.663 raeburn 15046:
1.655 raeburn 15047: idx (reference to hash of counters used in Domain Coordinator interface for
15048: editing Course Categories).
1.663 raeburn 15049:
1.655 raeburn 15050: jsarray (reference to array of categories used to create Javascript arrays for
15051: Domain Coordinator interface for editing Course Categories).
15052:
15053: Returns: nothing
15054:
15055: Side effects: populates cats, idx and jsarray.
15056:
15057: =cut
15058:
15059: sub gather_categories {
15060: my ($categories,$cats,$idx,$jsarray) = @_;
15061: my %counters;
15062: my $num = 0;
15063: foreach my $item (keys(%{$categories})) {
15064: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15065: if ($container eq '' && $depth == 0) {
15066: $cats->[$depth][$categories->{$item}] = $cat;
15067: } else {
15068: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15069: }
15070: my ($escitem,$tail) = split(/:/,$item,2);
15071: if ($counters{$tail} eq '') {
15072: $counters{$tail} = $num;
15073: $num ++;
15074: }
15075: if (ref($idx) eq 'HASH') {
15076: $idx->{$item} = $counters{$tail};
15077: }
15078: if (ref($jsarray) eq 'ARRAY') {
15079: push(@{$jsarray->[$counters{$tail}]},$item);
15080: }
15081: }
15082: return;
15083: }
15084:
15085: =pod
15086:
15087: =item * &extract_categories()
15088:
15089: Used to generate breadcrumb trails for course categories.
15090:
15091: Inputs:
1.663 raeburn 15092:
1.655 raeburn 15093: categories (reference to hash of category definitions).
1.663 raeburn 15094:
1.655 raeburn 15095: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15096: categories and subcategories).
1.663 raeburn 15097:
1.655 raeburn 15098: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15099:
1.655 raeburn 15100: allitems (reference to hash - key is category key
15101: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15102:
1.655 raeburn 15103: idx (reference to hash of counters used in Domain Coordinator interface for
15104: editing Course Categories).
1.663 raeburn 15105:
1.655 raeburn 15106: jsarray (reference to array of categories used to create Javascript arrays for
15107: Domain Coordinator interface for editing Course Categories).
15108:
1.665 raeburn 15109: subcats (reference to hash of arrays containing all subcategories within each
15110: category, -recursive)
15111:
1.655 raeburn 15112: Returns: nothing
15113:
15114: Side effects: populates trails and allitems hash references.
15115:
15116: =cut
15117:
15118: sub extract_categories {
1.665 raeburn 15119: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 15120: if (ref($categories) eq 'HASH') {
15121: &gather_categories($categories,$cats,$idx,$jsarray);
15122: if (ref($cats->[0]) eq 'ARRAY') {
15123: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15124: my $name = $cats->[0][$i];
15125: my $item = &escape($name).'::0';
15126: my $trailstr;
15127: if ($name eq 'instcode') {
15128: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15129: } elsif ($name eq 'communities') {
15130: $trailstr = &mt('Communities');
1.1239 raeburn 15131: } elsif ($name eq 'placement') {
15132: $trailstr = &mt('Placement Tests');
1.655 raeburn 15133: } else {
15134: $trailstr = $name;
15135: }
15136: if ($allitems->{$item} eq '') {
15137: push(@{$trails},$trailstr);
15138: $allitems->{$item} = scalar(@{$trails})-1;
15139: }
15140: my @parents = ($name);
15141: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15142: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15143: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15144: if (ref($subcats) eq 'HASH') {
15145: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15146: }
15147: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
15148: }
15149: } else {
15150: if (ref($subcats) eq 'HASH') {
15151: $subcats->{$item} = [];
1.655 raeburn 15152: }
15153: }
15154: }
15155: }
15156: }
15157: return;
15158: }
15159:
15160: =pod
15161:
1.1162 raeburn 15162: =item * &recurse_categories()
1.655 raeburn 15163:
15164: Recursively used to generate breadcrumb trails for course categories.
15165:
15166: Inputs:
1.663 raeburn 15167:
1.655 raeburn 15168: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15169: categories and subcategories).
1.663 raeburn 15170:
1.655 raeburn 15171: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 15172:
15173: category (current course category, for which breadcrumb trail is being generated).
15174:
15175: trails (reference to array of breadcrumb trails for each category).
15176:
1.655 raeburn 15177: allitems (reference to hash - key is category key
15178: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15179:
1.655 raeburn 15180: parents (array containing containers directories for current category,
15181: back to top level).
15182:
15183: Returns: nothing
15184:
15185: Side effects: populates trails and allitems hash references
15186:
15187: =cut
15188:
15189: sub recurse_categories {
1.665 raeburn 15190: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 15191: my $shallower = $depth - 1;
15192: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
15193: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
15194: my $name = $cats->[$depth]{$category}[$k];
15195: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
15196: my $trailstr = join(' -> ',(@{$parents},$category));
15197: if ($allitems->{$item} eq '') {
15198: push(@{$trails},$trailstr);
15199: $allitems->{$item} = scalar(@{$trails})-1;
15200: }
15201: my $deeper = $depth+1;
15202: push(@{$parents},$category);
1.665 raeburn 15203: if (ref($subcats) eq 'HASH') {
15204: my $subcat = &escape($name).':'.$category.':'.$depth;
15205: for (my $j=@{$parents}; $j>=0; $j--) {
15206: my $higher;
15207: if ($j > 0) {
15208: $higher = &escape($parents->[$j]).':'.
15209: &escape($parents->[$j-1]).':'.$j;
15210: } else {
15211: $higher = &escape($parents->[$j]).'::'.$j;
15212: }
15213: push(@{$subcats->{$higher}},$subcat);
15214: }
15215: }
15216: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
15217: $subcats);
1.655 raeburn 15218: pop(@{$parents});
15219: }
15220: } else {
15221: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
15222: my $trailstr = join(' -> ',(@{$parents},$category));
15223: if ($allitems->{$item} eq '') {
15224: push(@{$trails},$trailstr);
15225: $allitems->{$item} = scalar(@{$trails})-1;
15226: }
15227: }
15228: return;
15229: }
15230:
1.663 raeburn 15231: =pod
15232:
1.1162 raeburn 15233: =item * &assign_categories_table()
1.663 raeburn 15234:
15235: Create a datatable for display of hierarchical categories in a domain,
15236: with checkboxes to allow a course to be categorized.
15237:
15238: Inputs:
15239:
15240: cathash - reference to hash of categories defined for the domain (from
15241: configuration.db)
15242:
15243: currcat - scalar with an & separated list of categories assigned to a course.
15244:
1.919 raeburn 15245: type - scalar contains course type (Course or Community).
15246:
1.1260 raeburn 15247: disabled - scalar (optional) contains disabled="disabled" if input elements are
15248: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15249:
1.663 raeburn 15250: Returns: $output (markup to be displayed)
15251:
15252: =cut
15253:
15254: sub assign_categories_table {
1.1259 raeburn 15255: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15256: my $output;
15257: if (ref($cathash) eq 'HASH') {
15258: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
15259: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
15260: $maxdepth = scalar(@cats);
15261: if (@cats > 0) {
15262: my $itemcount = 0;
15263: if (ref($cats[0]) eq 'ARRAY') {
15264: my @currcategories;
15265: if ($currcat ne '') {
15266: @currcategories = split('&',$currcat);
15267: }
1.919 raeburn 15268: my $table;
1.663 raeburn 15269: for (my $i=0; $i<@{$cats[0]}; $i++) {
15270: my $parent = $cats[0][$i];
1.919 raeburn 15271: next if ($parent eq 'instcode');
15272: if ($type eq 'Community') {
15273: next unless ($parent eq 'communities');
1.1239 raeburn 15274: } elsif ($type eq 'Placement') {
15275: next unless ($parent eq 'placement');
1.919 raeburn 15276: } else {
1.1239 raeburn 15277: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 15278: }
1.663 raeburn 15279: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15280: my $item = &escape($parent).'::0';
15281: my $checked = '';
15282: if (@currcategories > 0) {
15283: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15284: $checked = ' checked="checked"';
1.663 raeburn 15285: }
15286: }
1.919 raeburn 15287: my $parent_title = $parent;
15288: if ($parent eq 'communities') {
15289: $parent_title = &mt('Communities');
1.1239 raeburn 15290: } elsif ($parent eq 'placement') {
15291: $parent_title = &mt('Placement Tests');
1.919 raeburn 15292: }
15293: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15294: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15295: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15296: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15297: my $depth = 1;
15298: push(@path,$parent);
1.1259 raeburn 15299: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15300: pop(@path);
1.919 raeburn 15301: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15302: $itemcount ++;
15303: }
1.919 raeburn 15304: if ($itemcount) {
15305: $output = &Apache::loncommon::start_data_table().
15306: $table.
15307: &Apache::loncommon::end_data_table();
15308: }
1.663 raeburn 15309: }
15310: }
15311: }
15312: return $output;
15313: }
15314:
15315: =pod
15316:
1.1162 raeburn 15317: =item * &assign_category_rows()
1.663 raeburn 15318:
15319: Create a datatable row for display of nested categories in a domain,
15320: with checkboxes to allow a course to be categorized,called recursively.
15321:
15322: Inputs:
15323:
15324: itemcount - track row number for alternating colors
15325:
15326: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15327: categories and subcategories.
15328:
15329: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15330:
15331: parent - parent of current category item
15332:
15333: path - Array containing all categories back up through the hierarchy from the
15334: current category to the top level.
15335:
15336: currcategories - reference to array of current categories assigned to the course
15337:
1.1260 raeburn 15338: disabled - scalar (optional) contains disabled="disabled" if input elements are
15339: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15340:
1.663 raeburn 15341: Returns: $output (markup to be displayed).
15342:
15343: =cut
15344:
15345: sub assign_category_rows {
1.1259 raeburn 15346: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15347: my ($text,$name,$item,$chgstr);
15348: if (ref($cats) eq 'ARRAY') {
15349: my $maxdepth = scalar(@{$cats});
15350: if (ref($cats->[$depth]) eq 'HASH') {
15351: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15352: my $numchildren = @{$cats->[$depth]{$parent}};
15353: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 15354: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15355: for (my $j=0; $j<$numchildren; $j++) {
15356: $name = $cats->[$depth]{$parent}[$j];
15357: $item = &escape($name).':'.&escape($parent).':'.$depth;
15358: my $deeper = $depth+1;
15359: my $checked = '';
15360: if (ref($currcategories) eq 'ARRAY') {
15361: if (@{$currcategories} > 0) {
15362: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15363: $checked = ' checked="checked"';
1.663 raeburn 15364: }
15365: }
15366: }
1.664 raeburn 15367: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15368: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15369: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15370: '<input type="hidden" name="catname" value="'.$name.'" />'.
15371: '</td><td>';
1.663 raeburn 15372: if (ref($path) eq 'ARRAY') {
15373: push(@{$path},$name);
1.1259 raeburn 15374: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15375: pop(@{$path});
15376: }
15377: $text .= '</td></tr>';
15378: }
15379: $text .= '</table></td>';
15380: }
15381: }
15382: }
15383: return $text;
15384: }
15385:
1.1181 raeburn 15386: =pod
15387:
15388: =back
15389:
15390: =cut
15391:
1.655 raeburn 15392: ############################################################
15393: ############################################################
15394:
15395:
1.443 albertel 15396: sub commit_customrole {
1.664 raeburn 15397: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15398: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15399: ($start?', '.&mt('starting').' '.localtime($start):'').
15400: ($end?', ending '.localtime($end):'').': <b>'.
15401: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15402: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15403: '</b><br />';
15404: return $output;
15405: }
15406:
15407: sub commit_standardrole {
1.1116 raeburn 15408: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15409: my ($output,$logmsg,$linefeed);
15410: if ($context eq 'auto') {
15411: $linefeed = "\n";
15412: } else {
15413: $linefeed = "<br />\n";
15414: }
1.443 albertel 15415: if ($three eq 'st') {
1.541 raeburn 15416: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 15417: $one,$two,$sec,$context,$credits);
1.541 raeburn 15418: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15419: ($result eq 'unknown_course') || ($result eq 'refused')) {
15420: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15421: } else {
1.541 raeburn 15422: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15423: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15424: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15425: if ($context eq 'auto') {
15426: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15427: } else {
15428: $output .= '<b>'.$result.'</b>'.$linefeed.
15429: &mt('Add to classlist').': <b>ok</b>';
15430: }
15431: $output .= $linefeed;
1.443 albertel 15432: }
15433: } else {
15434: $output = &mt('Assigning').' '.$three.' in '.$url.
15435: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15436: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15437: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15438: if ($context eq 'auto') {
15439: $output .= $result.$linefeed;
15440: } else {
15441: $output .= '<b>'.$result.'</b>'.$linefeed;
15442: }
1.443 albertel 15443: }
15444: return $output;
15445: }
15446:
15447: sub commit_studentrole {
1.1116 raeburn 15448: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15449: $credits) = @_;
1.626 raeburn 15450: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15451: if ($context eq 'auto') {
15452: $linefeed = "\n";
15453: } else {
15454: $linefeed = '<br />'."\n";
15455: }
1.443 albertel 15456: if (defined($one) && defined($two)) {
15457: my $cid=$one.'_'.$two;
15458: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15459: my $secchange = 0;
15460: my $expire_role_result;
15461: my $modify_section_result;
1.628 raeburn 15462: if ($oldsec ne '-1') {
15463: if ($oldsec ne $sec) {
1.443 albertel 15464: $secchange = 1;
1.628 raeburn 15465: my $now = time;
1.443 albertel 15466: my $uurl='/'.$cid;
15467: $uurl=~s/\_/\//g;
15468: if ($oldsec) {
15469: $uurl.='/'.$oldsec;
15470: }
1.626 raeburn 15471: $oldsecurl = $uurl;
1.628 raeburn 15472: $expire_role_result =
1.652 raeburn 15473: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15474: if ($env{'request.course.sec'} ne '') {
15475: if ($expire_role_result eq 'refused') {
15476: my @roles = ('st');
15477: my @statuses = ('previous');
15478: my @roledoms = ($one);
15479: my $withsec = 1;
15480: my %roleshash =
15481: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15482: \@statuses,\@roles,\@roledoms,$withsec);
15483: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15484: my ($oldstart,$oldend) =
15485: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15486: if ($oldend > 0 && $oldend <= $now) {
15487: $expire_role_result = 'ok';
15488: }
15489: }
15490: }
15491: }
1.443 albertel 15492: $result = $expire_role_result;
15493: }
15494: }
15495: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15496: $modify_section_result =
15497: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15498: undef,undef,undef,$sec,
15499: $end,$start,'','',$cid,
15500: '',$context,$credits);
1.443 albertel 15501: if ($modify_section_result =~ /^ok/) {
15502: if ($secchange == 1) {
1.628 raeburn 15503: if ($sec eq '') {
15504: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15505: } else {
15506: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15507: }
1.443 albertel 15508: } elsif ($oldsec eq '-1') {
1.628 raeburn 15509: if ($sec eq '') {
15510: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15511: } else {
15512: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15513: }
1.443 albertel 15514: } else {
1.628 raeburn 15515: if ($sec eq '') {
15516: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15517: } else {
15518: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15519: }
1.443 albertel 15520: }
15521: } else {
1.1115 raeburn 15522: if ($secchange) {
1.628 raeburn 15523: $$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;
15524: } else {
15525: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15526: }
1.443 albertel 15527: }
15528: $result = $modify_section_result;
15529: } elsif ($secchange == 1) {
1.628 raeburn 15530: if ($oldsec eq '') {
1.1103 raeburn 15531: $$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 15532: } else {
15533: $$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;
15534: }
1.626 raeburn 15535: if ($expire_role_result eq 'refused') {
15536: my $newsecurl = '/'.$cid;
15537: $newsecurl =~ s/\_/\//g;
15538: if ($sec ne '') {
15539: $newsecurl.='/'.$sec;
15540: }
15541: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15542: if ($sec eq '') {
15543: $$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;
15544: } else {
15545: $$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;
15546: }
15547: }
15548: }
1.443 albertel 15549: }
15550: } else {
1.626 raeburn 15551: $$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 15552: $result = "error: incomplete course id\n";
15553: }
15554: return $result;
15555: }
15556:
1.1108 raeburn 15557: sub show_role_extent {
15558: my ($scope,$context,$role) = @_;
15559: $scope =~ s{^/}{};
15560: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15561: push(@courseroles,'co');
15562: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15563: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15564: $scope =~ s{/}{_};
15565: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15566: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15567: my ($audom,$auname) = split(/\//,$scope);
15568: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15569: &Apache::loncommon::plainname($auname,$audom).'</span>');
15570: } else {
15571: $scope =~ s{/$}{};
15572: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15573: &Apache::lonnet::domain($scope,'description').'</span>');
15574: }
15575: }
15576:
1.443 albertel 15577: ############################################################
15578: ############################################################
15579:
1.566 albertel 15580: sub check_clone {
1.578 raeburn 15581: my ($args,$linefeed) = @_;
1.566 albertel 15582: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15583: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15584: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15585: my $clonemsg;
15586: my $can_clone = 0;
1.944 raeburn 15587: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15588: if ($lctype ne 'community') {
15589: $lctype = 'course';
15590: }
1.566 albertel 15591: if ($clonehome eq 'no_host') {
1.944 raeburn 15592: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15593: $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'});
15594: } else {
15595: $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'});
15596: }
1.566 albertel 15597: } else {
15598: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15599: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15600: if ($clonedesc{'type'} ne 'Community') {
1.1262 raeburn 15601: $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 15602: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15603: }
15604: }
1.1262 raeburn 15605: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15606: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15607: $can_clone = 1;
15608: } else {
1.1221 raeburn 15609: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15610: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15611: if ($clonehash{'cloners'} eq '') {
15612: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15613: if ($domdefs{'canclone'}) {
15614: unless ($domdefs{'canclone'} eq 'none') {
15615: if ($domdefs{'canclone'} eq 'domain') {
15616: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15617: $can_clone = 1;
15618: }
15619: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15620: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15621: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15622: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15623: $can_clone = 1;
15624: }
15625: }
15626: }
15627: }
1.578 raeburn 15628: } else {
1.1221 raeburn 15629: my @cloners = split(/,/,$clonehash{'cloners'});
15630: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15631: $can_clone = 1;
1.1221 raeburn 15632: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15633: $can_clone = 1;
1.1225 raeburn 15634: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15635: $can_clone = 1;
1.1221 raeburn 15636: }
15637: unless ($can_clone) {
1.1225 raeburn 15638: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15639: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15640: my (%gotdomdefaults,%gotcodedefaults);
15641: foreach my $cloner (@cloners) {
15642: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15643: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15644: my (%codedefaults,@code_order);
15645: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15646: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15647: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15648: }
15649: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15650: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15651: }
15652: } else {
15653: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15654: \%codedefaults,
15655: \@code_order);
15656: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15657: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15658: }
15659: if (@code_order > 0) {
15660: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15661: $cloner,$clonehash{'internal.coursecode'},
15662: $args->{'crscode'})) {
15663: $can_clone = 1;
15664: last;
15665: }
15666: }
15667: }
15668: }
15669: }
1.1225 raeburn 15670: }
15671: }
15672: unless ($can_clone) {
15673: my $ccrole = 'cc';
15674: if ($args->{'crstype'} eq 'Community') {
15675: $ccrole = 'co';
15676: }
15677: my %roleshash =
15678: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15679: $args->{'ccdomain'},
15680: 'userroles',['active'],[$ccrole],
15681: [$args->{'clonedomain'}]);
15682: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15683: $can_clone = 1;
15684: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15685: $args->{'ccuname'},$args->{'ccdomain'})) {
15686: $can_clone = 1;
1.1221 raeburn 15687: }
15688: }
15689: unless ($can_clone) {
15690: if ($args->{'crstype'} eq 'Community') {
15691: $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 15692: } else {
1.1221 raeburn 15693: $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'});
15694: }
1.566 albertel 15695: }
1.578 raeburn 15696: }
1.566 albertel 15697: }
15698: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15699: }
15700:
1.444 albertel 15701: sub construct_course {
1.1262 raeburn 15702: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
15703: $cnum,$category,$coderef) = @_;
1.444 albertel 15704: my $outcome;
1.541 raeburn 15705: my $linefeed = '<br />'."\n";
15706: if ($context eq 'auto') {
15707: $linefeed = "\n";
15708: }
1.566 albertel 15709:
15710: #
15711: # Are we cloning?
15712: #
15713: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15714: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15715: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15716: if ($context ne 'auto') {
1.578 raeburn 15717: if ($clonemsg ne '') {
15718: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15719: }
1.566 albertel 15720: }
15721: $outcome .= $clonemsg.$linefeed;
15722:
15723: if (!$can_clone) {
15724: return (0,$outcome);
15725: }
15726: }
15727:
1.444 albertel 15728: #
15729: # Open course
15730: #
1.1239 raeburn 15731: my $showncrstype;
15732: if ($args->{'crstype'} eq 'Placement') {
15733: $showncrstype = 'placement test';
15734: } else {
15735: $showncrstype = lc($args->{'crstype'});
15736: }
1.444 albertel 15737: my %cenv=();
15738: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15739: $args->{'cdescr'},
15740: $args->{'curl'},
15741: $args->{'course_home'},
15742: $args->{'nonstandard'},
15743: $args->{'crscode'},
15744: $args->{'ccuname'}.':'.
15745: $args->{'ccdomain'},
1.882 raeburn 15746: $args->{'crstype'},
1.885 raeburn 15747: $cnum,$context,$category);
1.444 albertel 15748:
15749: # Note: The testing routines depend on this being output; see
15750: # Utils::Course. This needs to at least be output as a comment
15751: # if anyone ever decides to not show this, and Utils::Course::new
15752: # will need to be suitably modified.
1.1239 raeburn 15753: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 15754: if ($$courseid =~ /^error:/) {
15755: return (0,$outcome);
15756: }
15757:
1.444 albertel 15758: #
15759: # Check if created correctly
15760: #
1.479 albertel 15761: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15762: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15763: if ($crsuhome eq 'no_host') {
15764: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15765: return (0,$outcome);
15766: }
1.541 raeburn 15767: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15768:
1.444 albertel 15769: #
1.566 albertel 15770: # Do the cloning
15771: #
15772: if ($can_clone && $cloneid) {
1.1239 raeburn 15773: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 15774: if ($context ne 'auto') {
15775: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15776: }
15777: $outcome .= $clonemsg.$linefeed;
15778: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15779: # Copy all files
1.637 www 15780: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15781: # Restore URL
1.566 albertel 15782: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15783: # Restore title
1.566 albertel 15784: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15785: # Restore creation date, creator and creation context.
15786: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15787: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15788: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15789: # Mark as cloned
1.566 albertel 15790: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15791: # Need to clone grading mode
15792: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15793: $cenv{'grading'}=$newenv{'grading'};
15794: # Do not clone these environment entries
15795: &Apache::lonnet::del('environment',
15796: ['default_enrollment_start_date',
15797: 'default_enrollment_end_date',
15798: 'question.email',
15799: 'policy.email',
15800: 'comment.email',
15801: 'pch.users.denied',
1.725 raeburn 15802: 'plc.users.denied',
15803: 'hidefromcat',
1.1121 raeburn 15804: 'checkforpriv',
1.1166 raeburn 15805: 'categories',
15806: 'internal.uniquecode'],
1.638 www 15807: $$crsudom,$$crsunum);
1.1170 raeburn 15808: if ($args->{'textbook'}) {
15809: $cenv{'internal.textbook'} = $args->{'textbook'};
15810: }
1.444 albertel 15811: }
1.566 albertel 15812:
1.444 albertel 15813: #
15814: # Set environment (will override cloned, if existing)
15815: #
15816: my @sections = ();
15817: my @xlists = ();
15818: if ($args->{'crstype'}) {
15819: $cenv{'type'}=$args->{'crstype'};
15820: }
15821: if ($args->{'crsid'}) {
15822: $cenv{'courseid'}=$args->{'crsid'};
15823: }
15824: if ($args->{'crscode'}) {
15825: $cenv{'internal.coursecode'}=$args->{'crscode'};
15826: }
15827: if ($args->{'crsquota'} ne '') {
15828: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15829: } else {
15830: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15831: }
15832: if ($args->{'ccuname'}) {
15833: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15834: ':'.$args->{'ccdomain'};
15835: } else {
15836: $cenv{'internal.courseowner'} = $args->{'curruser'};
15837: }
1.1116 raeburn 15838: if ($args->{'defaultcredits'}) {
15839: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15840: }
1.444 albertel 15841: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15842: if ($args->{'crssections'}) {
15843: $cenv{'internal.sectionnums'} = '';
15844: if ($args->{'crssections'} =~ m/,/) {
15845: @sections = split/,/,$args->{'crssections'};
15846: } else {
15847: $sections[0] = $args->{'crssections'};
15848: }
15849: if (@sections > 0) {
15850: foreach my $item (@sections) {
15851: my ($sec,$gp) = split/:/,$item;
15852: my $class = $args->{'crscode'}.$sec;
15853: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15854: $cenv{'internal.sectionnums'} .= $item.',';
15855: unless ($addcheck eq 'ok') {
1.1263 raeburn 15856: push(@badclasses,$class);
1.444 albertel 15857: }
15858: }
15859: $cenv{'internal.sectionnums'} =~ s/,$//;
15860: }
15861: }
15862: # do not hide course coordinator from staff listing,
15863: # even if privileged
15864: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15865: # add course coordinator's domain to domains to check for privileged users
15866: # if different to course domain
15867: if ($$crsudom ne $args->{'ccdomain'}) {
15868: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15869: }
1.444 albertel 15870: # add crosslistings
15871: if ($args->{'crsxlist'}) {
15872: $cenv{'internal.crosslistings'}='';
15873: if ($args->{'crsxlist'} =~ m/,/) {
15874: @xlists = split/,/,$args->{'crsxlist'};
15875: } else {
15876: $xlists[0] = $args->{'crsxlist'};
15877: }
15878: if (@xlists > 0) {
15879: foreach my $item (@xlists) {
15880: my ($xl,$gp) = split/:/,$item;
15881: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15882: $cenv{'internal.crosslistings'} .= $item.',';
15883: unless ($addcheck eq 'ok') {
1.1263 raeburn 15884: push(@badclasses,$xl);
1.444 albertel 15885: }
15886: }
15887: $cenv{'internal.crosslistings'} =~ s/,$//;
15888: }
15889: }
15890: if ($args->{'autoadds'}) {
15891: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15892: }
15893: if ($args->{'autodrops'}) {
15894: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15895: }
15896: # check for notification of enrollment changes
15897: my @notified = ();
15898: if ($args->{'notify_owner'}) {
15899: if ($args->{'ccuname'} ne '') {
15900: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15901: }
15902: }
15903: if ($args->{'notify_dc'}) {
15904: if ($uname ne '') {
1.630 raeburn 15905: push(@notified,$uname.':'.$udom);
1.444 albertel 15906: }
15907: }
15908: if (@notified > 0) {
15909: my $notifylist;
15910: if (@notified > 1) {
15911: $notifylist = join(',',@notified);
15912: } else {
15913: $notifylist = $notified[0];
15914: }
15915: $cenv{'internal.notifylist'} = $notifylist;
15916: }
15917: if (@badclasses > 0) {
15918: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 15919: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
15920: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
15921: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 15922: );
1.1264 raeburn 15923: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
15924: &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 15925: if ($context eq 'auto') {
15926: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 15927: } else {
1.566 albertel 15928: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 15929: }
15930: foreach my $item (@badclasses) {
1.541 raeburn 15931: if ($context eq 'auto') {
1.1261 raeburn 15932: $outcome .= " - $item\n";
1.541 raeburn 15933: } else {
1.1261 raeburn 15934: $outcome .= "<li>$item</li>\n";
1.541 raeburn 15935: }
1.1261 raeburn 15936: }
15937: if ($context eq 'auto') {
15938: $outcome .= $linefeed;
15939: } else {
15940: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15941: }
1.444 albertel 15942: }
15943: if ($args->{'no_end_date'}) {
15944: $args->{'endaccess'} = 0;
15945: }
15946: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15947: $cenv{'internal.autoend'}=$args->{'enrollend'};
15948: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15949: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15950: if ($args->{'showphotos'}) {
15951: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15952: }
15953: $cenv{'internal.authtype'} = $args->{'authtype'};
15954: $cenv{'internal.autharg'} = $args->{'autharg'};
15955: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15956: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15957: 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');
15958: if ($context eq 'auto') {
15959: $outcome .= $krb_msg;
15960: } else {
1.566 albertel 15961: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15962: }
15963: $outcome .= $linefeed;
1.444 albertel 15964: }
15965: }
15966: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15967: if ($args->{'setpolicy'}) {
15968: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15969: }
15970: if ($args->{'setcontent'}) {
15971: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15972: }
1.1251 raeburn 15973: if ($args->{'setcomment'}) {
15974: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15975: }
1.444 albertel 15976: }
15977: if ($args->{'reshome'}) {
15978: $cenv{'reshome'}=$args->{'reshome'}.'/';
15979: $cenv{'reshome'}=~s/\/+$/\//;
15980: }
15981: #
15982: # course has keyed access
15983: #
15984: if ($args->{'setkeys'}) {
15985: $cenv{'keyaccess'}='yes';
15986: }
15987: # if specified, key authority is not course, but user
15988: # only active if keyaccess is yes
15989: if ($args->{'keyauth'}) {
1.487 albertel 15990: my ($user,$domain) = split(':',$args->{'keyauth'});
15991: $user = &LONCAPA::clean_username($user);
15992: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15993: if ($user ne '' && $domain ne '') {
1.487 albertel 15994: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15995: }
15996: }
15997:
1.1166 raeburn 15998: #
1.1167 raeburn 15999: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 16000: #
16001: if ($args->{'uniquecode'}) {
16002: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16003: if ($code) {
16004: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 16005: my %crsinfo =
16006: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16007: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16008: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16009: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16010: }
1.1166 raeburn 16011: if (ref($coderef)) {
16012: $$coderef = $code;
16013: }
16014: }
16015: }
16016:
1.444 albertel 16017: if ($args->{'disresdis'}) {
16018: $cenv{'pch.roles.denied'}='st';
16019: }
16020: if ($args->{'disablechat'}) {
16021: $cenv{'plc.roles.denied'}='st';
16022: }
16023:
16024: # Record we've not yet viewed the Course Initialization Helper for this
16025: # course
16026: $cenv{'course.helper.not.run'} = 1;
16027: #
16028: # Use new Randomseed
16029: #
16030: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16031: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16032: #
16033: # The encryption code and receipt prefix for this course
16034: #
16035: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16036: $cenv{'internal.encpref'}=100+int(9*rand(99));
16037: #
16038: # By default, use standard grading
16039: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16040:
1.541 raeburn 16041: $outcome .= $linefeed.&mt('Setting environment').': '.
16042: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16043: #
16044: # Open all assignments
16045: #
16046: if ($args->{'openall'}) {
16047: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
16048: my %storecontent = ($storeunder => time,
16049: $storeunder.'.type' => 'date_start');
16050:
16051: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 16052: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16053: }
16054: #
16055: # Set first page
16056: #
16057: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16058: || ($cloneid)) {
1.445 albertel 16059: use LONCAPA::map;
1.444 albertel 16060: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16061:
16062: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16063: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16064:
1.444 albertel 16065: $outcome .= ($fatal?$errtext:'read ok').' - ';
16066: my $title; my $url;
16067: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16068: $title=&mt('Syllabus');
1.444 albertel 16069: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16070: } else {
1.963 raeburn 16071: $title=&mt('Table of Contents');
1.444 albertel 16072: $url='/adm/navmaps';
16073: }
1.445 albertel 16074:
16075: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16076: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16077:
16078: if ($errtext) { $fatal=2; }
1.541 raeburn 16079: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16080: }
1.566 albertel 16081:
1.1237 raeburn 16082: #
16083: # Set params for Placement Tests
16084: #
1.1239 raeburn 16085: if ($args->{'crstype'} eq 'Placement') {
16086: my %storecontent;
16087: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
16088: my %defaults = (
16089: buttonshide => { value => 'yes',
16090: type => 'string_yesno',},
16091: type => { value => 'randomizetry',
16092: type => 'string_questiontype',},
16093: maxtries => { value => 1,
16094: type => 'int_pos',},
16095: problemstatus => { value => 'no',
16096: type => 'string_problemstatus',},
16097: );
16098: foreach my $key (keys(%defaults)) {
16099: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
16100: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
16101: }
1.1237 raeburn 16102: &Apache::lonnet::cput
16103: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
16104: }
16105:
1.566 albertel 16106: return (1,$outcome);
1.444 albertel 16107: }
16108:
1.1166 raeburn 16109: sub make_unique_code {
16110: my ($cdom,$cnum) = @_;
16111: # get lock on uniquecodes db
16112: my $lockhash = {
16113: $cnum."\0".'uniquecodes' => $env{'user.name'}.
16114: ':'.$env{'user.domain'},
16115: };
16116: my $tries = 0;
16117: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16118: my ($code,$error);
16119:
16120: while (($gotlock ne 'ok') && ($tries<3)) {
16121: $tries ++;
16122: sleep 1;
16123: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16124: }
16125: if ($gotlock eq 'ok') {
16126: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
16127: my $gotcode;
16128: my $attempts = 0;
16129: while ((!$gotcode) && ($attempts < 100)) {
16130: $code = &generate_code();
16131: if (!exists($currcodes{$code})) {
16132: $gotcode = 1;
16133: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
16134: $error = 'nostore';
16135: }
16136: }
16137: $attempts ++;
16138: }
16139: my @del_lock = ($cnum."\0".'uniquecodes');
16140: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
16141: } else {
16142: $error = 'nolock';
16143: }
16144: return ($code,$error);
16145: }
16146:
16147: sub generate_code {
16148: my $code;
16149: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
16150: for (my $i=0; $i<6; $i++) {
16151: my $lettnum = int (rand 2);
16152: my $item = '';
16153: if ($lettnum) {
16154: $item = $letts[int( rand(18) )];
16155: } else {
16156: $item = 1+int( rand(8) );
16157: }
16158: $code .= $item;
16159: }
16160: return $code;
16161: }
16162:
1.444 albertel 16163: ############################################################
16164: ############################################################
16165:
1.1237 raeburn 16166: # Community, Course and Placement Test
1.378 raeburn 16167: sub course_type {
16168: my ($cid) = @_;
16169: if (!defined($cid)) {
16170: $cid = $env{'request.course.id'};
16171: }
1.404 albertel 16172: if (defined($env{'course.'.$cid.'.type'})) {
16173: return $env{'course.'.$cid.'.type'};
1.378 raeburn 16174: } else {
16175: return 'Course';
1.377 raeburn 16176: }
16177: }
1.156 albertel 16178:
1.406 raeburn 16179: sub group_term {
16180: my $crstype = &course_type();
16181: my %names = (
16182: 'Course' => 'group',
1.865 raeburn 16183: 'Community' => 'group',
1.1237 raeburn 16184: 'Placement' => 'group',
1.406 raeburn 16185: );
16186: return $names{$crstype};
16187: }
16188:
1.902 raeburn 16189: sub course_types {
1.1237 raeburn 16190: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 16191: my %typename = (
16192: official => 'Official course',
16193: unofficial => 'Unofficial course',
16194: community => 'Community',
1.1165 raeburn 16195: textbook => 'Textbook course',
1.1237 raeburn 16196: placement => 'Placement test',
1.902 raeburn 16197: );
16198: return (\@types,\%typename);
16199: }
16200:
1.156 albertel 16201: sub icon {
16202: my ($file)=@_;
1.505 albertel 16203: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 16204: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 16205: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 16206: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
16207: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
16208: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16209: $curfext.".gif") {
16210: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16211: $curfext.".gif";
16212: }
16213: }
1.249 albertel 16214: return &lonhttpdurl($iconname);
1.154 albertel 16215: }
1.84 albertel 16216:
1.575 albertel 16217: sub lonhttpdurl {
1.692 www 16218: #
16219: # Had been used for "small fry" static images on separate port 8080.
16220: # Modify here if lightweight http functionality desired again.
16221: # Currently eliminated due to increasing firewall issues.
16222: #
1.575 albertel 16223: my ($url)=@_;
1.692 www 16224: return $url;
1.215 albertel 16225: }
16226:
1.213 albertel 16227: sub connection_aborted {
16228: my ($r)=@_;
16229: $r->print(" ");$r->rflush();
16230: my $c = $r->connection;
16231: return $c->aborted();
16232: }
16233:
1.221 foxr 16234: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16235: # strings as 'strings'.
16236: sub escape_single {
1.221 foxr 16237: my ($input) = @_;
1.223 albertel 16238: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16239: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16240: return $input;
16241: }
1.223 albertel 16242:
1.222 foxr 16243: # Same as escape_single, but escape's "'s This
16244: # can be used for "strings"
16245: sub escape_double {
16246: my ($input) = @_;
16247: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16248: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16249: return $input;
16250: }
1.223 albertel 16251:
1.222 foxr 16252: # Escapes the last element of a full URL.
16253: sub escape_url {
16254: my ($url) = @_;
1.238 raeburn 16255: my @urlslices = split(/\//, $url,-1);
1.369 www 16256: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 16257: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16258: }
1.462 albertel 16259:
1.820 raeburn 16260: sub compare_arrays {
16261: my ($arrayref1,$arrayref2) = @_;
16262: my (@difference,%count);
16263: @difference = ();
16264: %count = ();
16265: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16266: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16267: foreach my $element (keys(%count)) {
16268: if ($count{$element} == 1) {
16269: push(@difference,$element);
16270: }
16271: }
16272: }
16273: return @difference;
16274: }
16275:
1.817 bisitz 16276: # -------------------------------------------------------- Initialize user login
1.462 albertel 16277: sub init_user_environment {
1.463 albertel 16278: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16279: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16280:
16281: my $public=($username eq 'public' && $domain eq 'public');
16282:
1.1062 raeburn 16283: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16284: my $now=time;
16285:
16286: if ($public) {
16287: my $max_public=100;
16288: my $oldest;
16289: my $oldest_time=0;
16290: for(my $next=1;$next<=$max_public;$next++) {
16291: if (-e $lonids."/publicuser_$next.id") {
16292: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16293: if ($mtime<$oldest_time || !$oldest_time) {
16294: $oldest_time=$mtime;
16295: $oldest=$next;
16296: }
16297: } else {
16298: $cookie="publicuser_$next";
16299: last;
16300: }
16301: }
16302: if (!$cookie) { $cookie="publicuser_$oldest"; }
16303: } else {
1.1275 raeburn 16304: # See if old ID present, if so, remove if this isn't a robot,
16305: # killing any existing non-robot sessions
1.463 albertel 16306: if (!$args->{'robot'}) {
16307: opendir(DIR,$lonids);
16308: while ($filename=readdir(DIR)) {
16309: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1295 raeburn 16310: if ($ENV{'SERVER_PORT'} == 443) {
16311: my $linkedfile;
16312: if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id",
16313: &GDBM_READER(),0640)) {
16314: if (exists($oldenv{'user.linkedenv'})) {
16315: $linkedfile = $oldenv{'user.linkedenv'};
16316: }
16317: untie(%oldenv);
16318: }
16319: if (unlink($lonids.'/'.$filename)) {
16320: if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) {
16321: unlink($lonids.'/'.$linkedfile);
16322: }
16323: }
16324: } else {
16325: unlink($lonids.'/'.$filename);
16326: }
1.463 albertel 16327: }
1.462 albertel 16328: }
1.463 albertel 16329: closedir(DIR);
1.1204 raeburn 16330: # If there is a undeleted lockfile for the user's paste buffer remove it.
16331: my $namespace = 'nohist_courseeditor';
16332: my $lockingkey = 'paste'."\0".'locked_num';
16333: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16334: $domain,$username);
16335: if (exists($lockhash{$lockingkey})) {
16336: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16337: unless ($delresult eq 'ok') {
16338: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16339: }
16340: }
1.462 albertel 16341: }
16342: # Give them a new cookie
1.463 albertel 16343: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16344: : $now.$$.int(rand(10000)));
1.463 albertel 16345: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16346:
16347: # Initialize roles
16348:
1.1062 raeburn 16349: ($userroles,$firstaccenv,$timerintenv) =
16350: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16351: }
16352: # ------------------------------------ Check browser type and MathML capability
16353:
1.1194 raeburn 16354: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16355: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16356:
16357: # ------------------------------------------------------------- Get environment
16358:
16359: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16360: my ($tmp) = keys(%userenv);
1.1275 raeburn 16361: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 16362: undef(%userenv);
16363: }
16364: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16365: $form->{'interface'}=$userenv{'interface'};
16366: }
16367: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16368:
16369: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16370: foreach my $option ('interface','localpath','localres') {
16371: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16372: }
16373: # --------------------------------------------------------- Write first profile
16374:
16375: {
16376: my %initial_env =
16377: ("user.name" => $username,
16378: "user.domain" => $domain,
16379: "user.home" => $authhost,
16380: "browser.type" => $clientbrowser,
16381: "browser.version" => $clientversion,
16382: "browser.mathml" => $clientmathml,
16383: "browser.unicode" => $clientunicode,
16384: "browser.os" => $clientos,
1.1137 raeburn 16385: "browser.mobile" => $clientmobile,
1.1141 raeburn 16386: "browser.info" => $clientinfo,
1.1194 raeburn 16387: "browser.osversion" => $clientosversion,
1.462 albertel 16388: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16389: "request.course.fn" => '',
16390: "request.course.uri" => '',
16391: "request.course.sec" => '',
16392: "request.role" => 'cm',
16393: "request.role.adv" => $env{'user.adv'},
16394: "request.host" => $ENV{'REMOTE_ADDR'},);
16395:
16396: if ($form->{'localpath'}) {
16397: $initial_env{"browser.localpath"} = $form->{'localpath'};
16398: $initial_env{"browser.localres"} = $form->{'localres'};
16399: }
16400:
16401: if ($form->{'interface'}) {
16402: $form->{'interface'}=~s/\W//gs;
16403: $initial_env{"browser.interface"} = $form->{'interface'};
16404: $env{'browser.interface'}=$form->{'interface'};
16405: }
16406:
1.1157 raeburn 16407: if ($form->{'iptoken'}) {
16408: my $lonhost = $r->dir_config('lonHostID');
16409: $initial_env{"user.noloadbalance"} = $lonhost;
16410: $env{'user.noloadbalance'} = $lonhost;
16411: }
16412:
1.1268 raeburn 16413: if ($form->{'noloadbalance'}) {
16414: my @hosts = &Apache::lonnet::current_machine_ids();
16415: my $hosthere = $form->{'noloadbalance'};
16416: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16417: $initial_env{"user.noloadbalance"} = $hosthere;
16418: $env{'user.noloadbalance'} = $hosthere;
16419: }
16420: }
16421:
1.1016 raeburn 16422: unless ($domain eq 'public') {
1.1273 raeburn 16423: my %is_adv = ( is_adv => $env{'user.adv'} );
16424: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
16425:
16426: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16427: $userenv{'availabletools.'.$tool} =
16428: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16429: undef,\%userenv,\%domdef,\%is_adv);
16430: }
1.980 raeburn 16431:
1.1273 raeburn 16432: foreach my $crstype ('official','unofficial','community','textbook','placement') {
16433: $userenv{'canrequest.'.$crstype} =
16434: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16435: 'reload','requestcourses',
16436: \%userenv,\%domdef,\%is_adv);
16437: }
1.724 raeburn 16438:
1.1273 raeburn 16439: $userenv{'canrequest.author'} =
16440: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16441: 'reload','requestauthor',
1.980 raeburn 16442: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 16443: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16444: $domain,$username);
16445: my $reqstatus = $reqauthor{'author_status'};
16446: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16447: if (ref($reqauthor{'author'}) eq 'HASH') {
16448: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16449: $reqauthor{'author'}{'timestamp'};
16450: }
1.1092 raeburn 16451: }
1.1287 raeburn 16452: my ($types,$typename) = &course_types();
16453: if (ref($types) eq 'ARRAY') {
16454: my @options = ('approval','validate','autolimit');
16455: my $optregex = join('|',@options);
16456: my (%willtrust,%trustchecked);
16457: foreach my $type (@{$types}) {
16458: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
16459: if ($dom_str ne '') {
16460: my $updatedstr = '';
16461: my @possdomains = split(',',$dom_str);
16462: foreach my $entry (@possdomains) {
16463: my ($extdom,$extopt) = split(':',$entry);
16464: unless ($trustchecked{$extdom}) {
16465: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
16466: $trustchecked{$extdom} = 1;
16467: }
16468: if ($willtrust{$extdom}) {
16469: $updatedstr .= $entry.',';
16470: }
16471: }
16472: $updatedstr =~ s/,$//;
16473: if ($updatedstr) {
16474: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
16475: } else {
16476: delete($userenv{'reqcrsotherdom.'.$type});
16477: }
16478: }
16479: }
16480: }
1.1092 raeburn 16481: }
1.462 albertel 16482: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16483:
1.462 albertel 16484: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16485: &GDBM_WRCREAT(),0640)) {
16486: &_add_to_env(\%disk_env,\%initial_env);
16487: &_add_to_env(\%disk_env,\%userenv,'environment.');
16488: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16489: if (ref($firstaccenv) eq 'HASH') {
16490: &_add_to_env(\%disk_env,$firstaccenv);
16491: }
16492: if (ref($timerintenv) eq 'HASH') {
16493: &_add_to_env(\%disk_env,$timerintenv);
16494: }
1.463 albertel 16495: if (ref($args->{'extra_env'})) {
16496: &_add_to_env(\%disk_env,$args->{'extra_env'});
16497: }
1.462 albertel 16498: untie(%disk_env);
16499: } else {
1.705 tempelho 16500: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16501: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16502: return 'error: '.$!;
16503: }
16504: }
16505: $env{'request.role'}='cm';
16506: $env{'request.role.adv'}=$env{'user.adv'};
16507: $env{'browser.type'}=$clientbrowser;
16508:
16509: return $cookie;
16510:
16511: }
16512:
16513: sub _add_to_env {
16514: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16515: if (ref($env_data) eq 'HASH') {
16516: while (my ($key,$value) = each(%$env_data)) {
16517: $idf->{$prefix.$key} = $value;
16518: $env{$prefix.$key} = $value;
16519: }
1.462 albertel 16520: }
16521: }
16522:
1.685 tempelho 16523: # --- Get the symbolic name of a problem and the url
16524: sub get_symb {
16525: my ($request,$silent) = @_;
1.726 raeburn 16526: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16527: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16528: if ($symb eq '') {
16529: if (!$silent) {
1.1071 raeburn 16530: if (ref($request)) {
16531: $request->print("Unable to handle ambiguous references:$url:.");
16532: }
1.685 tempelho 16533: return ();
16534: }
16535: }
16536: &Apache::lonenc::check_decrypt(\$symb);
16537: return ($symb);
16538: }
16539:
16540: # --------------------------------------------------------------Get annotation
16541:
16542: sub get_annotation {
16543: my ($symb,$enc) = @_;
16544:
16545: my $key = $symb;
16546: if (!$enc) {
16547: $key =
16548: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16549: }
16550: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16551: return $annotation{$key};
16552: }
16553:
16554: sub clean_symb {
1.731 raeburn 16555: my ($symb,$delete_enc) = @_;
1.685 tempelho 16556:
16557: &Apache::lonenc::check_decrypt(\$symb);
16558: my $enc = $env{'request.enc'};
1.731 raeburn 16559: if ($delete_enc) {
1.730 raeburn 16560: delete($env{'request.enc'});
16561: }
1.685 tempelho 16562:
16563: return ($symb,$enc);
16564: }
1.462 albertel 16565:
1.1181 raeburn 16566: ############################################################
16567: ############################################################
16568:
16569: =pod
16570:
16571: =head1 Routines for building display used to search for courses
16572:
16573:
16574: =over 4
16575:
16576: =item * &build_filters()
16577:
16578: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16579: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16580: and quotacheck.pl
16581:
1.1181 raeburn 16582:
16583: Inputs:
16584:
16585: filterlist - anonymous array of fields to include as potential filters
16586:
16587: crstype - course type
16588:
16589: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16590: to pop-open a course selector (will contain "extra element").
16591:
16592: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16593:
16594: filter - anonymous hash of criteria and their values
16595:
16596: action - form action
16597:
16598: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16599:
1.1182 raeburn 16600: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16601:
16602: cloneruname - username of owner of new course who wants to clone
16603:
16604: clonerudom - domain of owner of new course who wants to clone
16605:
16606: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16607:
16608: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16609:
16610: codedom - domain
16611:
16612: formname - value of form element named "form".
16613:
16614: fixeddom - domain, if fixed.
16615:
16616: prevphase - value to assign to form element named "phase" when going back to the previous screen
16617:
16618: cnameelement - name of form element in form on opener page which will receive title of selected course
16619:
16620: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16621:
16622: cdomelement - name of form element in form on opener page which will receive domain of selected course
16623:
16624: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16625:
16626: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16627:
16628: clonewarning - warning message about missing information for intended course owner when DC creates a course
16629:
1.1182 raeburn 16630:
1.1181 raeburn 16631: Returns: $output - HTML for display of search criteria, and hidden form elements.
16632:
1.1182 raeburn 16633:
1.1181 raeburn 16634: Side Effects: None
16635:
16636: =cut
16637:
16638: # ---------------------------------------------- search for courses based on last activity etc.
16639:
16640: sub build_filters {
16641: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16642: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16643: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16644: $cnameelement,$cnumelement,$cdomelement,$setroles,
16645: $clonetext,$clonewarning) = @_;
1.1182 raeburn 16646: my ($list,$jscript);
1.1181 raeburn 16647: my $onchange = 'javascript:updateFilters(this)';
16648: my ($domainselectform,$sincefilterform,$createdfilterform,
16649: $ownerdomselectform,$persondomselectform,$instcodeform,
16650: $typeselectform,$instcodetitle);
16651: if ($formname eq '') {
16652: $formname = $caller;
16653: }
16654: foreach my $item (@{$filterlist}) {
16655: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16656: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16657: if ($item eq 'domainfilter') {
16658: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16659: } elsif ($item eq 'coursefilter') {
16660: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16661: } elsif ($item eq 'ownerfilter') {
16662: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16663: } elsif ($item eq 'ownerdomfilter') {
16664: $filter->{'ownerdomfilter'} =
16665: &LONCAPA::clean_domain($filter->{$item});
16666: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16667: 'ownerdomfilter',1);
16668: } elsif ($item eq 'personfilter') {
16669: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16670: } elsif ($item eq 'persondomfilter') {
16671: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16672: 'persondomfilter',1);
16673: } else {
16674: $filter->{$item} =~ s/\W//g;
16675: }
16676: if (!$filter->{$item}) {
16677: $filter->{$item} = '';
16678: }
16679: }
16680: if ($item eq 'domainfilter') {
16681: my $allow_blank = 1;
16682: if ($formname eq 'portform') {
16683: $allow_blank=0;
16684: } elsif ($formname eq 'studentform') {
16685: $allow_blank=0;
16686: }
16687: if ($fixeddom) {
16688: $domainselectform = '<input type="hidden" name="domainfilter"'.
16689: ' value="'.$codedom.'" />'.
16690: &Apache::lonnet::domain($codedom,'description');
16691: } else {
16692: $domainselectform = &select_dom_form($filter->{$item},
16693: 'domainfilter',
16694: $allow_blank,'',$onchange);
16695: }
16696: } else {
16697: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16698: }
16699: }
16700:
16701: # last course activity filter and selection
16702: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16703:
16704: # course created filter and selection
16705: if (exists($filter->{'createdfilter'})) {
16706: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16707: }
16708:
1.1239 raeburn 16709: my $prefix = $crstype;
16710: if ($crstype eq 'Placement') {
16711: $prefix = 'Placement Test'
16712: }
1.1181 raeburn 16713: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 16714: 'cac' => "$prefix Activity",
16715: 'ccr' => "$prefix Created",
16716: 'cde' => "$prefix Title",
16717: 'cdo' => "$prefix Domain",
1.1181 raeburn 16718: 'ins' => 'Institutional Code',
16719: 'inc' => 'Institutional Categorization',
1.1239 raeburn 16720: 'cow' => "$prefix Owner/Co-owner",
16721: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 16722: 'cog' => 'Type',
16723: );
16724:
16725: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16726: my $typeval = 'Course';
16727: if ($crstype eq 'Community') {
16728: $typeval = 'Community';
1.1239 raeburn 16729: } elsif ($crstype eq 'Placement') {
16730: $typeval = 'Placement';
1.1181 raeburn 16731: }
16732: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16733: } else {
16734: $typeselectform = '<select name="type" size="1"';
16735: if ($onchange) {
16736: $typeselectform .= ' onchange="'.$onchange.'"';
16737: }
16738: $typeselectform .= '>'."\n";
1.1237 raeburn 16739: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 16740: my $shown;
16741: if ($posstype eq 'Placement') {
16742: $shown = &mt('Placement Test');
16743: } else {
16744: $shown = &mt($posstype);
16745: }
1.1181 raeburn 16746: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 16747: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 16748: }
16749: $typeselectform.="</select>";
16750: }
16751:
16752: my ($cloneableonlyform,$cloneabletitle);
16753: if (exists($filter->{'cloneableonly'})) {
16754: my $cloneableon = '';
16755: my $cloneableoff = ' checked="checked"';
16756: if ($filter->{'cloneableonly'}) {
16757: $cloneableon = $cloneableoff;
16758: $cloneableoff = '';
16759: }
16760: $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>';
16761: if ($formname eq 'ccrs') {
1.1187 bisitz 16762: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 16763: } else {
16764: $cloneabletitle = &mt('Cloneable by you');
16765: }
16766: }
16767: my $officialjs;
16768: if ($crstype eq 'Course') {
16769: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 16770: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16771: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16772: if ($codedom) {
1.1181 raeburn 16773: $officialjs = 1;
16774: ($instcodeform,$jscript,$$numtitlesref) =
16775: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16776: $officialjs,$codetitlesref);
16777: if ($jscript) {
1.1182 raeburn 16778: $jscript = '<script type="text/javascript">'."\n".
16779: '// <![CDATA['."\n".
16780: $jscript."\n".
16781: '// ]]>'."\n".
16782: '</script>'."\n";
1.1181 raeburn 16783: }
16784: }
16785: if ($instcodeform eq '') {
16786: $instcodeform =
16787: '<input type="text" name="instcodefilter" size="10" value="'.
16788: $list->{'instcodefilter'}.'" />';
16789: $instcodetitle = $lt{'ins'};
16790: } else {
16791: $instcodetitle = $lt{'inc'};
16792: }
16793: if ($fixeddom) {
16794: $instcodetitle .= '<br />('.$codedom.')';
16795: }
16796: }
16797: }
16798: my $output = qq|
16799: <form method="post" name="filterpicker" action="$action">
16800: <input type="hidden" name="form" value="$formname" />
16801: |;
16802: if ($formname eq 'modifycourse') {
16803: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16804: '<input type="hidden" name="prevphase" value="'.
16805: $prevphase.'" />'."\n";
1.1198 musolffc 16806: } elsif ($formname eq 'quotacheck') {
16807: $output .= qq|
16808: <input type="hidden" name="sortby" value="" />
16809: <input type="hidden" name="sortorder" value="" />
16810: |;
16811: } else {
1.1181 raeburn 16812: my $name_input;
16813: if ($cnameelement ne '') {
16814: $name_input = '<input type="hidden" name="cnameelement" value="'.
16815: $cnameelement.'" />';
16816: }
16817: $output .= qq|
1.1182 raeburn 16818: <input type="hidden" name="cnumelement" value="$cnumelement" />
16819: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 16820: $name_input
16821: $roleelement
16822: $multelement
16823: $typeelement
16824: |;
16825: if ($formname eq 'portform') {
16826: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16827: }
16828: }
16829: if ($fixeddom) {
16830: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16831: }
16832: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16833: if ($sincefilterform) {
16834: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16835: .$sincefilterform
16836: .&Apache::lonhtmlcommon::row_closure();
16837: }
16838: if ($createdfilterform) {
16839: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16840: .$createdfilterform
16841: .&Apache::lonhtmlcommon::row_closure();
16842: }
16843: if ($domainselectform) {
16844: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16845: .$domainselectform
16846: .&Apache::lonhtmlcommon::row_closure();
16847: }
16848: if ($typeselectform) {
16849: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16850: $output .= $typeselectform;
16851: } else {
16852: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16853: .$typeselectform
16854: .&Apache::lonhtmlcommon::row_closure();
16855: }
16856: }
16857: if ($instcodeform) {
16858: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16859: .$instcodeform
16860: .&Apache::lonhtmlcommon::row_closure();
16861: }
16862: if (exists($filter->{'ownerfilter'})) {
16863: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16864: '<table><tr><td>'.&mt('Username').'<br />'.
16865: '<input type="text" name="ownerfilter" size="20" value="'.
16866: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16867: $ownerdomselectform.'</td></tr></table>'.
16868: &Apache::lonhtmlcommon::row_closure();
16869: }
16870: if (exists($filter->{'personfilter'})) {
16871: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16872: '<table><tr><td>'.&mt('Username').'<br />'.
16873: '<input type="text" name="personfilter" size="20" value="'.
16874: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16875: $persondomselectform.'</td></tr></table>'.
16876: &Apache::lonhtmlcommon::row_closure();
16877: }
16878: if (exists($filter->{'coursefilter'})) {
16879: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16880: .'<input type="text" name="coursefilter" size="25" value="'
16881: .$list->{'coursefilter'}.'" />'
16882: .&Apache::lonhtmlcommon::row_closure();
16883: }
16884: if ($cloneableonlyform) {
16885: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16886: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16887: }
16888: if (exists($filter->{'descriptfilter'})) {
16889: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16890: .'<input type="text" name="descriptfilter" size="40" value="'
16891: .$list->{'descriptfilter'}.'" />'
16892: .&Apache::lonhtmlcommon::row_closure(1);
16893: }
16894: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16895: '<input type="hidden" name="updater" value="" />'."\n".
16896: '<input type="submit" name="gosearch" value="'.
16897: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16898: return $jscript.$clonewarning.$output;
16899: }
16900:
16901: =pod
16902:
16903: =item * &timebased_select_form()
16904:
1.1182 raeburn 16905: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 16906: filter e.g., Course Activity, Course Created, when searching for courses
16907: or communities
16908:
16909: Inputs:
16910:
16911: item - name of form element (sincefilter or createdfilter)
16912:
16913: filter - anonymous hash of criteria and their values
16914:
16915: Returns: HTML for a select box contained a blank, then six time selections,
16916: with value set in incoming form variables currently selected.
16917:
16918: Side Effects: None
16919:
16920: =cut
16921:
16922: sub timebased_select_form {
16923: my ($item,$filter) = @_;
16924: if (ref($filter) eq 'HASH') {
16925: $filter->{$item} =~ s/[^\d-]//g;
16926: if (!$filter->{$item}) { $filter->{$item}=-1; }
16927: return &select_form(
16928: $filter->{$item},
16929: $item,
16930: { '-1' => '',
16931: '86400' => &mt('today'),
16932: '604800' => &mt('last week'),
16933: '2592000' => &mt('last month'),
16934: '7776000' => &mt('last three months'),
16935: '15552000' => &mt('last six months'),
16936: '31104000' => &mt('last year'),
16937: 'select_form_order' =>
16938: ['-1','86400','604800','2592000','7776000',
16939: '15552000','31104000']});
16940: }
16941: }
16942:
16943: =pod
16944:
16945: =item * &js_changer()
16946:
16947: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 16948: when course type or domain is changed, and also to hide 'Searching ...' on
16949: page load completion for page showing search result.
1.1181 raeburn 16950:
16951: Inputs: None
16952:
1.1183 raeburn 16953: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16954:
16955: Side Effects: None
16956:
16957: =cut
16958:
16959: sub js_changer {
16960: return <<ENDJS;
16961: <script type="text/javascript">
16962: // <![CDATA[
16963: function updateFilters(caller) {
16964: if (typeof(caller) != "undefined") {
16965: document.filterpicker.updater.value = caller.name;
16966: }
16967: document.filterpicker.submit();
16968: }
1.1183 raeburn 16969:
16970: function hideSearching() {
16971: if (document.getElementById('searching')) {
16972: document.getElementById('searching').style.display = 'none';
16973: }
16974: return;
16975: }
16976:
1.1181 raeburn 16977: // ]]>
16978: </script>
16979:
16980: ENDJS
16981: }
16982:
16983: =pod
16984:
1.1182 raeburn 16985: =item * &search_courses()
16986:
16987: Process selected filters form course search form and pass to lonnet::courseiddump
16988: to retrieve a hash for which keys are courseIDs which match the selected filters.
16989:
16990: Inputs:
16991:
16992: dom - domain being searched
16993:
16994: type - course type ('Course' or 'Community' or '.' if any).
16995:
16996: filter - anonymous hash of criteria and their values
16997:
16998: numtitles - for institutional codes - number of categories
16999:
17000: cloneruname - optional username of new course owner
17001:
17002: clonerudom - optional domain of new course owner
17003:
1.1221 raeburn 17004: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 17005: (used when DC is using course creation form)
17006:
17007: codetitles - reference to array of titles of components in institutional codes (official courses).
17008:
1.1221 raeburn 17009: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17010: (and so can clone automatically)
17011:
17012: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17013:
17014: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17015: courses to clone
1.1182 raeburn 17016:
17017: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17018:
17019:
17020: Side Effects: None
17021:
17022: =cut
17023:
17024:
17025: sub search_courses {
1.1221 raeburn 17026: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17027: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 17028: my (%courses,%showcourses,$cloner);
17029: if (($filter->{'ownerfilter'} ne '') ||
17030: ($filter->{'ownerdomfilter'} ne '')) {
17031: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17032: $filter->{'ownerdomfilter'};
17033: }
17034: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17035: if (!$filter->{$item}) {
17036: $filter->{$item}='.';
17037: }
17038: }
17039: my $now = time;
17040: my $timefilter =
17041: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17042: my ($createdbefore,$createdafter);
17043: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17044: $createdbefore = $now;
17045: $createdafter = $now-$filter->{'createdfilter'};
17046: }
17047: my ($instcodefilter,$regexpok);
17048: if ($numtitles) {
17049: if ($env{'form.official'} eq 'on') {
17050: $instcodefilter =
17051: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17052: $regexpok = 1;
17053: } elsif ($env{'form.official'} eq 'off') {
17054: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17055: unless ($instcodefilter eq '') {
17056: $regexpok = -1;
17057: }
17058: }
17059: } else {
17060: $instcodefilter = $filter->{'instcodefilter'};
17061: }
17062: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17063: if ($type eq '') { $type = '.'; }
17064:
17065: if (($clonerudom ne '') && ($cloneruname ne '')) {
17066: $cloner = $cloneruname.':'.$clonerudom;
17067: }
17068: %courses = &Apache::lonnet::courseiddump($dom,
17069: $filter->{'descriptfilter'},
17070: $timefilter,
17071: $instcodefilter,
17072: $filter->{'combownerfilter'},
17073: $filter->{'coursefilter'},
17074: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 17075: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 17076: $filter->{'cloneableonly'},
17077: $createdbefore,$createdafter,undef,
1.1221 raeburn 17078: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 17079: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
17080: my $ccrole;
17081: if ($type eq 'Community') {
17082: $ccrole = 'co';
17083: } else {
17084: $ccrole = 'cc';
17085: }
17086: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
17087: $filter->{'persondomfilter'},
17088: 'userroles',undef,
17089: [$ccrole,'in','ad','ep','ta','cr'],
17090: $dom);
17091: foreach my $role (keys(%rolehash)) {
17092: my ($cnum,$cdom,$courserole) = split(':',$role);
17093: my $cid = $cdom.'_'.$cnum;
17094: if (exists($courses{$cid})) {
17095: if (ref($courses{$cid}) eq 'HASH') {
17096: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
17097: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 17098: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 17099: }
17100: } else {
17101: $courses{$cid}{roles} = [$courserole];
17102: }
17103: $showcourses{$cid} = $courses{$cid};
17104: }
17105: }
17106: }
17107: %courses = %showcourses;
17108: }
17109: return %courses;
17110: }
17111:
17112: =pod
17113:
1.1181 raeburn 17114: =back
17115:
1.1207 raeburn 17116: =head1 Routines for version requirements for current course.
17117:
17118: =over 4
17119:
17120: =item * &check_release_required()
17121:
17122: Compares required LON-CAPA version with version on server, and
17123: if required version is newer looks for a server with the required version.
17124:
17125: Looks first at servers in user's owen domain; if none suitable, looks at
17126: servers in course's domain are permitted to host sessions for user's domain.
17127:
17128: Inputs:
17129:
17130: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17131:
17132: $courseid - Course ID of current course
17133:
17134: $rolecode - User's current role in course (for switchserver query string).
17135:
17136: $required - LON-CAPA version needed by course (format: Major.Minor).
17137:
17138:
17139: Returns:
17140:
17141: $switchserver - query string tp append to /adm/switchserver call (if
17142: current server's LON-CAPA version is too old.
17143:
17144: $warning - Message is displayed if no suitable server could be found.
17145:
17146: =cut
17147:
17148: sub check_release_required {
17149: my ($loncaparev,$courseid,$rolecode,$required) = @_;
17150: my ($switchserver,$warning);
17151: if ($required ne '') {
17152: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
17153: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17154: if ($reqdmajor ne '' && $reqdminor ne '') {
17155: my $otherserver;
17156: if (($major eq '' && $minor eq '') ||
17157: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
17158: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
17159: my $switchlcrev =
17160: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
17161: $userdomserver);
17162: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17163: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
17164: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
17165: my $cdom = $env{'course.'.$courseid.'.domain'};
17166: if ($cdom ne $env{'user.domain'}) {
17167: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
17168: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
17169: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17170: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
17171: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
17172: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
17173: my $canhost =
17174: &Apache::lonnet::can_host_session($env{'user.domain'},
17175: $coursedomserver,
17176: $remoterev,
17177: $udomdefaults{'remotesessions'},
17178: $defdomdefaults{'hostedsessions'});
17179:
17180: if ($canhost) {
17181: $otherserver = $coursedomserver;
17182: } else {
17183: $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.");
17184: }
17185: } else {
17186: $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).");
17187: }
17188: } else {
17189: $otherserver = $userdomserver;
17190: }
17191: }
17192: if ($otherserver ne '') {
17193: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
17194: }
17195: }
17196: }
17197: return ($switchserver,$warning);
17198: }
17199:
17200: =pod
17201:
17202: =item * &check_release_result()
17203:
17204: Inputs:
17205:
17206: $switchwarning - Warning message if no suitable server found to host session.
17207:
17208: $switchserver - query string to append to /adm/switchserver containing lonHostID
17209: and current role.
17210:
17211: Returns: HTML to display with information about requirement to switch server.
17212: Either displaying warning with link to Roles/Courses screen or
17213: display link to switchserver.
17214:
1.1181 raeburn 17215: =cut
17216:
1.1207 raeburn 17217: sub check_release_result {
17218: my ($switchwarning,$switchserver) = @_;
17219: my $output = &start_page('Selected course unavailable on this server').
17220: '<p class="LC_warning">';
17221: if ($switchwarning) {
17222: $output .= $switchwarning.'<br /><a href="/adm/roles">';
17223: if (&show_course()) {
17224: $output .= &mt('Display courses');
17225: } else {
17226: $output .= &mt('Display roles');
17227: }
17228: $output .= '</a>';
17229: } elsif ($switchserver) {
17230: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17231: '<br />'.
17232: '<a href="/adm/switchserver?'.$switchserver.'">'.
17233: &mt('Switch Server').
17234: '</a>';
17235: }
17236: $output .= '</p>'.&end_page();
17237: return $output;
17238: }
17239:
17240: =pod
17241:
17242: =item * &needs_coursereinit()
17243:
17244: Determine if course contents stored for user's session needs to be
17245: refreshed, because content has changed since "Big Hash" last tied.
17246:
17247: Check for change is made if time last checked is more than 10 minutes ago
17248: (by default).
17249:
17250: Inputs:
17251:
17252: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17253:
17254: $interval (optional) - Time which may elapse (in s) between last check for content
17255: change in current course. (default: 600 s).
17256:
17257: Returns: an array; first element is:
17258:
17259: =over 4
17260:
17261: 'switch' - if content updates mean user's session
17262: needs to be switched to a server running a newer LON-CAPA version
17263:
17264: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17265: on current server hosting user's session
17266:
17267: '' - if no action required.
17268:
17269: =back
17270:
17271: If first item element is 'switch':
17272:
17273: second item is $switchwarning - Warning message if no suitable server found to host session.
17274:
17275: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17276: and current role.
17277:
17278: otherwise: no other elements returned.
17279:
17280: =back
17281:
17282: =cut
17283:
17284: sub needs_coursereinit {
17285: my ($loncaparev,$interval) = @_;
17286: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17287: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17288: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17289: my $now = time;
17290: if ($interval eq '') {
17291: $interval = 600;
17292: }
17293: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 17294: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1283 raeburn 17295: my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
1.1282 raeburn 17296: if ($blocked) {
17297: return ();
17298: }
1.1207 raeburn 17299: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
17300: if ($lastchange > $env{'request.course.tied'}) {
17301: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17302: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17303: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17304: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17305: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17306: $curr_reqd_hash{'internal.releaserequired'}});
17307: my ($switchserver,$switchwarning) =
17308: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17309: $curr_reqd_hash{'internal.releaserequired'});
17310: if ($switchwarning ne '' || $switchserver ne '') {
17311: return ('switch',$switchwarning,$switchserver);
17312: }
17313: }
17314: }
17315: return ('update');
17316: }
17317: }
17318: return ();
17319: }
1.1181 raeburn 17320:
1.1083 raeburn 17321: sub update_content_constraints {
17322: my ($cdom,$cnum,$chome,$cid) = @_;
17323: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17324: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 17325: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 17326: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 17327: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 17328: if ($item eq 'resourcetag') {
17329: if ($name eq 'responsetype') {
17330: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17331: }
1.1307 raeburn 17332: } elsif ($item eq 'course') {
17333: if ($name eq 'courserestype') {
17334: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
17335: }
1.1083 raeburn 17336: }
17337: }
17338: my $navmap = Apache::lonnavmaps::navmap->new();
17339: if (defined($navmap)) {
1.1307 raeburn 17340: my (%allresponses,%allcrsrestypes);
17341: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
17342: if ($res->is_tool()) {
17343: if ($allcrsrestypes{'exttool'}) {
17344: $allcrsrestypes{'exttool'} ++;
17345: } else {
17346: $allcrsrestypes{'exttool'} = 1;
17347: }
17348: next;
17349: }
1.1083 raeburn 17350: my %responses = $res->responseTypes();
17351: foreach my $key (keys(%responses)) {
17352: next unless(exists($checkresponsetypes{$key}));
17353: $allresponses{$key} += $responses{$key};
17354: }
17355: }
17356: foreach my $key (keys(%allresponses)) {
17357: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17358: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17359: ($reqdmajor,$reqdminor) = ($major,$minor);
17360: }
17361: }
1.1307 raeburn 17362: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 17363: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 17364: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17365: ($reqdmajor,$reqdminor) = ($major,$minor);
17366: }
17367: }
1.1083 raeburn 17368: undef($navmap);
17369: }
1.1308 raeburn 17370: my $suppmap = 'supplemental.sequence';
17371: my ($suppcount,$supptools,$errors) = (0,0,0);
17372: ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
17373: $suppcount,$supptools,$errors);
17374: if ($supptools) {
17375: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
17376: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17377: ($reqdmajor,$reqdminor) = ($major,$minor);
17378: }
17379: }
1.1083 raeburn 17380: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17381: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17382: }
17383: return;
17384: }
17385:
1.1110 raeburn 17386: sub allmaps_incourse {
17387: my ($cdom,$cnum,$chome,$cid) = @_;
17388: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17389: $cid = $env{'request.course.id'};
17390: $cdom = $env{'course.'.$cid.'.domain'};
17391: $cnum = $env{'course.'.$cid.'.num'};
17392: $chome = $env{'course.'.$cid.'.home'};
17393: }
17394: my %allmaps = ();
17395: my $lastchange =
17396: &Apache::lonnet::get_coursechange($cdom,$cnum);
17397: if ($lastchange > $env{'request.course.tied'}) {
17398: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17399: unless ($ferr) {
17400: &update_content_constraints($cdom,$cnum,$chome,$cid);
17401: }
17402: }
17403: my $navmap = Apache::lonnavmaps::navmap->new();
17404: if (defined($navmap)) {
17405: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17406: $allmaps{$res->src()} = 1;
17407: }
17408: }
17409: return \%allmaps;
17410: }
17411:
1.1083 raeburn 17412: sub parse_supplemental_title {
17413: my ($title) = @_;
17414:
17415: my ($foldertitle,$renametitle);
17416: if ($title =~ /&&&/) {
17417: $title = &HTML::Entites::decode($title);
17418: }
17419: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17420: $renametitle=$4;
17421: my ($time,$uname,$udom) = ($1,$2,$3);
17422: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17423: my $name = &plainname($uname,$udom);
17424: $name = &HTML::Entities::encode($name,'"<>&\'');
17425: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17426: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17427: $name.': <br />'.$foldertitle;
17428: }
17429: if (wantarray) {
17430: return ($title,$foldertitle,$renametitle);
17431: }
17432: return $title;
17433: }
17434:
1.1143 raeburn 17435: sub recurse_supplemental {
1.1308 raeburn 17436: my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
1.1143 raeburn 17437: if ($suppmap) {
17438: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17439: if ($fatal) {
17440: $errors ++;
17441: } else {
17442: if ($#LONCAPA::map::resources > 0) {
17443: foreach my $res (@LONCAPA::map::resources) {
17444: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
17445: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 17446: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1308 raeburn 17447: ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
17448: $numfiles,$numexttools,$errors);
1.1143 raeburn 17449: } else {
1.1308 raeburn 17450: if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
17451: $numexttools ++;
17452: }
1.1143 raeburn 17453: $numfiles ++;
17454: }
17455: }
17456: }
17457: }
17458: }
17459: }
1.1308 raeburn 17460: return ($numfiles,$numexttools,$errors);
1.1143 raeburn 17461: }
17462:
1.1101 raeburn 17463: sub symb_to_docspath {
1.1267 raeburn 17464: my ($symb,$navmapref) = @_;
17465: return unless ($symb && ref($navmapref));
1.1101 raeburn 17466: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17467: if ($resurl=~/\.(sequence|page)$/) {
17468: $mapurl=$resurl;
17469: } elsif ($resurl eq 'adm/navmaps') {
17470: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17471: }
17472: my $mapresobj;
1.1267 raeburn 17473: unless (ref($$navmapref)) {
17474: $$navmapref = Apache::lonnavmaps::navmap->new();
17475: }
17476: if (ref($$navmapref)) {
17477: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 17478: }
17479: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17480: my $type=$2;
17481: my $path;
17482: if (ref($mapresobj)) {
17483: my $pcslist = $mapresobj->map_hierarchy();
17484: if ($pcslist ne '') {
17485: foreach my $pc (split(/,/,$pcslist)) {
17486: next if ($pc <= 1);
1.1267 raeburn 17487: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 17488: if (ref($res)) {
17489: my $thisurl = $res->src();
17490: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17491: my $thistitle = $res->title();
17492: $path .= '&'.
17493: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 17494: &escape($thistitle).
1.1101 raeburn 17495: ':'.$res->randompick().
17496: ':'.$res->randomout().
17497: ':'.$res->encrypted().
17498: ':'.$res->randomorder().
17499: ':'.$res->is_page();
17500: }
17501: }
17502: }
17503: $path =~ s/^\&//;
17504: my $maptitle = $mapresobj->title();
17505: if ($mapurl eq 'default') {
1.1129 raeburn 17506: $maptitle = 'Main Content';
1.1101 raeburn 17507: }
17508: $path .= (($path ne '')? '&' : '').
17509: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17510: &escape($maptitle).
1.1101 raeburn 17511: ':'.$mapresobj->randompick().
17512: ':'.$mapresobj->randomout().
17513: ':'.$mapresobj->encrypted().
17514: ':'.$mapresobj->randomorder().
17515: ':'.$mapresobj->is_page();
17516: } else {
17517: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17518: my $ispage = (($type eq 'page')? 1 : '');
17519: if ($mapurl eq 'default') {
1.1129 raeburn 17520: $maptitle = 'Main Content';
1.1101 raeburn 17521: }
17522: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17523: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 17524: }
17525: unless ($mapurl eq 'default') {
17526: $path = 'default&'.
1.1146 raeburn 17527: &escape('Main Content').
1.1101 raeburn 17528: ':::::&'.$path;
17529: }
17530: return $path;
17531: }
17532:
1.1094 raeburn 17533: sub captcha_display {
17534: my ($context,$lonhost) = @_;
17535: my ($output,$error);
1.1234 raeburn 17536: my ($captcha,$pubkey,$privkey,$version) =
17537: &get_captcha_config($context,$lonhost);
1.1095 raeburn 17538: if ($captcha eq 'original') {
1.1094 raeburn 17539: $output = &create_captcha();
17540: unless ($output) {
1.1172 raeburn 17541: $error = 'captcha';
1.1094 raeburn 17542: }
17543: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17544: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17545: unless ($output) {
1.1172 raeburn 17546: $error = 'recaptcha';
1.1094 raeburn 17547: }
17548: }
1.1234 raeburn 17549: return ($output,$error,$captcha,$version);
1.1094 raeburn 17550: }
17551:
17552: sub captcha_response {
17553: my ($context,$lonhost) = @_;
17554: my ($captcha_chk,$captcha_error);
1.1234 raeburn 17555: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 17556: if ($captcha eq 'original') {
1.1094 raeburn 17557: ($captcha_chk,$captcha_error) = &check_captcha();
17558: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17559: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17560: } else {
17561: $captcha_chk = 1;
17562: }
17563: return ($captcha_chk,$captcha_error);
17564: }
17565:
17566: sub get_captcha_config {
17567: my ($context,$lonhost) = @_;
1.1234 raeburn 17568: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17569: my $hostname = &Apache::lonnet::hostname($lonhost);
17570: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17571: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17572: if ($context eq 'usercreation') {
17573: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17574: if (ref($domconfig{$context}) eq 'HASH') {
17575: $hashtocheck = $domconfig{$context}{'cancreate'};
17576: if (ref($hashtocheck) eq 'HASH') {
17577: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17578: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17579: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17580: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17581: }
17582: if ($privkey && $pubkey) {
17583: $captcha = 'recaptcha';
1.1234 raeburn 17584: $version = $hashtocheck->{'recaptchaversion'};
17585: if ($version ne '2') {
17586: $version = 1;
17587: }
1.1095 raeburn 17588: } else {
17589: $captcha = 'original';
17590: }
17591: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17592: $captcha = 'original';
17593: }
1.1094 raeburn 17594: }
1.1095 raeburn 17595: } else {
17596: $captcha = 'captcha';
17597: }
17598: } elsif ($context eq 'login') {
17599: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17600: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17601: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17602: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17603: if ($privkey && $pubkey) {
17604: $captcha = 'recaptcha';
1.1234 raeburn 17605: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17606: if ($version ne '2') {
17607: $version = 1;
17608: }
1.1095 raeburn 17609: } else {
17610: $captcha = 'original';
1.1094 raeburn 17611: }
1.1095 raeburn 17612: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17613: $captcha = 'original';
1.1094 raeburn 17614: }
17615: }
1.1234 raeburn 17616: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 17617: }
17618:
17619: sub create_captcha {
17620: my %captcha_params = &captcha_settings();
17621: my ($output,$maxtries,$tries) = ('',10,0);
17622: while ($tries < $maxtries) {
17623: $tries ++;
17624: my $captcha = Authen::Captcha->new (
17625: output_folder => $captcha_params{'output_dir'},
17626: data_folder => $captcha_params{'db_dir'},
17627: );
17628: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17629:
17630: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17631: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
17632: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 17633: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
17634: '<br />'.
17635: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 17636: last;
17637: }
17638: }
17639: return $output;
17640: }
17641:
17642: sub captcha_settings {
17643: my %captcha_params = (
17644: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17645: www_output_dir => "/captchaspool",
17646: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17647: numchars => '5',
17648: );
17649: return %captcha_params;
17650: }
17651:
17652: sub check_captcha {
17653: my ($captcha_chk,$captcha_error);
17654: my $code = $env{'form.code'};
17655: my $md5sum = $env{'form.crypt'};
17656: my %captcha_params = &captcha_settings();
17657: my $captcha = Authen::Captcha->new(
17658: output_folder => $captcha_params{'output_dir'},
17659: data_folder => $captcha_params{'db_dir'},
17660: );
1.1109 raeburn 17661: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 17662: my %captcha_hash = (
17663: 0 => 'Code not checked (file error)',
17664: -1 => 'Failed: code expired',
17665: -2 => 'Failed: invalid code (not in database)',
17666: -3 => 'Failed: invalid code (code does not match crypt)',
17667: );
17668: if ($captcha_chk != 1) {
17669: $captcha_error = $captcha_hash{$captcha_chk}
17670: }
17671: return ($captcha_chk,$captcha_error);
17672: }
17673:
17674: sub create_recaptcha {
1.1234 raeburn 17675: my ($pubkey,$version) = @_;
17676: if ($version >= 2) {
17677: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17678: } else {
17679: my $use_ssl;
17680: if ($ENV{'SERVER_PORT'} == 443) {
17681: $use_ssl = 1;
17682: }
17683: my $captcha = Captcha::reCAPTCHA->new;
17684: return $captcha->get_options_setter({theme => 'white'})."\n".
17685: $captcha->get_html($pubkey,undef,$use_ssl).
17686: &mt('If the text is hard to read, [_1] will replace them.',
17687: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17688: '<br /><br />';
17689: }
1.1094 raeburn 17690: }
17691:
17692: sub check_recaptcha {
1.1234 raeburn 17693: my ($privkey,$version) = @_;
1.1094 raeburn 17694: my $captcha_chk;
1.1234 raeburn 17695: if ($version >= 2) {
17696: my %info = (
17697: secret => $privkey,
17698: response => $env{'form.g-recaptcha-response'},
17699: remoteip => $ENV{'REMOTE_ADDR'},
17700: );
1.1280 raeburn 17701: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
17702: $request->content(join('&',map {
17703: my $name = escape($_);
17704: "$name=" . ( ref($info{$_}) eq 'ARRAY'
17705: ? join("&$name=", map {escape($_) } @{$info{$_}})
17706: : &escape($info{$_}) );
17707: } keys(%info)));
17708: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 17709: if ($response->is_success) {
17710: my $data = JSON::DWIW->from_json($response->decoded_content);
17711: if (ref($data) eq 'HASH') {
17712: if ($data->{'success'}) {
17713: $captcha_chk = 1;
17714: }
17715: }
17716: }
17717: } else {
17718: my $captcha = Captcha::reCAPTCHA->new;
17719: my $captcha_result =
17720: $captcha->check_answer(
17721: $privkey,
17722: $ENV{'REMOTE_ADDR'},
17723: $env{'form.recaptcha_challenge_field'},
17724: $env{'form.recaptcha_response_field'},
17725: );
17726: if ($captcha_result->{is_valid}) {
17727: $captcha_chk = 1;
17728: }
1.1094 raeburn 17729: }
17730: return $captcha_chk;
17731: }
17732:
1.1174 raeburn 17733: sub emailusername_info {
1.1244 raeburn 17734: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 17735: my %titles = &Apache::lonlocal::texthash (
17736: lastname => 'Last Name',
17737: firstname => 'First Name',
17738: institution => 'School/college/university',
17739: location => "School's city, state/province, country",
17740: web => "School's web address",
17741: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 17742: id => 'Student/Employee ID',
1.1174 raeburn 17743: );
17744: return (\@fields,\%titles);
17745: }
17746:
1.1161 raeburn 17747: sub cleanup_html {
17748: my ($incoming) = @_;
17749: my $outgoing;
17750: if ($incoming ne '') {
17751: $outgoing = $incoming;
17752: $outgoing =~ s/;/;/g;
17753: $outgoing =~ s/\#/#/g;
17754: $outgoing =~ s/\&/&/g;
17755: $outgoing =~ s/</</g;
17756: $outgoing =~ s/>/>/g;
17757: $outgoing =~ s/\(/(/g;
17758: $outgoing =~ s/\)/)/g;
17759: $outgoing =~ s/"/"/g;
17760: $outgoing =~ s/'/'/g;
17761: $outgoing =~ s/\$/$/g;
17762: $outgoing =~ s{/}{/}g;
17763: $outgoing =~ s/=/=/g;
17764: $outgoing =~ s/\\/\/g
17765: }
17766: return $outgoing;
17767: }
17768:
1.1190 musolffc 17769: # Checks for critical messages and returns a redirect url if one exists.
17770: # $interval indicates how often to check for messages.
1.1282 raeburn 17771: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 17772: sub critical_redirect {
1.1282 raeburn 17773: my ($interval,$context) = @_;
1.1190 musolffc 17774: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 17775: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
17776: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17777: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17778: my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
17779: if ($blocked) {
17780: my $checkrole = "cm./$cdom/$cnum";
17781: if ($env{'request.course.sec'} ne '') {
17782: $checkrole .= "/$env{'request.course.sec'}";
17783: }
17784: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
17785: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
17786: return;
17787: }
17788: }
17789: }
1.1190 musolffc 17790: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17791: $env{'user.name'});
17792: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 17793: my $redirecturl;
1.1190 musolffc 17794: if ($what[0]) {
17795: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17796: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 17797: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17798: return (1, $url);
1.1190 musolffc 17799: }
1.1191 raeburn 17800: }
17801: }
17802: return ();
1.1190 musolffc 17803: }
17804:
1.1174 raeburn 17805: # Use:
17806: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17807: #
17808: ##################################################
17809: # password associated functions #
17810: ##################################################
17811: sub des_keys {
17812: # Make a new key for DES encryption.
17813: # Each key has two parts which are returned separately.
17814: # Please note: Each key must be passed through the &hex function
17815: # before it is output to the web browser. The hex versions cannot
17816: # be used to decrypt.
17817: my @hexstr=('0','1','2','3','4','5','6','7',
17818: '8','9','a','b','c','d','e','f');
17819: my $lkey='';
17820: for (0..7) {
17821: $lkey.=$hexstr[rand(15)];
17822: }
17823: my $ukey='';
17824: for (0..7) {
17825: $ukey.=$hexstr[rand(15)];
17826: }
17827: return ($lkey,$ukey);
17828: }
17829:
17830: sub des_decrypt {
17831: my ($key,$cyphertext) = @_;
17832: my $keybin=pack("H16",$key);
17833: my $cypher;
17834: if ($Crypt::DES::VERSION>=2.03) {
17835: $cypher=new Crypt::DES $keybin;
17836: } else {
17837: $cypher=new DES $keybin;
17838: }
1.1233 raeburn 17839: my $plaintext='';
17840: my $cypherlength = length($cyphertext);
17841: my $numchunks = int($cypherlength/32);
17842: for (my $j=0; $j<$numchunks; $j++) {
17843: my $start = $j*32;
17844: my $cypherblock = substr($cyphertext,$start,32);
17845: my $chunk =
17846: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17847: $chunk .=
17848: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17849: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17850: $plaintext .= $chunk;
17851: }
1.1174 raeburn 17852: return $plaintext;
17853: }
17854:
1.1309 ! raeburn 17855: sub make_short_symbs {
! 17856: my ($cdom,$cnum,$navmap) = @_;
! 17857: return unless (ref($navmap));
! 17858: my ($numnew,@errors);
! 17859: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
! 17860: if (@toshorten) {
! 17861: my (%maps,%resources,%titles);
! 17862: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
! 17863: 'shorturls',$cdom,$cnum);
! 17864: my %tocreate;
! 17865: if (keys(%resources)) {
! 17866: foreach my $item (sort {$a <=> $b} (@toshorten)) {
! 17867: my $symb = $resources{$item};
! 17868: if ($symb) {
! 17869: $tocreate{$cnum.'&'.$symb} = 1;
! 17870: }
! 17871: }
! 17872: }
! 17873: if (keys(%tocreate)) {
! 17874: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
! 17875: my $su = Short::URL->new(no_vowels => 1);
! 17876: my $init = '';
! 17877: my (%newunique,%addcourse,%courseonly,%failed);
! 17878: # get lock on tiny db
! 17879: my $now = time;
! 17880: my $lockhash = {
! 17881: "lock\0$now" => $env{'user.name'}.
! 17882: ':'.$env{'user.domain'},
! 17883: };
! 17884: my $tries = 0;
! 17885: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
! 17886: my ($code,$error);
! 17887: while (($gotlock ne 'ok') && ($tries<3)) {
! 17888: $tries ++;
! 17889: sleep 1;
! 17890: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
! 17891: }
! 17892: if ($gotlock eq 'ok') {
! 17893: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
! 17894: \%addcourse,\%courseonly,\%failed);
! 17895: if (keys(%failed)) {
! 17896: my $numfailed = scalar(keys(%failed));
! 17897: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
! 17898: }
! 17899: if (keys(%newunique)) {
! 17900: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
! 17901: if ($putres eq 'ok') {
! 17902: $numnew = scalar(keys(%newunique));
! 17903: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
! 17904: unless ($newputres eq 'ok') {
! 17905: push(@errors,&mt('error: could not store course look-up of short URLs'));
! 17906: }
! 17907: } else {
! 17908: push(@errors,&mt('error: could not store unique six character URLs'));
! 17909: }
! 17910: }
! 17911: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
! 17912: unless ($dellockres eq 'ok') {
! 17913: push(@errors,&mt('error: could not release lockfile'));
! 17914: }
! 17915: } else {
! 17916: push(@errors,&mt('error: could not obtain lockfile'));
! 17917: }
! 17918: if (keys(%courseonly)) {
! 17919: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
! 17920: if ($result ne 'ok') {
! 17921: push(@errors,&mt('error: could not update course look-up of short URLs'));
! 17922: }
! 17923: }
! 17924: }
! 17925: }
! 17926: return ($numnew,\@errors);
! 17927: }
! 17928:
! 17929: sub shorten_symbs {
! 17930: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
! 17931: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
! 17932: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
! 17933: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
! 17934: my (%possibles,%collisions);
! 17935: foreach my $key (keys(%{$tocreate})) {
! 17936: my $num = String::CRC32::crc32($key);
! 17937: my $tiny = $su->encode($num,$init);
! 17938: if ($tiny) {
! 17939: $possibles{$tiny} = $key;
! 17940: }
! 17941: }
! 17942: if (!$init) {
! 17943: $init = 1;
! 17944: } else {
! 17945: $init ++;
! 17946: }
! 17947: if (keys(%possibles)) {
! 17948: my @posstiny = keys(%possibles);
! 17949: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
! 17950: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
! 17951: if (keys(%currtiny)) {
! 17952: foreach my $key (keys(%currtiny)) {
! 17953: next if ($currtiny{$key} eq '');
! 17954: if ($currtiny{$key} eq $possibles{$key}) {
! 17955: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
! 17956: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
! 17957: $courseonly->{$tsymb} = $key;
! 17958: }
! 17959: } else {
! 17960: $collisions{$possibles{$key}} = 1;
! 17961: }
! 17962: delete($possibles{$key});
! 17963: }
! 17964: }
! 17965: foreach my $key (keys(%possibles)) {
! 17966: $newunique->{$key} = $possibles{$key};
! 17967: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
! 17968: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
! 17969: $addcourse->{$tsymb} = $key;
! 17970: }
! 17971: }
! 17972: }
! 17973: if (keys(%collisions)) {
! 17974: if ($init <5) {
! 17975: if (!$init) {
! 17976: $init = 1;
! 17977: } else {
! 17978: $init ++;
! 17979: }
! 17980: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
! 17981: $newunique,$addcourse,$courseonly,$failed);
! 17982: } else {
! 17983: foreach my $key (keys(%collisions)) {
! 17984: $failed->{$key} = 1;
! 17985: }
! 17986: }
! 17987: }
! 17988: return $init;
! 17989: }
! 17990:
1.112 bowersj2 17991: 1;
17992: __END__;
1.41 ng 17993:
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