Annotation of loncom/interface/loncommon.pm, revision 1.1314
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1314 ! raeburn 4: # $Id: loncommon.pm,v 1.1313 2018/04/15 00:28:07 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.1314 ! raeburn 1300: my $target = ' target="_top"';
! 1301: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
! 1302: $target = '';
! 1303: }
1.755 neumanie 1304: if ($text ne "") {
1.763 bisitz 1305: $template.='<span class="LC_help_open_topic">'
1.1314 ! raeburn 1306: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1307: .$text.'</a>';
1.48 bowersj2 1308: }
1309:
1.763 bisitz 1310: # (Always) Add the graphic
1.179 matthew 1311: my $title = &mt('Online Help');
1.667 raeburn 1312: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1313: if ($imgid ne '') {
1314: $imgid = ' id="'.$imgid.'"';
1315: }
1.1314 ! raeburn 1316: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1317: .'<img src="'.$helpicon.'" border="0"'
1318: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1319: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1320: .' /></a>';
1321: if ($text ne "") {
1322: $template.='</span>';
1323: }
1.44 bowersj2 1324: return $template;
1325:
1.106 bowersj2 1326: }
1327:
1328: # This is a quicky function for Latex cheatsheet editing, since it
1329: # appears in at least four places
1330: sub helpLatexCheatsheet {
1.1037 www 1331: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1332: my $out;
1.106 bowersj2 1333: my $addOther = '';
1.732 raeburn 1334: if ($topic) {
1.1037 www 1335: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1336: }
1337: $out = '<span>' # Start cheatsheet
1338: .$addOther
1339: .'<span>'
1.1037 www 1340: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1341: .'</span> <span>'
1.1037 www 1342: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1343: .'</span>';
1.732 raeburn 1344: unless ($not_author) {
1.1186 kruse 1345: $out .= '<span>'
1346: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1347: .'</span> <span>'
1348: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1349: .'</span>';
1.732 raeburn 1350: }
1.763 bisitz 1351: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1352: return $out;
1.172 www 1353: }
1354:
1.430 albertel 1355: sub general_help {
1356: my $helptopic='Student_Intro';
1357: if ($env{'request.role'}=~/^(ca|au)/) {
1358: $helptopic='Authoring_Intro';
1.907 raeburn 1359: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1360: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1361: } elsif ($env{'request.role'}=~/^dc/) {
1362: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1363: }
1364: return $helptopic;
1365: }
1366:
1367: sub update_help_link {
1368: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1369: my $origurl = $ENV{'REQUEST_URI'};
1370: $origurl=~s|^/~|/priv/|;
1371: my $timestamp = time;
1372: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1373: $$datum = &escape($$datum);
1374: }
1375:
1376: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1377: my $output .= <<"ENDOUTPUT";
1378: <script type="text/javascript">
1.824 bisitz 1379: // <![CDATA[
1.430 albertel 1380: banner_link = '$banner_link';
1.824 bisitz 1381: // ]]>
1.430 albertel 1382: </script>
1383: ENDOUTPUT
1384: return $output;
1385: }
1386:
1387: # now just updates the help link and generates a blue icon
1.193 raeburn 1388: sub help_open_menu {
1.430 albertel 1389: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1390: = @_;
1.949 droeschl 1391: $stayOnPage = 1;
1.430 albertel 1392: my $output;
1393: if ($component_help) {
1394: if (!$text) {
1395: $output=&help_open_topic($component_help,undef,$stayOnPage,
1396: $width,$height);
1397: } else {
1398: my $help_text;
1399: $help_text=&unescape($topic);
1400: $output='<table><tr><td>'.
1401: &help_open_topic($component_help,$help_text,$stayOnPage,
1402: $width,$height).'</td></tr></table>';
1403: }
1404: }
1405: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1406: return $output.$banner_link;
1407: }
1408:
1409: sub top_nav_help {
1410: my ($text) = @_;
1.436 albertel 1411: $text = &mt($text);
1.949 droeschl 1412: my $stay_on_page = 1;
1413:
1.1168 raeburn 1414: my ($link,$banner_link);
1415: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1416: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1417: : "javascript:helpMenu('open')";
1418: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1419: }
1.201 raeburn 1420: my $title = &mt('Get help');
1.1168 raeburn 1421: if ($link) {
1422: return <<"END";
1.436 albertel 1423: $banner_link
1.1159 raeburn 1424: <a href="$link" title="$title">$text</a>
1.436 albertel 1425: END
1.1168 raeburn 1426: } else {
1427: return ' '.$text.' ';
1428: }
1.436 albertel 1429: }
1430:
1431: sub help_menu_js {
1.1154 raeburn 1432: my ($httphost) = @_;
1.949 droeschl 1433: my $stayOnPage = 1;
1.436 albertel 1434: my $width = 620;
1435: my $height = 600;
1.430 albertel 1436: my $helptopic=&general_help();
1.1154 raeburn 1437: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1438: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1439: my $start_page =
1440: &Apache::loncommon::start_page('Help Menu', undef,
1441: {'frameset' => 1,
1442: 'js_ready' => 1,
1.1154 raeburn 1443: 'use_absolute' => $httphost,
1.331 albertel 1444: 'add_entries' => {
1.1168 raeburn 1445: 'border' => '0',
1.579 raeburn 1446: 'rows' => "110,*",},});
1.331 albertel 1447: my $end_page =
1448: &Apache::loncommon::end_page({'frameset' => 1,
1449: 'js_ready' => 1,});
1450:
1.436 albertel 1451: my $template .= <<"ENDTEMPLATE";
1452: <script type="text/javascript">
1.877 bisitz 1453: // <![CDATA[
1.253 albertel 1454: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1455: var banner_link = '';
1.243 raeburn 1456: function helpMenu(target) {
1457: var caller = this;
1458: if (target == 'open') {
1459: var newWindow = null;
1460: try {
1.262 albertel 1461: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1462: }
1463: catch(error) {
1464: writeHelp(caller);
1465: return;
1466: }
1467: if (newWindow) {
1468: caller = newWindow;
1469: }
1.193 raeburn 1470: }
1.243 raeburn 1471: writeHelp(caller);
1472: return;
1473: }
1474: function writeHelp(caller) {
1.1168 raeburn 1475: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1476: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1477: caller.document.close();
1478: caller.focus();
1.193 raeburn 1479: }
1.877 bisitz 1480: // END LON-CAPA Internal -->
1.253 albertel 1481: // ]]>
1.436 albertel 1482: </script>
1.193 raeburn 1483: ENDTEMPLATE
1484: return $template;
1485: }
1486:
1.172 www 1487: sub help_open_bug {
1488: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1489: unless ($env{'user.adv'}) { return ''; }
1.172 www 1490: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1491: $text = "" if (not defined $text);
1492: $stayOnPage=1;
1.184 albertel 1493: $width = 600 if (not defined $width);
1494: $height = 600 if (not defined $height);
1.172 www 1495:
1496: $topic=~s/\W+/\+/g;
1497: my $link='';
1498: my $template='';
1.379 albertel 1499: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1500: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1501: if (!$stayOnPage)
1502: {
1503: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1504: }
1505: else
1506: {
1507: $link = $url;
1508: }
1.1314 ! raeburn 1509:
! 1510: my $target = ' target="_top"';
! 1511: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
! 1512: $target = '';
! 1513: }
1.172 www 1514: # Add the text
1515: if ($text ne "")
1516: {
1517: $template .=
1518: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1314 ! raeburn 1519: "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1520: }
1521:
1522: # Add the graphic
1.179 matthew 1523: my $title = &mt('Report a Bug');
1.215 albertel 1524: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1525: $template .= <<"ENDTEMPLATE";
1.1314 ! raeburn 1526: <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1527: ENDTEMPLATE
1528: if ($text ne '') { $template.='</td></tr></table>' };
1529: return $template;
1530:
1531: }
1532:
1533: sub help_open_faq {
1534: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1535: unless ($env{'user.adv'}) { return ''; }
1.172 www 1536: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1537: $text = "" if (not defined $text);
1538: $stayOnPage=1;
1539: $width = 350 if (not defined $width);
1540: $height = 400 if (not defined $height);
1541:
1542: $topic=~s/\W+/\+/g;
1543: my $link='';
1544: my $template='';
1545: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1546: if (!$stayOnPage)
1547: {
1548: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1549: }
1550: else
1551: {
1552: $link = $url;
1553: }
1554:
1555: # Add the text
1556: if ($text ne "")
1557: {
1558: $template .=
1.173 www 1559: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1560: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1561: }
1562:
1563: # Add the graphic
1.179 matthew 1564: my $title = &mt('View the FAQ');
1.215 albertel 1565: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1566: $template .= <<"ENDTEMPLATE";
1.436 albertel 1567: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1568: ENDTEMPLATE
1569: if ($text ne '') { $template.='</td></tr></table>' };
1570: return $template;
1571:
1.44 bowersj2 1572: }
1.37 matthew 1573:
1.180 matthew 1574: ###############################################################
1575: ###############################################################
1576:
1.45 matthew 1577: =pod
1578:
1.648 raeburn 1579: =item * &change_content_javascript():
1.256 matthew 1580:
1581: This and the next function allow you to create small sections of an
1582: otherwise static HTML page that you can update on the fly with
1583: Javascript, even in Netscape 4.
1584:
1585: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1586: must be written to the HTML page once. It will prove the Javascript
1587: function "change(name, content)". Calling the change function with the
1588: name of the section
1589: you want to update, matching the name passed to C<changable_area>, and
1590: the new content you want to put in there, will put the content into
1591: that area.
1592:
1593: B<Note>: Netscape 4 only reserves enough space for the changable area
1594: to contain room for the original contents. You need to "make space"
1595: for whatever changes you wish to make, and be B<sure> to check your
1596: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1597: it's adequate for updating a one-line status display, but little more.
1598: This script will set the space to 100% width, so you only need to
1599: worry about height in Netscape 4.
1600:
1601: Modern browsers are much less limiting, and if you can commit to the
1602: user not using Netscape 4, this feature may be used freely with
1603: pretty much any HTML.
1604:
1605: =cut
1606:
1607: sub change_content_javascript {
1608: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1609: if ($env{'browser.type'} eq 'netscape' &&
1610: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1611: return (<<NETSCAPE4);
1612: function change(name, content) {
1613: doc = document.layers[name+"___escape"].layers[0].document;
1614: doc.open();
1615: doc.write(content);
1616: doc.close();
1617: }
1618: NETSCAPE4
1619: } else {
1620: # Otherwise, we need to use semi-standards-compliant code
1621: # (technically, "innerHTML" isn't standard but the equivalent
1622: # is really scary, and every useful browser supports it
1623: return (<<DOMBASED);
1624: function change(name, content) {
1625: element = document.getElementById(name);
1626: element.innerHTML = content;
1627: }
1628: DOMBASED
1629: }
1630: }
1631:
1632: =pod
1633:
1.648 raeburn 1634: =item * &changable_area($name,$origContent):
1.256 matthew 1635:
1636: This provides a "changable area" that can be modified on the fly via
1637: the Javascript code provided in C<change_content_javascript>. $name is
1638: the name you will use to reference the area later; do not repeat the
1639: same name on a given HTML page more then once. $origContent is what
1640: the area will originally contain, which can be left blank.
1641:
1642: =cut
1643:
1644: sub changable_area {
1645: my ($name, $origContent) = @_;
1646:
1.258 albertel 1647: if ($env{'browser.type'} eq 'netscape' &&
1648: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1649: # If this is netscape 4, we need to use the Layer tag
1650: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1651: } else {
1652: return "<span id='$name'>$origContent</span>";
1653: }
1654: }
1655:
1656: =pod
1657:
1.648 raeburn 1658: =item * &viewport_geometry_js
1.590 raeburn 1659:
1660: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1661:
1662: =cut
1663:
1664:
1665: sub viewport_geometry_js {
1666: return <<"GEOMETRY";
1667: var Geometry = {};
1668: function init_geometry() {
1669: if (Geometry.init) { return };
1670: Geometry.init=1;
1671: if (window.innerHeight) {
1672: Geometry.getViewportHeight = function() { return window.innerHeight; };
1673: Geometry.getViewportWidth = function() { return window.innerWidth; };
1674: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1675: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1676: }
1677: else if (document.documentElement && document.documentElement.clientHeight) {
1678: Geometry.getViewportHeight =
1679: function() { return document.documentElement.clientHeight; };
1680: Geometry.getViewportWidth =
1681: function() { return document.documentElement.clientWidth; };
1682:
1683: Geometry.getHorizontalScroll =
1684: function() { return document.documentElement.scrollLeft; };
1685: Geometry.getVerticalScroll =
1686: function() { return document.documentElement.scrollTop; };
1687: }
1688: else if (document.body.clientHeight) {
1689: Geometry.getViewportHeight =
1690: function() { return document.body.clientHeight; };
1691: Geometry.getViewportWidth =
1692: function() { return document.body.clientWidth; };
1693: Geometry.getHorizontalScroll =
1694: function() { return document.body.scrollLeft; };
1695: Geometry.getVerticalScroll =
1696: function() { return document.body.scrollTop; };
1697: }
1698: }
1699:
1700: GEOMETRY
1701: }
1702:
1703: =pod
1704:
1.648 raeburn 1705: =item * &viewport_size_js()
1.590 raeburn 1706:
1707: 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.
1708:
1709: =cut
1710:
1711: sub viewport_size_js {
1712: my $geometry = &viewport_geometry_js();
1713: return <<"DIMS";
1714:
1715: $geometry
1716:
1717: function getViewportDims(width,height) {
1718: init_geometry();
1719: width.value = Geometry.getViewportWidth();
1720: height.value = Geometry.getViewportHeight();
1721: return;
1722: }
1723:
1724: DIMS
1725: }
1726:
1727: =pod
1728:
1.648 raeburn 1729: =item * &resize_textarea_js()
1.565 albertel 1730:
1731: emits the needed javascript to resize a textarea to be as big as possible
1732:
1733: creates a function resize_textrea that takes two IDs first should be
1734: the id of the element to resize, second should be the id of a div that
1735: surrounds everything that comes after the textarea, this routine needs
1736: to be attached to the <body> for the onload and onresize events.
1737:
1.648 raeburn 1738: =back
1.565 albertel 1739:
1740: =cut
1741:
1742: sub resize_textarea_js {
1.590 raeburn 1743: my $geometry = &viewport_geometry_js();
1.565 albertel 1744: return <<"RESIZE";
1745: <script type="text/javascript">
1.824 bisitz 1746: // <![CDATA[
1.590 raeburn 1747: $geometry
1.565 albertel 1748:
1.588 albertel 1749: function getX(element) {
1750: var x = 0;
1751: while (element) {
1752: x += element.offsetLeft;
1753: element = element.offsetParent;
1754: }
1755: return x;
1756: }
1757: function getY(element) {
1758: var y = 0;
1759: while (element) {
1760: y += element.offsetTop;
1761: element = element.offsetParent;
1762: }
1763: return y;
1764: }
1765:
1766:
1.565 albertel 1767: function resize_textarea(textarea_id,bottom_id) {
1768: init_geometry();
1769: var textarea = document.getElementById(textarea_id);
1770: //alert(textarea);
1771:
1.588 albertel 1772: var textarea_top = getY(textarea);
1.565 albertel 1773: var textarea_height = textarea.offsetHeight;
1774: var bottom = document.getElementById(bottom_id);
1.588 albertel 1775: var bottom_top = getY(bottom);
1.565 albertel 1776: var bottom_height = bottom.offsetHeight;
1777: var window_height = Geometry.getViewportHeight();
1.588 albertel 1778: var fudge = 23;
1.565 albertel 1779: var new_height = window_height-fudge-textarea_top-bottom_height;
1780: if (new_height < 300) {
1781: new_height = 300;
1782: }
1783: textarea.style.height=new_height+'px';
1784: }
1.824 bisitz 1785: // ]]>
1.565 albertel 1786: </script>
1787: RESIZE
1788:
1789: }
1790:
1.1205 golterma 1791: sub colorfuleditor_js {
1.1248 raeburn 1792: my $browse_or_search;
1793: my $respath;
1794: my ($cnum,$cdom) = &crsauthor_url();
1795: if ($cnum) {
1796: $respath = "/res/$cdom/$cnum/";
1797: my %js_lt = &Apache::lonlocal::texthash(
1798: sunm => 'Sub-directory name',
1799: save => 'Save page to make this permanent',
1800: );
1801: &js_escape(\%js_lt);
1802: $browse_or_search = <<"END";
1803:
1804: function toggleChooser(form,element,titleid,only,search) {
1805: var disp = 'none';
1806: if (document.getElementById('chooser_'+element)) {
1807: var curr = document.getElementById('chooser_'+element).style.display;
1808: if (curr == 'none') {
1809: disp='inline';
1810: if (form.elements['chooser_'+element].length) {
1811: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1812: form.elements['chooser_'+element][i].checked = false;
1813: }
1814: }
1815: toggleResImport(form,element);
1816: }
1817: document.getElementById('chooser_'+element).style.display = disp;
1818: }
1819: }
1820:
1821: function toggleCrsFile(form,element,numdirs) {
1822: if (document.getElementById('chooser_'+element+'_crsres')) {
1823: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1824: if (curr == 'none') {
1825: if (numdirs) {
1826: form.elements['coursepath_'+element].selectedIndex = 0;
1827: if (numdirs > 1) {
1828: window['select1'+element+'_changed']();
1829: }
1830: }
1831: }
1832: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1833:
1834: }
1835: if (document.getElementById('chooser_'+element+'_upload')) {
1836: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1837: if (document.getElementById('uploadcrsres_'+element)) {
1838: document.getElementById('uploadcrsres_'+element).value = '';
1839: }
1840: }
1841: return;
1842: }
1843:
1844: function toggleCrsUpload(form,element,numcrsdirs) {
1845: if (document.getElementById('chooser_'+element+'_crsres')) {
1846: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1847: }
1848: if (document.getElementById('chooser_'+element+'_upload')) {
1849: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1850: if (curr == 'none') {
1851: if (numcrsdirs) {
1852: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1853: form.elements['newsubdir_'+element][0].checked = true;
1854: toggleNewsubdir(form,element);
1855: }
1856: }
1857: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1858: }
1859: return;
1860: }
1861:
1862: function toggleResImport(form,element) {
1863: var choices = new Array('crsres','upload');
1864: for (var i=0; i<choices.length; i++) {
1865: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1866: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1867: }
1868: }
1869: }
1870:
1871: function toggleNewsubdir(form,element) {
1872: var newsub = form.elements['newsubdir_'+element];
1873: if (newsub) {
1874: if (newsub.length) {
1875: for (var j=0; j<newsub.length; j++) {
1876: if (newsub[j].checked) {
1877: if (document.getElementById('newsubdirname_'+element)) {
1878: if (newsub[j].value == '1') {
1879: document.getElementById('newsubdirname_'+element).type = "text";
1880: if (document.getElementById('newsubdir_'+element)) {
1881: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1882: }
1883: } else {
1884: document.getElementById('newsubdirname_'+element).type = "hidden";
1885: document.getElementById('newsubdirname_'+element).value = "";
1886: document.getElementById('newsubdir_'+element).innerHTML = "";
1887: }
1888: }
1889: break;
1890: }
1891: }
1892: }
1893: }
1894: }
1895:
1896: function updateCrsFile(form,element) {
1897: var directory = form.elements['coursepath_'+element];
1898: var filename = form.elements['coursefile_'+element];
1899: var path = directory.options[directory.selectedIndex].value;
1900: var file = filename.options[filename.selectedIndex].value;
1901: form.elements[element].value = '$respath';
1902: if (path == '/') {
1903: form.elements[element].value += file;
1904: } else {
1905: form.elements[element].value += path+'/'+file;
1906: }
1907: unClean();
1908: if (document.getElementById('previewimg_'+element)) {
1909: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1910: var newsrc = document.getElementById('previewimg_'+element).src;
1911: }
1912: if (document.getElementById('showimg_'+element)) {
1913: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1914: }
1915: toggleChooser(form,element);
1916: return;
1917: }
1918:
1919: function uploadDone(suffix,name) {
1920: if (name) {
1921: document.forms["lonhomework"].elements[suffix].value = name;
1922: unClean();
1923: toggleChooser(document.forms["lonhomework"],suffix);
1924: }
1925: }
1926:
1927: \$(document).ready(function(){
1928:
1929: \$(document).delegate('form :submit', 'click', function( event ) {
1930: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1931: var buttonId = this.id;
1932: var suffix = buttonId.toString();
1933: suffix = suffix.replace(/^crsupload_/,'');
1934: event.preventDefault();
1935: document.lonhomework.target = 'crsupload_target_'+suffix;
1936: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1937: \$(this.form).submit();
1938: document.lonhomework.target = '';
1939: if (document.getElementById('crsuploadto_'+suffix)) {
1940: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1941: }
1942: return false;
1943: }
1944: });
1945: });
1946: END
1947: }
1.1205 golterma 1948: return <<"COLORFULEDIT"
1949: <script type="text/javascript">
1950: // <![CDATA[>
1951: function fold_box(curDepth, lastresource){
1952:
1953: // we need a list because there can be several blocks you need to fold in one tag
1954: var block = document.getElementsByName('foldblock_'+curDepth);
1955: // but there is only one folding button per tag
1956: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1957:
1958: if(block.item(0).style.display == 'none'){
1959:
1960: foldbutton.value = '@{[&mt("Hide")]}';
1961: for (i = 0; i < block.length; i++){
1962: block.item(i).style.display = '';
1963: }
1964: }else{
1965:
1966: foldbutton.value = '@{[&mt("Show")]}';
1967: for (i = 0; i < block.length; i++){
1968: // block.item(i).style.visibility = 'collapse';
1969: block.item(i).style.display = 'none';
1970: }
1971: };
1972: saveState(lastresource);
1973: }
1974:
1975: function saveState (lastresource) {
1976:
1977: var tag_list = getTagList();
1978: if(tag_list != null){
1979: var timestamp = new Date().getTime();
1980: var key = lastresource;
1981:
1982: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1983: // starting with timestamp
1984: var value = timestamp+';';
1985:
1986: // building the list of key-value pairs
1987: for(var i = 0; i < tag_list.length; i++){
1988: value += tag_list[i]+',';
1989: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1990: }
1991:
1992: // only iterate whole storage if nothing to override
1993: if(localStorage.getItem(key) == null){
1994:
1995: // prevent storage from growing large
1996: if(localStorage.length > 50){
1997: var regex_getTimestamp = /^(?:\d)+;/;
1998: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1999: var oldest_key;
2000:
2001: for(var i = 1; i < localStorage.length; i++){
2002: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2003: oldest_key = localStorage.key(i);
2004: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2005: }
2006: }
2007: localStorage.removeItem(oldest_key);
2008: }
2009: }
2010: localStorage.setItem(key,value);
2011: }
2012: }
2013:
2014: // restore folding status of blocks (on page load)
2015: function restoreState (lastresource) {
2016: if(localStorage.getItem(lastresource) != null){
2017: var key = lastresource;
2018: var value = localStorage.getItem(key);
2019: var regex_delTimestamp = /^\d+;/;
2020:
2021: value.replace(regex_delTimestamp, '');
2022:
2023: var valueArr = value.split(';');
2024: var pairs;
2025: var elements;
2026: for (var i = 0; i < valueArr.length; i++){
2027: pairs = valueArr[i].split(',');
2028: elements = document.getElementsByName(pairs[0]);
2029:
2030: for (var j = 0; j < elements.length; j++){
2031: elements[j].style.display = pairs[1];
2032: if (pairs[1] == "none"){
2033: var regex_id = /([_\\d]+)\$/;
2034: regex_id.exec(pairs[0]);
2035: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2036: }
2037: }
2038: }
2039: }
2040: }
2041:
2042: function getTagList () {
2043:
2044: var stringToSearch = document.lonhomework.innerHTML;
2045:
2046: var ret = new Array();
2047: var regex_findBlock = /(foldblock_.*?)"/g;
2048: var tag_list = stringToSearch.match(regex_findBlock);
2049:
2050: if(tag_list != null){
2051: for(var i = 0; i < tag_list.length; i++){
2052: ret.push(tag_list[i].replace(/"/, ''));
2053: }
2054: }
2055: return ret;
2056: }
2057:
2058: function saveScrollPosition (resource) {
2059: var tag_list = getTagList();
2060:
2061: // we dont always want to jump to the first block
2062: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2063: if(\$(window).scrollTop() > 170){
2064: if(tag_list != null){
2065: var result;
2066: for(var i = 0; i < tag_list.length; i++){
2067: if(isElementInViewport(tag_list[i])){
2068: result += tag_list[i]+';';
2069: }
2070: }
2071: sessionStorage.setItem('anchor_'+resource, result);
2072: }
2073: } else {
2074: // we dont need to save zero, just delete the item to leave everything tidy
2075: sessionStorage.removeItem('anchor_'+resource);
2076: }
2077: }
2078:
2079: function restoreScrollPosition(resource){
2080:
2081: var elem = sessionStorage.getItem('anchor_'+resource);
2082: if(elem != null){
2083: var tag_list = elem.split(';');
2084: var elem_list;
2085:
2086: for(var i = 0; i < tag_list.length; i++){
2087: elem_list = document.getElementsByName(tag_list[i]);
2088:
2089: if(elem_list.length > 0){
2090: elem = elem_list[0];
2091: break;
2092: }
2093: }
2094: elem.scrollIntoView();
2095: }
2096: }
2097:
2098: function isElementInViewport(el) {
2099:
2100: // change to last element instead of first
2101: var elem = document.getElementsByName(el);
2102: var rect = elem[0].getBoundingClientRect();
2103:
2104: return (
2105: rect.top >= 0 &&
2106: rect.left >= 0 &&
2107: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2108: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2109: );
2110: }
2111:
2112: function autosize(depth){
2113: var cmInst = window['cm'+depth];
2114: var fitsizeButton = document.getElementById('fitsize'+depth);
2115:
2116: // is fixed size, switching to dynamic
2117: if (sessionStorage.getItem("autosized_"+depth) == null) {
2118: cmInst.setSize("","auto");
2119: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2120: sessionStorage.setItem("autosized_"+depth, "yes");
2121:
2122: // is dynamic size, switching to fixed
2123: } else {
2124: cmInst.setSize("","300px");
2125: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2126: sessionStorage.removeItem("autosized_"+depth);
2127: }
2128: }
2129:
1.1248 raeburn 2130: $browse_or_search
1.1205 golterma 2131:
2132: // ]]>
2133: </script>
2134: COLORFULEDIT
2135: }
2136:
2137: sub xmleditor_js {
2138: return <<XMLEDIT
2139: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2140: <script type="text/javascript">
2141: // <![CDATA[>
2142:
2143: function saveScrollPosition (resource) {
2144:
2145: var scrollPos = \$(window).scrollTop();
2146: sessionStorage.setItem(resource,scrollPos);
2147: }
2148:
2149: function restoreScrollPosition(resource){
2150:
2151: var scrollPos = sessionStorage.getItem(resource);
2152: \$(window).scrollTop(scrollPos);
2153: }
2154:
2155: // unless internet explorer
2156: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2157:
2158: \$(document).ready(function() {
2159: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2160: });
2161: }
2162:
2163: // inserts text at cursor position into codemirror (xml editor only)
2164: function insertText(text){
2165: cm.focus();
2166: var curPos = cm.getCursor();
2167: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2168: }
2169: // ]]>
2170: </script>
2171: XMLEDIT
2172: }
2173:
2174: sub insert_folding_button {
2175: my $curDepth = $Apache::lonxml::curdepth;
2176: my $lastresource = $env{'request.ambiguous'};
2177:
2178: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2179: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2180: }
2181:
1.1248 raeburn 2182: sub crsauthor_url {
2183: my ($url) = @_;
2184: if ($url eq '') {
2185: $url = $ENV{'REQUEST_URI'};
2186: }
2187: my ($cnum,$cdom);
2188: if ($env{'request.course.id'}) {
2189: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2190: if ($audom ne '' && $auname ne '') {
2191: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2192: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2193: $cnum = $auname;
2194: $cdom = $audom;
2195: }
2196: }
2197: }
2198: return ($cnum,$cdom);
2199: }
2200:
2201: sub import_crsauthor_form {
1.1265 raeburn 2202: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2203: return (0) unless ($env{'request.course.id'});
2204: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2205: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2206: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2207: return (0) unless (($cnum ne '') && ($cdom ne ''));
2208: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2209: my @ids=&Apache::lonnet::current_machine_ids();
2210: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2211:
2212: if (grep(/^\Q$crshome\E$/,@ids)) {
2213: $is_home = 1;
2214: }
2215: $relpath = "/priv/$cdom/$cnum";
2216: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2217: my %lt = &Apache::lonlocal::texthash (
2218: fnam => 'Filename',
2219: dire => 'Directory',
2220: );
2221: my $numdirs = scalar(keys(%files));
2222: my (%possexts,$singledir,@singledirfiles);
2223: if ($only) {
2224: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2225: }
2226: my (%nonemptydirs,$possdirs);
2227: if ($numdirs > 1) {
2228: my @order;
2229: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2230: if (ref($files{$key}) eq 'HASH') {
2231: my $shown = $key;
2232: if ($key eq '') {
2233: $shown = '/';
2234: }
2235: my @ordered = ();
2236: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
2237: if ($only) {
2238: my ($ext) = ($file =~ /\.([^.]+)$/);
2239: unless ($possexts{lc($ext)}) {
2240: next;
2241: }
2242: }
2243: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2244: push(@ordered,$file);
2245: }
2246: if (@ordered) {
2247: push(@order,$key);
2248: $nonemptydirs{$key} = 1;
2249: $selimport_menus{$key}->{'text'} = $shown;
2250: $selimport_menus{$key}->{'default'} = '';
2251: $selimport_menus{$key}->{'select2'}->{''} = '';
2252: $selimport_menus{$key}->{'order'} = \@ordered;
2253: }
2254: }
2255: }
2256: $possdirs = scalar(keys(%nonemptydirs));
2257: if ($possdirs > 1) {
2258: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2259: $output = $lt{'dire'}.
2260: &linked_select_forms($form,'<br />'.
2261: $lt{'fnam'},'',
2262: $firstselectname,$secondselectname,
2263: \%selimport_menus,\@order,
2264: $onchangefirst,'',$suffix).'<br />';
2265: } elsif ($possdirs == 1) {
2266: $singledir = (keys(%nonemptydirs))[0];
2267: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2268: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2269: }
2270: delete($selimport_menus{$singledir});
2271: }
2272: } elsif ($numdirs == 1) {
2273: $singledir = (keys(%files))[0];
2274: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2275: if ($only) {
2276: my ($ext) = ($file =~ /\.([^.]+)$/);
2277: unless ($possexts{lc($ext)}) {
2278: next;
2279: }
2280: }
2281: push(@singledirfiles,$file);
2282: }
2283: if (@singledirfiles) {
2284: $possdirs == 1;
2285: }
2286: }
2287: if (($possdirs == 1) && (@singledirfiles)) {
2288: my $showdir = $singledir;
2289: if ($singledir eq '') {
2290: $showdir = '/';
2291: }
2292: $output = $lt{'dire'}.
2293: '<select name="'.$firstselectname.'">'.
2294: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2295: '</select><br />'.
2296: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2297: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2298: foreach my $file (@singledirfiles) {
2299: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2300: }
2301: $output .= '</select><br />'."\n";
2302: }
2303: return ($possdirs,$output);
2304: }
2305:
1.565 albertel 2306: =pod
2307:
1.256 matthew 2308: =head1 Excel and CSV file utility routines
2309:
2310: =cut
2311:
2312: ###############################################################
2313: ###############################################################
2314:
2315: =pod
2316:
1.1162 raeburn 2317: =over 4
2318:
1.648 raeburn 2319: =item * &csv_translate($text)
1.37 matthew 2320:
1.185 www 2321: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2322: format.
2323:
2324: =cut
2325:
1.180 matthew 2326: ###############################################################
2327: ###############################################################
1.37 matthew 2328: sub csv_translate {
2329: my $text = shift;
2330: $text =~ s/\"/\"\"/g;
1.209 albertel 2331: $text =~ s/\n/ /g;
1.37 matthew 2332: return $text;
2333: }
1.180 matthew 2334:
2335: ###############################################################
2336: ###############################################################
2337:
2338: =pod
2339:
1.648 raeburn 2340: =item * &define_excel_formats()
1.180 matthew 2341:
2342: Define some commonly used Excel cell formats.
2343:
2344: Currently supported formats:
2345:
2346: =over 4
2347:
2348: =item header
2349:
2350: =item bold
2351:
2352: =item h1
2353:
2354: =item h2
2355:
2356: =item h3
2357:
1.256 matthew 2358: =item h4
2359:
2360: =item i
2361:
1.180 matthew 2362: =item date
2363:
2364: =back
2365:
2366: Inputs: $workbook
2367:
2368: Returns: $format, a hash reference.
2369:
1.1057 foxr 2370:
1.180 matthew 2371: =cut
2372:
2373: ###############################################################
2374: ###############################################################
2375: sub define_excel_formats {
2376: my ($workbook) = @_;
2377: my $format;
2378: $format->{'header'} = $workbook->add_format(bold => 1,
2379: bottom => 1,
2380: align => 'center');
2381: $format->{'bold'} = $workbook->add_format(bold=>1);
2382: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2383: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2384: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2385: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2386: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2387: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2388: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2389: return $format;
2390: }
2391:
2392: ###############################################################
2393: ###############################################################
1.113 bowersj2 2394:
2395: =pod
2396:
1.648 raeburn 2397: =item * &create_workbook()
1.255 matthew 2398:
2399: Create an Excel worksheet. If it fails, output message on the
2400: request object and return undefs.
2401:
2402: Inputs: Apache request object
2403:
2404: Returns (undef) on failure,
2405: Excel worksheet object, scalar with filename, and formats
2406: from &Apache::loncommon::define_excel_formats on success
2407:
2408: =cut
2409:
2410: ###############################################################
2411: ###############################################################
2412: sub create_workbook {
2413: my ($r) = @_;
2414: #
2415: # Create the excel spreadsheet
2416: my $filename = '/prtspool/'.
1.258 albertel 2417: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2418: time.'_'.rand(1000000000).'.xls';
2419: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2420: if (! defined($workbook)) {
2421: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2422: $r->print(
2423: '<p class="LC_error">'
2424: .&mt('Problems occurred in creating the new Excel file.')
2425: .' '.&mt('This error has been logged.')
2426: .' '.&mt('Please alert your LON-CAPA administrator.')
2427: .'</p>'
2428: );
1.255 matthew 2429: return (undef);
2430: }
2431: #
1.1014 foxr 2432: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2433: #
2434: my $format = &Apache::loncommon::define_excel_formats($workbook);
2435: return ($workbook,$filename,$format);
2436: }
2437:
2438: ###############################################################
2439: ###############################################################
2440:
2441: =pod
2442:
1.648 raeburn 2443: =item * &create_text_file()
1.113 bowersj2 2444:
1.542 raeburn 2445: Create a file to write to and eventually make available to the user.
1.256 matthew 2446: If file creation fails, outputs an error message on the request object and
2447: return undefs.
1.113 bowersj2 2448:
1.256 matthew 2449: Inputs: Apache request object, and file suffix
1.113 bowersj2 2450:
1.256 matthew 2451: Returns (undef) on failure,
2452: Filehandle and filename on success.
1.113 bowersj2 2453:
2454: =cut
2455:
1.256 matthew 2456: ###############################################################
2457: ###############################################################
2458: sub create_text_file {
2459: my ($r,$suffix) = @_;
2460: if (! defined($suffix)) { $suffix = 'txt'; };
2461: my $fh;
2462: my $filename = '/prtspool/'.
1.258 albertel 2463: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2464: time.'_'.rand(1000000000).'.'.$suffix;
2465: $fh = Apache::File->new('>/home/httpd'.$filename);
2466: if (! defined($fh)) {
2467: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2468: $r->print(
2469: '<p class="LC_error">'
2470: .&mt('Problems occurred in creating the output file.')
2471: .' '.&mt('This error has been logged.')
2472: .' '.&mt('Please alert your LON-CAPA administrator.')
2473: .'</p>'
2474: );
1.113 bowersj2 2475: }
1.256 matthew 2476: return ($fh,$filename)
1.113 bowersj2 2477: }
2478:
2479:
1.256 matthew 2480: =pod
1.113 bowersj2 2481:
2482: =back
2483:
2484: =cut
1.37 matthew 2485:
2486: ###############################################################
1.33 matthew 2487: ## Home server <option> list generating code ##
2488: ###############################################################
1.35 matthew 2489:
1.169 www 2490: # ------------------------------------------
2491:
2492: sub domain_select {
1.1289 raeburn 2493: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2494: my @possdoms;
2495: if (ref($incdoms) eq 'ARRAY') {
2496: @possdoms = @{$incdoms};
2497: } else {
2498: @possdoms = &Apache::lonnet::all_domains();
2499: }
2500:
1.169 www 2501: my %domains=map {
1.514 albertel 2502: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2503: } @possdoms;
2504:
2505: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2506: foreach my $dom (@{$excdoms}) {
2507: delete($domains{$dom});
2508: }
2509: }
2510:
1.169 www 2511: if ($multiple) {
2512: $domains{''}=&mt('Any domain');
1.550 albertel 2513: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2514: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2515: } else {
1.550 albertel 2516: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2517: return &select_form($name,$value,\%domains);
1.169 www 2518: }
2519: }
2520:
1.282 albertel 2521: #-------------------------------------------
2522:
2523: =pod
2524:
1.519 raeburn 2525: =head1 Routines for form select boxes
2526:
2527: =over 4
2528:
1.648 raeburn 2529: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2530:
2531: Returns a string containing a <select> element int multiple mode
2532:
2533:
2534: Args:
2535: $name - name of the <select> element
1.506 raeburn 2536: $value - scalar or array ref of values that should already be selected
1.282 albertel 2537: $size - number of rows long the select element is
1.283 albertel 2538: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2539: (shown text should already have been &mt())
1.506 raeburn 2540: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2541:
1.282 albertel 2542: =cut
2543:
2544: #-------------------------------------------
1.169 www 2545: sub multiple_select_form {
1.284 albertel 2546: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2547: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2548: my $output='';
1.191 matthew 2549: if (! defined($size)) {
2550: $size = 4;
1.283 albertel 2551: if (scalar(keys(%$hash))<4) {
2552: $size = scalar(keys(%$hash));
1.191 matthew 2553: }
2554: }
1.734 bisitz 2555: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2556: my @order;
1.506 raeburn 2557: if (ref($order) eq 'ARRAY') {
2558: @order = @{$order};
2559: } else {
2560: @order = sort(keys(%$hash));
1.501 banghart 2561: }
2562: if (exists($$hash{'select_form_order'})) {
2563: @order = @{$$hash{'select_form_order'}};
2564: }
2565:
1.284 albertel 2566: foreach my $key (@order) {
1.356 albertel 2567: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2568: $output.='selected="selected" ' if ($selected{$key});
2569: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2570: }
2571: $output.="</select>\n";
2572: return $output;
2573: }
2574:
1.88 www 2575: #-------------------------------------------
2576:
2577: =pod
2578:
1.1254 raeburn 2579: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2580:
2581: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2582: allow a user to select options from a ref to a hash containing:
2583: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2584: a javascript onchange item, e.g., onchange="this.form.submit();".
2585: An optional arg -- $readonly -- if true will cause the select form
2586: to be disabled, e.g., for the case where an instructor has a section-
2587: specific role, and is viewing/modifying parameters.
1.970 raeburn 2588:
1.88 www 2589: See lonrights.pm for an example invocation and use.
2590:
2591: =cut
2592:
2593: #-------------------------------------------
2594: sub select_form {
1.1228 raeburn 2595: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2596: return unless (ref($hashref) eq 'HASH');
2597: if ($onchange) {
2598: $onchange = ' onchange="'.$onchange.'"';
2599: }
1.1228 raeburn 2600: my $disabled;
2601: if ($readonly) {
2602: $disabled = ' disabled="disabled"';
2603: }
2604: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2605: my @keys;
1.970 raeburn 2606: if (exists($hashref->{'select_form_order'})) {
2607: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2608: } else {
1.970 raeburn 2609: @keys=sort(keys(%{$hashref}));
1.128 albertel 2610: }
1.356 albertel 2611: foreach my $key (@keys) {
2612: $selectform.=
2613: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2614: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2615: ">".$hashref->{$key}."</option>\n";
1.88 www 2616: }
2617: $selectform.="</select>";
2618: return $selectform;
2619: }
2620:
1.475 www 2621: # For display filters
2622:
2623: sub display_filter {
1.1074 raeburn 2624: my ($context) = @_;
1.475 www 2625: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2626: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2627: my $phraseinput = 'hidden';
2628: my $includeinput = 'hidden';
2629: my ($checked,$includetypestext);
2630: if ($env{'form.displayfilter'} eq 'containing') {
2631: $phraseinput = 'text';
2632: if ($context eq 'parmslog') {
2633: $includeinput = 'checkbox';
2634: if ($env{'form.includetypes'}) {
2635: $checked = ' checked="checked"';
2636: }
2637: $includetypestext = &mt('Include parameter types');
2638: }
2639: } else {
2640: $includetypestext = ' ';
2641: }
2642: my ($additional,$secondid,$thirdid);
2643: if ($context eq 'parmslog') {
2644: $additional =
2645: '<label><input type="'.$includeinput.'" name="includetypes"'.
2646: $checked.' name="includetypes" value="1" id="includetypes" />'.
2647: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2648: '</label>';
2649: $secondid = 'includetypes';
2650: $thirdid = 'includetypestext';
2651: }
2652: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2653: '$secondid','$thirdid')";
2654: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2655: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2656: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2657: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2658: &mt('Filter: [_1]',
1.477 www 2659: &select_form($env{'form.displayfilter'},
2660: 'displayfilter',
1.970 raeburn 2661: {'currentfolder' => 'Current folder/page',
1.477 www 2662: 'containing' => 'Containing phrase',
1.1074 raeburn 2663: 'none' => 'None'},$onchange)).' '.
2664: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2665: &HTML::Entities::encode($env{'form.containingphrase'}).
2666: '" />'.$additional;
2667: }
2668:
2669: sub display_filter_js {
2670: my $includetext = &mt('Include parameter types');
2671: return <<"ENDJS";
2672:
2673: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2674: var firstType = 'hidden';
2675: if (setter.options[setter.selectedIndex].value == 'containing') {
2676: firstType = 'text';
2677: }
2678: firstObject = document.getElementById(firstid);
2679: if (typeof(firstObject) == 'object') {
2680: if (firstObject.type != firstType) {
2681: changeInputType(firstObject,firstType);
2682: }
2683: }
2684: if (context == 'parmslog') {
2685: var secondType = 'hidden';
2686: if (firstType == 'text') {
2687: secondType = 'checkbox';
2688: }
2689: secondObject = document.getElementById(secondid);
2690: if (typeof(secondObject) == 'object') {
2691: if (secondObject.type != secondType) {
2692: changeInputType(secondObject,secondType);
2693: }
2694: }
2695: var textItem = document.getElementById(thirdid);
2696: var currtext = textItem.innerHTML;
2697: var newtext;
2698: if (firstType == 'text') {
2699: newtext = '$includetext';
2700: } else {
2701: newtext = ' ';
2702: }
2703: if (currtext != newtext) {
2704: textItem.innerHTML = newtext;
2705: }
2706: }
2707: return;
2708: }
2709:
2710: function changeInputType(oldObject,newType) {
2711: var newObject = document.createElement('input');
2712: newObject.type = newType;
2713: if (oldObject.size) {
2714: newObject.size = oldObject.size;
2715: }
2716: if (oldObject.value) {
2717: newObject.value = oldObject.value;
2718: }
2719: if (oldObject.name) {
2720: newObject.name = oldObject.name;
2721: }
2722: if (oldObject.id) {
2723: newObject.id = oldObject.id;
2724: }
2725: oldObject.parentNode.replaceChild(newObject,oldObject);
2726: return;
2727: }
2728:
2729: ENDJS
1.475 www 2730: }
2731:
1.167 www 2732: sub gradeleveldescription {
2733: my $gradelevel=shift;
2734: my %gradelevels=(0 => 'Not specified',
2735: 1 => 'Grade 1',
2736: 2 => 'Grade 2',
2737: 3 => 'Grade 3',
2738: 4 => 'Grade 4',
2739: 5 => 'Grade 5',
2740: 6 => 'Grade 6',
2741: 7 => 'Grade 7',
2742: 8 => 'Grade 8',
2743: 9 => 'Grade 9',
2744: 10 => 'Grade 10',
2745: 11 => 'Grade 11',
2746: 12 => 'Grade 12',
2747: 13 => 'Grade 13',
2748: 14 => '100 Level',
2749: 15 => '200 Level',
2750: 16 => '300 Level',
2751: 17 => '400 Level',
2752: 18 => 'Graduate Level');
2753: return &mt($gradelevels{$gradelevel});
2754: }
2755:
1.163 www 2756: sub select_level_form {
2757: my ($deflevel,$name)=@_;
2758: unless ($deflevel) { $deflevel=0; }
1.167 www 2759: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2760: for (my $i=0; $i<=18; $i++) {
2761: $selectform.="<option value=\"$i\" ".
1.253 albertel 2762: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2763: ">".&gradeleveldescription($i)."</option>\n";
2764: }
2765: $selectform.="</select>";
2766: return $selectform;
1.163 www 2767: }
1.167 www 2768:
1.35 matthew 2769: #-------------------------------------------
2770:
1.45 matthew 2771: =pod
2772:
1.1256 raeburn 2773: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2774:
2775: Returns a string containing a <select name='$name' size='1'> form to
2776: allow a user to select the domain to preform an operation in.
2777: See loncreateuser.pm for an example invocation and use.
2778:
1.90 www 2779: If the $includeempty flag is set, it also includes an empty choice ("no domain
2780: selected");
2781:
1.743 raeburn 2782: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2783:
1.910 raeburn 2784: 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.
2785:
1.1121 raeburn 2786: The optional $incdoms is a reference to an array of domains which will be the only available options.
2787:
2788: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2789:
1.1256 raeburn 2790: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2791:
1.35 matthew 2792: =cut
2793:
2794: #-------------------------------------------
1.34 matthew 2795: sub select_dom_form {
1.1256 raeburn 2796: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2797: if ($onchange) {
1.874 raeburn 2798: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2799: }
1.1256 raeburn 2800: if ($disabled) {
2801: $disabled = ' disabled="disabled"';
2802: }
1.1121 raeburn 2803: my (@domains,%exclude);
1.910 raeburn 2804: if (ref($incdoms) eq 'ARRAY') {
2805: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2806: } else {
2807: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2808: }
1.90 www 2809: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2810: if (ref($excdoms) eq 'ARRAY') {
2811: map { $exclude{$_} = 1; } @{$excdoms};
2812: }
1.1256 raeburn 2813: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2814: foreach my $dom (@domains) {
1.1121 raeburn 2815: next if ($exclude{$dom});
1.356 albertel 2816: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2817: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2818: if ($showdomdesc) {
2819: if ($dom ne '') {
2820: my $domdesc = &Apache::lonnet::domain($dom,'description');
2821: if ($domdesc ne '') {
2822: $selectdomain .= ' ('.$domdesc.')';
2823: }
2824: }
2825: }
2826: $selectdomain .= "</option>\n";
1.34 matthew 2827: }
2828: $selectdomain.="</select>";
2829: return $selectdomain;
2830: }
2831:
1.35 matthew 2832: #-------------------------------------------
2833:
1.45 matthew 2834: =pod
2835:
1.648 raeburn 2836: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2837:
1.586 raeburn 2838: input: 4 arguments (two required, two optional) -
2839: $domain - domain of new user
2840: $name - name of form element
2841: $default - Value of 'default' causes a default item to be first
2842: option, and selected by default.
2843: $hide - Value of 'hide' causes hiding of the name of the server,
2844: if 1 server found, or default, if 0 found.
1.594 raeburn 2845: output: returns 2 items:
1.586 raeburn 2846: (a) form element which contains either:
2847: (i) <select name="$name">
2848: <option value="$hostid1">$hostid $servers{$hostid}</option>
2849: <option value="$hostid2">$hostid $servers{$hostid}</option>
2850: </select>
2851: form item if there are multiple library servers in $domain, or
2852: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2853: if there is only one library server in $domain.
2854:
2855: (b) number of library servers found.
2856:
2857: See loncreateuser.pm for example of use.
1.35 matthew 2858:
2859: =cut
2860:
2861: #-------------------------------------------
1.586 raeburn 2862: sub home_server_form_item {
2863: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2864: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2865: my $result;
2866: my $numlib = keys(%servers);
2867: if ($numlib > 1) {
2868: $result .= '<select name="'.$name.'" />'."\n";
2869: if ($default) {
1.804 bisitz 2870: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2871: '</option>'."\n";
2872: }
2873: foreach my $hostid (sort(keys(%servers))) {
2874: $result.= '<option value="'.$hostid.'">'.
2875: $hostid.' '.$servers{$hostid}."</option>\n";
2876: }
2877: $result .= '</select>'."\n";
2878: } elsif ($numlib == 1) {
2879: my $hostid;
2880: foreach my $item (keys(%servers)) {
2881: $hostid = $item;
2882: }
2883: $result .= '<input type="hidden" name="'.$name.'" value="'.
2884: $hostid.'" />';
2885: if (!$hide) {
2886: $result .= $hostid.' '.$servers{$hostid};
2887: }
2888: $result .= "\n";
2889: } elsif ($default) {
2890: $result .= '<input type="hidden" name="'.$name.
2891: '" value="default" />';
2892: if (!$hide) {
2893: $result .= &mt('default');
2894: }
2895: $result .= "\n";
1.33 matthew 2896: }
1.586 raeburn 2897: return ($result,$numlib);
1.33 matthew 2898: }
1.112 bowersj2 2899:
2900: =pod
2901:
1.534 albertel 2902: =back
2903:
1.112 bowersj2 2904: =cut
1.87 matthew 2905:
2906: ###############################################################
1.112 bowersj2 2907: ## Decoding User Agent ##
1.87 matthew 2908: ###############################################################
2909:
2910: =pod
2911:
1.112 bowersj2 2912: =head1 Decoding the User Agent
2913:
2914: =over 4
2915:
2916: =item * &decode_user_agent()
1.87 matthew 2917:
2918: Inputs: $r
2919:
2920: Outputs:
2921:
2922: =over 4
2923:
1.112 bowersj2 2924: =item * $httpbrowser
1.87 matthew 2925:
1.112 bowersj2 2926: =item * $clientbrowser
1.87 matthew 2927:
1.112 bowersj2 2928: =item * $clientversion
1.87 matthew 2929:
1.112 bowersj2 2930: =item * $clientmathml
1.87 matthew 2931:
1.112 bowersj2 2932: =item * $clientunicode
1.87 matthew 2933:
1.112 bowersj2 2934: =item * $clientos
1.87 matthew 2935:
1.1137 raeburn 2936: =item * $clientmobile
2937:
1.1141 raeburn 2938: =item * $clientinfo
2939:
1.1194 raeburn 2940: =item * $clientosversion
2941:
1.87 matthew 2942: =back
2943:
1.157 matthew 2944: =back
2945:
1.87 matthew 2946: =cut
2947:
2948: ###############################################################
2949: ###############################################################
2950: sub decode_user_agent {
1.247 albertel 2951: my ($r)=@_;
1.87 matthew 2952: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2953: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2954: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2955: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2956: my $clientbrowser='unknown';
2957: my $clientversion='0';
2958: my $clientmathml='';
2959: my $clientunicode='0';
1.1137 raeburn 2960: my $clientmobile=0;
1.1194 raeburn 2961: my $clientosversion='';
1.87 matthew 2962: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2963: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2964: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2965: $clientbrowser=$bname;
2966: $httpbrowser=~/$vreg/i;
2967: $clientversion=$1;
2968: $clientmathml=($clientversion>=$minv);
2969: $clientunicode=($clientversion>=$univ);
2970: }
2971: }
2972: my $clientos='unknown';
1.1141 raeburn 2973: my $clientinfo;
1.87 matthew 2974: if (($httpbrowser=~/linux/i) ||
2975: ($httpbrowser=~/unix/i) ||
2976: ($httpbrowser=~/ux/i) ||
2977: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2978: if (($httpbrowser=~/vax/i) ||
2979: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2980: if ($httpbrowser=~/next/i) { $clientos='next'; }
2981: if (($httpbrowser=~/mac/i) ||
2982: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2983: if ($httpbrowser=~/win/i) {
2984: $clientos='win';
2985: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2986: $clientosversion = $1;
2987: }
2988: }
1.87 matthew 2989: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2990: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2991: $clientmobile=lc($1);
2992: }
1.1141 raeburn 2993: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2994: $clientinfo = 'firefox-'.$1;
2995: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2996: $clientinfo = 'chromeframe-'.$1;
2997: }
1.87 matthew 2998: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2999: $clientunicode,$clientos,$clientmobile,$clientinfo,
3000: $clientosversion);
1.87 matthew 3001: }
3002:
1.32 matthew 3003: ###############################################################
3004: ## Authentication changing form generation subroutines ##
3005: ###############################################################
3006: ##
3007: ## All of the authform_xxxxxxx subroutines take their inputs in a
3008: ## hash, and have reasonable default values.
3009: ##
3010: ## formname = the name given in the <form> tag.
1.35 matthew 3011: #-------------------------------------------
3012:
1.45 matthew 3013: =pod
3014:
1.112 bowersj2 3015: =head1 Authentication Routines
3016:
3017: =over 4
3018:
1.648 raeburn 3019: =item * &authform_xxxxxx()
1.35 matthew 3020:
3021: The authform_xxxxxx subroutines provide javascript and html forms which
3022: handle some of the conveniences required for authentication forms.
3023: This is not an optimal method, but it works.
3024:
3025: =over 4
3026:
1.112 bowersj2 3027: =item * authform_header
1.35 matthew 3028:
1.112 bowersj2 3029: =item * authform_authorwarning
1.35 matthew 3030:
1.112 bowersj2 3031: =item * authform_nochange
1.35 matthew 3032:
1.112 bowersj2 3033: =item * authform_kerberos
1.35 matthew 3034:
1.112 bowersj2 3035: =item * authform_internal
1.35 matthew 3036:
1.112 bowersj2 3037: =item * authform_filesystem
1.35 matthew 3038:
1.1310 raeburn 3039: =item * authform_lti
3040:
1.35 matthew 3041: =back
3042:
1.648 raeburn 3043: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3044:
1.35 matthew 3045: =cut
3046:
3047: #-------------------------------------------
1.32 matthew 3048: sub authform_header{
3049: my %in = (
3050: formname => 'cu',
1.80 albertel 3051: kerb_def_dom => '',
1.32 matthew 3052: @_,
3053: );
3054: $in{'formname'} = 'document.' . $in{'formname'};
3055: my $result='';
1.80 albertel 3056:
3057: #---------------------------------------------- Code for upper case translation
3058: my $Javascript_toUpperCase;
3059: unless ($in{kerb_def_dom}) {
3060: $Javascript_toUpperCase =<<"END";
3061: switch (choice) {
3062: case 'krb': currentform.elements[choicearg].value =
3063: currentform.elements[choicearg].value.toUpperCase();
3064: break;
3065: default:
3066: }
3067: END
3068: } else {
3069: $Javascript_toUpperCase = "";
3070: }
3071:
1.165 raeburn 3072: my $radioval = "'nochange'";
1.591 raeburn 3073: if (defined($in{'curr_authtype'})) {
3074: if ($in{'curr_authtype'} ne '') {
3075: $radioval = "'".$in{'curr_authtype'}."arg'";
3076: }
1.174 matthew 3077: }
1.165 raeburn 3078: my $argfield = 'null';
1.591 raeburn 3079: if (defined($in{'mode'})) {
1.165 raeburn 3080: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3081: if (defined($in{'curr_autharg'})) {
3082: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3083: $argfield = "'$in{'curr_autharg'}'";
3084: }
3085: }
3086: }
3087: }
3088:
1.32 matthew 3089: $result.=<<"END";
3090: var current = new Object();
1.165 raeburn 3091: current.radiovalue = $radioval;
3092: current.argfield = $argfield;
1.32 matthew 3093:
3094: function changed_radio(choice,currentform) {
3095: var choicearg = choice + 'arg';
3096: // If a radio button in changed, we need to change the argfield
3097: if (current.radiovalue != choice) {
3098: current.radiovalue = choice;
3099: if (current.argfield != null) {
3100: currentform.elements[current.argfield].value = '';
3101: }
3102: if (choice == 'nochange') {
3103: current.argfield = null;
3104: } else {
3105: current.argfield = choicearg;
3106: switch(choice) {
3107: case 'krb':
3108: currentform.elements[current.argfield].value =
3109: "$in{'kerb_def_dom'}";
3110: break;
3111: default:
3112: break;
3113: }
3114: }
3115: }
3116: return;
3117: }
1.22 www 3118:
1.32 matthew 3119: function changed_text(choice,currentform) {
3120: var choicearg = choice + 'arg';
3121: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3122: $Javascript_toUpperCase
1.32 matthew 3123: // clear old field
3124: if ((current.argfield != choicearg) && (current.argfield != null)) {
3125: currentform.elements[current.argfield].value = '';
3126: }
3127: current.argfield = choicearg;
3128: }
3129: set_auth_radio_buttons(choice,currentform);
3130: return;
1.20 www 3131: }
1.32 matthew 3132:
3133: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3134: var numauthchoices = currentform.login.length;
3135: if (typeof numauthchoices == "undefined") {
3136: return;
3137: }
1.32 matthew 3138: var i=0;
1.986 raeburn 3139: while (i < numauthchoices) {
1.32 matthew 3140: if (currentform.login[i].value == newvalue) { break; }
3141: i++;
3142: }
1.986 raeburn 3143: if (i == numauthchoices) {
1.32 matthew 3144: return;
3145: }
3146: current.radiovalue = newvalue;
3147: currentform.login[i].checked = true;
3148: return;
3149: }
3150: END
3151: return $result;
3152: }
3153:
1.1106 raeburn 3154: sub authform_authorwarning {
1.32 matthew 3155: my $result='';
1.144 matthew 3156: $result='<i>'.
3157: &mt('As a general rule, only authors or co-authors should be '.
3158: 'filesystem authenticated '.
3159: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3160: return $result;
3161: }
3162:
1.1106 raeburn 3163: sub authform_nochange {
1.32 matthew 3164: my %in = (
3165: formname => 'document.cu',
3166: kerb_def_dom => 'MSU.EDU',
3167: @_,
3168: );
1.1106 raeburn 3169: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3170: my $result;
1.1104 raeburn 3171: if (!$authnum) {
1.1105 raeburn 3172: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3173: } else {
3174: $result = '<label>'.&mt('[_1] Do not change login data',
3175: '<input type="radio" name="login" value="nochange" '.
3176: 'checked="checked" onclick="'.
1.281 albertel 3177: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3178: '</label>';
1.586 raeburn 3179: }
1.32 matthew 3180: return $result;
3181: }
3182:
1.591 raeburn 3183: sub authform_kerberos {
1.32 matthew 3184: my %in = (
3185: formname => 'document.cu',
3186: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3187: kerb_def_auth => 'krb4',
1.32 matthew 3188: @_,
3189: );
1.586 raeburn 3190: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3191: $autharg,$jscall,$disabled);
1.1106 raeburn 3192: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3193: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3194: $check5 = ' checked="checked"';
1.80 albertel 3195: } else {
1.772 bisitz 3196: $check4 = ' checked="checked"';
1.80 albertel 3197: }
1.1259 raeburn 3198: if ($in{'readonly'}) {
3199: $disabled = ' disabled="disabled"';
3200: }
1.165 raeburn 3201: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3202: if (defined($in{'curr_authtype'})) {
3203: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3204: $krbcheck = ' checked="checked"';
1.623 raeburn 3205: if (defined($in{'mode'})) {
3206: if ($in{'mode'} eq 'modifyuser') {
3207: $krbcheck = '';
3208: }
3209: }
1.591 raeburn 3210: if (defined($in{'curr_kerb_ver'})) {
3211: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3212: $check5 = ' checked="checked"';
1.591 raeburn 3213: $check4 = '';
3214: } else {
1.772 bisitz 3215: $check4 = ' checked="checked"';
1.591 raeburn 3216: $check5 = '';
3217: }
1.586 raeburn 3218: }
1.591 raeburn 3219: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3220: $krbarg = $in{'curr_autharg'};
3221: }
1.586 raeburn 3222: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3223: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3224: $result =
3225: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3226: $in{'curr_autharg'},$krbver);
3227: } else {
3228: $result =
3229: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3230: }
3231: return $result;
3232: }
3233: }
3234: } else {
3235: if ($authnum == 1) {
1.784 bisitz 3236: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3237: }
3238: }
1.586 raeburn 3239: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3240: return;
1.587 raeburn 3241: } elsif ($authtype eq '') {
1.591 raeburn 3242: if (defined($in{'mode'})) {
1.587 raeburn 3243: if ($in{'mode'} eq 'modifycourse') {
3244: if ($authnum == 1) {
1.1259 raeburn 3245: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3246: }
3247: }
3248: }
1.586 raeburn 3249: }
3250: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3251: if ($authtype eq '') {
3252: $authtype = '<input type="radio" name="login" value="krb" '.
3253: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3254: $krbcheck.$disabled.' />';
1.586 raeburn 3255: }
3256: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3257: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3258: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3259: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3260: $in{'curr_authtype'} eq 'krb4')) {
3261: $result .= &mt
1.144 matthew 3262: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3263: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3264: '<label>'.$authtype,
1.281 albertel 3265: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3266: 'value="'.$krbarg.'" '.
1.1259 raeburn 3267: 'onchange="'.$jscall.'"'.$disabled.' />',
3268: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3269: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3270: '</label>');
1.586 raeburn 3271: } elsif ($can_assign{'krb4'}) {
3272: $result .= &mt
3273: ('[_1] Kerberos authenticated with domain [_2] '.
3274: '[_3] Version 4 [_4]',
3275: '<label>'.$authtype,
3276: '</label><input type="text" size="10" name="krbarg" '.
3277: 'value="'.$krbarg.'" '.
1.1259 raeburn 3278: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3279: '<label><input type="hidden" name="krbver" value="4" />',
3280: '</label>');
3281: } elsif ($can_assign{'krb5'}) {
3282: $result .= &mt
3283: ('[_1] Kerberos authenticated with domain [_2] '.
3284: '[_3] Version 5 [_4]',
3285: '<label>'.$authtype,
3286: '</label><input type="text" size="10" name="krbarg" '.
3287: 'value="'.$krbarg.'" '.
1.1259 raeburn 3288: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3289: '<label><input type="hidden" name="krbver" value="5" />',
3290: '</label>');
3291: }
1.32 matthew 3292: return $result;
3293: }
3294:
1.1106 raeburn 3295: sub authform_internal {
1.586 raeburn 3296: my %in = (
1.32 matthew 3297: formname => 'document.cu',
3298: kerb_def_dom => 'MSU.EDU',
3299: @_,
3300: );
1.1259 raeburn 3301: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3302: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3303: if ($in{'readonly'}) {
3304: $disabled = ' disabled="disabled"';
3305: }
1.591 raeburn 3306: if (defined($in{'curr_authtype'})) {
3307: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3308: if ($can_assign{'int'}) {
1.772 bisitz 3309: $intcheck = 'checked="checked" ';
1.623 raeburn 3310: if (defined($in{'mode'})) {
3311: if ($in{'mode'} eq 'modifyuser') {
3312: $intcheck = '';
3313: }
3314: }
1.591 raeburn 3315: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3316: $intarg = $in{'curr_autharg'};
3317: }
3318: } else {
3319: $result = &mt('Currently internally authenticated.');
3320: return $result;
1.165 raeburn 3321: }
3322: }
1.586 raeburn 3323: } else {
3324: if ($authnum == 1) {
1.784 bisitz 3325: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3326: }
3327: }
3328: if (!$can_assign{'int'}) {
3329: return;
1.587 raeburn 3330: } elsif ($authtype eq '') {
1.591 raeburn 3331: if (defined($in{'mode'})) {
1.587 raeburn 3332: if ($in{'mode'} eq 'modifycourse') {
3333: if ($authnum == 1) {
1.1259 raeburn 3334: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3335: }
3336: }
3337: }
1.165 raeburn 3338: }
1.586 raeburn 3339: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3340: if ($authtype eq '') {
3341: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3342: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3343: }
1.605 bisitz 3344: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3345: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3346: $result = &mt
1.144 matthew 3347: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3348: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3349: $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 3350: return $result;
3351: }
3352:
1.1104 raeburn 3353: sub authform_local {
1.32 matthew 3354: my %in = (
3355: formname => 'document.cu',
3356: kerb_def_dom => 'MSU.EDU',
3357: @_,
3358: );
1.1259 raeburn 3359: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3360: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3361: if ($in{'readonly'}) {
3362: $disabled = ' disabled="disabled"';
3363: }
1.591 raeburn 3364: if (defined($in{'curr_authtype'})) {
3365: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3366: if ($can_assign{'loc'}) {
1.772 bisitz 3367: $loccheck = 'checked="checked" ';
1.623 raeburn 3368: if (defined($in{'mode'})) {
3369: if ($in{'mode'} eq 'modifyuser') {
3370: $loccheck = '';
3371: }
3372: }
1.591 raeburn 3373: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3374: $locarg = $in{'curr_autharg'};
3375: }
3376: } else {
3377: $result = &mt('Currently using local (institutional) authentication.');
3378: return $result;
1.165 raeburn 3379: }
3380: }
1.586 raeburn 3381: } else {
3382: if ($authnum == 1) {
1.784 bisitz 3383: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3384: }
3385: }
3386: if (!$can_assign{'loc'}) {
3387: return;
1.587 raeburn 3388: } elsif ($authtype eq '') {
1.591 raeburn 3389: if (defined($in{'mode'})) {
1.587 raeburn 3390: if ($in{'mode'} eq 'modifycourse') {
3391: if ($authnum == 1) {
1.1259 raeburn 3392: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3393: }
3394: }
3395: }
1.165 raeburn 3396: }
1.586 raeburn 3397: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3398: if ($authtype eq '') {
3399: $authtype = '<input type="radio" name="login" value="loc" '.
3400: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3401: $jscall.'"'.$disabled.' />';
1.586 raeburn 3402: }
3403: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3404: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3405: $result = &mt('[_1] Local Authentication with argument [_2]',
3406: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3407: return $result;
3408: }
3409:
1.1106 raeburn 3410: sub authform_filesystem {
1.32 matthew 3411: my %in = (
3412: formname => 'document.cu',
3413: kerb_def_dom => 'MSU.EDU',
3414: @_,
3415: );
1.1259 raeburn 3416: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3417: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3418: if ($in{'readonly'}) {
3419: $disabled = ' disabled="disabled"';
3420: }
1.591 raeburn 3421: if (defined($in{'curr_authtype'})) {
3422: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3423: if ($can_assign{'fsys'}) {
1.772 bisitz 3424: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3425: if (defined($in{'mode'})) {
3426: if ($in{'mode'} eq 'modifyuser') {
3427: $fsyscheck = '';
3428: }
3429: }
1.586 raeburn 3430: } else {
3431: $result = &mt('Currently Filesystem Authenticated.');
3432: return $result;
1.1259 raeburn 3433: }
1.586 raeburn 3434: }
3435: } else {
3436: if ($authnum == 1) {
1.784 bisitz 3437: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3438: }
3439: }
3440: if (!$can_assign{'fsys'}) {
3441: return;
1.587 raeburn 3442: } elsif ($authtype eq '') {
1.591 raeburn 3443: if (defined($in{'mode'})) {
1.587 raeburn 3444: if ($in{'mode'} eq 'modifycourse') {
3445: if ($authnum == 1) {
1.1259 raeburn 3446: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3447: }
3448: }
3449: }
1.586 raeburn 3450: }
3451: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3452: if ($authtype eq '') {
3453: $authtype = '<input type="radio" name="login" value="fsys" '.
3454: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3455: $jscall.'"'.$disabled.' />';
1.586 raeburn 3456: }
1.1310 raeburn 3457: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3458: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3459: $result = &mt
1.144 matthew 3460: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3461: '<label>'.$authtype,'</label>'.$autharg);
3462: return $result;
3463: }
3464:
3465: sub authform_lti {
3466: my %in = (
3467: formname => 'document.cu',
3468: kerb_def_dom => 'MSU.EDU',
3469: @_,
3470: );
3471: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3472: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3473: if ($in{'readonly'}) {
3474: $disabled = ' disabled="disabled"';
3475: }
3476: if (defined($in{'curr_authtype'})) {
3477: if ($in{'curr_authtype'} eq 'lti') {
3478: if ($can_assign{'lti'}) {
3479: $lticheck = 'checked="checked" ';
3480: if (defined($in{'mode'})) {
3481: if ($in{'mode'} eq 'modifyuser') {
3482: $lticheck = '';
3483: }
3484: }
3485: } else {
3486: $result = &mt('Currently LTI Authenticated.');
3487: return $result;
3488: }
3489: }
3490: } else {
3491: if ($authnum == 1) {
3492: $authtype = '<input type="hidden" name="login" value="lti" />';
3493: }
3494: }
3495: if (!$can_assign{'lti'}) {
3496: return;
3497: } elsif ($authtype eq '') {
3498: if (defined($in{'mode'})) {
3499: if ($in{'mode'} eq 'modifycourse') {
3500: if ($authnum == 1) {
3501: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3502: }
3503: }
3504: }
3505: }
3506: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3507: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3508: $authtype = '<input type="radio" name="login" value="lti" '.
3509: $lticheck.' onchange="'.$jscall.'" onclick="'.
3510: $jscall.'"'.$disabled.' />';
3511: }
3512: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3513: if ($authtype) {
3514: $result = &mt('[_1] LTI Authenticated',
3515: '<label>'.$authtype.'</label>'.$autharg);
3516: } else {
3517: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3518: $autharg;
3519: }
1.32 matthew 3520: return $result;
3521: }
3522:
1.586 raeburn 3523: sub get_assignable_auth {
3524: my ($dom) = @_;
3525: if ($dom eq '') {
3526: $dom = $env{'request.role.domain'};
3527: }
3528: my %can_assign = (
3529: krb4 => 1,
3530: krb5 => 1,
3531: int => 1,
3532: loc => 1,
1.1310 raeburn 3533: lti => 1,
1.586 raeburn 3534: );
3535: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3536: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3537: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3538: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3539: my $context;
3540: if ($env{'request.role'} =~ /^au/) {
3541: $context = 'author';
1.1259 raeburn 3542: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3543: $context = 'domain';
3544: } elsif ($env{'request.course.id'}) {
3545: $context = 'course';
3546: }
3547: if ($context) {
3548: if (ref($authhash->{$context}) eq 'HASH') {
3549: %can_assign = %{$authhash->{$context}};
3550: }
3551: }
3552: }
3553: }
3554: my $authnum = 0;
3555: foreach my $key (keys(%can_assign)) {
3556: if ($can_assign{$key}) {
3557: $authnum ++;
3558: }
3559: }
3560: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3561: $authnum --;
3562: }
3563: return ($authnum,%can_assign);
3564: }
3565:
1.80 albertel 3566: ###############################################################
3567: ## Get Kerberos Defaults for Domain ##
3568: ###############################################################
3569: ##
3570: ## Returns default kerberos version and an associated argument
3571: ## as listed in file domain.tab. If not listed, provides
3572: ## appropriate default domain and kerberos version.
3573: ##
3574: #-------------------------------------------
3575:
3576: =pod
3577:
1.648 raeburn 3578: =item * &get_kerberos_defaults()
1.80 albertel 3579:
3580: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3581: version and domain. If not found, it defaults to version 4 and the
3582: domain of the server.
1.80 albertel 3583:
1.648 raeburn 3584: =over 4
3585:
1.80 albertel 3586: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3587:
1.648 raeburn 3588: =back
3589:
3590: =back
3591:
1.80 albertel 3592: =cut
3593:
3594: #-------------------------------------------
3595: sub get_kerberos_defaults {
3596: my $domain=shift;
1.641 raeburn 3597: my ($krbdef,$krbdefdom);
3598: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3599: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3600: $krbdef = $domdefaults{'auth_def'};
3601: $krbdefdom = $domdefaults{'auth_arg_def'};
3602: } else {
1.80 albertel 3603: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3604: my $krbdefdom=$1;
3605: $krbdefdom=~tr/a-z/A-Z/;
3606: $krbdef = "krb4";
3607: }
3608: return ($krbdef,$krbdefdom);
3609: }
1.112 bowersj2 3610:
1.32 matthew 3611:
1.46 matthew 3612: ###############################################################
3613: ## Thesaurus Functions ##
3614: ###############################################################
1.20 www 3615:
1.46 matthew 3616: =pod
1.20 www 3617:
1.112 bowersj2 3618: =head1 Thesaurus Functions
3619:
3620: =over 4
3621:
1.648 raeburn 3622: =item * &initialize_keywords()
1.46 matthew 3623:
3624: Initializes the package variable %Keywords if it is empty. Uses the
3625: package variable $thesaurus_db_file.
3626:
3627: =cut
3628:
3629: ###################################################
3630:
3631: sub initialize_keywords {
3632: return 1 if (scalar keys(%Keywords));
3633: # If we are here, %Keywords is empty, so fill it up
3634: # Make sure the file we need exists...
3635: if (! -e $thesaurus_db_file) {
3636: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3637: " failed because it does not exist");
3638: return 0;
3639: }
3640: # Set up the hash as a database
3641: my %thesaurus_db;
3642: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3643: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3644: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3645: $thesaurus_db_file);
3646: return 0;
3647: }
3648: # Get the average number of appearances of a word.
3649: my $avecount = $thesaurus_db{'average.count'};
3650: # Put keywords (those that appear > average) into %Keywords
3651: while (my ($word,$data)=each (%thesaurus_db)) {
3652: my ($count,undef) = split /:/,$data;
3653: $Keywords{$word}++ if ($count > $avecount);
3654: }
3655: untie %thesaurus_db;
3656: # Remove special values from %Keywords.
1.356 albertel 3657: foreach my $value ('total.count','average.count') {
3658: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3659: }
1.46 matthew 3660: return 1;
3661: }
3662:
3663: ###################################################
3664:
3665: =pod
3666:
1.648 raeburn 3667: =item * &keyword($word)
1.46 matthew 3668:
3669: Returns true if $word is a keyword. A keyword is a word that appears more
3670: than the average number of times in the thesaurus database. Calls
3671: &initialize_keywords
3672:
3673: =cut
3674:
3675: ###################################################
1.20 www 3676:
3677: sub keyword {
1.46 matthew 3678: return if (!&initialize_keywords());
3679: my $word=lc(shift());
3680: $word=~s/\W//g;
3681: return exists($Keywords{$word});
1.20 www 3682: }
1.46 matthew 3683:
3684: ###############################################################
3685:
3686: =pod
1.20 www 3687:
1.648 raeburn 3688: =item * &get_related_words()
1.46 matthew 3689:
1.160 matthew 3690: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3691: an array of words. If the keyword is not in the thesaurus, an empty array
3692: will be returned. The order of the words returned is determined by the
3693: database which holds them.
3694:
3695: Uses global $thesaurus_db_file.
3696:
1.1057 foxr 3697:
1.46 matthew 3698: =cut
3699:
3700: ###############################################################
3701: sub get_related_words {
3702: my $keyword = shift;
3703: my %thesaurus_db;
3704: if (! -e $thesaurus_db_file) {
3705: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3706: "failed because the file does not exist");
3707: return ();
3708: }
3709: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3710: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3711: return ();
3712: }
3713: my @Words=();
1.429 www 3714: my $count=0;
1.46 matthew 3715: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3716: # The first element is the number of times
3717: # the word appears. We do not need it now.
1.429 www 3718: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3719: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3720: my $threshold=$mostfrequentcount/10;
3721: foreach my $possibleword (@RelatedWords) {
3722: my ($word,$wordcount)=split(/\,/,$possibleword);
3723: if ($wordcount>$threshold) {
3724: push(@Words,$word);
3725: $count++;
3726: if ($count>10) { last; }
3727: }
1.20 www 3728: }
3729: }
1.46 matthew 3730: untie %thesaurus_db;
3731: return @Words;
1.14 harris41 3732: }
1.1090 foxr 3733: ###############################################################
3734: #
3735: # Spell checking
3736: #
3737:
3738: =pod
3739:
1.1142 raeburn 3740: =back
3741:
1.1090 foxr 3742: =head1 Spell checking
3743:
3744: =over 4
3745:
3746: =item * &check_spelling($wordlist $language)
3747:
3748: Takes a string containing words and feeds it to an external
3749: spellcheck program via a pipeline. Returns a string containing
3750: them mis-spelled words.
3751:
3752: Parameters:
3753:
3754: =over 4
3755:
3756: =item - $wordlist
3757:
3758: String that will be fed into the spellcheck program.
3759:
3760: =item - $language
3761:
3762: Language string that specifies the language for which the spell
3763: check will be performed.
3764:
3765: =back
3766:
3767: =back
3768:
3769: Note: This sub assumes that aspell is installed.
3770:
3771:
3772: =cut
3773:
1.46 matthew 3774:
1.1090 foxr 3775: sub check_spelling {
3776: my ($wordlist, $language) = @_;
1.1091 foxr 3777: my @misspellings;
3778:
3779: # Generate the speller and set the langauge.
3780: # if explicitly selected:
1.1090 foxr 3781:
1.1091 foxr 3782: my $speller = Text::Aspell->new;
1.1090 foxr 3783: if ($language) {
1.1091 foxr 3784: $speller->set_option('lang', $language);
1.1090 foxr 3785: }
3786:
1.1091 foxr 3787: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3788:
1.1091 foxr 3789: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3790:
1.1091 foxr 3791: foreach my $word (@words) {
3792: if(! $speller->check($word)) {
3793: push(@misspellings, $word);
1.1090 foxr 3794: }
3795: }
1.1091 foxr 3796: return join(' ', @misspellings);
3797:
1.1090 foxr 3798: }
3799:
1.61 www 3800: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3801: =pod
3802:
1.112 bowersj2 3803: =head1 User Name Functions
3804:
3805: =over 4
3806:
1.648 raeburn 3807: =item * &plainname($uname,$udom,$first)
1.81 albertel 3808:
1.112 bowersj2 3809: Takes a users logon name and returns it as a string in
1.226 albertel 3810: "first middle last generation" form
3811: if $first is set to 'lastname' then it returns it as
3812: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3813:
3814: =cut
1.61 www 3815:
1.295 www 3816:
1.81 albertel 3817: ###############################################################
1.61 www 3818: sub plainname {
1.226 albertel 3819: my ($uname,$udom,$first)=@_;
1.537 albertel 3820: return if (!defined($uname) || !defined($udom));
1.295 www 3821: my %names=&getnames($uname,$udom);
1.226 albertel 3822: my $name=&Apache::lonnet::format_name($names{'firstname'},
3823: $names{'middlename'},
3824: $names{'lastname'},
3825: $names{'generation'},$first);
3826: $name=~s/^\s+//;
1.62 www 3827: $name=~s/\s+$//;
3828: $name=~s/\s+/ /g;
1.353 albertel 3829: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3830: return $name;
1.61 www 3831: }
1.66 www 3832:
3833: # -------------------------------------------------------------------- Nickname
1.81 albertel 3834: =pod
3835:
1.648 raeburn 3836: =item * &nickname($uname,$udom)
1.81 albertel 3837:
3838: Gets a users name and returns it as a string as
3839:
3840: ""nickname""
1.66 www 3841:
1.81 albertel 3842: if the user has a nickname or
3843:
3844: "first middle last generation"
3845:
3846: if the user does not
3847:
3848: =cut
1.66 www 3849:
3850: sub nickname {
3851: my ($uname,$udom)=@_;
1.537 albertel 3852: return if (!defined($uname) || !defined($udom));
1.295 www 3853: my %names=&getnames($uname,$udom);
1.68 albertel 3854: my $name=$names{'nickname'};
1.66 www 3855: if ($name) {
3856: $name='"'.$name.'"';
3857: } else {
3858: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3859: $names{'lastname'}.' '.$names{'generation'};
3860: $name=~s/\s+$//;
3861: $name=~s/\s+/ /g;
3862: }
3863: return $name;
3864: }
3865:
1.295 www 3866: sub getnames {
3867: my ($uname,$udom)=@_;
1.537 albertel 3868: return if (!defined($uname) || !defined($udom));
1.433 albertel 3869: if ($udom eq 'public' && $uname eq 'public') {
3870: return ('lastname' => &mt('Public'));
3871: }
1.295 www 3872: my $id=$uname.':'.$udom;
3873: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3874: if ($cached) {
3875: return %{$names};
3876: } else {
3877: my %loadnames=&Apache::lonnet::get('environment',
3878: ['firstname','middlename','lastname','generation','nickname'],
3879: $udom,$uname);
3880: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3881: return %loadnames;
3882: }
3883: }
1.61 www 3884:
1.542 raeburn 3885: # -------------------------------------------------------------------- getemails
1.648 raeburn 3886:
1.542 raeburn 3887: =pod
3888:
1.648 raeburn 3889: =item * &getemails($uname,$udom)
1.542 raeburn 3890:
3891: Gets a user's email information and returns it as a hash with keys:
3892: notification, critnotification, permanentemail
3893:
3894: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3895: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3896:
1.648 raeburn 3897:
1.542 raeburn 3898: =cut
3899:
1.648 raeburn 3900:
1.466 albertel 3901: sub getemails {
3902: my ($uname,$udom)=@_;
3903: if ($udom eq 'public' && $uname eq 'public') {
3904: return;
3905: }
1.467 www 3906: if (!$udom) { $udom=$env{'user.domain'}; }
3907: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3908: my $id=$uname.':'.$udom;
3909: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3910: if ($cached) {
3911: return %{$names};
3912: } else {
3913: my %loadnames=&Apache::lonnet::get('environment',
3914: ['notification','critnotification',
3915: 'permanentemail'],
3916: $udom,$uname);
3917: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3918: return %loadnames;
3919: }
3920: }
3921:
1.551 albertel 3922: sub flush_email_cache {
3923: my ($uname,$udom)=@_;
3924: if (!$udom) { $udom =$env{'user.domain'}; }
3925: if (!$uname) { $uname=$env{'user.name'}; }
3926: return if ($udom eq 'public' && $uname eq 'public');
3927: my $id=$uname.':'.$udom;
3928: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3929: }
3930:
1.728 raeburn 3931: # -------------------------------------------------------------------- getlangs
3932:
3933: =pod
3934:
3935: =item * &getlangs($uname,$udom)
3936:
3937: Gets a user's language preference and returns it as a hash with key:
3938: language.
3939:
3940: =cut
3941:
3942:
3943: sub getlangs {
3944: my ($uname,$udom) = @_;
3945: if (!$udom) { $udom =$env{'user.domain'}; }
3946: if (!$uname) { $uname=$env{'user.name'}; }
3947: my $id=$uname.':'.$udom;
3948: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3949: if ($cached) {
3950: return %{$langs};
3951: } else {
3952: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3953: $udom,$uname);
3954: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3955: return %loadlangs;
3956: }
3957: }
3958:
3959: sub flush_langs_cache {
3960: my ($uname,$udom)=@_;
3961: if (!$udom) { $udom =$env{'user.domain'}; }
3962: if (!$uname) { $uname=$env{'user.name'}; }
3963: return if ($udom eq 'public' && $uname eq 'public');
3964: my $id=$uname.':'.$udom;
3965: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3966: }
3967:
1.61 www 3968: # ------------------------------------------------------------------ Screenname
1.81 albertel 3969:
3970: =pod
3971:
1.648 raeburn 3972: =item * &screenname($uname,$udom)
1.81 albertel 3973:
3974: Gets a users screenname and returns it as a string
3975:
3976: =cut
1.61 www 3977:
3978: sub screenname {
3979: my ($uname,$udom)=@_;
1.258 albertel 3980: if ($uname eq $env{'user.name'} &&
3981: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3982: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3983: return $names{'screenname'};
1.62 www 3984: }
3985:
1.212 albertel 3986:
1.802 bisitz 3987: # ------------------------------------------------------------- Confirm Wrapper
3988: =pod
3989:
1.1142 raeburn 3990: =item * &confirmwrapper($message)
1.802 bisitz 3991:
3992: Wrap messages about completion of operation in box
3993:
3994: =cut
3995:
3996: sub confirmwrapper {
3997: my ($message)=@_;
3998: if ($message) {
3999: return "\n".'<div class="LC_confirm_box">'."\n"
4000: .$message."\n"
4001: .'</div>'."\n";
4002: } else {
4003: return $message;
4004: }
4005: }
4006:
1.62 www 4007: # ------------------------------------------------------------- Message Wrapper
4008:
4009: sub messagewrapper {
1.369 www 4010: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4011: return
1.441 albertel 4012: '<a href="/adm/email?compose=individual&'.
4013: 'recname='.$username.'&recdom='.$domain.
4014: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4015: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4016: }
1.802 bisitz 4017:
1.74 www 4018: # --------------------------------------------------------------- Notes Wrapper
4019:
4020: sub noteswrapper {
4021: my ($link,$un,$do)=@_;
4022: return
1.896 amueller 4023: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4024: }
1.802 bisitz 4025:
1.62 www 4026: # ------------------------------------------------------------- Aboutme Wrapper
4027:
4028: sub aboutmewrapper {
1.1070 raeburn 4029: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4030: if (!defined($username) && !defined($domain)) {
4031: return;
4032: }
1.1096 raeburn 4033: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4034: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4035: }
4036:
4037: # ------------------------------------------------------------ Syllabus Wrapper
4038:
4039: sub syllabuswrapper {
1.707 bisitz 4040: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4041: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4042: }
1.14 harris41 4043:
1.802 bisitz 4044: # -----------------------------------------------------------------------------
4045:
1.208 matthew 4046: sub track_student_link {
1.887 raeburn 4047: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4048: my $link ="/adm/trackstudent?";
1.208 matthew 4049: my $title = 'View recent activity';
4050: if (defined($sname) && $sname !~ /^\s*$/ &&
4051: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4052: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4053: $title .= ' of this student';
1.268 albertel 4054: }
1.208 matthew 4055: if (defined($target) && $target !~ /^\s*$/) {
4056: $target = qq{target="$target"};
4057: } else {
4058: $target = '';
4059: }
1.268 albertel 4060: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4061: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4062: $title = &mt($title);
4063: $linktext = &mt($linktext);
1.448 albertel 4064: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4065: &help_open_topic('View_recent_activity');
1.208 matthew 4066: }
4067:
1.781 raeburn 4068: sub slot_reservations_link {
4069: my ($linktext,$sname,$sdom,$target) = @_;
4070: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4071: my $title = 'View slot reservation history';
4072: if (defined($sname) && $sname !~ /^\s*$/ &&
4073: defined($sdom) && $sdom !~ /^\s*$/) {
4074: $link .= "&uname=$sname&udom=$sdom";
4075: $title .= ' of this student';
4076: }
4077: if (defined($target) && $target !~ /^\s*$/) {
4078: $target = qq{target="$target"};
4079: } else {
4080: $target = '';
4081: }
4082: $title = &mt($title);
4083: $linktext = &mt($linktext);
4084: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4085: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4086:
4087: }
4088:
1.508 www 4089: # ===================================================== Display a student photo
4090:
4091:
1.509 albertel 4092: sub student_image_tag {
1.508 www 4093: my ($domain,$user)=@_;
4094: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4095: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4096: return '<img src="'.$imgsrc.'" align="right" />';
4097: } else {
4098: return '';
4099: }
4100: }
4101:
1.112 bowersj2 4102: =pod
4103:
4104: =back
4105:
4106: =head1 Access .tab File Data
4107:
4108: =over 4
4109:
1.648 raeburn 4110: =item * &languageids()
1.112 bowersj2 4111:
4112: returns list of all language ids
4113:
4114: =cut
4115:
1.14 harris41 4116: sub languageids {
1.16 harris41 4117: return sort(keys(%language));
1.14 harris41 4118: }
4119:
1.112 bowersj2 4120: =pod
4121:
1.648 raeburn 4122: =item * &languagedescription()
1.112 bowersj2 4123:
4124: returns description of a specified language id
4125:
4126: =cut
4127:
1.14 harris41 4128: sub languagedescription {
1.125 www 4129: my $code=shift;
4130: return ($supported_language{$code}?'* ':'').
4131: $language{$code}.
1.126 www 4132: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4133: }
4134:
1.1048 foxr 4135: =pod
4136:
4137: =item * &plainlanguagedescription
4138:
4139: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4140: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4141:
4142: =cut
4143:
1.145 www 4144: sub plainlanguagedescription {
4145: my $code=shift;
4146: return $language{$code};
4147: }
4148:
1.1048 foxr 4149: =pod
4150:
4151: =item * &supportedlanguagecode
4152:
4153: Returns the supported language code (e.g. sptutf maps to pt) given a language
4154: code.
4155:
4156: =cut
4157:
1.145 www 4158: sub supportedlanguagecode {
4159: my $code=shift;
4160: return $supported_language{$code};
1.97 www 4161: }
4162:
1.112 bowersj2 4163: =pod
4164:
1.1048 foxr 4165: =item * &latexlanguage()
4166:
4167: Given a language key code returns the correspondnig language to use
4168: to select the correct hyphenation on LaTeX printouts. This is undef if there
4169: is no supported hyphenation for the language code.
4170:
4171: =cut
4172:
4173: sub latexlanguage {
4174: my $code = shift;
4175: return $latex_language{$code};
4176: }
4177:
4178: =pod
4179:
4180: =item * &latexhyphenation()
4181:
4182: Same as above but what's supplied is the language as it might be stored
4183: in the metadata.
4184:
4185: =cut
4186:
4187: sub latexhyphenation {
4188: my $key = shift;
4189: return $latex_language_bykey{$key};
4190: }
4191:
4192: =pod
4193:
1.648 raeburn 4194: =item * ©rightids()
1.112 bowersj2 4195:
4196: returns list of all copyrights
4197:
4198: =cut
4199:
4200: sub copyrightids {
4201: return sort(keys(%cprtag));
4202: }
4203:
4204: =pod
4205:
1.648 raeburn 4206: =item * ©rightdescription()
1.112 bowersj2 4207:
4208: returns description of a specified copyright id
4209:
4210: =cut
4211:
4212: sub copyrightdescription {
1.166 www 4213: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4214: }
1.197 matthew 4215:
4216: =pod
4217:
1.648 raeburn 4218: =item * &source_copyrightids()
1.192 taceyjo1 4219:
4220: returns list of all source copyrights
4221:
4222: =cut
4223:
4224: sub source_copyrightids {
4225: return sort(keys(%scprtag));
4226: }
4227:
4228: =pod
4229:
1.648 raeburn 4230: =item * &source_copyrightdescription()
1.192 taceyjo1 4231:
4232: returns description of a specified source copyright id
4233:
4234: =cut
4235:
4236: sub source_copyrightdescription {
4237: return &mt($scprtag{shift(@_)});
4238: }
1.112 bowersj2 4239:
4240: =pod
4241:
1.648 raeburn 4242: =item * &filecategories()
1.112 bowersj2 4243:
4244: returns list of all file categories
4245:
4246: =cut
4247:
4248: sub filecategories {
4249: return sort(keys(%category_extensions));
4250: }
4251:
4252: =pod
4253:
1.648 raeburn 4254: =item * &filecategorytypes()
1.112 bowersj2 4255:
4256: returns list of file types belonging to a given file
4257: category
4258:
4259: =cut
4260:
4261: sub filecategorytypes {
1.356 albertel 4262: my ($cat) = @_;
1.1248 raeburn 4263: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4264: return @{$category_extensions{lc($cat)}};
4265: } else {
4266: return ();
4267: }
1.112 bowersj2 4268: }
4269:
4270: =pod
4271:
1.648 raeburn 4272: =item * &fileembstyle()
1.112 bowersj2 4273:
4274: returns embedding style for a specified file type
4275:
4276: =cut
4277:
4278: sub fileembstyle {
4279: return $fe{lc(shift(@_))};
1.169 www 4280: }
4281:
1.351 www 4282: sub filemimetype {
4283: return $fm{lc(shift(@_))};
4284: }
4285:
1.169 www 4286:
4287: sub filecategoryselect {
4288: my ($name,$value)=@_;
1.189 matthew 4289: return &select_form($value,$name,
1.970 raeburn 4290: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4291: }
4292:
4293: =pod
4294:
1.648 raeburn 4295: =item * &filedescription()
1.112 bowersj2 4296:
4297: returns description for a specified file type
4298:
4299: =cut
4300:
4301: sub filedescription {
1.188 matthew 4302: my $file_description = $fd{lc(shift())};
4303: $file_description =~ s:([\[\]]):~$1:g;
4304: return &mt($file_description);
1.112 bowersj2 4305: }
4306:
4307: =pod
4308:
1.648 raeburn 4309: =item * &filedescriptionex()
1.112 bowersj2 4310:
4311: returns description for a specified file type with
4312: extra formatting
4313:
4314: =cut
4315:
4316: sub filedescriptionex {
4317: my $ex=shift;
1.188 matthew 4318: my $file_description = $fd{lc($ex)};
4319: $file_description =~ s:([\[\]]):~$1:g;
4320: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4321: }
4322:
4323: # End of .tab access
4324: =pod
4325:
4326: =back
4327:
4328: =cut
4329:
4330: # ------------------------------------------------------------------ File Types
4331: sub fileextensions {
4332: return sort(keys(%fe));
4333: }
4334:
1.97 www 4335: # ----------------------------------------------------------- Display Languages
4336: # returns a hash with all desired display languages
4337: #
4338:
4339: sub display_languages {
4340: my %languages=();
1.695 raeburn 4341: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4342: $languages{$lang}=1;
1.97 www 4343: }
4344: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4345: if ($env{'form.displaylanguage'}) {
1.356 albertel 4346: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4347: $languages{$lang}=1;
1.97 www 4348: }
4349: }
4350: return %languages;
1.14 harris41 4351: }
4352:
1.582 albertel 4353: sub languages {
4354: my ($possible_langs) = @_;
1.695 raeburn 4355: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4356: if (!ref($possible_langs)) {
4357: if( wantarray ) {
4358: return @preferred_langs;
4359: } else {
4360: return $preferred_langs[0];
4361: }
4362: }
4363: my %possibilities = map { $_ => 1 } (@$possible_langs);
4364: my @preferred_possibilities;
4365: foreach my $preferred_lang (@preferred_langs) {
4366: if (exists($possibilities{$preferred_lang})) {
4367: push(@preferred_possibilities, $preferred_lang);
4368: }
4369: }
4370: if( wantarray ) {
4371: return @preferred_possibilities;
4372: }
4373: return $preferred_possibilities[0];
4374: }
4375:
1.742 raeburn 4376: sub user_lang {
4377: my ($touname,$toudom,$fromcid) = @_;
4378: my @userlangs;
4379: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4380: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4381: $env{'course.'.$fromcid.'.languages'}));
4382: } else {
4383: my %langhash = &getlangs($touname,$toudom);
4384: if ($langhash{'languages'} ne '') {
4385: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4386: } else {
4387: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4388: if ($domdefs{'lang_def'} ne '') {
4389: @userlangs = ($domdefs{'lang_def'});
4390: }
4391: }
4392: }
4393: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4394: my $user_lh = Apache::localize->get_handle(@languages);
4395: return $user_lh;
4396: }
4397:
4398:
1.112 bowersj2 4399: ###############################################################
4400: ## Student Answer Attempts ##
4401: ###############################################################
4402:
4403: =pod
4404:
4405: =head1 Alternate Problem Views
4406:
4407: =over 4
4408:
1.648 raeburn 4409: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4410: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4411:
4412: Return string with previous attempt on problem. Arguments:
4413:
4414: =over 4
4415:
4416: =item * $symb: Problem, including path
4417:
4418: =item * $username: username of the desired student
4419:
4420: =item * $domain: domain of the desired student
1.14 harris41 4421:
1.112 bowersj2 4422: =item * $course: Course ID
1.14 harris41 4423:
1.112 bowersj2 4424: =item * $getattempt: Leave blank for all attempts, otherwise put
4425: something
1.14 harris41 4426:
1.112 bowersj2 4427: =item * $regexp: if string matches this regexp, the string will be
4428: sent to $gradesub
1.14 harris41 4429:
1.112 bowersj2 4430: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4431:
1.1199 raeburn 4432: =item * $usec: section of the desired student
4433:
4434: =item * $identifier: counter for student (multiple students one problem) or
4435: problem (one student; whole sequence).
4436:
1.112 bowersj2 4437: =back
1.14 harris41 4438:
1.112 bowersj2 4439: The output string is a table containing all desired attempts, if any.
1.16 harris41 4440:
1.112 bowersj2 4441: =cut
1.1 albertel 4442:
4443: sub get_previous_attempt {
1.1199 raeburn 4444: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4445: my $prevattempts='';
1.43 ng 4446: no strict 'refs';
1.1 albertel 4447: if ($symb) {
1.3 albertel 4448: my (%returnhash)=
4449: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4450: if ($returnhash{'version'}) {
4451: my %lasthash=();
4452: my $version;
4453: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4454: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4455: if ($key =~ /\.rawrndseed$/) {
4456: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4457: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4458: } else {
4459: $lasthash{$key}=$returnhash{$version.':'.$key};
4460: }
1.19 harris41 4461: }
1.1 albertel 4462: }
1.596 albertel 4463: $prevattempts=&start_data_table().&start_data_table_header_row();
4464: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4465: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4466: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4467: foreach my $key (sort(keys(%lasthash))) {
4468: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4469: if ($#parts > 0) {
1.31 albertel 4470: my $data=$parts[-1];
1.989 raeburn 4471: next if ($data eq 'foilorder');
1.31 albertel 4472: pop(@parts);
1.1010 www 4473: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4474: if ($data eq 'type') {
4475: unless ($showsurv) {
4476: my $id = join(',',@parts);
4477: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4478: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4479: $lasthidden{$ign.'.'.$id} = 1;
4480: }
1.945 raeburn 4481: }
1.1199 raeburn 4482: if ($identifier ne '') {
4483: my $id = join(',',@parts);
4484: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4485: $domain,$username,$usec,undef,$course) =~ /^no/) {
4486: $hidestatus{$ign.'.'.$id} = 1;
4487: }
4488: }
4489: } elsif ($data eq 'regrader') {
4490: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4491: my $id = join(',',@parts);
4492: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4493: }
1.1010 www 4494: }
1.31 albertel 4495: } else {
1.41 ng 4496: if ($#parts == 0) {
4497: $prevattempts.='<th>'.$parts[0].'</th>';
4498: } else {
4499: $prevattempts.='<th>'.$ign.'</th>';
4500: }
1.31 albertel 4501: }
1.16 harris41 4502: }
1.596 albertel 4503: $prevattempts.=&end_data_table_header_row();
1.40 ng 4504: if ($getattempt eq '') {
1.1199 raeburn 4505: my (%solved,%resets,%probstatus);
1.1200 raeburn 4506: if (($identifier ne '') && (keys(%regraded) > 0)) {
4507: for ($version=1;$version<=$returnhash{'version'};$version++) {
4508: foreach my $id (keys(%regraded)) {
4509: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4510: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4511: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4512: push(@{$resets{$id}},$version);
1.1199 raeburn 4513: }
4514: }
4515: }
1.1200 raeburn 4516: }
4517: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4518: my (@hidden,@unsolved);
1.945 raeburn 4519: if (%typeparts) {
4520: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4521: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4522: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4523: push(@hidden,$id);
1.1199 raeburn 4524: } elsif ($identifier ne '') {
4525: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4526: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4527: ($hidestatus{$id})) {
1.1200 raeburn 4528: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4529: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4530: push(@{$solved{$id}},$version);
4531: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4532: (ref($solved{$id}) eq 'ARRAY')) {
4533: my $skip;
4534: if (ref($resets{$id}) eq 'ARRAY') {
4535: foreach my $reset (@{$resets{$id}}) {
4536: if ($reset > $solved{$id}[-1]) {
4537: $skip=1;
4538: last;
4539: }
4540: }
4541: }
4542: unless ($skip) {
4543: my ($ign,$partslist) = split(/\./,$id,2);
4544: push(@unsolved,$partslist);
4545: }
4546: }
4547: }
1.945 raeburn 4548: }
4549: }
4550: }
4551: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4552: '<td>'.&mt('Transaction [_1]',$version);
4553: if (@unsolved) {
4554: $prevattempts .= '<span class="LC_nobreak"><label>'.
4555: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4556: &mt('Hide').'</label></span>';
4557: }
4558: $prevattempts .= '</td>';
1.945 raeburn 4559: if (@hidden) {
4560: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4561: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4562: my $hide;
4563: foreach my $id (@hidden) {
4564: if ($key =~ /^\Q$id\E/) {
4565: $hide = 1;
4566: last;
4567: }
4568: }
4569: if ($hide) {
4570: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4571: if (($data eq 'award') || ($data eq 'awarddetail')) {
4572: my $value = &format_previous_attempt_value($key,
4573: $returnhash{$version.':'.$key});
1.1173 kruse 4574: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4575: } else {
4576: $prevattempts.='<td> </td>';
4577: }
4578: } else {
4579: if ($key =~ /\./) {
1.1212 raeburn 4580: my $value = $returnhash{$version.':'.$key};
4581: if ($key =~ /\.rndseed$/) {
4582: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4583: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4584: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4585: }
4586: }
4587: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4588: ' </td>';
1.945 raeburn 4589: } else {
4590: $prevattempts.='<td> </td>';
4591: }
4592: }
4593: }
4594: } else {
4595: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4596: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4597: my $value = $returnhash{$version.':'.$key};
4598: if ($key =~ /\.rndseed$/) {
4599: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4600: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4601: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4602: }
4603: }
4604: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4605: ' </td>';
1.945 raeburn 4606: }
4607: }
4608: $prevattempts.=&end_data_table_row();
1.40 ng 4609: }
1.1 albertel 4610: }
1.945 raeburn 4611: my @currhidden = keys(%lasthidden);
1.596 albertel 4612: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4613: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4614: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4615: if (%typeparts) {
4616: my $hidden;
4617: foreach my $id (@currhidden) {
4618: if ($key =~ /^\Q$id\E/) {
4619: $hidden = 1;
4620: last;
4621: }
4622: }
4623: if ($hidden) {
4624: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4625: if (($data eq 'award') || ($data eq 'awarddetail')) {
4626: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4627: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4628: $value = &$gradesub($value);
4629: }
1.1173 kruse 4630: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4631: } else {
4632: $prevattempts.='<td> </td>';
4633: }
4634: } else {
4635: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4636: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4637: $value = &$gradesub($value);
4638: }
1.1173 kruse 4639: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4640: }
4641: } else {
4642: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4643: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4644: $value = &$gradesub($value);
4645: }
1.1173 kruse 4646: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4647: }
1.16 harris41 4648: }
1.596 albertel 4649: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4650: } else {
1.1305 raeburn 4651: my $msg;
4652: if ($symb =~ /ext\.tool$/) {
4653: $msg = &mt('No grade passed back.');
4654: } else {
4655: $msg = &mt('Nothing submitted - no attempts.');
4656: }
1.596 albertel 4657: $prevattempts=
4658: &start_data_table().&start_data_table_row().
1.1305 raeburn 4659: '<td>'.$msg.'</td>'.
1.596 albertel 4660: &end_data_table_row().&end_data_table();
1.1 albertel 4661: }
4662: } else {
1.596 albertel 4663: $prevattempts=
4664: &start_data_table().&start_data_table_row().
4665: '<td>'.&mt('No data.').'</td>'.
4666: &end_data_table_row().&end_data_table();
1.1 albertel 4667: }
1.10 albertel 4668: }
4669:
1.581 albertel 4670: sub format_previous_attempt_value {
4671: my ($key,$value) = @_;
1.1011 www 4672: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4673: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4674: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4675: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4676: } elsif ($key =~ /answerstring$/) {
4677: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4678: my @answer = %answers;
4679: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4680: my @anskeys = sort(keys(%answers));
4681: if (@anskeys == 1) {
4682: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4683: if ($answer =~ m{\0}) {
4684: $answer =~ s{\0}{,}g;
1.988 raeburn 4685: }
4686: my $tag_internal_answer_name = 'INTERNAL';
4687: if ($anskeys[0] eq $tag_internal_answer_name) {
4688: $value = $answer;
4689: } else {
4690: $value = $anskeys[0].'='.$answer;
4691: }
4692: } else {
4693: foreach my $ans (@anskeys) {
4694: my $answer = $answers{$ans};
1.1001 raeburn 4695: if ($answer =~ m{\0}) {
4696: $answer =~ s{\0}{,}g;
1.988 raeburn 4697: }
4698: $value .= $ans.'='.$answer.'<br />';;
4699: }
4700: }
1.581 albertel 4701: } else {
1.1173 kruse 4702: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4703: }
4704: return $value;
4705: }
4706:
4707:
1.107 albertel 4708: sub relative_to_absolute {
4709: my ($url,$output)=@_;
4710: my $parser=HTML::TokeParser->new(\$output);
4711: my $token;
4712: my $thisdir=$url;
4713: my @rlinks=();
4714: while ($token=$parser->get_token) {
4715: if ($token->[0] eq 'S') {
4716: if ($token->[1] eq 'a') {
4717: if ($token->[2]->{'href'}) {
4718: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4719: }
4720: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4721: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4722: } elsif ($token->[1] eq 'base') {
4723: $thisdir=$token->[2]->{'href'};
4724: }
4725: }
4726: }
4727: $thisdir=~s-/[^/]*$--;
1.356 albertel 4728: foreach my $link (@rlinks) {
1.726 raeburn 4729: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4730: ($link=~/^\//) ||
4731: ($link=~/^javascript:/i) ||
4732: ($link=~/^mailto:/i) ||
4733: ($link=~/^\#/)) {
4734: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4735: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4736: }
4737: }
4738: # -------------------------------------------------- Deal with Applet codebases
4739: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4740: return $output;
4741: }
4742:
1.112 bowersj2 4743: =pod
4744:
1.648 raeburn 4745: =item * &get_student_view()
1.112 bowersj2 4746:
4747: show a snapshot of what student was looking at
4748:
4749: =cut
4750:
1.10 albertel 4751: sub get_student_view {
1.186 albertel 4752: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4753: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4754: my (%form);
1.10 albertel 4755: my @elements=('symb','courseid','domain','username');
4756: foreach my $element (@elements) {
1.186 albertel 4757: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4758: }
1.186 albertel 4759: if (defined($moreenv)) {
4760: %form=(%form,%{$moreenv});
4761: }
1.236 albertel 4762: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4763: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 4764: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
4765: $feedurl =~ s{^/adm/wrapper}{};
4766: }
1.650 www 4767: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4768: $userview=~s/\<body[^\>]*\>//gi;
4769: $userview=~s/\<\/body\>//gi;
4770: $userview=~s/\<html\>//gi;
4771: $userview=~s/\<\/html\>//gi;
4772: $userview=~s/\<head\>//gi;
4773: $userview=~s/\<\/head\>//gi;
4774: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4775: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4776: if (wantarray) {
4777: return ($userview,$response);
4778: } else {
4779: return $userview;
4780: }
4781: }
4782:
4783: sub get_student_view_with_retries {
4784: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4785:
4786: my $ok = 0; # True if we got a good response.
4787: my $content;
4788: my $response;
4789:
4790: # Try to get the student_view done. within the retries count:
4791:
4792: do {
4793: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4794: $ok = $response->is_success;
4795: if (!$ok) {
4796: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4797: }
4798: $retries--;
4799: } while (!$ok && ($retries > 0));
4800:
4801: if (!$ok) {
4802: $content = ''; # On error return an empty content.
4803: }
1.651 www 4804: if (wantarray) {
4805: return ($content, $response);
4806: } else {
4807: return $content;
4808: }
1.11 albertel 4809: }
4810:
1.112 bowersj2 4811: =pod
4812:
1.648 raeburn 4813: =item * &get_student_answers()
1.112 bowersj2 4814:
4815: show a snapshot of how student was answering problem
4816:
4817: =cut
4818:
1.11 albertel 4819: sub get_student_answers {
1.100 sakharuk 4820: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4821: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4822: my (%moreenv);
1.11 albertel 4823: my @elements=('symb','courseid','domain','username');
4824: foreach my $element (@elements) {
1.186 albertel 4825: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4826: }
1.186 albertel 4827: $moreenv{'grade_target'}='answer';
4828: %moreenv=(%form,%moreenv);
1.497 raeburn 4829: $feedurl = &Apache::lonnet::clutter($feedurl);
4830: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4831: return $userview;
1.1 albertel 4832: }
1.116 albertel 4833:
4834: =pod
4835:
4836: =item * &submlink()
4837:
1.242 albertel 4838: Inputs: $text $uname $udom $symb $target
1.116 albertel 4839:
4840: Returns: A link to grades.pm such as to see the SUBM view of a student
4841:
4842: =cut
4843:
4844: ###############################################
4845: sub submlink {
1.242 albertel 4846: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4847: if (!($uname && $udom)) {
4848: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4849: &Apache::lonnet::whichuser($symb);
1.116 albertel 4850: if (!$symb) { $symb=$cursymb; }
4851: }
1.254 matthew 4852: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4853: $symb=&escape($symb);
1.960 bisitz 4854: if ($target) { $target=" target=\"$target\""; }
4855: return
4856: '<a href="/adm/grades?command=submission'.
4857: '&symb='.$symb.
4858: '&student='.$uname.
4859: '&userdom='.$udom.'"'.
4860: $target.'>'.$text.'</a>';
1.242 albertel 4861: }
4862: ##############################################
4863:
4864: =pod
4865:
4866: =item * &pgrdlink()
4867:
4868: Inputs: $text $uname $udom $symb $target
4869:
4870: Returns: A link to grades.pm such as to see the PGRD view of a student
4871:
4872: =cut
4873:
4874: ###############################################
4875: sub pgrdlink {
4876: my $link=&submlink(@_);
4877: $link=~s/(&command=submission)/$1&showgrading=yes/;
4878: return $link;
4879: }
4880: ##############################################
4881:
4882: =pod
4883:
4884: =item * &pprmlink()
4885:
4886: Inputs: $text $uname $udom $symb $target
4887:
4888: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4889: student and a specific resource
1.242 albertel 4890:
4891: =cut
4892:
4893: ###############################################
4894: sub pprmlink {
4895: my ($text,$uname,$udom,$symb,$target)=@_;
4896: if (!($uname && $udom)) {
4897: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4898: &Apache::lonnet::whichuser($symb);
1.242 albertel 4899: if (!$symb) { $symb=$cursymb; }
4900: }
1.254 matthew 4901: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4902: $symb=&escape($symb);
1.242 albertel 4903: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4904: return '<a href="/adm/parmset?command=set&'.
4905: 'symb='.$symb.'&uname='.$uname.
4906: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4907: }
4908: ##############################################
1.37 matthew 4909:
1.112 bowersj2 4910: =pod
4911:
4912: =back
4913:
4914: =cut
4915:
1.37 matthew 4916: ###############################################
1.51 www 4917:
4918:
4919: sub timehash {
1.687 raeburn 4920: my ($thistime) = @_;
4921: my $timezone = &Apache::lonlocal::gettimezone();
4922: my $dt = DateTime->from_epoch(epoch => $thistime)
4923: ->set_time_zone($timezone);
4924: my $wday = $dt->day_of_week();
4925: if ($wday == 7) { $wday = 0; }
4926: return ( 'second' => $dt->second(),
4927: 'minute' => $dt->minute(),
4928: 'hour' => $dt->hour(),
4929: 'day' => $dt->day_of_month(),
4930: 'month' => $dt->month(),
4931: 'year' => $dt->year(),
4932: 'weekday' => $wday,
4933: 'dayyear' => $dt->day_of_year(),
4934: 'dlsav' => $dt->is_dst() );
1.51 www 4935: }
4936:
1.370 www 4937: sub utc_string {
4938: my ($date)=@_;
1.371 www 4939: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4940: }
4941:
1.51 www 4942: sub maketime {
4943: my %th=@_;
1.687 raeburn 4944: my ($epoch_time,$timezone,$dt);
4945: $timezone = &Apache::lonlocal::gettimezone();
4946: eval {
4947: $dt = DateTime->new( year => $th{'year'},
4948: month => $th{'month'},
4949: day => $th{'day'},
4950: hour => $th{'hour'},
4951: minute => $th{'minute'},
4952: second => $th{'second'},
4953: time_zone => $timezone,
4954: );
4955: };
4956: if (!$@) {
4957: $epoch_time = $dt->epoch;
4958: if ($epoch_time) {
4959: return $epoch_time;
4960: }
4961: }
1.51 www 4962: return POSIX::mktime(
4963: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4964: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4965: }
4966:
4967: #########################################
1.51 www 4968:
4969: sub findallcourses {
1.482 raeburn 4970: my ($roles,$uname,$udom) = @_;
1.355 albertel 4971: my %roles;
4972: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4973: my %courses;
1.51 www 4974: my $now=time;
1.482 raeburn 4975: if (!defined($uname)) {
4976: $uname = $env{'user.name'};
4977: }
4978: if (!defined($udom)) {
4979: $udom = $env{'user.domain'};
4980: }
4981: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4982: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4983: if (!%roles) {
4984: %roles = (
4985: cc => 1,
1.907 raeburn 4986: co => 1,
1.482 raeburn 4987: in => 1,
4988: ep => 1,
4989: ta => 1,
4990: cr => 1,
4991: st => 1,
4992: );
4993: }
4994: foreach my $entry (keys(%roleshash)) {
4995: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4996: if ($trole =~ /^cr/) {
4997: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4998: } else {
4999: next if (!exists($roles{$trole}));
5000: }
5001: if ($tend) {
5002: next if ($tend < $now);
5003: }
5004: if ($tstart) {
5005: next if ($tstart > $now);
5006: }
1.1058 raeburn 5007: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5008: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5009: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5010: if ($secpart eq '') {
5011: ($cnum,$role) = split(/_/,$cnumpart);
5012: $sec = 'none';
1.1058 raeburn 5013: $value .= $cnum.'/';
1.482 raeburn 5014: } else {
5015: $cnum = $cnumpart;
5016: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5017: $value .= $cnum.'/'.$sec;
5018: }
5019: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5020: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5021: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5022: }
5023: } else {
5024: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5025: }
1.482 raeburn 5026: }
5027: } else {
5028: foreach my $key (keys(%env)) {
1.483 albertel 5029: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5030: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5031: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5032: next if ($role eq 'ca' || $role eq 'aa');
5033: next if (%roles && !exists($roles{$role}));
5034: my ($starttime,$endtime)=split(/\./,$env{$key});
5035: my $active=1;
5036: if ($starttime) {
5037: if ($now<$starttime) { $active=0; }
5038: }
5039: if ($endtime) {
5040: if ($now>$endtime) { $active=0; }
5041: }
5042: if ($active) {
1.1058 raeburn 5043: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5044: if ($sec eq '') {
5045: $sec = 'none';
1.1058 raeburn 5046: } else {
5047: $value .= $sec;
5048: }
5049: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5050: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5051: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5052: }
5053: } else {
5054: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5055: }
1.474 raeburn 5056: }
5057: }
1.51 www 5058: }
5059: }
1.474 raeburn 5060: return %courses;
1.51 www 5061: }
1.37 matthew 5062:
1.54 www 5063: ###############################################
1.474 raeburn 5064:
5065: sub blockcheck {
1.1189 raeburn 5066: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 5067:
1.1189 raeburn 5068: if (defined($udom) && defined($uname)) {
5069: # If uname and udom are for a course, check for blocks in the course.
5070: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5071: my ($startblock,$endblock,$triggerblock) =
5072: &get_blocks($setters,$activity,$udom,$uname,$url);
5073: return ($startblock,$endblock,$triggerblock);
5074: }
5075: } else {
1.490 raeburn 5076: $udom = $env{'user.domain'};
5077: $uname = $env{'user.name'};
5078: }
5079:
1.502 raeburn 5080: my $startblock = 0;
5081: my $endblock = 0;
1.1062 raeburn 5082: my $triggerblock = '';
1.482 raeburn 5083: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 5084:
1.490 raeburn 5085: # If uname is for a user, and activity is course-specific, i.e.,
5086: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5087:
1.490 raeburn 5088: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5089: $activity eq 'groups' || $activity eq 'printout' ||
5090: $activity eq 'reinit' || $activity eq 'alert') &&
1.1189 raeburn 5091: ($env{'request.course.id'})) {
1.490 raeburn 5092: foreach my $key (keys(%live_courses)) {
5093: if ($key ne $env{'request.course.id'}) {
5094: delete($live_courses{$key});
5095: }
5096: }
5097: }
5098:
5099: my $otheruser = 0;
5100: my %own_courses;
5101: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5102: # Resource belongs to user other than current user.
5103: $otheruser = 1;
5104: # Gather courses for current user
5105: %own_courses =
5106: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5107: }
5108:
5109: # Gather active course roles - course coordinator, instructor,
5110: # exam proctor, ta, student, or custom role.
1.474 raeburn 5111:
5112: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5113: my ($cdom,$cnum);
5114: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5115: $cdom = $env{'course.'.$course.'.domain'};
5116: $cnum = $env{'course.'.$course.'.num'};
5117: } else {
1.490 raeburn 5118: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5119: }
5120: my $no_ownblock = 0;
5121: my $no_userblock = 0;
1.533 raeburn 5122: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5123: # Check if current user has 'evb' priv for this
5124: if (defined($own_courses{$course})) {
5125: foreach my $sec (keys(%{$own_courses{$course}})) {
5126: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5127: if ($sec ne 'none') {
5128: $checkrole .= '/'.$sec;
5129: }
5130: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5131: $no_ownblock = 1;
5132: last;
5133: }
5134: }
5135: }
5136: # if they have 'evb' priv and are currently not playing student
5137: next if (($no_ownblock) &&
5138: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5139: }
1.474 raeburn 5140: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5141: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5142: if ($sec ne 'none') {
1.482 raeburn 5143: $checkrole .= '/'.$sec;
1.474 raeburn 5144: }
1.490 raeburn 5145: if ($otheruser) {
5146: # Resource belongs to user other than current user.
5147: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5148: my (%allroles,%userroles);
5149: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5150: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5151: my ($trole,$tdom,$tnum,$tsec);
5152: if ($entry =~ /^cr/) {
5153: ($trole,$tdom,$tnum,$tsec) =
5154: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5155: } else {
5156: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5157: }
5158: my ($spec,$area,$trest);
5159: $area = '/'.$tdom.'/'.$tnum;
5160: $trest = $tnum;
5161: if ($tsec ne '') {
5162: $area .= '/'.$tsec;
5163: $trest .= '/'.$tsec;
5164: }
5165: $spec = $trole.'.'.$area;
5166: if ($trole =~ /^cr/) {
5167: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5168: $tdom,$spec,$trest,$area);
5169: } else {
5170: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5171: $tdom,$spec,$trest,$area);
5172: }
5173: }
1.1276 raeburn 5174: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5175: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5176: if ($1) {
5177: $no_userblock = 1;
5178: last;
5179: }
1.486 raeburn 5180: }
5181: }
1.490 raeburn 5182: } else {
5183: # Resource belongs to current user
5184: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5185: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5186: $no_ownblock = 1;
5187: last;
5188: }
1.474 raeburn 5189: }
5190: }
5191: # if they have the evb priv and are currently not playing student
1.482 raeburn 5192: next if (($no_ownblock) &&
1.491 albertel 5193: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5194: next if ($no_userblock);
1.474 raeburn 5195:
1.1303 raeburn 5196: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5197: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5198:
1.1062 raeburn 5199: my ($start,$end,$trigger) =
5200: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5201: if (($start != 0) &&
5202: (($startblock == 0) || ($startblock > $start))) {
5203: $startblock = $start;
1.1062 raeburn 5204: if ($trigger ne '') {
5205: $triggerblock = $trigger;
5206: }
1.502 raeburn 5207: }
5208: if (($end != 0) &&
5209: (($endblock == 0) || ($endblock < $end))) {
5210: $endblock = $end;
1.1062 raeburn 5211: if ($trigger ne '') {
5212: $triggerblock = $trigger;
5213: }
1.502 raeburn 5214: }
1.490 raeburn 5215: }
1.1062 raeburn 5216: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5217: }
5218:
5219: sub get_blocks {
1.1062 raeburn 5220: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5221: my $startblock = 0;
5222: my $endblock = 0;
1.1062 raeburn 5223: my $triggerblock = '';
1.490 raeburn 5224: my $course = $cdom.'_'.$cnum;
5225: $setters->{$course} = {};
5226: $setters->{$course}{'staff'} = [];
5227: $setters->{$course}{'times'} = [];
1.1062 raeburn 5228: $setters->{$course}{'triggers'} = [];
5229: my (@blockers,%triggered);
5230: my $now = time;
5231: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5232: if ($activity eq 'docs') {
5233: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5234: foreach my $block (@blockers) {
5235: if ($block =~ /^firstaccess____(.+)$/) {
5236: my $item = $1;
5237: my $type = 'map';
5238: my $timersymb = $item;
5239: if ($item eq 'course') {
5240: $type = 'course';
5241: } elsif ($item =~ /___\d+___/) {
5242: $type = 'resource';
5243: } else {
5244: $timersymb = &Apache::lonnet::symbread($item);
5245: }
5246: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5247: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5248: $triggered{$block} = {
5249: start => $start,
5250: end => $end,
5251: type => $type,
5252: };
5253: }
5254: }
5255: } else {
5256: foreach my $block (keys(%commblocks)) {
5257: if ($block =~ m/^(\d+)____(\d+)$/) {
5258: my ($start,$end) = ($1,$2);
5259: if ($start <= time && $end >= time) {
5260: if (ref($commblocks{$block}) eq 'HASH') {
5261: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5262: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5263: unless(grep(/^\Q$block\E$/,@blockers)) {
5264: push(@blockers,$block);
5265: }
5266: }
5267: }
5268: }
5269: }
5270: } elsif ($block =~ /^firstaccess____(.+)$/) {
5271: my $item = $1;
5272: my $timersymb = $item;
5273: my $type = 'map';
5274: if ($item eq 'course') {
5275: $type = 'course';
5276: } elsif ($item =~ /___\d+___/) {
5277: $type = 'resource';
5278: } else {
5279: $timersymb = &Apache::lonnet::symbread($item);
5280: }
5281: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5282: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5283: if ($start && $end) {
5284: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5285: if (ref($commblocks{$block}) eq 'HASH') {
5286: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5287: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5288: unless(grep(/^\Q$block\E$/,@blockers)) {
5289: push(@blockers,$block);
5290: $triggered{$block} = {
5291: start => $start,
5292: end => $end,
5293: type => $type,
5294: };
5295: }
5296: }
5297: }
1.1062 raeburn 5298: }
5299: }
1.490 raeburn 5300: }
1.1062 raeburn 5301: }
5302: }
5303: }
5304: foreach my $blocker (@blockers) {
5305: my ($staff_name,$staff_dom,$title,$blocks) =
5306: &parse_block_record($commblocks{$blocker});
5307: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5308: my ($start,$end,$triggertype);
5309: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5310: ($start,$end) = ($1,$2);
5311: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5312: $start = $triggered{$blocker}{'start'};
5313: $end = $triggered{$blocker}{'end'};
5314: $triggertype = $triggered{$blocker}{'type'};
5315: }
5316: if ($start) {
5317: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5318: if ($triggertype) {
5319: push(@{$$setters{$course}{'triggers'}},$triggertype);
5320: } else {
5321: push(@{$$setters{$course}{'triggers'}},0);
5322: }
5323: if ( ($startblock == 0) || ($startblock > $start) ) {
5324: $startblock = $start;
5325: if ($triggertype) {
5326: $triggerblock = $blocker;
1.474 raeburn 5327: }
5328: }
1.1062 raeburn 5329: if ( ($endblock == 0) || ($endblock < $end) ) {
5330: $endblock = $end;
5331: if ($triggertype) {
5332: $triggerblock = $blocker;
5333: }
5334: }
1.474 raeburn 5335: }
5336: }
1.1062 raeburn 5337: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5338: }
5339:
5340: sub parse_block_record {
5341: my ($record) = @_;
5342: my ($setuname,$setudom,$title,$blocks);
5343: if (ref($record) eq 'HASH') {
5344: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5345: $title = &unescape($record->{'event'});
5346: $blocks = $record->{'blocks'};
5347: } else {
5348: my @data = split(/:/,$record,3);
5349: if (scalar(@data) eq 2) {
5350: $title = $data[1];
5351: ($setuname,$setudom) = split(/@/,$data[0]);
5352: } else {
5353: ($setuname,$setudom,$title) = @data;
5354: }
5355: $blocks = { 'com' => 'on' };
5356: }
5357: return ($setuname,$setudom,$title,$blocks);
5358: }
5359:
1.854 kalberla 5360: sub blocking_status {
1.1189 raeburn 5361: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5362: my %setters;
1.890 droeschl 5363:
1.1061 raeburn 5364: # check for active blocking
1.1062 raeburn 5365: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5366: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5367: my $blocked = 0;
5368: if ($startblock && $endblock) {
5369: $blocked = 1;
5370: }
1.890 droeschl 5371:
1.1061 raeburn 5372: # caller just wants to know whether a block is active
5373: if (!wantarray) { return $blocked; }
5374:
5375: # build a link to a popup window containing the details
5376: my $querystring = "?activity=$activity";
5377: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5378: if (($activity eq 'port') || ($activity eq 'passwd')) {
5379: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5380: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5381: } elsif ($activity eq 'docs') {
5382: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5383: }
1.1061 raeburn 5384:
5385: my $output .= <<'END_MYBLOCK';
5386: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5387: var options = "width=" + w + ",height=" + h + ",";
5388: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5389: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5390: var newWin = window.open(url, wdwName, options);
5391: newWin.focus();
5392: }
1.890 droeschl 5393: END_MYBLOCK
1.854 kalberla 5394:
1.1061 raeburn 5395: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5396:
1.1061 raeburn 5397: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5398: my $text = &mt('Communication Blocked');
1.1217 raeburn 5399: my $class = 'LC_comblock';
1.1062 raeburn 5400: if ($activity eq 'docs') {
5401: $text = &mt('Content Access Blocked');
1.1217 raeburn 5402: $class = '';
1.1063 raeburn 5403: } elsif ($activity eq 'printout') {
5404: $text = &mt('Printing Blocked');
1.1232 raeburn 5405: } elsif ($activity eq 'passwd') {
5406: $text = &mt('Password Changing Blocked');
1.1282 raeburn 5407: } elsif ($activity eq 'alert') {
5408: $text = &mt('Checking Critical Messages Blocked');
5409: } elsif ($activity eq 'reinit') {
5410: $text = &mt('Checking Course Update Blocked');
1.1062 raeburn 5411: }
1.1061 raeburn 5412: $output .= <<"END_BLOCK";
1.1217 raeburn 5413: <div class='$class'>
1.869 kalberla 5414: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5415: title='$text'>
5416: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5417: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5418: title='$text'>$text</a>
1.867 kalberla 5419: </div>
5420:
5421: END_BLOCK
1.474 raeburn 5422:
1.1061 raeburn 5423: return ($blocked, $output);
1.854 kalberla 5424: }
1.490 raeburn 5425:
1.60 matthew 5426: ###############################################
5427:
1.682 raeburn 5428: sub check_ip_acc {
1.1201 raeburn 5429: my ($acc,$clientip)=@_;
1.682 raeburn 5430: &Apache::lonxml::debug("acc is $acc");
5431: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5432: return 1;
5433: }
1.1219 raeburn 5434: my $allowed;
1.1252 raeburn 5435: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5436:
5437: my $name;
1.1219 raeburn 5438: my %access = (
5439: allowfrom => 1,
5440: denyfrom => 0,
5441: );
5442: my @allows;
5443: my @denies;
5444: foreach my $item (split(',',$acc)) {
5445: $item =~ s/^\s*//;
5446: $item =~ s/\s*$//;
5447: my $pattern;
5448: if ($item =~ /^\!(.+)$/) {
5449: push(@denies,$1);
5450: } else {
5451: push(@allows,$item);
5452: }
5453: }
5454: my $numdenies = scalar(@denies);
5455: my $numallows = scalar(@allows);
5456: my $count = 0;
5457: foreach my $pattern (@denies,@allows) {
5458: $count ++;
5459: my $acctype = 'allowfrom';
5460: if ($count <= $numdenies) {
5461: $acctype = 'denyfrom';
5462: }
1.682 raeburn 5463: if ($pattern =~ /\*$/) {
5464: #35.8.*
5465: $pattern=~s/\*//;
1.1219 raeburn 5466: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5467: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5468: #35.8.3.[34-56]
5469: my $low=$2;
5470: my $high=$3;
5471: $pattern=$1;
5472: if ($ip =~ /^\Q$pattern\E/) {
5473: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5474: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5475: }
5476: } elsif ($pattern =~ /^\*/) {
5477: #*.msu.edu
5478: $pattern=~s/\*//;
5479: if (!defined($name)) {
5480: use Socket;
5481: my $netaddr=inet_aton($ip);
5482: ($name)=gethostbyaddr($netaddr,AF_INET);
5483: }
1.1219 raeburn 5484: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5485: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5486: #127.0.0.1
1.1219 raeburn 5487: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5488: } else {
5489: #some.name.com
5490: if (!defined($name)) {
5491: use Socket;
5492: my $netaddr=inet_aton($ip);
5493: ($name)=gethostbyaddr($netaddr,AF_INET);
5494: }
1.1219 raeburn 5495: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5496: }
5497: if ($allowed =~ /^(0|1)$/) { last; }
5498: }
5499: if ($allowed eq '') {
5500: if ($numdenies && !$numallows) {
5501: $allowed = 1;
5502: } else {
5503: $allowed = 0;
1.682 raeburn 5504: }
5505: }
5506: return $allowed;
5507: }
5508:
5509: ###############################################
5510:
1.60 matthew 5511: =pod
5512:
1.112 bowersj2 5513: =head1 Domain Template Functions
5514:
5515: =over 4
5516:
5517: =item * &determinedomain()
1.60 matthew 5518:
5519: Inputs: $domain (usually will be undef)
5520:
1.63 www 5521: Returns: Determines which domain should be used for designs
1.60 matthew 5522:
5523: =cut
1.54 www 5524:
1.60 matthew 5525: ###############################################
1.63 www 5526: sub determinedomain {
5527: my $domain=shift;
1.531 albertel 5528: if (! $domain) {
1.60 matthew 5529: # Determine domain if we have not been given one
1.893 raeburn 5530: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5531: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5532: if ($env{'request.role.domain'}) {
5533: $domain=$env{'request.role.domain'};
1.60 matthew 5534: }
5535: }
1.63 www 5536: return $domain;
5537: }
5538: ###############################################
1.517 raeburn 5539:
1.518 albertel 5540: sub devalidate_domconfig_cache {
5541: my ($udom)=@_;
5542: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5543: }
5544:
5545: # ---------------------- Get domain configuration for a domain
5546: sub get_domainconf {
5547: my ($udom) = @_;
5548: my $cachetime=1800;
5549: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5550: if (defined($cached)) { return %{$result}; }
5551:
5552: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5553: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5554: my (%designhash,%legacy);
1.518 albertel 5555: if (keys(%domconfig) > 0) {
5556: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5557: if (keys(%{$domconfig{'login'}})) {
5558: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5559: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5560: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5561: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5562: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5563: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5564: if ($key eq 'loginvia') {
5565: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5566: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5567: $designhash{$udom.'.login.loginvia'} = $server;
5568: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5569:
5570: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5571: } else {
5572: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5573: }
1.948 raeburn 5574: }
1.1208 raeburn 5575: } elsif ($key eq 'headtag') {
5576: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5577: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5578: }
1.946 raeburn 5579: }
1.1208 raeburn 5580: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5581: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5582: }
1.946 raeburn 5583: }
5584: }
5585: }
5586: } else {
5587: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5588: $designhash{$udom.'.login.'.$key.'_'.$img} =
5589: $domconfig{'login'}{$key}{$img};
5590: }
1.699 raeburn 5591: }
5592: } else {
5593: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5594: }
1.632 raeburn 5595: }
5596: } else {
5597: $legacy{'login'} = 1;
1.518 albertel 5598: }
1.632 raeburn 5599: } else {
5600: $legacy{'login'} = 1;
1.518 albertel 5601: }
5602: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5603: if (keys(%{$domconfig{'rolecolors'}})) {
5604: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5605: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5606: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5607: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5608: }
1.518 albertel 5609: }
5610: }
1.632 raeburn 5611: } else {
5612: $legacy{'rolecolors'} = 1;
1.518 albertel 5613: }
1.632 raeburn 5614: } else {
5615: $legacy{'rolecolors'} = 1;
1.518 albertel 5616: }
1.948 raeburn 5617: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5618: if ($domconfig{'autoenroll'}{'co-owners'}) {
5619: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5620: }
5621: }
1.632 raeburn 5622: if (keys(%legacy) > 0) {
5623: my %legacyhash = &get_legacy_domconf($udom);
5624: foreach my $item (keys(%legacyhash)) {
5625: if ($item =~ /^\Q$udom\E\.login/) {
5626: if ($legacy{'login'}) {
5627: $designhash{$item} = $legacyhash{$item};
5628: }
5629: } else {
5630: if ($legacy{'rolecolors'}) {
5631: $designhash{$item} = $legacyhash{$item};
5632: }
1.518 albertel 5633: }
5634: }
5635: }
1.632 raeburn 5636: } else {
5637: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5638: }
5639: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5640: $cachetime);
5641: return %designhash;
5642: }
5643:
1.632 raeburn 5644: sub get_legacy_domconf {
5645: my ($udom) = @_;
5646: my %legacyhash;
5647: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5648: my $designfile = $designdir.'/'.$udom.'.tab';
5649: if (-e $designfile) {
5650: if ( open (my $fh,"<$designfile") ) {
5651: while (my $line = <$fh>) {
5652: next if ($line =~ /^\#/);
5653: chomp($line);
5654: my ($key,$val)=(split(/\=/,$line));
5655: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5656: }
5657: close($fh);
5658: }
5659: }
1.1026 raeburn 5660: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5661: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5662: }
5663: return %legacyhash;
5664: }
5665:
1.63 www 5666: =pod
5667:
1.112 bowersj2 5668: =item * &domainlogo()
1.63 www 5669:
5670: Inputs: $domain (usually will be undef)
5671:
5672: Returns: A link to a domain logo, if the domain logo exists.
5673: If the domain logo does not exist, a description of the domain.
5674:
5675: =cut
1.112 bowersj2 5676:
1.63 www 5677: ###############################################
5678: sub domainlogo {
1.517 raeburn 5679: my $domain = &determinedomain(shift);
1.518 albertel 5680: my %designhash = &get_domainconf($domain);
1.517 raeburn 5681: # See if there is a logo
5682: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5683: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5684: if ($imgsrc =~ m{^/(adm|res)/}) {
5685: if ($imgsrc =~ m{^/res/}) {
5686: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5687: &Apache::lonnet::repcopy($local_name);
5688: }
5689: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5690: }
5691: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5692: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5693: return &Apache::lonnet::domain($domain,'description');
1.59 www 5694: } else {
1.60 matthew 5695: return '';
1.59 www 5696: }
5697: }
1.63 www 5698: ##############################################
5699:
5700: =pod
5701:
1.112 bowersj2 5702: =item * &designparm()
1.63 www 5703:
5704: Inputs: $which parameter; $domain (usually will be undef)
5705:
5706: Returns: value of designparamter $which
5707:
5708: =cut
1.112 bowersj2 5709:
1.397 albertel 5710:
1.400 albertel 5711: ##############################################
1.397 albertel 5712: sub designparm {
5713: my ($which,$domain)=@_;
5714: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5715: return $env{'environment.color.'.$which};
1.96 www 5716: }
1.63 www 5717: $domain=&determinedomain($domain);
1.1016 raeburn 5718: my %domdesign;
5719: unless ($domain eq 'public') {
5720: %domdesign = &get_domainconf($domain);
5721: }
1.520 raeburn 5722: my $output;
1.517 raeburn 5723: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5724: $output = $domdesign{$domain.'.'.$which};
1.63 www 5725: } else {
1.520 raeburn 5726: $output = $defaultdesign{$which};
5727: }
5728: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5729: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5730: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5731: if ($output =~ m{^/res/}) {
5732: my $local_name = &Apache::lonnet::filelocation('',$output);
5733: &Apache::lonnet::repcopy($local_name);
5734: }
1.520 raeburn 5735: $output = &lonhttpdurl($output);
5736: }
1.63 www 5737: }
1.520 raeburn 5738: return $output;
1.63 www 5739: }
1.59 www 5740:
1.822 bisitz 5741: ##############################################
5742: =pod
5743:
1.832 bisitz 5744: =item * &authorspace()
5745:
1.1028 raeburn 5746: Inputs: $url (usually will be undef).
1.832 bisitz 5747:
1.1132 raeburn 5748: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5749: directory being viewed (or for which action is being taken).
5750: If $url is provided, and begins /priv/<domain>/<uname>
5751: the path will be that portion of the $context argument.
5752: Otherwise the path will be for the author space of the current
5753: user when the current role is author, or for that of the
5754: co-author/assistant co-author space when the current role
5755: is co-author or assistant co-author.
1.832 bisitz 5756:
5757: =cut
5758:
5759: sub authorspace {
1.1028 raeburn 5760: my ($url) = @_;
5761: if ($url ne '') {
5762: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5763: return $1;
5764: }
5765: }
1.832 bisitz 5766: my $caname = '';
1.1024 www 5767: my $cadom = '';
1.1028 raeburn 5768: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5769: ($cadom,$caname) =
1.832 bisitz 5770: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5771: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5772: $caname = $env{'user.name'};
1.1024 www 5773: $cadom = $env{'user.domain'};
1.832 bisitz 5774: }
1.1028 raeburn 5775: if (($caname ne '') && ($cadom ne '')) {
5776: return "/priv/$cadom/$caname/";
5777: }
5778: return;
1.832 bisitz 5779: }
5780:
5781: ##############################################
5782: =pod
5783:
1.822 bisitz 5784: =item * &head_subbox()
5785:
5786: Inputs: $content (contains HTML code with page functions, etc.)
5787:
5788: Returns: HTML div with $content
5789: To be included in page header
5790:
5791: =cut
5792:
5793: sub head_subbox {
5794: my ($content)=@_;
5795: my $output =
1.993 raeburn 5796: '<div class="LC_head_subbox">'
1.822 bisitz 5797: .$content
5798: .'</div>'
5799: }
5800:
5801: ##############################################
5802: =pod
5803:
5804: =item * &CSTR_pageheader()
5805:
1.1026 raeburn 5806: Input: (optional) filename from which breadcrumb trail is built.
5807: In most cases no input as needed, as $env{'request.filename'}
5808: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5809:
5810: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5811: To be included on Authoring Space pages
1.822 bisitz 5812:
5813: =cut
5814:
5815: sub CSTR_pageheader {
1.1026 raeburn 5816: my ($trailfile) = @_;
5817: if ($trailfile eq '') {
5818: $trailfile = $env{'request.filename'};
5819: }
5820:
5821: # this is for resources; directories have customtitle, and crumbs
5822: # and select recent are created in lonpubdir.pm
5823:
5824: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5825: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5826: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5827: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5828: $formaction =~ s{/+}{/}g;
1.822 bisitz 5829:
5830: my $parentpath = '';
5831: my $lastitem = '';
5832: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5833: $parentpath = $1;
5834: $lastitem = $2;
5835: } else {
5836: $lastitem = $thisdisfn;
5837: }
1.921 bisitz 5838:
1.1246 raeburn 5839: my ($crsauthor,$title);
5840: if (($env{'request.course.id'}) &&
5841: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5842: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5843: $crsauthor = 1;
5844: $title = &mt('Course Authoring Space');
5845: } else {
5846: $title = &mt('Authoring Space');
5847: }
5848:
1.1314 ! raeburn 5849: my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
1.1313 raeburn 5850: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 ! raeburn 5851: $target = '';
! 5852: $crumbtarget = '';
1.1313 raeburn 5853: }
5854:
1.921 bisitz 5855: my $output =
1.822 bisitz 5856: '<div>'
5857: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5858: .'<b>'.$title.'</b> '
1.1314 ! raeburn 5859: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
! 5860: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 5861:
5862: if ($lastitem) {
5863: $output .=
5864: '<span class="LC_filename">'
5865: .$lastitem
5866: .'</span>';
5867: }
1.1245 raeburn 5868:
1.1246 raeburn 5869: if ($crsauthor) {
5870: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5871: } else {
5872: $output .=
5873: '<br />'
1.1314 ! raeburn 5874: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 5875: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5876: .'</form>'
5877: .&Apache::lonmenu::constspaceform();
5878: }
5879: $output .= '</div>';
1.921 bisitz 5880:
5881: return $output;
1.822 bisitz 5882: }
5883:
1.60 matthew 5884: ###############################################
5885: ###############################################
5886:
5887: =pod
5888:
1.112 bowersj2 5889: =back
5890:
1.549 albertel 5891: =head1 HTML Helpers
1.112 bowersj2 5892:
5893: =over 4
5894:
5895: =item * &bodytag()
1.60 matthew 5896:
5897: Returns a uniform header for LON-CAPA web pages.
5898:
5899: Inputs:
5900:
1.112 bowersj2 5901: =over 4
5902:
5903: =item * $title, A title to be displayed on the page.
5904:
5905: =item * $function, the current role (can be undef).
5906:
5907: =item * $addentries, extra parameters for the <body> tag.
5908:
5909: =item * $bodyonly, if defined, only return the <body> tag.
5910:
5911: =item * $domain, if defined, force a given domain.
5912:
5913: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5914: text interface only)
1.60 matthew 5915:
1.814 bisitz 5916: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5917: navigational links
1.317 albertel 5918:
1.338 albertel 5919: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5920:
1.460 albertel 5921: =item * $args, optional argument valid values are
5922: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 5923: use_absolute -> for external resource or syllabus, this will
5924: contain https://<hostname> if server uses
5925: https (as per hosts.tab), but request is for http
5926: hostname -> hostname, from $r->hostname().
1.460 albertel 5927:
1.1096 raeburn 5928: =item * $advtoolsref, optional argument, ref to an array containing
5929: inlineremote items to be added in "Functions" menu below
5930: breadcrumbs.
5931:
1.112 bowersj2 5932: =back
5933:
1.60 matthew 5934: Returns: A uniform header for LON-CAPA web pages.
5935: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5936: If $bodyonly is undef or zero, an html string containing a <body> tag and
5937: other decorations will be returned.
5938:
5939: =cut
5940:
1.54 www 5941: sub bodytag {
1.831 bisitz 5942: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5943: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5944:
1.954 raeburn 5945: my $public;
5946: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5947: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5948: $public = 1;
5949: }
1.460 albertel 5950: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5951: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 5952: my $hostname = $args->{'hostname'};
1.339 albertel 5953:
1.183 matthew 5954: $function = &get_users_function() if (!$function);
1.339 albertel 5955: my $img = &designparm($function.'.img',$domain);
5956: my $font = &designparm($function.'.font',$domain);
5957: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5958:
1.803 bisitz 5959: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5960: 'bgcolor' => $pgbg,
1.339 albertel 5961: 'text' => $font,
5962: 'alink' => &designparm($function.'.alink',$domain),
5963: 'vlink' => &designparm($function.'.vlink',$domain),
5964: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5965: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5966:
1.63 www 5967: # role and realm
1.1178 raeburn 5968: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5969: if ($realm) {
5970: $realm = '/'.$realm;
5971: }
1.378 raeburn 5972: if ($role eq 'ca') {
1.479 albertel 5973: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5974: $realm = &plainname($rname,$rdom);
1.378 raeburn 5975: }
1.55 www 5976: # realm
1.258 albertel 5977: if ($env{'request.course.id'}) {
1.378 raeburn 5978: if ($env{'request.role'} !~ /^cr/) {
5979: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 5980: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 5981: if ($env{'request.role.desc'}) {
5982: $role = $env{'request.role.desc'};
5983: } else {
5984: $role = &mt('Helpdesk[_1]',' '.$2);
5985: }
1.1257 raeburn 5986: } else {
5987: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5988: }
1.898 raeburn 5989: if ($env{'request.course.sec'}) {
5990: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5991: }
1.359 albertel 5992: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5993: } else {
5994: $role = &Apache::lonnet::plaintext($role);
1.54 www 5995: }
1.433 albertel 5996:
1.359 albertel 5997: if (!$realm) { $realm=' '; }
1.330 albertel 5998:
1.438 albertel 5999: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6000:
1.101 www 6001: # construct main body tag
1.359 albertel 6002: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6003: &Apache::lontexconvert::init_math_support();
1.252 albertel 6004:
1.1131 raeburn 6005: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6006:
1.1130 raeburn 6007: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6008: return $bodytag;
1.1130 raeburn 6009: }
1.359 albertel 6010:
1.954 raeburn 6011: if ($public) {
1.433 albertel 6012: undef($role);
6013: }
1.359 albertel 6014:
1.762 bisitz 6015: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6016: #
6017: # Extra info if you are the DC
6018: my $dc_info = '';
6019: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
6020: $env{'course.'.$env{'request.course.id'}.
6021: '.domain'}.'/'})) {
6022: my $cid = $env{'request.course.id'};
1.917 raeburn 6023: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6024: $dc_info =~ s/\s+$//;
1.359 albertel 6025: }
6026:
1.1237 raeburn 6027: my $crstype;
6028: if ($env{'request.course.id'}) {
6029: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
6030: } elsif ($args->{'crstype'}) {
6031: $crstype = $args->{'crstype'};
6032: }
6033: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6034: undef($role);
6035: } else {
1.1242 raeburn 6036: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6037: }
1.853 droeschl 6038:
1.903 droeschl 6039: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6040:
6041: # if ($env{'request.state'} eq 'construct') {
6042: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6043: # }
6044:
1.1130 raeburn 6045: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6046: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6047:
1.1237 raeburn 6048: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 6049:
1.916 droeschl 6050: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 6051: if ($dc_info) {
6052: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6053: }
1.1130 raeburn 6054: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 6055: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 6056: return $bodytag;
6057: }
1.894 droeschl 6058:
1.927 raeburn 6059: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 6060: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 6061: }
1.916 droeschl 6062:
1.1130 raeburn 6063: $bodytag .= $right;
1.852 droeschl 6064:
1.917 raeburn 6065: if ($dc_info) {
6066: $dc_info = &dc_courseid_toggle($dc_info);
6067: }
6068: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 6069:
1.1169 raeburn 6070: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6071: if ($args->{'no_secondary_menu'}) {
6072: return $bodytag;
6073: }
1.1169 raeburn 6074: #don't show menus for public users
1.954 raeburn 6075: if (!$public){
1.1154 raeburn 6076: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 6077: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6078: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6079: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6080: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1274 raeburn 6081: $args->{'bread_crumbs'},'','',$hostname);
1.1096 raeburn 6082: } elsif ($forcereg) {
6083: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 6084: $args->{'group'},
1.1274 raeburn 6085: $args->{'hide_buttons'},
6086: $hostname);
1.1096 raeburn 6087: } else {
6088: $bodytag .=
6089: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6090: $forcereg,$args->{'group'},
6091: $args->{'bread_crumbs'},
1.1274 raeburn 6092: $advtoolsref,'',$hostname);
1.920 raeburn 6093: }
1.903 droeschl 6094: }else{
6095: # this is to seperate menu from content when there's no secondary
6096: # menu. Especially needed for public accessible ressources.
6097: $bodytag .= '<hr style="clear:both" />';
6098: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6099: }
1.903 droeschl 6100:
1.235 raeburn 6101: return $bodytag;
1.182 matthew 6102: }
6103:
1.917 raeburn 6104: sub dc_courseid_toggle {
6105: my ($dc_info) = @_;
1.980 raeburn 6106: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6107: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6108: &mt('(More ...)').'</a></span>'.
6109: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6110: }
6111:
1.330 albertel 6112: sub make_attr_string {
6113: my ($register,$attr_ref) = @_;
6114:
6115: if ($attr_ref && !ref($attr_ref)) {
6116: die("addentries Must be a hash ref ".
6117: join(':',caller(1))." ".
6118: join(':',caller(0))." ");
6119: }
6120:
6121: if ($register) {
1.339 albertel 6122: my ($on_load,$on_unload);
6123: foreach my $key (keys(%{$attr_ref})) {
6124: if (lc($key) eq 'onload') {
6125: $on_load.=$attr_ref->{$key}.';';
6126: delete($attr_ref->{$key});
6127:
6128: } elsif (lc($key) eq 'onunload') {
6129: $on_unload.=$attr_ref->{$key}.';';
6130: delete($attr_ref->{$key});
6131: }
6132: }
1.953 droeschl 6133: $attr_ref->{'onload'} = $on_load;
6134: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6135: }
1.339 albertel 6136:
1.330 albertel 6137: my $attr_string;
1.1159 raeburn 6138: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6139: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6140: }
6141: return $attr_string;
6142: }
6143:
6144:
1.182 matthew 6145: ###############################################
1.251 albertel 6146: ###############################################
6147:
6148: =pod
6149:
6150: =item * &endbodytag()
6151:
6152: Returns a uniform footer for LON-CAPA web pages.
6153:
1.635 raeburn 6154: Inputs: 1 - optional reference to an args hash
6155: If in the hash, key for noredirectlink has a value which evaluates to true,
6156: a 'Continue' link is not displayed if the page contains an
6157: internal redirect in the <head></head> section,
6158: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6159:
6160: =cut
6161:
6162: sub endbodytag {
1.635 raeburn 6163: my ($args) = @_;
1.1080 raeburn 6164: my $endbodytag;
6165: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6166: $endbodytag='</body>';
6167: }
1.315 albertel 6168: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6169: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6170: $endbodytag=
6171: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6172: &mt('Continue').'</a>'.
6173: $endbodytag;
6174: }
1.315 albertel 6175: }
1.251 albertel 6176: return $endbodytag;
6177: }
6178:
1.352 albertel 6179: =pod
6180:
6181: =item * &standard_css()
6182:
6183: Returns a style sheet
6184:
6185: Inputs: (all optional)
6186: domain -> force to color decorate a page for a specific
6187: domain
6188: function -> force usage of a specific rolish color scheme
6189: bgcolor -> override the default page bgcolor
6190:
6191: =cut
6192:
1.343 albertel 6193: sub standard_css {
1.345 albertel 6194: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6195: $function = &get_users_function() if (!$function);
6196: my $img = &designparm($function.'.img', $domain);
6197: my $tabbg = &designparm($function.'.tabbg', $domain);
6198: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6199: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6200: #second colour for later usage
1.345 albertel 6201: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6202: my $pgbg_or_bgcolor =
6203: $bgcolor ||
1.352 albertel 6204: &designparm($function.'.pgbg', $domain);
1.382 albertel 6205: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6206: my $alink = &designparm($function.'.alink', $domain);
6207: my $vlink = &designparm($function.'.vlink', $domain);
6208: my $link = &designparm($function.'.link', $domain);
6209:
1.602 albertel 6210: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6211: my $mono = 'monospace';
1.850 bisitz 6212: my $data_table_head = $sidebg;
6213: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6214: my $data_table_dark = '#E0E0E0';
1.470 banghart 6215: my $data_table_darker = '#CCCCCC';
1.349 albertel 6216: my $data_table_highlight = '#FFFF00';
1.352 albertel 6217: my $mail_new = '#FFBB77';
6218: my $mail_new_hover = '#DD9955';
6219: my $mail_read = '#BBBB77';
6220: my $mail_read_hover = '#999944';
6221: my $mail_replied = '#AAAA88';
6222: my $mail_replied_hover = '#888855';
6223: my $mail_other = '#99BBBB';
6224: my $mail_other_hover = '#669999';
1.391 albertel 6225: my $table_header = '#DDDDDD';
1.489 raeburn 6226: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6227: my $lg_border_color = '#C8C8C8';
1.952 onken 6228: my $button_hover = '#BF2317';
1.392 albertel 6229:
1.608 albertel 6230: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6231: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6232: : '0 3px 0 4px';
1.448 albertel 6233:
1.523 albertel 6234:
1.343 albertel 6235: return <<END;
1.947 droeschl 6236:
6237: /* needed for iframe to allow 100% height in FF */
6238: body, html {
6239: margin: 0;
6240: padding: 0 0.5%;
6241: height: 99%; /* to avoid scrollbars */
6242: }
6243:
1.795 www 6244: body {
1.911 bisitz 6245: font-family: $sans;
6246: line-height:130%;
6247: font-size:0.83em;
6248: color:$font;
1.795 www 6249: }
6250:
1.959 onken 6251: a:focus,
6252: a:focus img {
1.795 www 6253: color: red;
6254: }
1.698 harmsja 6255:
1.911 bisitz 6256: form, .inline {
6257: display: inline;
1.795 www 6258: }
1.721 harmsja 6259:
1.795 www 6260: .LC_right {
1.911 bisitz 6261: text-align:right;
1.795 www 6262: }
6263:
6264: .LC_middle {
1.911 bisitz 6265: vertical-align:middle;
1.795 www 6266: }
1.721 harmsja 6267:
1.1130 raeburn 6268: .LC_floatleft {
6269: float: left;
6270: }
6271:
6272: .LC_floatright {
6273: float: right;
6274: }
6275:
1.911 bisitz 6276: .LC_400Box {
6277: width:400px;
6278: }
1.721 harmsja 6279:
1.947 droeschl 6280: .LC_iframecontainer {
6281: width: 98%;
6282: margin: 0;
6283: position: fixed;
6284: top: 8.5em;
6285: bottom: 0;
6286: }
6287:
6288: .LC_iframecontainer iframe{
6289: border: none;
6290: width: 100%;
6291: height: 100%;
6292: }
6293:
1.778 bisitz 6294: .LC_filename {
6295: font-family: $mono;
6296: white-space:pre;
1.921 bisitz 6297: font-size: 120%;
1.778 bisitz 6298: }
6299:
6300: .LC_fileicon {
6301: border: none;
6302: height: 1.3em;
6303: vertical-align: text-bottom;
6304: margin-right: 0.3em;
6305: text-decoration:none;
6306: }
6307:
1.1008 www 6308: .LC_setting {
6309: text-decoration:underline;
6310: }
6311:
1.350 albertel 6312: .LC_error {
6313: color: red;
6314: }
1.795 www 6315:
1.1097 bisitz 6316: .LC_warning {
6317: color: darkorange;
6318: }
6319:
1.457 albertel 6320: .LC_diff_removed {
1.733 bisitz 6321: color: red;
1.394 albertel 6322: }
1.532 albertel 6323:
6324: .LC_info,
1.457 albertel 6325: .LC_success,
6326: .LC_diff_added {
1.350 albertel 6327: color: green;
6328: }
1.795 www 6329:
1.802 bisitz 6330: div.LC_confirm_box {
6331: background-color: #FAFAFA;
6332: border: 1px solid $lg_border_color;
6333: margin-right: 0;
6334: padding: 5px;
6335: }
6336:
6337: div.LC_confirm_box .LC_error img,
6338: div.LC_confirm_box .LC_success img {
6339: vertical-align: middle;
6340: }
6341:
1.1242 raeburn 6342: .LC_maxwidth {
6343: max-width: 100%;
6344: height: auto;
6345: }
6346:
1.1243 raeburn 6347: .LC_textsize_mobile {
6348: \@media only screen and (max-device-width: 480px) {
6349: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6350: }
6351: }
6352:
1.440 albertel 6353: .LC_icon {
1.771 droeschl 6354: border: none;
1.790 droeschl 6355: vertical-align: middle;
1.771 droeschl 6356: }
6357:
1.543 albertel 6358: .LC_docs_spacer {
6359: width: 25px;
6360: height: 1px;
1.771 droeschl 6361: border: none;
1.543 albertel 6362: }
1.346 albertel 6363:
1.532 albertel 6364: .LC_internal_info {
1.735 bisitz 6365: color: #999999;
1.532 albertel 6366: }
6367:
1.794 www 6368: .LC_discussion {
1.1050 www 6369: background: $data_table_dark;
1.911 bisitz 6370: border: 1px solid black;
6371: margin: 2px;
1.794 www 6372: }
6373:
6374: .LC_disc_action_left {
1.1050 www 6375: background: $sidebg;
1.911 bisitz 6376: text-align: left;
1.1050 www 6377: padding: 4px;
6378: margin: 2px;
1.794 www 6379: }
6380:
6381: .LC_disc_action_right {
1.1050 www 6382: background: $sidebg;
1.911 bisitz 6383: text-align: right;
1.1050 www 6384: padding: 4px;
6385: margin: 2px;
1.794 www 6386: }
6387:
6388: .LC_disc_new_item {
1.911 bisitz 6389: background: white;
6390: border: 2px solid red;
1.1050 www 6391: margin: 4px;
6392: padding: 4px;
1.794 www 6393: }
6394:
6395: .LC_disc_old_item {
1.911 bisitz 6396: background: white;
1.1050 www 6397: margin: 4px;
6398: padding: 4px;
1.794 www 6399: }
6400:
1.458 albertel 6401: table.LC_pastsubmission {
6402: border: 1px solid black;
6403: margin: 2px;
6404: }
6405:
1.924 bisitz 6406: table#LC_menubuttons {
1.345 albertel 6407: width: 100%;
6408: background: $pgbg;
1.392 albertel 6409: border: 2px;
1.402 albertel 6410: border-collapse: separate;
1.803 bisitz 6411: padding: 0;
1.345 albertel 6412: }
1.392 albertel 6413:
1.801 tempelho 6414: table#LC_title_bar a {
6415: color: $fontmenu;
6416: }
1.836 bisitz 6417:
1.807 droeschl 6418: table#LC_title_bar {
1.819 tempelho 6419: clear: both;
1.836 bisitz 6420: display: none;
1.807 droeschl 6421: }
6422:
1.795 www 6423: table#LC_title_bar,
1.933 droeschl 6424: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6425: table#LC_title_bar.LC_with_remote {
1.359 albertel 6426: width: 100%;
1.392 albertel 6427: border-color: $pgbg;
6428: border-style: solid;
6429: border-width: $border;
1.379 albertel 6430: background: $pgbg;
1.801 tempelho 6431: color: $fontmenu;
1.392 albertel 6432: border-collapse: collapse;
1.803 bisitz 6433: padding: 0;
1.819 tempelho 6434: margin: 0;
1.359 albertel 6435: }
1.795 www 6436:
1.933 droeschl 6437: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6438: margin: 0;
6439: padding: 0;
1.933 droeschl 6440: position: relative;
6441: list-style: none;
1.913 droeschl 6442: }
1.933 droeschl 6443: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6444: display: inline;
6445: }
1.933 droeschl 6446:
6447: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6448: padding: 0;
1.933 droeschl 6449: margin: 0;
6450: float: left;
1.913 droeschl 6451: }
1.933 droeschl 6452: .LC_breadcrumb_tools_tools {
6453: padding: 0;
6454: margin: 0;
1.913 droeschl 6455: float: right;
6456: }
6457:
1.1240 raeburn 6458: .LC_placement_prog {
6459: padding-right: 20px;
6460: font-weight: bold;
6461: font-size: 90%;
6462: }
6463:
1.359 albertel 6464: table#LC_title_bar td {
6465: background: $tabbg;
6466: }
1.795 www 6467:
1.911 bisitz 6468: table#LC_menubuttons img {
1.803 bisitz 6469: border: none;
1.346 albertel 6470: }
1.795 www 6471:
1.842 droeschl 6472: .LC_breadcrumbs_component {
1.911 bisitz 6473: float: right;
6474: margin: 0 1em;
1.357 albertel 6475: }
1.842 droeschl 6476: .LC_breadcrumbs_component img {
1.911 bisitz 6477: vertical-align: middle;
1.777 tempelho 6478: }
1.795 www 6479:
1.1243 raeburn 6480: .LC_breadcrumbs_hoverable {
6481: background: $sidebg;
6482: }
6483:
1.383 albertel 6484: td.LC_table_cell_checkbox {
6485: text-align: center;
6486: }
1.795 www 6487:
6488: .LC_fontsize_small {
1.911 bisitz 6489: font-size: 70%;
1.705 tempelho 6490: }
6491:
1.844 bisitz 6492: #LC_breadcrumbs {
1.911 bisitz 6493: clear:both;
6494: background: $sidebg;
6495: border-bottom: 1px solid $lg_border_color;
6496: line-height: 2.5em;
1.933 droeschl 6497: overflow: hidden;
1.911 bisitz 6498: margin: 0;
6499: padding: 0;
1.995 raeburn 6500: text-align: left;
1.819 tempelho 6501: }
1.862 bisitz 6502:
1.1098 bisitz 6503: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6504: clear:both;
6505: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6506: border: 1px solid $sidebg;
1.1098 bisitz 6507: margin: 0 0 10px 0;
1.966 bisitz 6508: padding: 3px;
1.995 raeburn 6509: text-align: left;
1.822 bisitz 6510: }
6511:
1.795 www 6512: .LC_fontsize_medium {
1.911 bisitz 6513: font-size: 85%;
1.705 tempelho 6514: }
6515:
1.795 www 6516: .LC_fontsize_large {
1.911 bisitz 6517: font-size: 120%;
1.705 tempelho 6518: }
6519:
1.346 albertel 6520: .LC_menubuttons_inline_text {
6521: color: $font;
1.698 harmsja 6522: font-size: 90%;
1.701 harmsja 6523: padding-left:3px;
1.346 albertel 6524: }
6525:
1.934 droeschl 6526: .LC_menubuttons_inline_text img{
6527: vertical-align: middle;
6528: }
6529:
1.1051 www 6530: li.LC_menubuttons_inline_text img {
1.951 onken 6531: cursor:pointer;
1.1002 droeschl 6532: text-decoration: none;
1.951 onken 6533: }
6534:
1.526 www 6535: .LC_menubuttons_link {
6536: text-decoration: none;
6537: }
1.795 www 6538:
1.522 albertel 6539: .LC_menubuttons_category {
1.521 www 6540: color: $font;
1.526 www 6541: background: $pgbg;
1.521 www 6542: font-size: larger;
6543: font-weight: bold;
6544: }
6545:
1.346 albertel 6546: td.LC_menubuttons_text {
1.911 bisitz 6547: color: $font;
1.346 albertel 6548: }
1.706 harmsja 6549:
1.346 albertel 6550: .LC_current_location {
6551: background: $tabbg;
6552: }
1.795 www 6553:
1.1286 raeburn 6554: td.LC_zero_height {
6555: line-height: 0;
6556: cellpadding: 0;
6557: }
6558:
1.938 bisitz 6559: table.LC_data_table {
1.347 albertel 6560: border: 1px solid #000000;
1.402 albertel 6561: border-collapse: separate;
1.426 albertel 6562: border-spacing: 1px;
1.610 albertel 6563: background: $pgbg;
1.347 albertel 6564: }
1.795 www 6565:
1.422 albertel 6566: .LC_data_table_dense {
6567: font-size: small;
6568: }
1.795 www 6569:
1.507 raeburn 6570: table.LC_nested_outer {
6571: border: 1px solid #000000;
1.589 raeburn 6572: border-collapse: collapse;
1.803 bisitz 6573: border-spacing: 0;
1.507 raeburn 6574: width: 100%;
6575: }
1.795 www 6576:
1.879 raeburn 6577: table.LC_innerpickbox,
1.507 raeburn 6578: table.LC_nested {
1.803 bisitz 6579: border: none;
1.589 raeburn 6580: border-collapse: collapse;
1.803 bisitz 6581: border-spacing: 0;
1.507 raeburn 6582: width: 100%;
6583: }
1.795 www 6584:
1.911 bisitz 6585: table.LC_data_table tr th,
6586: table.LC_calendar tr th,
1.879 raeburn 6587: table.LC_prior_tries tr th,
6588: table.LC_innerpickbox tr th {
1.349 albertel 6589: font-weight: bold;
6590: background-color: $data_table_head;
1.801 tempelho 6591: color:$fontmenu;
1.701 harmsja 6592: font-size:90%;
1.347 albertel 6593: }
1.795 www 6594:
1.879 raeburn 6595: table.LC_innerpickbox tr th,
6596: table.LC_innerpickbox tr td {
6597: vertical-align: top;
6598: }
6599:
1.711 raeburn 6600: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6601: background-color: #CCCCCC;
1.711 raeburn 6602: font-weight: bold;
6603: text-align: left;
6604: }
1.795 www 6605:
1.912 bisitz 6606: table.LC_data_table tr.LC_odd_row > td {
6607: background-color: $data_table_light;
6608: padding: 2px;
6609: vertical-align: top;
6610: }
6611:
1.809 bisitz 6612: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6613: background-color: $data_table_light;
1.912 bisitz 6614: vertical-align: top;
6615: }
6616:
6617: table.LC_data_table tr.LC_even_row > td {
6618: background-color: $data_table_dark;
1.425 albertel 6619: padding: 2px;
1.900 bisitz 6620: vertical-align: top;
1.347 albertel 6621: }
1.795 www 6622:
1.809 bisitz 6623: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6624: background-color: $data_table_dark;
1.900 bisitz 6625: vertical-align: top;
1.347 albertel 6626: }
1.795 www 6627:
1.425 albertel 6628: table.LC_data_table tr.LC_data_table_highlight td {
6629: background-color: $data_table_darker;
6630: }
1.795 www 6631:
1.639 raeburn 6632: table.LC_data_table tr td.LC_leftcol_header {
6633: background-color: $data_table_head;
6634: font-weight: bold;
6635: }
1.795 www 6636:
1.451 albertel 6637: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6638: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6639: font-weight: bold;
6640: font-style: italic;
6641: text-align: center;
6642: padding: 8px;
1.347 albertel 6643: }
1.795 www 6644:
1.1114 raeburn 6645: table.LC_data_table tr.LC_empty_row td,
6646: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6647: background-color: $sidebg;
6648: }
6649:
6650: table.LC_nested tr.LC_empty_row td {
6651: background-color: #FFFFFF;
6652: }
6653:
1.890 droeschl 6654: table.LC_caption {
6655: }
6656:
1.507 raeburn 6657: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6658: padding: 4ex
6659: }
1.795 www 6660:
1.507 raeburn 6661: table.LC_nested_outer tr th {
6662: font-weight: bold;
1.801 tempelho 6663: color:$fontmenu;
1.507 raeburn 6664: background-color: $data_table_head;
1.701 harmsja 6665: font-size: small;
1.507 raeburn 6666: border-bottom: 1px solid #000000;
6667: }
1.795 www 6668:
1.507 raeburn 6669: table.LC_nested_outer tr td.LC_subheader {
6670: background-color: $data_table_head;
6671: font-weight: bold;
6672: font-size: small;
6673: border-bottom: 1px solid #000000;
6674: text-align: right;
1.451 albertel 6675: }
1.795 www 6676:
1.507 raeburn 6677: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6678: background-color: #CCCCCC;
1.451 albertel 6679: font-weight: bold;
6680: font-size: small;
1.507 raeburn 6681: text-align: center;
6682: }
1.795 www 6683:
1.589 raeburn 6684: table.LC_nested tr.LC_info_row td.LC_left_item,
6685: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6686: text-align: left;
1.451 albertel 6687: }
1.795 www 6688:
1.507 raeburn 6689: table.LC_nested td {
1.735 bisitz 6690: background-color: #FFFFFF;
1.451 albertel 6691: font-size: small;
1.507 raeburn 6692: }
1.795 www 6693:
1.507 raeburn 6694: table.LC_nested_outer tr th.LC_right_item,
6695: table.LC_nested tr.LC_info_row td.LC_right_item,
6696: table.LC_nested tr.LC_odd_row td.LC_right_item,
6697: table.LC_nested tr td.LC_right_item {
1.451 albertel 6698: text-align: right;
6699: }
6700:
1.507 raeburn 6701: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6702: background-color: #EEEEEE;
1.451 albertel 6703: }
6704:
1.473 raeburn 6705: table.LC_createuser {
6706: }
6707:
6708: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6709: font-size: small;
1.473 raeburn 6710: }
6711:
6712: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6713: background-color: #CCCCCC;
1.473 raeburn 6714: font-weight: bold;
6715: text-align: center;
6716: }
6717:
1.349 albertel 6718: table.LC_calendar {
6719: border: 1px solid #000000;
6720: border-collapse: collapse;
1.917 raeburn 6721: width: 98%;
1.349 albertel 6722: }
1.795 www 6723:
1.349 albertel 6724: table.LC_calendar_pickdate {
6725: font-size: xx-small;
6726: }
1.795 www 6727:
1.349 albertel 6728: table.LC_calendar tr td {
6729: border: 1px solid #000000;
6730: vertical-align: top;
1.917 raeburn 6731: width: 14%;
1.349 albertel 6732: }
1.795 www 6733:
1.349 albertel 6734: table.LC_calendar tr td.LC_calendar_day_empty {
6735: background-color: $data_table_dark;
6736: }
1.795 www 6737:
1.779 bisitz 6738: table.LC_calendar tr td.LC_calendar_day_current {
6739: background-color: $data_table_highlight;
1.777 tempelho 6740: }
1.795 www 6741:
1.938 bisitz 6742: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6743: background-color: $mail_new;
6744: }
1.795 www 6745:
1.938 bisitz 6746: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6747: background-color: $mail_new_hover;
6748: }
1.795 www 6749:
1.938 bisitz 6750: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6751: background-color: $mail_read;
6752: }
1.795 www 6753:
1.938 bisitz 6754: /*
6755: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6756: background-color: $mail_read_hover;
6757: }
1.938 bisitz 6758: */
1.795 www 6759:
1.938 bisitz 6760: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6761: background-color: $mail_replied;
6762: }
1.795 www 6763:
1.938 bisitz 6764: /*
6765: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6766: background-color: $mail_replied_hover;
6767: }
1.938 bisitz 6768: */
1.795 www 6769:
1.938 bisitz 6770: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6771: background-color: $mail_other;
6772: }
1.795 www 6773:
1.938 bisitz 6774: /*
6775: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6776: background-color: $mail_other_hover;
6777: }
1.938 bisitz 6778: */
1.494 raeburn 6779:
1.777 tempelho 6780: table.LC_data_table tr > td.LC_browser_file,
6781: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6782: background: #AAEE77;
1.389 albertel 6783: }
1.795 www 6784:
1.777 tempelho 6785: table.LC_data_table tr > td.LC_browser_file_locked,
6786: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6787: background: #FFAA99;
1.387 albertel 6788: }
1.795 www 6789:
1.777 tempelho 6790: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6791: background: #888888;
1.779 bisitz 6792: }
1.795 www 6793:
1.777 tempelho 6794: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6795: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6796: background: #F8F866;
1.777 tempelho 6797: }
1.795 www 6798:
1.696 bisitz 6799: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6800: background: #E0E8FF;
1.387 albertel 6801: }
1.696 bisitz 6802:
1.707 bisitz 6803: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6804: /* background: #77FF77; */
1.707 bisitz 6805: }
1.795 www 6806:
1.707 bisitz 6807: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6808: border-right: 8px solid #FFFF77;
1.707 bisitz 6809: }
1.795 www 6810:
1.707 bisitz 6811: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6812: border-right: 8px solid #FFAA77;
1.707 bisitz 6813: }
1.795 www 6814:
1.707 bisitz 6815: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6816: border-right: 8px solid #FF7777;
1.707 bisitz 6817: }
1.795 www 6818:
1.707 bisitz 6819: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6820: border-right: 8px solid #AAFF77;
1.707 bisitz 6821: }
1.795 www 6822:
1.707 bisitz 6823: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6824: border-right: 8px solid #11CC55;
1.707 bisitz 6825: }
6826:
1.388 albertel 6827: span.LC_current_location {
1.701 harmsja 6828: font-size:larger;
1.388 albertel 6829: background: $pgbg;
6830: }
1.387 albertel 6831:
1.1029 www 6832: span.LC_current_nav_location {
6833: font-weight:bold;
6834: background: $sidebg;
6835: }
6836:
1.395 albertel 6837: span.LC_parm_menu_item {
6838: font-size: larger;
6839: }
1.795 www 6840:
1.395 albertel 6841: span.LC_parm_scope_all {
6842: color: red;
6843: }
1.795 www 6844:
1.395 albertel 6845: span.LC_parm_scope_folder {
6846: color: green;
6847: }
1.795 www 6848:
1.395 albertel 6849: span.LC_parm_scope_resource {
6850: color: orange;
6851: }
1.795 www 6852:
1.395 albertel 6853: span.LC_parm_part {
6854: color: blue;
6855: }
1.795 www 6856:
1.911 bisitz 6857: span.LC_parm_folder,
6858: span.LC_parm_symb {
1.395 albertel 6859: font-size: x-small;
6860: font-family: $mono;
6861: color: #AAAAAA;
6862: }
6863:
1.977 bisitz 6864: ul.LC_parm_parmlist li {
6865: display: inline-block;
6866: padding: 0.3em 0.8em;
6867: vertical-align: top;
6868: width: 150px;
6869: border-top:1px solid $lg_border_color;
6870: }
6871:
1.795 www 6872: td.LC_parm_overview_level_menu,
6873: td.LC_parm_overview_map_menu,
6874: td.LC_parm_overview_parm_selectors,
6875: td.LC_parm_overview_restrictions {
1.396 albertel 6876: border: 1px solid black;
6877: border-collapse: collapse;
6878: }
1.795 www 6879:
1.1285 raeburn 6880: span.LC_parm_recursive,
6881: td.LC_parm_recursive {
6882: font-weight: bold;
6883: font-size: smaller;
6884: }
6885:
1.396 albertel 6886: table.LC_parm_overview_restrictions td {
6887: border-width: 1px 4px 1px 4px;
6888: border-style: solid;
6889: border-color: $pgbg;
6890: text-align: center;
6891: }
1.795 www 6892:
1.396 albertel 6893: table.LC_parm_overview_restrictions th {
6894: background: $tabbg;
6895: border-width: 1px 4px 1px 4px;
6896: border-style: solid;
6897: border-color: $pgbg;
6898: }
1.795 www 6899:
1.398 albertel 6900: table#LC_helpmenu {
1.803 bisitz 6901: border: none;
1.398 albertel 6902: height: 55px;
1.803 bisitz 6903: border-spacing: 0;
1.398 albertel 6904: }
6905:
6906: table#LC_helpmenu fieldset legend {
6907: font-size: larger;
6908: }
1.795 www 6909:
1.397 albertel 6910: table#LC_helpmenu_links {
6911: width: 100%;
6912: border: 1px solid black;
6913: background: $pgbg;
1.803 bisitz 6914: padding: 0;
1.397 albertel 6915: border-spacing: 1px;
6916: }
1.795 www 6917:
1.397 albertel 6918: table#LC_helpmenu_links tr td {
6919: padding: 1px;
6920: background: $tabbg;
1.399 albertel 6921: text-align: center;
6922: font-weight: bold;
1.397 albertel 6923: }
1.396 albertel 6924:
1.795 www 6925: table#LC_helpmenu_links a:link,
6926: table#LC_helpmenu_links a:visited,
1.397 albertel 6927: table#LC_helpmenu_links a:active {
6928: text-decoration: none;
6929: color: $font;
6930: }
1.795 www 6931:
1.397 albertel 6932: table#LC_helpmenu_links a:hover {
6933: text-decoration: underline;
6934: color: $vlink;
6935: }
1.396 albertel 6936:
1.417 albertel 6937: .LC_chrt_popup_exists {
6938: border: 1px solid #339933;
6939: margin: -1px;
6940: }
1.795 www 6941:
1.417 albertel 6942: .LC_chrt_popup_up {
6943: border: 1px solid yellow;
6944: margin: -1px;
6945: }
1.795 www 6946:
1.417 albertel 6947: .LC_chrt_popup {
6948: border: 1px solid #8888FF;
6949: background: #CCCCFF;
6950: }
1.795 www 6951:
1.421 albertel 6952: table.LC_pick_box {
6953: border-collapse: separate;
6954: background: white;
6955: border: 1px solid black;
6956: border-spacing: 1px;
6957: }
1.795 www 6958:
1.421 albertel 6959: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6960: background: $sidebg;
1.421 albertel 6961: font-weight: bold;
1.900 bisitz 6962: text-align: left;
1.740 bisitz 6963: vertical-align: top;
1.421 albertel 6964: width: 184px;
6965: padding: 8px;
6966: }
1.795 www 6967:
1.579 raeburn 6968: table.LC_pick_box td.LC_pick_box_value {
6969: text-align: left;
6970: padding: 8px;
6971: }
1.795 www 6972:
1.579 raeburn 6973: table.LC_pick_box td.LC_pick_box_select {
6974: text-align: left;
6975: padding: 8px;
6976: }
1.795 www 6977:
1.424 albertel 6978: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6979: padding: 0;
1.421 albertel 6980: height: 1px;
6981: background: black;
6982: }
1.795 www 6983:
1.421 albertel 6984: table.LC_pick_box td.LC_pick_box_submit {
6985: text-align: right;
6986: }
1.795 www 6987:
1.579 raeburn 6988: table.LC_pick_box td.LC_evenrow_value {
6989: text-align: left;
6990: padding: 8px;
6991: background-color: $data_table_light;
6992: }
1.795 www 6993:
1.579 raeburn 6994: table.LC_pick_box td.LC_oddrow_value {
6995: text-align: left;
6996: padding: 8px;
6997: background-color: $data_table_light;
6998: }
1.795 www 6999:
1.579 raeburn 7000: span.LC_helpform_receipt_cat {
7001: font-weight: bold;
7002: }
1.795 www 7003:
1.424 albertel 7004: table.LC_group_priv_box {
7005: background: white;
7006: border: 1px solid black;
7007: border-spacing: 1px;
7008: }
1.795 www 7009:
1.424 albertel 7010: table.LC_group_priv_box td.LC_pick_box_title {
7011: background: $tabbg;
7012: font-weight: bold;
7013: text-align: right;
7014: width: 184px;
7015: }
1.795 www 7016:
1.424 albertel 7017: table.LC_group_priv_box td.LC_groups_fixed {
7018: background: $data_table_light;
7019: text-align: center;
7020: }
1.795 www 7021:
1.424 albertel 7022: table.LC_group_priv_box td.LC_groups_optional {
7023: background: $data_table_dark;
7024: text-align: center;
7025: }
1.795 www 7026:
1.424 albertel 7027: table.LC_group_priv_box td.LC_groups_functionality {
7028: background: $data_table_darker;
7029: text-align: center;
7030: font-weight: bold;
7031: }
1.795 www 7032:
1.424 albertel 7033: table.LC_group_priv td {
7034: text-align: left;
1.803 bisitz 7035: padding: 0;
1.424 albertel 7036: }
7037:
7038: .LC_navbuttons {
7039: margin: 2ex 0ex 2ex 0ex;
7040: }
1.795 www 7041:
1.423 albertel 7042: .LC_topic_bar {
7043: font-weight: bold;
7044: background: $tabbg;
1.918 wenzelju 7045: margin: 1em 0em 1em 2em;
1.805 bisitz 7046: padding: 3px;
1.918 wenzelju 7047: font-size: 1.2em;
1.423 albertel 7048: }
1.795 www 7049:
1.423 albertel 7050: .LC_topic_bar span {
1.918 wenzelju 7051: left: 0.5em;
7052: position: absolute;
1.423 albertel 7053: vertical-align: middle;
1.918 wenzelju 7054: font-size: 1.2em;
1.423 albertel 7055: }
1.795 www 7056:
1.423 albertel 7057: table.LC_course_group_status {
7058: margin: 20px;
7059: }
1.795 www 7060:
1.423 albertel 7061: table.LC_status_selector td {
7062: vertical-align: top;
7063: text-align: center;
1.424 albertel 7064: padding: 4px;
7065: }
1.795 www 7066:
1.599 albertel 7067: div.LC_feedback_link {
1.616 albertel 7068: clear: both;
1.829 kalberla 7069: background: $sidebg;
1.779 bisitz 7070: width: 100%;
1.829 kalberla 7071: padding-bottom: 10px;
7072: border: 1px $tabbg solid;
1.833 kalberla 7073: height: 22px;
7074: line-height: 22px;
7075: padding-top: 5px;
7076: }
7077:
7078: div.LC_feedback_link img {
7079: height: 22px;
1.867 kalberla 7080: vertical-align:middle;
1.829 kalberla 7081: }
7082:
1.911 bisitz 7083: div.LC_feedback_link a {
1.829 kalberla 7084: text-decoration: none;
1.489 raeburn 7085: }
1.795 www 7086:
1.867 kalberla 7087: div.LC_comblock {
1.911 bisitz 7088: display:inline;
1.867 kalberla 7089: color:$font;
7090: font-size:90%;
7091: }
7092:
7093: div.LC_feedback_link div.LC_comblock {
7094: padding-left:5px;
7095: }
7096:
7097: div.LC_feedback_link div.LC_comblock a {
7098: color:$font;
7099: }
7100:
1.489 raeburn 7101: span.LC_feedback_link {
1.858 bisitz 7102: /* background: $feedback_link_bg; */
1.599 albertel 7103: font-size: larger;
7104: }
1.795 www 7105:
1.599 albertel 7106: span.LC_message_link {
1.858 bisitz 7107: /* background: $feedback_link_bg; */
1.599 albertel 7108: font-size: larger;
7109: position: absolute;
7110: right: 1em;
1.489 raeburn 7111: }
1.421 albertel 7112:
1.515 albertel 7113: table.LC_prior_tries {
1.524 albertel 7114: border: 1px solid #000000;
7115: border-collapse: separate;
7116: border-spacing: 1px;
1.515 albertel 7117: }
1.523 albertel 7118:
1.515 albertel 7119: table.LC_prior_tries td {
1.524 albertel 7120: padding: 2px;
1.515 albertel 7121: }
1.523 albertel 7122:
7123: .LC_answer_correct {
1.795 www 7124: background: lightgreen;
7125: color: darkgreen;
7126: padding: 6px;
1.523 albertel 7127: }
1.795 www 7128:
1.523 albertel 7129: .LC_answer_charged_try {
1.797 www 7130: background: #FFAAAA;
1.795 www 7131: color: darkred;
7132: padding: 6px;
1.523 albertel 7133: }
1.795 www 7134:
1.779 bisitz 7135: .LC_answer_not_charged_try,
1.523 albertel 7136: .LC_answer_no_grade,
7137: .LC_answer_late {
1.795 www 7138: background: lightyellow;
1.523 albertel 7139: color: black;
1.795 www 7140: padding: 6px;
1.523 albertel 7141: }
1.795 www 7142:
1.523 albertel 7143: .LC_answer_previous {
1.795 www 7144: background: lightblue;
7145: color: darkblue;
7146: padding: 6px;
1.523 albertel 7147: }
1.795 www 7148:
1.779 bisitz 7149: .LC_answer_no_message {
1.777 tempelho 7150: background: #FFFFFF;
7151: color: black;
1.795 www 7152: padding: 6px;
1.779 bisitz 7153: }
1.795 www 7154:
1.779 bisitz 7155: .LC_answer_unknown {
7156: background: orange;
7157: color: black;
1.795 www 7158: padding: 6px;
1.777 tempelho 7159: }
1.795 www 7160:
1.529 albertel 7161: span.LC_prior_numerical,
7162: span.LC_prior_string,
7163: span.LC_prior_custom,
7164: span.LC_prior_reaction,
7165: span.LC_prior_math {
1.925 bisitz 7166: font-family: $mono;
1.523 albertel 7167: white-space: pre;
7168: }
7169:
1.525 albertel 7170: span.LC_prior_string {
1.925 bisitz 7171: font-family: $mono;
1.525 albertel 7172: white-space: pre;
7173: }
7174:
1.523 albertel 7175: table.LC_prior_option {
7176: width: 100%;
7177: border-collapse: collapse;
7178: }
1.795 www 7179:
1.911 bisitz 7180: table.LC_prior_rank,
1.795 www 7181: table.LC_prior_match {
1.528 albertel 7182: border-collapse: collapse;
7183: }
1.795 www 7184:
1.528 albertel 7185: table.LC_prior_option tr td,
7186: table.LC_prior_rank tr td,
7187: table.LC_prior_match tr td {
1.524 albertel 7188: border: 1px solid #000000;
1.515 albertel 7189: }
7190:
1.855 bisitz 7191: .LC_nobreak {
1.544 albertel 7192: white-space: nowrap;
1.519 raeburn 7193: }
7194:
1.576 raeburn 7195: span.LC_cusr_emph {
7196: font-style: italic;
7197: }
7198:
1.633 raeburn 7199: span.LC_cusr_subheading {
7200: font-weight: normal;
7201: font-size: 85%;
7202: }
7203:
1.861 bisitz 7204: div.LC_docs_entry_move {
1.859 bisitz 7205: border: 1px solid #BBBBBB;
1.545 albertel 7206: background: #DDDDDD;
1.861 bisitz 7207: width: 22px;
1.859 bisitz 7208: padding: 1px;
7209: margin: 0;
1.545 albertel 7210: }
7211:
1.861 bisitz 7212: table.LC_data_table tr > td.LC_docs_entry_commands,
7213: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7214: font-size: x-small;
7215: }
1.795 www 7216:
1.861 bisitz 7217: .LC_docs_entry_parameter {
7218: white-space: nowrap;
7219: }
7220:
1.544 albertel 7221: .LC_docs_copy {
1.545 albertel 7222: color: #000099;
1.544 albertel 7223: }
1.795 www 7224:
1.544 albertel 7225: .LC_docs_cut {
1.545 albertel 7226: color: #550044;
1.544 albertel 7227: }
1.795 www 7228:
1.544 albertel 7229: .LC_docs_rename {
1.545 albertel 7230: color: #009900;
1.544 albertel 7231: }
1.795 www 7232:
1.544 albertel 7233: .LC_docs_remove {
1.545 albertel 7234: color: #990000;
7235: }
7236:
1.1284 raeburn 7237: .LC_docs_alias {
7238: color: #440055;
7239: }
7240:
1.1286 raeburn 7241: .LC_domprefs_email,
1.1284 raeburn 7242: .LC_docs_alias_name,
1.547 albertel 7243: .LC_docs_reinit_warn,
7244: .LC_docs_ext_edit {
7245: font-size: x-small;
7246: }
7247:
1.545 albertel 7248: table.LC_docs_adddocs td,
7249: table.LC_docs_adddocs th {
7250: border: 1px solid #BBBBBB;
7251: padding: 4px;
7252: background: #DDDDDD;
1.543 albertel 7253: }
7254:
1.584 albertel 7255: table.LC_sty_begin {
7256: background: #BBFFBB;
7257: }
1.795 www 7258:
1.584 albertel 7259: table.LC_sty_end {
7260: background: #FFBBBB;
7261: }
7262:
1.589 raeburn 7263: table.LC_double_column {
1.803 bisitz 7264: border-width: 0;
1.589 raeburn 7265: border-collapse: collapse;
7266: width: 100%;
7267: padding: 2px;
7268: }
7269:
7270: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7271: top: 2px;
1.589 raeburn 7272: left: 2px;
7273: width: 47%;
7274: vertical-align: top;
7275: }
7276:
7277: table.LC_double_column tr td.LC_right_col {
7278: top: 2px;
1.779 bisitz 7279: right: 2px;
1.589 raeburn 7280: width: 47%;
7281: vertical-align: top;
7282: }
7283:
1.591 raeburn 7284: div.LC_left_float {
7285: float: left;
7286: padding-right: 5%;
1.597 albertel 7287: padding-bottom: 4px;
1.591 raeburn 7288: }
7289:
7290: div.LC_clear_float_header {
1.597 albertel 7291: padding-bottom: 2px;
1.591 raeburn 7292: }
7293:
7294: div.LC_clear_float_footer {
1.597 albertel 7295: padding-top: 10px;
1.591 raeburn 7296: clear: both;
7297: }
7298:
1.597 albertel 7299: div.LC_grade_show_user {
1.941 bisitz 7300: /* border-left: 5px solid $sidebg; */
7301: border-top: 5px solid #000000;
7302: margin: 50px 0 0 0;
1.936 bisitz 7303: padding: 15px 0 5px 10px;
1.597 albertel 7304: }
1.795 www 7305:
1.936 bisitz 7306: div.LC_grade_show_user_odd_row {
1.941 bisitz 7307: /* border-left: 5px solid #000000; */
7308: }
7309:
7310: div.LC_grade_show_user div.LC_Box {
7311: margin-right: 50px;
1.597 albertel 7312: }
7313:
7314: div.LC_grade_submissions,
7315: div.LC_grade_message_center,
1.936 bisitz 7316: div.LC_grade_info_links {
1.597 albertel 7317: margin: 5px;
7318: width: 99%;
7319: background: #FFFFFF;
7320: }
1.795 www 7321:
1.597 albertel 7322: div.LC_grade_submissions_header,
1.936 bisitz 7323: div.LC_grade_message_center_header {
1.705 tempelho 7324: font-weight: bold;
7325: font-size: large;
1.597 albertel 7326: }
1.795 www 7327:
1.597 albertel 7328: div.LC_grade_submissions_body,
1.936 bisitz 7329: div.LC_grade_message_center_body {
1.597 albertel 7330: border: 1px solid black;
7331: width: 99%;
7332: background: #FFFFFF;
7333: }
1.795 www 7334:
1.613 albertel 7335: table.LC_scantron_action {
7336: width: 100%;
7337: }
1.795 www 7338:
1.613 albertel 7339: table.LC_scantron_action tr th {
1.698 harmsja 7340: font-weight:bold;
7341: font-style:normal;
1.613 albertel 7342: }
1.795 www 7343:
1.779 bisitz 7344: .LC_edit_problem_header,
1.614 albertel 7345: div.LC_edit_problem_footer {
1.705 tempelho 7346: font-weight: normal;
7347: font-size: medium;
1.602 albertel 7348: margin: 2px;
1.1060 bisitz 7349: background-color: $sidebg;
1.600 albertel 7350: }
1.795 www 7351:
1.600 albertel 7352: div.LC_edit_problem_header,
1.602 albertel 7353: div.LC_edit_problem_header div,
1.614 albertel 7354: div.LC_edit_problem_footer,
7355: div.LC_edit_problem_footer div,
1.602 albertel 7356: div.LC_edit_problem_editxml_header,
7357: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7358: z-index: 100;
1.600 albertel 7359: }
1.795 www 7360:
1.600 albertel 7361: div.LC_edit_problem_header_title {
1.705 tempelho 7362: font-weight: bold;
7363: font-size: larger;
1.602 albertel 7364: background: $tabbg;
7365: padding: 3px;
1.1060 bisitz 7366: margin: 0 0 5px 0;
1.602 albertel 7367: }
1.795 www 7368:
1.602 albertel 7369: table.LC_edit_problem_header_title {
7370: width: 100%;
1.600 albertel 7371: background: $tabbg;
1.602 albertel 7372: }
7373:
1.1205 golterma 7374: div.LC_edit_actionbar {
7375: background-color: $sidebg;
1.1218 droeschl 7376: margin: 0;
7377: padding: 0;
7378: line-height: 200%;
1.602 albertel 7379: }
1.795 www 7380:
1.1218 droeschl 7381: div.LC_edit_actionbar div{
7382: padding: 0;
7383: margin: 0;
7384: display: inline-block;
1.600 albertel 7385: }
1.795 www 7386:
1.1124 bisitz 7387: .LC_edit_opt {
7388: padding-left: 1em;
7389: white-space: nowrap;
7390: }
7391:
1.1152 golterma 7392: .LC_edit_problem_latexhelper{
7393: text-align: right;
7394: }
7395:
7396: #LC_edit_problem_colorful div{
7397: margin-left: 40px;
7398: }
7399:
1.1205 golterma 7400: #LC_edit_problem_codemirror div{
7401: margin-left: 0px;
7402: }
7403:
1.911 bisitz 7404: img.stift {
1.803 bisitz 7405: border-width: 0;
7406: vertical-align: middle;
1.677 riegler 7407: }
1.680 riegler 7408:
1.923 bisitz 7409: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7410: vertical-align: top;
1.777 tempelho 7411: }
1.795 www 7412:
1.716 raeburn 7413: div.LC_createcourse {
1.911 bisitz 7414: margin: 10px 10px 10px 10px;
1.716 raeburn 7415: }
7416:
1.917 raeburn 7417: .LC_dccid {
1.1130 raeburn 7418: float: right;
1.917 raeburn 7419: margin: 0.2em 0 0 0;
7420: padding: 0;
7421: font-size: 90%;
7422: display:none;
7423: }
7424:
1.897 wenzelju 7425: ol.LC_primary_menu a:hover,
1.721 harmsja 7426: ol#LC_MenuBreadcrumbs a:hover,
7427: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7428: ul#LC_secondary_menu a:hover,
1.721 harmsja 7429: .LC_FormSectionClearButton input:hover
1.795 www 7430: ul.LC_TabContent li:hover a {
1.952 onken 7431: color:$button_hover;
1.911 bisitz 7432: text-decoration:none;
1.693 droeschl 7433: }
7434:
1.779 bisitz 7435: h1 {
1.911 bisitz 7436: padding: 0;
7437: line-height:130%;
1.693 droeschl 7438: }
1.698 harmsja 7439:
1.911 bisitz 7440: h2,
7441: h3,
7442: h4,
7443: h5,
7444: h6 {
7445: margin: 5px 0 5px 0;
7446: padding: 0;
7447: line-height:130%;
1.693 droeschl 7448: }
1.795 www 7449:
7450: .LC_hcell {
1.911 bisitz 7451: padding:3px 15px 3px 15px;
7452: margin: 0;
7453: background-color:$tabbg;
7454: color:$fontmenu;
7455: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7456: }
1.795 www 7457:
1.840 bisitz 7458: .LC_Box > .LC_hcell {
1.911 bisitz 7459: margin: 0 -10px 10px -10px;
1.835 bisitz 7460: }
7461:
1.721 harmsja 7462: .LC_noBorder {
1.911 bisitz 7463: border: 0;
1.698 harmsja 7464: }
1.693 droeschl 7465:
1.721 harmsja 7466: .LC_FormSectionClearButton input {
1.911 bisitz 7467: background-color:transparent;
7468: border: none;
7469: cursor:pointer;
7470: text-decoration:underline;
1.693 droeschl 7471: }
1.763 bisitz 7472:
7473: .LC_help_open_topic {
1.911 bisitz 7474: color: #FFFFFF;
7475: background-color: #EEEEFF;
7476: margin: 1px;
7477: padding: 4px;
7478: border: 1px solid #000033;
7479: white-space: nowrap;
7480: /* vertical-align: middle; */
1.759 neumanie 7481: }
1.693 droeschl 7482:
1.911 bisitz 7483: dl,
7484: ul,
7485: div,
7486: fieldset {
7487: margin: 10px 10px 10px 0;
7488: /* overflow: hidden; */
1.693 droeschl 7489: }
1.795 www 7490:
1.1211 raeburn 7491: article.geogebraweb div {
7492: margin: 0;
7493: }
7494:
1.838 bisitz 7495: fieldset > legend {
1.911 bisitz 7496: font-weight: bold;
7497: padding: 0 5px 0 5px;
1.838 bisitz 7498: }
7499:
1.813 bisitz 7500: #LC_nav_bar {
1.911 bisitz 7501: float: left;
1.995 raeburn 7502: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7503: margin: 0 0 2px 0;
1.807 droeschl 7504: }
7505:
1.916 droeschl 7506: #LC_realm {
7507: margin: 0.2em 0 0 0;
7508: padding: 0;
7509: font-weight: bold;
7510: text-align: center;
1.995 raeburn 7511: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7512: }
7513:
1.911 bisitz 7514: #LC_nav_bar em {
7515: font-weight: bold;
7516: font-style: normal;
1.807 droeschl 7517: }
7518:
1.897 wenzelju 7519: ol.LC_primary_menu {
1.934 droeschl 7520: margin: 0;
1.1076 raeburn 7521: padding: 0;
1.807 droeschl 7522: }
7523:
1.852 droeschl 7524: ol#LC_PathBreadcrumbs {
1.911 bisitz 7525: margin: 0;
1.693 droeschl 7526: }
7527:
1.897 wenzelju 7528: ol.LC_primary_menu li {
1.1076 raeburn 7529: color: RGB(80, 80, 80);
7530: vertical-align: middle;
7531: text-align: left;
7532: list-style: none;
1.1205 golterma 7533: position: relative;
1.1076 raeburn 7534: float: left;
1.1205 golterma 7535: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7536: line-height: 1.5em;
1.1076 raeburn 7537: }
7538:
1.1205 golterma 7539: ol.LC_primary_menu li a,
7540: ol.LC_primary_menu li p {
1.1076 raeburn 7541: display: block;
7542: margin: 0;
7543: padding: 0 5px 0 10px;
7544: text-decoration: none;
7545: }
7546:
1.1205 golterma 7547: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7548: display: inline-block;
7549: width: 95%;
7550: text-align: left;
7551: }
7552:
7553: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7554: display: inline-block;
7555: width: 5%;
7556: float: right;
7557: text-align: right;
7558: font-size: 70%;
7559: }
7560:
7561: ol.LC_primary_menu ul {
1.1076 raeburn 7562: display: none;
1.1205 golterma 7563: width: 15em;
1.1076 raeburn 7564: background-color: $data_table_light;
1.1205 golterma 7565: position: absolute;
7566: top: 100%;
1.1076 raeburn 7567: }
7568:
1.1205 golterma 7569: ol.LC_primary_menu ul ul {
7570: left: 100%;
7571: top: 0;
7572: }
7573:
7574: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7575: display: block;
7576: position: absolute;
7577: margin: 0;
7578: padding: 0;
1.1078 raeburn 7579: z-index: 2;
1.1076 raeburn 7580: }
7581:
7582: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7583: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7584: font-size: 90%;
1.911 bisitz 7585: vertical-align: top;
1.1076 raeburn 7586: float: none;
1.1079 raeburn 7587: border-left: 1px solid black;
7588: border-right: 1px solid black;
1.1205 golterma 7589: /* A dark bottom border to visualize different menu options;
7590: overwritten in the create_submenu routine for the last border-bottom of the menu */
7591: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7592: }
7593:
1.1205 golterma 7594: ol.LC_primary_menu li li p:hover {
7595: color:$button_hover;
7596: text-decoration:none;
7597: background-color:$data_table_dark;
1.1076 raeburn 7598: }
7599:
7600: ol.LC_primary_menu li li a:hover {
7601: color:$button_hover;
7602: background-color:$data_table_dark;
1.693 droeschl 7603: }
7604:
1.1205 golterma 7605: /* Font-size equal to the size of the predecessors*/
7606: ol.LC_primary_menu li:hover li li {
7607: font-size: 100%;
7608: }
7609:
1.897 wenzelju 7610: ol.LC_primary_menu li img {
1.911 bisitz 7611: vertical-align: bottom;
1.934 droeschl 7612: height: 1.1em;
1.1077 raeburn 7613: margin: 0.2em 0 0 0;
1.693 droeschl 7614: }
7615:
1.897 wenzelju 7616: ol.LC_primary_menu a {
1.911 bisitz 7617: color: RGB(80, 80, 80);
7618: text-decoration: none;
1.693 droeschl 7619: }
1.795 www 7620:
1.949 droeschl 7621: ol.LC_primary_menu a.LC_new_message {
7622: font-weight:bold;
7623: color: darkred;
7624: }
7625:
1.975 raeburn 7626: ol.LC_docs_parameters {
7627: margin-left: 0;
7628: padding: 0;
7629: list-style: none;
7630: }
7631:
7632: ol.LC_docs_parameters li {
7633: margin: 0;
7634: padding-right: 20px;
7635: display: inline;
7636: }
7637:
1.976 raeburn 7638: ol.LC_docs_parameters li:before {
7639: content: "\\002022 \\0020";
7640: }
7641:
7642: li.LC_docs_parameters_title {
7643: font-weight: bold;
7644: }
7645:
7646: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7647: content: "";
7648: }
7649:
1.897 wenzelju 7650: ul#LC_secondary_menu {
1.1107 raeburn 7651: clear: right;
1.911 bisitz 7652: color: $fontmenu;
7653: background: $tabbg;
7654: list-style: none;
7655: padding: 0;
7656: margin: 0;
7657: width: 100%;
1.995 raeburn 7658: text-align: left;
1.1107 raeburn 7659: float: left;
1.808 droeschl 7660: }
7661:
1.897 wenzelju 7662: ul#LC_secondary_menu li {
1.911 bisitz 7663: font-weight: bold;
7664: line-height: 1.8em;
1.1107 raeburn 7665: border-right: 1px solid black;
7666: float: left;
7667: }
7668:
7669: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7670: background-color: $data_table_light;
7671: }
7672:
7673: ul#LC_secondary_menu li a {
1.911 bisitz 7674: padding: 0 0.8em;
1.1107 raeburn 7675: }
7676:
7677: ul#LC_secondary_menu li ul {
7678: display: none;
7679: }
7680:
7681: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7682: display: block;
7683: position: absolute;
7684: margin: 0;
7685: padding: 0;
7686: list-style:none;
7687: float: none;
7688: background-color: $data_table_light;
7689: z-index: 2;
7690: margin-left: -1px;
7691: }
7692:
7693: ul#LC_secondary_menu li ul li {
7694: font-size: 90%;
7695: vertical-align: top;
7696: border-left: 1px solid black;
1.911 bisitz 7697: border-right: 1px solid black;
1.1119 raeburn 7698: background-color: $data_table_light;
1.1107 raeburn 7699: list-style:none;
7700: float: none;
7701: }
7702:
7703: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7704: background-color: $data_table_dark;
1.807 droeschl 7705: }
7706:
1.847 tempelho 7707: ul.LC_TabContent {
1.911 bisitz 7708: display:block;
7709: background: $sidebg;
7710: border-bottom: solid 1px $lg_border_color;
7711: list-style:none;
1.1020 raeburn 7712: margin: -1px -10px 0 -10px;
1.911 bisitz 7713: padding: 0;
1.693 droeschl 7714: }
7715:
1.795 www 7716: ul.LC_TabContent li,
7717: ul.LC_TabContentBigger li {
1.911 bisitz 7718: float:left;
1.741 harmsja 7719: }
1.795 www 7720:
1.897 wenzelju 7721: ul#LC_secondary_menu li a {
1.911 bisitz 7722: color: $fontmenu;
7723: text-decoration: none;
1.693 droeschl 7724: }
1.795 www 7725:
1.721 harmsja 7726: ul.LC_TabContent {
1.952 onken 7727: min-height:20px;
1.721 harmsja 7728: }
1.795 www 7729:
7730: ul.LC_TabContent li {
1.911 bisitz 7731: vertical-align:middle;
1.959 onken 7732: padding: 0 16px 0 10px;
1.911 bisitz 7733: background-color:$tabbg;
7734: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7735: border-left: solid 1px $font;
1.721 harmsja 7736: }
1.795 www 7737:
1.847 tempelho 7738: ul.LC_TabContent .right {
1.911 bisitz 7739: float:right;
1.847 tempelho 7740: }
7741:
1.911 bisitz 7742: ul.LC_TabContent li a,
7743: ul.LC_TabContent li {
7744: color:rgb(47,47,47);
7745: text-decoration:none;
7746: font-size:95%;
7747: font-weight:bold;
1.952 onken 7748: min-height:20px;
7749: }
7750:
1.959 onken 7751: ul.LC_TabContent li a:hover,
7752: ul.LC_TabContent li a:focus {
1.952 onken 7753: color: $button_hover;
1.959 onken 7754: background:none;
7755: outline:none;
1.952 onken 7756: }
7757:
7758: ul.LC_TabContent li:hover {
7759: color: $button_hover;
7760: cursor:pointer;
1.721 harmsja 7761: }
1.795 www 7762:
1.911 bisitz 7763: ul.LC_TabContent li.active {
1.952 onken 7764: color: $font;
1.911 bisitz 7765: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7766: border-bottom:solid 1px #FFFFFF;
7767: cursor: default;
1.744 ehlerst 7768: }
1.795 www 7769:
1.959 onken 7770: ul.LC_TabContent li.active a {
7771: color:$font;
7772: background:#FFFFFF;
7773: outline: none;
7774: }
1.1047 raeburn 7775:
7776: ul.LC_TabContent li.goback {
7777: float: left;
7778: border-left: none;
7779: }
7780:
1.870 tempelho 7781: #maincoursedoc {
1.911 bisitz 7782: clear:both;
1.870 tempelho 7783: }
7784:
7785: ul.LC_TabContentBigger {
1.911 bisitz 7786: display:block;
7787: list-style:none;
7788: padding: 0;
1.870 tempelho 7789: }
7790:
1.795 www 7791: ul.LC_TabContentBigger li {
1.911 bisitz 7792: vertical-align:bottom;
7793: height: 30px;
7794: font-size:110%;
7795: font-weight:bold;
7796: color: #737373;
1.841 tempelho 7797: }
7798:
1.957 onken 7799: ul.LC_TabContentBigger li.active {
7800: position: relative;
7801: top: 1px;
7802: }
7803:
1.870 tempelho 7804: ul.LC_TabContentBigger li a {
1.911 bisitz 7805: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7806: height: 30px;
7807: line-height: 30px;
7808: text-align: center;
7809: display: block;
7810: text-decoration: none;
1.958 onken 7811: outline: none;
1.741 harmsja 7812: }
1.795 www 7813:
1.870 tempelho 7814: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7815: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7816: color:$font;
1.744 ehlerst 7817: }
1.795 www 7818:
1.870 tempelho 7819: ul.LC_TabContentBigger li b {
1.911 bisitz 7820: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7821: display: block;
7822: float: left;
7823: padding: 0 30px;
1.957 onken 7824: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7825: }
7826:
1.956 onken 7827: ul.LC_TabContentBigger li:hover b {
7828: color:$button_hover;
7829: }
7830:
1.870 tempelho 7831: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7832: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7833: color:$font;
1.957 onken 7834: border: 0;
1.741 harmsja 7835: }
1.693 droeschl 7836:
1.870 tempelho 7837:
1.862 bisitz 7838: ul.LC_CourseBreadcrumbs {
7839: background: $sidebg;
1.1020 raeburn 7840: height: 2em;
1.862 bisitz 7841: padding-left: 10px;
1.1020 raeburn 7842: margin: 0;
1.862 bisitz 7843: list-style-position: inside;
7844: }
7845:
1.911 bisitz 7846: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7847: ol#LC_PathBreadcrumbs {
1.911 bisitz 7848: padding-left: 10px;
7849: margin: 0;
1.933 droeschl 7850: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7851: }
7852:
1.911 bisitz 7853: ol#LC_MenuBreadcrumbs li,
7854: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7855: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7856: display: inline;
1.933 droeschl 7857: white-space: normal;
1.693 droeschl 7858: }
7859:
1.823 bisitz 7860: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7861: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7862: text-decoration: none;
7863: font-size:90%;
1.693 droeschl 7864: }
1.795 www 7865:
1.969 droeschl 7866: ol#LC_MenuBreadcrumbs h1 {
7867: display: inline;
7868: font-size: 90%;
7869: line-height: 2.5em;
7870: margin: 0;
7871: padding: 0;
7872: }
7873:
1.795 www 7874: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7875: text-decoration:none;
7876: font-size:100%;
7877: font-weight:bold;
1.693 droeschl 7878: }
1.795 www 7879:
1.840 bisitz 7880: .LC_Box {
1.911 bisitz 7881: border: solid 1px $lg_border_color;
7882: padding: 0 10px 10px 10px;
1.746 neumanie 7883: }
1.795 www 7884:
1.1020 raeburn 7885: .LC_DocsBox {
7886: border: solid 1px $lg_border_color;
7887: padding: 0 0 10px 10px;
7888: }
7889:
1.795 www 7890: .LC_AboutMe_Image {
1.911 bisitz 7891: float:left;
7892: margin-right:10px;
1.747 neumanie 7893: }
1.795 www 7894:
7895: .LC_Clear_AboutMe_Image {
1.911 bisitz 7896: clear:left;
1.747 neumanie 7897: }
1.795 www 7898:
1.721 harmsja 7899: dl.LC_ListStyleClean dt {
1.911 bisitz 7900: padding-right: 5px;
7901: display: table-header-group;
1.693 droeschl 7902: }
7903:
1.721 harmsja 7904: dl.LC_ListStyleClean dd {
1.911 bisitz 7905: display: table-row;
1.693 droeschl 7906: }
7907:
1.721 harmsja 7908: .LC_ListStyleClean,
7909: .LC_ListStyleSimple,
7910: .LC_ListStyleNormal,
1.795 www 7911: .LC_ListStyleSpecial {
1.911 bisitz 7912: /* display:block; */
7913: list-style-position: inside;
7914: list-style-type: none;
7915: overflow: hidden;
7916: padding: 0;
1.693 droeschl 7917: }
7918:
1.721 harmsja 7919: .LC_ListStyleSimple li,
7920: .LC_ListStyleSimple dd,
7921: .LC_ListStyleNormal li,
7922: .LC_ListStyleNormal dd,
7923: .LC_ListStyleSpecial li,
1.795 www 7924: .LC_ListStyleSpecial dd {
1.911 bisitz 7925: margin: 0;
7926: padding: 5px 5px 5px 10px;
7927: clear: both;
1.693 droeschl 7928: }
7929:
1.721 harmsja 7930: .LC_ListStyleClean li,
7931: .LC_ListStyleClean dd {
1.911 bisitz 7932: padding-top: 0;
7933: padding-bottom: 0;
1.693 droeschl 7934: }
7935:
1.721 harmsja 7936: .LC_ListStyleSimple dd,
1.795 www 7937: .LC_ListStyleSimple li {
1.911 bisitz 7938: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7939: }
7940:
1.721 harmsja 7941: .LC_ListStyleSpecial li,
7942: .LC_ListStyleSpecial dd {
1.911 bisitz 7943: list-style-type: none;
7944: background-color: RGB(220, 220, 220);
7945: margin-bottom: 4px;
1.693 droeschl 7946: }
7947:
1.721 harmsja 7948: table.LC_SimpleTable {
1.911 bisitz 7949: margin:5px;
7950: border:solid 1px $lg_border_color;
1.795 www 7951: }
1.693 droeschl 7952:
1.721 harmsja 7953: table.LC_SimpleTable tr {
1.911 bisitz 7954: padding: 0;
7955: border:solid 1px $lg_border_color;
1.693 droeschl 7956: }
1.795 www 7957:
7958: table.LC_SimpleTable thead {
1.911 bisitz 7959: background:rgb(220,220,220);
1.693 droeschl 7960: }
7961:
1.721 harmsja 7962: div.LC_columnSection {
1.911 bisitz 7963: display: block;
7964: clear: both;
7965: overflow: hidden;
7966: margin: 0;
1.693 droeschl 7967: }
7968:
1.721 harmsja 7969: div.LC_columnSection>* {
1.911 bisitz 7970: float: left;
7971: margin: 10px 20px 10px 0;
7972: overflow:hidden;
1.693 droeschl 7973: }
1.721 harmsja 7974:
1.795 www 7975: table em {
1.911 bisitz 7976: font-weight: bold;
7977: font-style: normal;
1.748 schulted 7978: }
1.795 www 7979:
1.779 bisitz 7980: table.LC_tableBrowseRes,
1.795 www 7981: table.LC_tableOfContent {
1.911 bisitz 7982: border:none;
7983: border-spacing: 1px;
7984: padding: 3px;
7985: background-color: #FFFFFF;
7986: font-size: 90%;
1.753 droeschl 7987: }
1.789 droeschl 7988:
1.911 bisitz 7989: table.LC_tableOfContent {
7990: border-collapse: collapse;
1.789 droeschl 7991: }
7992:
1.771 droeschl 7993: table.LC_tableBrowseRes a,
1.768 schulted 7994: table.LC_tableOfContent a {
1.911 bisitz 7995: background-color: transparent;
7996: text-decoration: none;
1.753 droeschl 7997: }
7998:
1.795 www 7999: table.LC_tableOfContent img {
1.911 bisitz 8000: border: none;
8001: height: 1.3em;
8002: vertical-align: text-bottom;
8003: margin-right: 0.3em;
1.753 droeschl 8004: }
1.757 schulted 8005:
1.795 www 8006: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8007: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8008: }
8009:
1.795 www 8010: a#LC_content_toolbar_everything {
1.911 bisitz 8011: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8012: }
8013:
1.795 www 8014: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8015: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8016: }
8017:
1.795 www 8018: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8019: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8020: }
8021:
1.795 www 8022: a#LC_content_toolbar_changefolder {
1.911 bisitz 8023: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8024: }
8025:
1.795 www 8026: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8027: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8028: }
8029:
1.1043 raeburn 8030: a#LC_content_toolbar_edittoplevel {
8031: background-image:url(/res/adm/pages/edittoplevel.gif);
8032: }
8033:
1.795 www 8034: ul#LC_toolbar li a:hover {
1.911 bisitz 8035: background-position: bottom center;
1.757 schulted 8036: }
8037:
1.795 www 8038: ul#LC_toolbar {
1.911 bisitz 8039: padding: 0;
8040: margin: 2px;
8041: list-style:none;
8042: position:relative;
8043: background-color:white;
1.1082 raeburn 8044: overflow: auto;
1.757 schulted 8045: }
8046:
1.795 www 8047: ul#LC_toolbar li {
1.911 bisitz 8048: border:1px solid white;
8049: padding: 0;
8050: margin: 0;
8051: float: left;
8052: display:inline;
8053: vertical-align:middle;
1.1082 raeburn 8054: white-space: nowrap;
1.911 bisitz 8055: }
1.757 schulted 8056:
1.783 amueller 8057:
1.795 www 8058: a.LC_toolbarItem {
1.911 bisitz 8059: display:block;
8060: padding: 0;
8061: margin: 0;
8062: height: 32px;
8063: width: 32px;
8064: color:white;
8065: border: none;
8066: background-repeat:no-repeat;
8067: background-color:transparent;
1.757 schulted 8068: }
8069:
1.915 droeschl 8070: ul.LC_funclist {
8071: margin: 0;
8072: padding: 0.5em 1em 0.5em 0;
8073: }
8074:
1.933 droeschl 8075: ul.LC_funclist > li:first-child {
8076: font-weight:bold;
8077: margin-left:0.8em;
8078: }
8079:
1.915 droeschl 8080: ul.LC_funclist + ul.LC_funclist {
8081: /*
8082: left border as a seperator if we have more than
8083: one list
8084: */
8085: border-left: 1px solid $sidebg;
8086: /*
8087: this hides the left border behind the border of the
8088: outer box if element is wrapped to the next 'line'
8089: */
8090: margin-left: -1px;
8091: }
8092:
1.843 bisitz 8093: ul.LC_funclist li {
1.915 droeschl 8094: display: inline;
1.782 bisitz 8095: white-space: nowrap;
1.915 droeschl 8096: margin: 0 0 0 25px;
8097: line-height: 150%;
1.782 bisitz 8098: }
8099:
1.974 wenzelju 8100: .LC_hidden {
8101: display: none;
8102: }
8103:
1.1030 www 8104: .LCmodal-overlay {
8105: position:fixed;
8106: top:0;
8107: right:0;
8108: bottom:0;
8109: left:0;
8110: height:100%;
8111: width:100%;
8112: margin:0;
8113: padding:0;
8114: background:#999;
8115: opacity:.75;
8116: filter: alpha(opacity=75);
8117: -moz-opacity: 0.75;
8118: z-index:101;
8119: }
8120:
8121: * html .LCmodal-overlay {
8122: position: absolute;
8123: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8124: }
8125:
8126: .LCmodal-window {
8127: position:fixed;
8128: top:50%;
8129: left:50%;
8130: margin:0;
8131: padding:0;
8132: z-index:102;
8133: }
8134:
8135: * html .LCmodal-window {
8136: position:absolute;
8137: }
8138:
8139: .LCclose-window {
8140: position:absolute;
8141: width:32px;
8142: height:32px;
8143: right:8px;
8144: top:8px;
8145: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8146: text-indent:-99999px;
8147: overflow:hidden;
8148: cursor:pointer;
8149: }
8150:
1.1100 raeburn 8151: /*
1.1231 damieng 8152: styles used for response display
8153: */
8154: div.LC_radiofoil, div.LC_rankfoil {
8155: margin: .5em 0em .5em 0em;
8156: }
8157: table.LC_itemgroup {
8158: margin-top: 1em;
8159: }
8160:
8161: /*
1.1100 raeburn 8162: styles used by TTH when "Default set of options to pass to tth/m
8163: when converting TeX" in course settings has been set
8164:
8165: option passed: -t
8166:
8167: */
8168:
8169: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8170: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8171: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8172: td div.norm {line-height:normal;}
8173:
8174: /*
8175: option passed -y3
8176: */
8177:
8178: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8179: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8180: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8181:
1.1230 damieng 8182: /*
8183: sections with roles, for content only
8184: */
8185: section[class^="role-"] {
8186: padding-left: 10px;
8187: padding-right: 5px;
8188: margin-top: 8px;
8189: margin-bottom: 8px;
8190: border: 1px solid #2A4;
8191: border-radius: 5px;
8192: box-shadow: 0px 1px 1px #BBB;
8193: }
8194: section[class^="role-"]>h1 {
8195: position: relative;
8196: margin: 0px;
8197: padding-top: 10px;
8198: padding-left: 40px;
8199: }
8200: section[class^="role-"]>h1:before {
8201: position: absolute;
8202: left: -5px;
8203: top: 5px;
8204: }
8205: section.role-activity>h1:before {
8206: content:url('/adm/daxe/images/section_icons/activity.png');
8207: }
8208: section.role-advice>h1:before {
8209: content:url('/adm/daxe/images/section_icons/advice.png');
8210: }
8211: section.role-bibliography>h1:before {
8212: content:url('/adm/daxe/images/section_icons/bibliography.png');
8213: }
8214: section.role-citation>h1:before {
8215: content:url('/adm/daxe/images/section_icons/citation.png');
8216: }
8217: section.role-conclusion>h1:before {
8218: content:url('/adm/daxe/images/section_icons/conclusion.png');
8219: }
8220: section.role-definition>h1:before {
8221: content:url('/adm/daxe/images/section_icons/definition.png');
8222: }
8223: section.role-demonstration>h1:before {
8224: content:url('/adm/daxe/images/section_icons/demonstration.png');
8225: }
8226: section.role-example>h1:before {
8227: content:url('/adm/daxe/images/section_icons/example.png');
8228: }
8229: section.role-explanation>h1:before {
8230: content:url('/adm/daxe/images/section_icons/explanation.png');
8231: }
8232: section.role-introduction>h1:before {
8233: content:url('/adm/daxe/images/section_icons/introduction.png');
8234: }
8235: section.role-method>h1:before {
8236: content:url('/adm/daxe/images/section_icons/method.png');
8237: }
8238: section.role-more_information>h1:before {
8239: content:url('/adm/daxe/images/section_icons/more_information.png');
8240: }
8241: section.role-objectives>h1:before {
8242: content:url('/adm/daxe/images/section_icons/objectives.png');
8243: }
8244: section.role-prerequisites>h1:before {
8245: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8246: }
8247: section.role-remark>h1:before {
8248: content:url('/adm/daxe/images/section_icons/remark.png');
8249: }
8250: section.role-reminder>h1:before {
8251: content:url('/adm/daxe/images/section_icons/reminder.png');
8252: }
8253: section.role-summary>h1:before {
8254: content:url('/adm/daxe/images/section_icons/summary.png');
8255: }
8256: section.role-syntax>h1:before {
8257: content:url('/adm/daxe/images/section_icons/syntax.png');
8258: }
8259: section.role-warning>h1:before {
8260: content:url('/adm/daxe/images/section_icons/warning.png');
8261: }
8262:
1.1269 raeburn 8263: #LC_minitab_header {
8264: float:left;
8265: width:100%;
8266: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8267: font-size:93%;
8268: line-height:normal;
8269: margin: 0.5em 0 0.5em 0;
8270: }
8271: #LC_minitab_header ul {
8272: margin:0;
8273: padding:10px 10px 0;
8274: list-style:none;
8275: }
8276: #LC_minitab_header li {
8277: float:left;
8278: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8279: margin:0;
8280: padding:0 0 0 9px;
8281: }
8282: #LC_minitab_header a {
8283: display:block;
8284: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8285: padding:5px 15px 4px 6px;
8286: }
8287: #LC_minitab_header #LC_current_minitab {
8288: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8289: }
8290: #LC_minitab_header #LC_current_minitab a {
8291: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8292: padding-bottom:5px;
8293: }
8294:
8295:
1.343 albertel 8296: END
8297: }
8298:
1.306 albertel 8299: =pod
8300:
8301: =item * &headtag()
8302:
8303: Returns a uniform footer for LON-CAPA web pages.
8304:
1.307 albertel 8305: Inputs: $title - optional title for the head
8306: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8307: $args - optional arguments
1.319 albertel 8308: force_register - if is true call registerurl so the remote is
8309: informed
1.415 albertel 8310: redirect -> array ref of
8311: 1- seconds before redirect occurs
8312: 2- url to redirect to
8313: 3- whether the side effect should occur
1.315 albertel 8314: (side effect of setting
8315: $env{'internal.head.redirect'} to the url
8316: redirected too)
1.352 albertel 8317: domain -> force to color decorate a page for a specific
8318: domain
8319: function -> force usage of a specific rolish color scheme
8320: bgcolor -> override the default page bgcolor
1.460 albertel 8321: no_auto_mt_title
8322: -> prevent &mt()ing the title arg
1.464 albertel 8323:
1.306 albertel 8324: =cut
8325:
8326: sub headtag {
1.313 albertel 8327: my ($title,$head_extra,$args) = @_;
1.306 albertel 8328:
1.363 albertel 8329: my $function = $args->{'function'} || &get_users_function();
8330: my $domain = $args->{'domain'} || &determinedomain();
8331: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8332: my $httphost = $args->{'use_absolute'};
1.418 albertel 8333: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8334: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8335: #time(),
1.418 albertel 8336: $env{'environment.color.timestamp'},
1.363 albertel 8337: $function,$domain,$bgcolor);
8338:
1.369 www 8339: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8340:
1.308 albertel 8341: my $result =
8342: '<head>'.
1.1160 raeburn 8343: &font_settings($args);
1.319 albertel 8344:
1.1188 raeburn 8345: my $inhibitprint;
8346: if ($args->{'print_suppress'}) {
8347: $inhibitprint = &print_suppression();
8348: }
1.1064 raeburn 8349:
1.461 albertel 8350: if (!$args->{'frameset'}) {
8351: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8352: }
1.962 droeschl 8353: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8354: $result .= Apache::lonxml::display_title();
1.319 albertel 8355: }
1.436 albertel 8356: if (!$args->{'no_nav_bar'}
8357: && !$args->{'only_body'}
8358: && !$args->{'frameset'}) {
1.1154 raeburn 8359: $result .= &help_menu_js($httphost);
1.1032 www 8360: $result.=&modal_window();
1.1038 www 8361: $result.=&togglebox_script();
1.1034 www 8362: $result.=&wishlist_window();
1.1041 www 8363: $result.=&LCprogressbarUpdate_script();
1.1034 www 8364: } else {
8365: if ($args->{'add_modal'}) {
8366: $result.=&modal_window();
8367: }
8368: if ($args->{'add_wishlist'}) {
8369: $result.=&wishlist_window();
8370: }
1.1038 www 8371: if ($args->{'add_togglebox'}) {
8372: $result.=&togglebox_script();
8373: }
1.1041 www 8374: if ($args->{'add_progressbar'}) {
8375: $result.=&LCprogressbarUpdate_script();
8376: }
1.436 albertel 8377: }
1.314 albertel 8378: if (ref($args->{'redirect'})) {
1.414 albertel 8379: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8380: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8381: if (!$inhibit_continue) {
8382: $env{'internal.head.redirect'} = $url;
8383: }
1.313 albertel 8384: $result.=<<ADDMETA
8385: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8386: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8387: ADDMETA
1.1210 raeburn 8388: } else {
8389: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8390: my $requrl = $env{'request.uri'};
8391: if ($requrl eq '') {
8392: $requrl = $ENV{'REQUEST_URI'};
8393: $requrl =~ s/\?.+$//;
8394: }
8395: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8396: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8397: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8398: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8399: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8400: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
8401: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8402: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8403: if ($domdefs{'offloadnow'}{$lonhost}) {
8404: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8405: if (($newserver) && ($newserver ne $lonhost)) {
8406: my $numsec = 5;
8407: my $timeout = $numsec * 1000;
8408: my ($newurl,$locknum,%locks,$msg);
8409: if ($env{'request.role.adv'}) {
8410: ($locknum,%locks) = &Apache::lonnet::get_locks();
8411: }
8412: my $disable_submit = 0;
8413: if ($requrl =~ /$LONCAPA::assess_re/) {
8414: $disable_submit = 1;
8415: }
8416: if ($locknum) {
8417: my @lockinfo = sort(values(%locks));
8418: $msg = &mt('Once the following tasks are complete: ')."\\n".
8419: join(", ",sort(values(%locks)))."\\n".
8420: &mt('your session will be transferred to a different server, after you click "Roles".');
8421: } else {
8422: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8423: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
8424: }
8425: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8426: $newurl = '/adm/switchserver?otherserver='.$newserver;
8427: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8428: $newurl .= '&role='.$env{'request.role'};
8429: }
8430: if ($env{'request.symb'}) {
8431: $newurl .= '&symb='.$env{'request.symb'};
8432: } else {
8433: $newurl .= '&origurl='.$requrl;
8434: }
8435: }
1.1222 damieng 8436: &js_escape(\$msg);
1.1210 raeburn 8437: $result.=<<OFFLOAD
8438: <meta http-equiv="pragma" content="no-cache" />
8439: <script type="text/javascript">
1.1215 raeburn 8440: // <![CDATA[
1.1210 raeburn 8441: function LC_Offload_Now() {
8442: var dest = "$newurl";
8443: if (dest != '') {
8444: window.location.href="$newurl";
8445: }
8446: }
1.1214 raeburn 8447: \$(document).ready(function () {
8448: window.alert('$msg');
8449: if ($disable_submit) {
1.1210 raeburn 8450: \$(".LC_hwk_submit").prop("disabled", true);
8451: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8452: }
8453: setTimeout('LC_Offload_Now()', $timeout);
8454: });
1.1215 raeburn 8455: // ]]>
1.1210 raeburn 8456: </script>
8457: OFFLOAD
8458: }
8459: }
8460: }
8461: }
8462: }
8463: }
1.313 albertel 8464: }
1.306 albertel 8465: if (!defined($title)) {
8466: $title = 'The LearningOnline Network with CAPA';
8467: }
1.460 albertel 8468: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8469: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8470: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8471: if (!$args->{'frameset'}) {
8472: $result .= ' /';
8473: }
8474: $result .= '>'
1.1064 raeburn 8475: .$inhibitprint
1.414 albertel 8476: .$head_extra;
1.1242 raeburn 8477: my $clientmobile;
8478: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8479: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8480: } else {
8481: $clientmobile = $env{'browser.mobile'};
8482: }
8483: if ($clientmobile) {
1.1137 raeburn 8484: $result .= '
8485: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8486: <meta name="apple-mobile-web-app-capable" content="yes" />';
8487: }
1.1278 raeburn 8488: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8489: return $result.'</head>';
1.306 albertel 8490: }
8491:
8492: =pod
8493:
1.340 albertel 8494: =item * &font_settings()
8495:
8496: Returns neccessary <meta> to set the proper encoding
8497:
1.1160 raeburn 8498: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8499:
8500: =cut
8501:
8502: sub font_settings {
1.1160 raeburn 8503: my ($args) = @_;
1.340 albertel 8504: my $headerstring='';
1.1160 raeburn 8505: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8506: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8507: $headerstring.=
8508: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8509: if (!$args->{'frameset'}) {
8510: $headerstring.= ' /';
8511: }
8512: $headerstring .= '>'."\n";
1.340 albertel 8513: }
8514: return $headerstring;
8515: }
8516:
1.341 albertel 8517: =pod
8518:
1.1064 raeburn 8519: =item * &print_suppression()
8520:
8521: In course context returns css which causes the body to be blank when media="print",
8522: if printout generation is unavailable for the current resource.
8523:
8524: This could be because:
8525:
8526: (a) printstartdate is in the future
8527:
8528: (b) printenddate is in the past
8529:
8530: (c) there is an active exam block with "printout"
8531: functionality blocked
8532:
8533: Users with pav, pfo or evb privileges are exempt.
8534:
8535: Inputs: none
8536:
8537: =cut
8538:
8539:
8540: sub print_suppression {
8541: my $noprint;
8542: if ($env{'request.course.id'}) {
8543: my $scope = $env{'request.course.id'};
8544: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8545: (&Apache::lonnet::allowed('pfo',$scope))) {
8546: return;
8547: }
8548: if ($env{'request.course.sec'} ne '') {
8549: $scope .= "/$env{'request.course.sec'}";
8550: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8551: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8552: return;
1.1064 raeburn 8553: }
8554: }
8555: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8556: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8557: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8558: if ($blocked) {
8559: my $checkrole = "cm./$cdom/$cnum";
8560: if ($env{'request.course.sec'} ne '') {
8561: $checkrole .= "/$env{'request.course.sec'}";
8562: }
8563: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8564: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8565: $noprint = 1;
8566: }
8567: }
8568: unless ($noprint) {
8569: my $symb = &Apache::lonnet::symbread();
8570: if ($symb ne '') {
8571: my $navmap = Apache::lonnavmaps::navmap->new();
8572: if (ref($navmap)) {
8573: my $res = $navmap->getBySymb($symb);
8574: if (ref($res)) {
8575: if (!$res->resprintable()) {
8576: $noprint = 1;
8577: }
8578: }
8579: }
8580: }
8581: }
8582: if ($noprint) {
8583: return <<"ENDSTYLE";
8584: <style type="text/css" media="print">
8585: body { display:none }
8586: </style>
8587: ENDSTYLE
8588: }
8589: }
8590: return;
8591: }
8592:
8593: =pod
8594:
1.341 albertel 8595: =item * &xml_begin()
8596:
8597: Returns the needed doctype and <html>
8598:
8599: Inputs: none
8600:
8601: =cut
8602:
8603: sub xml_begin {
1.1168 raeburn 8604: my ($is_frameset) = @_;
1.341 albertel 8605: my $output='';
8606:
8607: if ($env{'browser.mathml'}) {
8608: $output='<?xml version="1.0"?>'
8609: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8610: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8611:
8612: # .'<!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">] >'
8613: .'<!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">'
8614: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8615: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8616: } elsif ($is_frameset) {
8617: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8618: '<html>'."\n";
1.341 albertel 8619: } else {
1.1168 raeburn 8620: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8621: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8622: }
8623: return $output;
8624: }
1.340 albertel 8625:
8626: =pod
8627:
1.306 albertel 8628: =item * &start_page()
8629:
8630: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8631:
1.648 raeburn 8632: Inputs:
8633:
8634: =over 4
8635:
8636: $title - optional title for the page
8637:
8638: $head_extra - optional extra HTML to incude inside the <head>
8639:
8640: $args - additional optional args supported are:
8641:
8642: =over 8
8643:
8644: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8645: arg on
1.814 bisitz 8646: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8647: add_entries -> additional attributes to add to the <body>
8648: domain -> force to color decorate a page for a
1.317 albertel 8649: specific domain
1.648 raeburn 8650: function -> force usage of a specific rolish color
1.317 albertel 8651: scheme
1.648 raeburn 8652: redirect -> see &headtag()
8653: bgcolor -> override the default page bg color
8654: js_ready -> return a string ready for being used in
1.317 albertel 8655: a javascript writeln
1.648 raeburn 8656: html_encode -> return a string ready for being used in
1.320 albertel 8657: a html attribute
1.648 raeburn 8658: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8659: $forcereg arg
1.648 raeburn 8660: frameset -> if true will start with a <frameset>
1.330 albertel 8661: rather than <body>
1.648 raeburn 8662: skip_phases -> hash ref of
1.338 albertel 8663: head -> skip the <html><head> generation
8664: body -> skip all <body> generation
1.648 raeburn 8665: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8666: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8667: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 8668: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8669: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 8670: group -> includes the current group, if page is for a
1.1274 raeburn 8671: specific group
8672: use_absolute -> for request for external resource or syllabus, this
8673: will contain https://<hostname> if server uses
8674: https (as per hosts.tab), but request is for http
8675: hostname -> hostname, originally from $r->hostname(), (optional).
1.361 albertel 8676:
1.648 raeburn 8677: =back
1.460 albertel 8678:
1.648 raeburn 8679: =back
1.562 albertel 8680:
1.306 albertel 8681: =cut
8682:
8683: sub start_page {
1.309 albertel 8684: my ($title,$head_extra,$args) = @_;
1.318 albertel 8685: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8686:
1.315 albertel 8687: $env{'internal.start_page'}++;
1.1096 raeburn 8688: my ($result,@advtools);
1.964 droeschl 8689:
1.338 albertel 8690: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8691: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8692: }
8693:
8694: if (! exists($args->{'skip_phases'}{'body'}) ) {
8695: if ($args->{'frameset'}) {
8696: my $attr_string = &make_attr_string($args->{'force_register'},
8697: $args->{'add_entries'});
8698: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8699: } else {
8700: $result .=
8701: &bodytag($title,
8702: $args->{'function'}, $args->{'add_entries'},
8703: $args->{'only_body'}, $args->{'domain'},
8704: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8705: $args->{'bgcolor'}, $args,
8706: \@advtools);
1.831 bisitz 8707: }
1.330 albertel 8708: }
1.338 albertel 8709:
1.315 albertel 8710: if ($args->{'js_ready'}) {
1.713 kaisler 8711: $result = &js_ready($result);
1.315 albertel 8712: }
1.320 albertel 8713: if ($args->{'html_encode'}) {
1.713 kaisler 8714: $result = &html_encode($result);
8715: }
8716:
1.813 bisitz 8717: # Preparation for new and consistent functionlist at top of screen
8718: # if ($args->{'functionlist'}) {
8719: # $result .= &build_functionlist();
8720: #}
8721:
1.964 droeschl 8722: # Don't add anything more if only_body wanted or in const space
8723: return $result if $args->{'only_body'}
8724: || $env{'request.state'} eq 'construct';
1.813 bisitz 8725:
8726: #Breadcrumbs
1.758 kaisler 8727: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8728: &Apache::lonhtmlcommon::clear_breadcrumbs();
8729: #if any br links exists, add them to the breadcrumbs
8730: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8731: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8732: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8733: }
8734: }
1.1096 raeburn 8735: # if @advtools array contains items add then to the breadcrumbs
8736: if (@advtools > 0) {
8737: &Apache::lonmenu::advtools_crumbs(@advtools);
8738: }
1.1312 raeburn 8739: my $ltiscope;
8740: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
8741: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8742: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
8743: ($ltiscope) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},$cdom,$cnum);
8744: }
1.1272 raeburn 8745: my $menulink;
8746: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8747: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 8748: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 8749: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
8750: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
8751: (!$env{'request.role.adv'}))) {
8752: $menulink = 0;
8753: } else {
8754: undef($menulink);
8755: }
1.758 kaisler 8756: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8757: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 8758: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 8759: } else {
1.1272 raeburn 8760: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8761: }
1.320 albertel 8762: }
1.315 albertel 8763: return $result;
1.306 albertel 8764: }
8765:
8766: sub end_page {
1.315 albertel 8767: my ($args) = @_;
8768: $env{'internal.end_page'}++;
1.330 albertel 8769: my $result;
1.335 albertel 8770: if ($args->{'discussion'}) {
8771: my ($target,$parser);
8772: if (ref($args->{'discussion'})) {
8773: ($target,$parser) =($args->{'discussion'}{'target'},
8774: $args->{'discussion'}{'parser'});
8775: }
8776: $result .= &Apache::lonxml::xmlend($target,$parser);
8777: }
1.330 albertel 8778: if ($args->{'frameset'}) {
8779: $result .= '</frameset>';
8780: } else {
1.635 raeburn 8781: $result .= &endbodytag($args);
1.330 albertel 8782: }
1.1080 raeburn 8783: unless ($args->{'notbody'}) {
8784: $result .= "\n</html>";
8785: }
1.330 albertel 8786:
1.315 albertel 8787: if ($args->{'js_ready'}) {
1.317 albertel 8788: $result = &js_ready($result);
1.315 albertel 8789: }
1.335 albertel 8790:
1.320 albertel 8791: if ($args->{'html_encode'}) {
8792: $result = &html_encode($result);
8793: }
1.335 albertel 8794:
1.315 albertel 8795: return $result;
8796: }
8797:
1.1034 www 8798: sub wishlist_window {
8799: return(<<'ENDWISHLIST');
1.1046 raeburn 8800: <script type="text/javascript">
1.1034 www 8801: // <![CDATA[
8802: // <!-- BEGIN LON-CAPA Internal
8803: function set_wishlistlink(title, path) {
8804: if (!title) {
8805: title = document.title;
8806: title = title.replace(/^LON-CAPA /,'');
8807: }
1.1175 raeburn 8808: title = encodeURIComponent(title);
1.1203 raeburn 8809: title = title.replace("'","\\\'");
1.1034 www 8810: if (!path) {
8811: path = location.pathname;
8812: }
1.1175 raeburn 8813: path = encodeURIComponent(path);
1.1203 raeburn 8814: path = path.replace("'","\\\'");
1.1034 www 8815: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8816: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8817: }
8818: // END LON-CAPA Internal -->
8819: // ]]>
8820: </script>
8821: ENDWISHLIST
8822: }
8823:
1.1030 www 8824: sub modal_window {
8825: return(<<'ENDMODAL');
1.1046 raeburn 8826: <script type="text/javascript">
1.1030 www 8827: // <![CDATA[
8828: // <!-- BEGIN LON-CAPA Internal
8829: var modalWindow = {
8830: parent:"body",
8831: windowId:null,
8832: content:null,
8833: width:null,
8834: height:null,
8835: close:function()
8836: {
8837: $(".LCmodal-window").remove();
8838: $(".LCmodal-overlay").remove();
8839: },
8840: open:function()
8841: {
8842: var modal = "";
8843: modal += "<div class=\"LCmodal-overlay\"></div>";
8844: 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;\">";
8845: modal += this.content;
8846: modal += "</div>";
8847:
8848: $(this.parent).append(modal);
8849:
8850: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8851: $(".LCclose-window").click(function(){modalWindow.close();});
8852: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8853: }
8854: };
1.1140 raeburn 8855: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8856: {
1.1266 raeburn 8857: source = source.replace(/'/g,"'");
1.1030 www 8858: modalWindow.windowId = "myModal";
8859: modalWindow.width = width;
8860: modalWindow.height = height;
1.1196 raeburn 8861: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8862: modalWindow.open();
1.1208 raeburn 8863: };
1.1030 www 8864: // END LON-CAPA Internal -->
8865: // ]]>
8866: </script>
8867: ENDMODAL
8868: }
8869:
8870: sub modal_link {
1.1140 raeburn 8871: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8872: unless ($width) { $width=480; }
8873: unless ($height) { $height=400; }
1.1031 www 8874: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8875: unless ($transparency) { $transparency='true'; }
8876:
1.1074 raeburn 8877: my $target_attr;
8878: if (defined($target)) {
8879: $target_attr = 'target="'.$target.'"';
8880: }
8881: return <<"ENDLINK";
1.1140 raeburn 8882: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8883: $linktext</a>
8884: ENDLINK
1.1030 www 8885: }
8886:
1.1032 www 8887: sub modal_adhoc_script {
8888: my ($funcname,$width,$height,$content)=@_;
8889: return (<<ENDADHOC);
1.1046 raeburn 8890: <script type="text/javascript">
1.1032 www 8891: // <![CDATA[
8892: var $funcname = function()
8893: {
8894: modalWindow.windowId = "myModal";
8895: modalWindow.width = $width;
8896: modalWindow.height = $height;
8897: modalWindow.content = '$content';
8898: modalWindow.open();
8899: };
8900: // ]]>
8901: </script>
8902: ENDADHOC
8903: }
8904:
1.1041 www 8905: sub modal_adhoc_inner {
8906: my ($funcname,$width,$height,$content)=@_;
8907: my $innerwidth=$width-20;
8908: $content=&js_ready(
1.1140 raeburn 8909: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8910: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8911: $content.
1.1041 www 8912: &end_scrollbox().
1.1140 raeburn 8913: &end_page()
1.1041 www 8914: );
8915: return &modal_adhoc_script($funcname,$width,$height,$content);
8916: }
8917:
8918: sub modal_adhoc_window {
8919: my ($funcname,$width,$height,$content,$linktext)=@_;
8920: return &modal_adhoc_inner($funcname,$width,$height,$content).
8921: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8922: }
8923:
8924: sub modal_adhoc_launch {
8925: my ($funcname,$width,$height,$content)=@_;
8926: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8927: <script type="text/javascript">
8928: // <![CDATA[
8929: $funcname();
8930: // ]]>
8931: </script>
8932: ENDLAUNCH
8933: }
8934:
8935: sub modal_adhoc_close {
8936: return (<<ENDCLOSE);
8937: <script type="text/javascript">
8938: // <![CDATA[
8939: modalWindow.close();
8940: // ]]>
8941: </script>
8942: ENDCLOSE
8943: }
8944:
1.1038 www 8945: sub togglebox_script {
8946: return(<<ENDTOGGLE);
8947: <script type="text/javascript">
8948: // <![CDATA[
8949: function LCtoggleDisplay(id,hidetext,showtext) {
8950: link = document.getElementById(id + "link").childNodes[0];
8951: with (document.getElementById(id).style) {
8952: if (display == "none" ) {
8953: display = "inline";
8954: link.nodeValue = hidetext;
8955: } else {
8956: display = "none";
8957: link.nodeValue = showtext;
8958: }
8959: }
8960: }
8961: // ]]>
8962: </script>
8963: ENDTOGGLE
8964: }
8965:
1.1039 www 8966: sub start_togglebox {
8967: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8968: unless ($heading) { $heading=''; } else { $heading.=' '; }
8969: unless ($showtext) { $showtext=&mt('show'); }
8970: unless ($hidetext) { $hidetext=&mt('hide'); }
8971: unless ($headerbg) { $headerbg='#FFFFFF'; }
8972: return &start_data_table().
8973: &start_data_table_header_row().
8974: '<td bgcolor="'.$headerbg.'">'.$heading.
8975: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8976: $showtext.'\')">'.$showtext.'</a>]</td>'.
8977: &end_data_table_header_row().
8978: '<tr id="'.$id.'" style="display:none""><td>';
8979: }
8980:
8981: sub end_togglebox {
8982: return '</td></tr>'.&end_data_table();
8983: }
8984:
1.1041 www 8985: sub LCprogressbar_script {
1.1302 raeburn 8986: my ($id,$number_to_do)=@_;
8987: if ($number_to_do) {
8988: return(<<ENDPROGRESS);
1.1041 www 8989: <script type="text/javascript">
8990: // <![CDATA[
1.1045 www 8991: \$('#progressbar$id').progressbar({
1.1041 www 8992: value: 0,
8993: change: function(event, ui) {
8994: var newVal = \$(this).progressbar('option', 'value');
8995: \$('.pblabel', this).text(LCprogressTxt);
8996: }
8997: });
8998: // ]]>
8999: </script>
9000: ENDPROGRESS
1.1302 raeburn 9001: } else {
9002: return(<<ENDPROGRESS);
9003: <script type="text/javascript">
9004: // <![CDATA[
9005: \$('#progressbar$id').progressbar({
9006: value: false,
9007: create: function(event, ui) {
9008: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9009: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9010: }
9011: });
9012: // ]]>
9013: </script>
9014: ENDPROGRESS
9015: }
1.1041 www 9016: }
9017:
9018: sub LCprogressbarUpdate_script {
9019: return(<<ENDPROGRESSUPDATE);
9020: <style type="text/css">
9021: .ui-progressbar { position:relative; }
1.1302 raeburn 9022: .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 9023: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9024: </style>
9025: <script type="text/javascript">
9026: // <![CDATA[
1.1045 www 9027: var LCprogressTxt='---';
9028:
1.1302 raeburn 9029: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9030: LCprogressTxt=progresstext;
1.1302 raeburn 9031: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9032: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9033: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 9034: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9035: } else {
9036: \$('#progressbar'+id).progressbar('value',percent);
9037: }
1.1041 www 9038: }
9039: // ]]>
9040: </script>
9041: ENDPROGRESSUPDATE
9042: }
9043:
1.1042 www 9044: my $LClastpercent;
1.1045 www 9045: my $LCidcnt;
9046: my $LCcurrentid;
1.1042 www 9047:
1.1041 www 9048: sub LCprogressbar {
1.1302 raeburn 9049: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9050: $LClastpercent=0;
1.1045 www 9051: $LCidcnt++;
9052: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 9053: my ($starting,$content);
9054: if ($number_to_do) {
9055: $starting=&mt('Starting');
9056: $content=(<<ENDPROGBAR);
9057: $preamble
1.1045 www 9058: <div id="progressbar$LCcurrentid">
1.1041 www 9059: <span class="pblabel">$starting</span>
9060: </div>
9061: ENDPROGBAR
1.1302 raeburn 9062: } else {
9063: $starting=&mt('Loading...');
9064: $LClastpercent='false';
9065: $content=(<<ENDPROGBAR);
9066: $preamble
9067: <div id="progressbar$LCcurrentid">
9068: <div class="progress-label">$starting</div>
9069: </div>
9070: ENDPROGBAR
9071: }
9072: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9073: }
9074:
9075: sub LCprogressbarUpdate {
1.1302 raeburn 9076: my ($r,$val,$text,$number_to_do)=@_;
9077: if ($number_to_do) {
9078: unless ($val) {
9079: if ($LClastpercent) {
9080: $val=$LClastpercent;
9081: } else {
9082: $val=0;
9083: }
9084: }
9085: if ($val<0) { $val=0; }
9086: if ($val>100) { $val=0; }
9087: $LClastpercent=$val;
9088: unless ($text) { $text=$val.'%'; }
9089: } else {
9090: $val = 'false';
1.1042 www 9091: }
1.1041 www 9092: $text=&js_ready($text);
1.1044 www 9093: &r_print($r,<<ENDUPDATE);
1.1041 www 9094: <script type="text/javascript">
9095: // <![CDATA[
1.1302 raeburn 9096: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9097: // ]]>
9098: </script>
9099: ENDUPDATE
1.1035 www 9100: }
9101:
1.1042 www 9102: sub LCprogressbarClose {
9103: my ($r)=@_;
9104: $LClastpercent=0;
1.1044 www 9105: &r_print($r,<<ENDCLOSE);
1.1042 www 9106: <script type="text/javascript">
9107: // <![CDATA[
1.1045 www 9108: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9109: // ]]>
9110: </script>
9111: ENDCLOSE
1.1044 www 9112: }
9113:
9114: sub r_print {
9115: my ($r,$to_print)=@_;
9116: if ($r) {
9117: $r->print($to_print);
9118: $r->rflush();
9119: } else {
9120: print($to_print);
9121: }
1.1042 www 9122: }
9123:
1.320 albertel 9124: sub html_encode {
9125: my ($result) = @_;
9126:
1.322 albertel 9127: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9128:
9129: return $result;
9130: }
1.1044 www 9131:
1.317 albertel 9132: sub js_ready {
9133: my ($result) = @_;
9134:
1.323 albertel 9135: $result =~ s/[\n\r]/ /xmsg;
9136: $result =~ s/\\/\\\\/xmsg;
9137: $result =~ s/'/\\'/xmsg;
1.372 albertel 9138: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9139:
9140: return $result;
9141: }
9142:
1.315 albertel 9143: sub validate_page {
9144: if ( exists($env{'internal.start_page'})
1.316 albertel 9145: && $env{'internal.start_page'} > 1) {
9146: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9147: $env{'internal.start_page'}.' '.
1.316 albertel 9148: $ENV{'request.filename'});
1.315 albertel 9149: }
9150: if ( exists($env{'internal.end_page'})
1.316 albertel 9151: && $env{'internal.end_page'} > 1) {
9152: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9153: $env{'internal.end_page'}.' '.
1.316 albertel 9154: $env{'request.filename'});
1.315 albertel 9155: }
9156: if ( exists($env{'internal.start_page'})
9157: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9158: &Apache::lonnet::logthis('start_page called without end_page '.
9159: $env{'request.filename'});
1.315 albertel 9160: }
9161: if ( ! exists($env{'internal.start_page'})
9162: && exists($env{'internal.end_page'})) {
1.316 albertel 9163: &Apache::lonnet::logthis('end_page called without start_page'.
9164: $env{'request.filename'});
1.315 albertel 9165: }
1.306 albertel 9166: }
1.315 albertel 9167:
1.996 www 9168:
9169: sub start_scrollbox {
1.1140 raeburn 9170: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9171: unless ($outerwidth) { $outerwidth='520px'; }
9172: unless ($width) { $width='500px'; }
9173: unless ($height) { $height='200px'; }
1.1075 raeburn 9174: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9175: if ($id ne '') {
1.1140 raeburn 9176: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9177: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9178: }
1.1075 raeburn 9179: if ($bgcolor ne '') {
9180: $tdcol = "background-color: $bgcolor;";
9181: }
1.1137 raeburn 9182: my $nicescroll_js;
9183: if ($env{'browser.mobile'}) {
1.1140 raeburn 9184: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9185: }
9186: return <<"END";
9187: $nicescroll_js
9188:
9189: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9190: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9191: END
9192: }
9193:
9194: sub end_scrollbox {
9195: return '</div></td></tr></table>';
9196: }
9197:
9198: sub nicescroll_javascript {
9199: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9200: my %options;
9201: if (ref($cursor) eq 'HASH') {
9202: %options = %{$cursor};
9203: }
9204: unless ($options{'railalign'} =~ /^left|right$/) {
9205: $options{'railalign'} = 'left';
9206: }
9207: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9208: my $function = &get_users_function();
9209: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9210: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9211: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9212: }
1.1140 raeburn 9213: }
9214: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9215: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9216: $options{'cursoropacity'}='1.0';
9217: }
1.1140 raeburn 9218: } else {
9219: $options{'cursoropacity'}='1.0';
9220: }
9221: if ($options{'cursorfixedheight'} eq 'none') {
9222: delete($options{'cursorfixedheight'});
9223: } else {
9224: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9225: }
9226: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9227: delete($options{'railoffset'});
9228: }
9229: my @niceoptions;
9230: while (my($key,$value) = each(%options)) {
9231: if ($value =~ /^\{.+\}$/) {
9232: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9233: } else {
1.1140 raeburn 9234: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9235: }
1.1140 raeburn 9236: }
9237: my $nicescroll_js = '
1.1137 raeburn 9238: $(document).ready(
1.1140 raeburn 9239: function() {
9240: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9241: }
1.1137 raeburn 9242: );
9243: ';
1.1140 raeburn 9244: if ($framecheck) {
9245: $nicescroll_js .= '
9246: function expand_div(caller) {
9247: if (top === self) {
9248: document.getElementById("'.$id.'").style.width = "auto";
9249: document.getElementById("'.$id.'").style.height = "auto";
9250: } else {
9251: try {
9252: if (parent.frames) {
9253: if (parent.frames.length > 1) {
9254: var framesrc = parent.frames[1].location.href;
9255: var currsrc = framesrc.replace(/\#.*$/,"");
9256: if ((caller == "search") || (currsrc == "'.$location.'")) {
9257: document.getElementById("'.$id.'").style.width = "auto";
9258: document.getElementById("'.$id.'").style.height = "auto";
9259: }
9260: }
9261: }
9262: } catch (e) {
9263: return;
9264: }
1.1137 raeburn 9265: }
1.1140 raeburn 9266: return;
1.996 www 9267: }
1.1140 raeburn 9268: ';
9269: }
9270: if ($needjsready) {
9271: $nicescroll_js = '
9272: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9273: } else {
9274: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9275: }
9276: return $nicescroll_js;
1.996 www 9277: }
9278:
1.318 albertel 9279: sub simple_error_page {
1.1150 bisitz 9280: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 9281: my %displayargs;
1.1151 raeburn 9282: if (ref($args) eq 'HASH') {
9283: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 9284: if ($args->{'only_body'}) {
9285: $displayargs{'only_body'} = 1;
9286: }
9287: if ($args->{'no_nav_bar'}) {
9288: $displayargs{'no_nav_bar'} = 1;
9289: }
1.1151 raeburn 9290: } else {
9291: $msg = &mt($msg);
9292: }
1.1150 bisitz 9293:
1.318 albertel 9294: my $page =
1.1304 raeburn 9295: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 9296: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9297: &Apache::loncommon::end_page();
9298: if (ref($r)) {
9299: $r->print($page);
1.327 albertel 9300: return;
1.318 albertel 9301: }
9302: return $page;
9303: }
1.347 albertel 9304:
9305: {
1.610 albertel 9306: my @row_count;
1.961 onken 9307:
9308: sub start_data_table_count {
9309: unshift(@row_count, 0);
9310: return;
9311: }
9312:
9313: sub end_data_table_count {
9314: shift(@row_count);
9315: return;
9316: }
9317:
1.347 albertel 9318: sub start_data_table {
1.1018 raeburn 9319: my ($add_class,$id) = @_;
1.422 albertel 9320: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9321: my $table_id;
9322: if (defined($id)) {
9323: $table_id = ' id="'.$id.'"';
9324: }
1.961 onken 9325: &start_data_table_count();
1.1018 raeburn 9326: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9327: }
9328:
9329: sub end_data_table {
1.961 onken 9330: &end_data_table_count();
1.389 albertel 9331: return '</table>'."\n";;
1.347 albertel 9332: }
9333:
9334: sub start_data_table_row {
1.974 wenzelju 9335: my ($add_class, $id) = @_;
1.610 albertel 9336: $row_count[0]++;
9337: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9338: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9339: $id = (' id="'.$id.'"') unless ($id eq '');
9340: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9341: }
1.471 banghart 9342:
9343: sub continue_data_table_row {
1.974 wenzelju 9344: my ($add_class, $id) = @_;
1.610 albertel 9345: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9346: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9347: $id = (' id="'.$id.'"') unless ($id eq '');
9348: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9349: }
1.347 albertel 9350:
9351: sub end_data_table_row {
1.389 albertel 9352: return '</tr>'."\n";;
1.347 albertel 9353: }
1.367 www 9354:
1.421 albertel 9355: sub start_data_table_empty_row {
1.707 bisitz 9356: # $row_count[0]++;
1.421 albertel 9357: return '<tr class="LC_empty_row" >'."\n";;
9358: }
9359:
9360: sub end_data_table_empty_row {
9361: return '</tr>'."\n";;
9362: }
9363:
1.367 www 9364: sub start_data_table_header_row {
1.389 albertel 9365: return '<tr class="LC_header_row">'."\n";;
1.367 www 9366: }
9367:
9368: sub end_data_table_header_row {
1.389 albertel 9369: return '</tr>'."\n";;
1.367 www 9370: }
1.890 droeschl 9371:
9372: sub data_table_caption {
9373: my $caption = shift;
9374: return "<caption class=\"LC_caption\">$caption</caption>";
9375: }
1.347 albertel 9376: }
9377:
1.548 albertel 9378: =pod
9379:
9380: =item * &inhibit_menu_check($arg)
9381:
9382: Checks for a inhibitmenu state and generates output to preserve it
9383:
9384: Inputs: $arg - can be any of
9385: - undef - in which case the return value is a string
9386: to add into arguments list of a uri
9387: - 'input' - in which case the return value is a HTML
9388: <form> <input> field of type hidden to
9389: preserve the value
9390: - a url - in which case the return value is the url with
9391: the neccesary cgi args added to preserve the
9392: inhibitmenu state
9393: - a ref to a url - no return value, but the string is
9394: updated to include the neccessary cgi
9395: args to preserve the inhibitmenu state
9396:
9397: =cut
9398:
9399: sub inhibit_menu_check {
9400: my ($arg) = @_;
9401: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9402: if ($arg eq 'input') {
9403: if ($env{'form.inhibitmenu'}) {
9404: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9405: } else {
9406: return
9407: }
9408: }
9409: if ($env{'form.inhibitmenu'}) {
9410: if (ref($arg)) {
9411: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9412: } elsif ($arg eq '') {
9413: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9414: } else {
9415: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9416: }
9417: }
9418: if (!ref($arg)) {
9419: return $arg;
9420: }
9421: }
9422:
1.251 albertel 9423: ###############################################
1.182 matthew 9424:
9425: =pod
9426:
1.549 albertel 9427: =back
9428:
9429: =head1 User Information Routines
9430:
9431: =over 4
9432:
1.405 albertel 9433: =item * &get_users_function()
1.182 matthew 9434:
9435: Used by &bodytag to determine the current users primary role.
9436: Returns either 'student','coordinator','admin', or 'author'.
9437:
9438: =cut
9439:
9440: ###############################################
9441: sub get_users_function {
1.815 tempelho 9442: my $function = 'norole';
1.818 tempelho 9443: if ($env{'request.role'}=~/^(st)/) {
9444: $function='student';
9445: }
1.907 raeburn 9446: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9447: $function='coordinator';
9448: }
1.258 albertel 9449: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9450: $function='admin';
9451: }
1.826 bisitz 9452: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9453: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9454: $function='author';
9455: }
9456: return $function;
1.54 www 9457: }
1.99 www 9458:
9459: ###############################################
9460:
1.233 raeburn 9461: =pod
9462:
1.821 raeburn 9463: =item * &show_course()
9464:
9465: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9466: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9467:
9468: Inputs:
9469: None
9470:
9471: Outputs:
9472: Scalar: 1 if 'Course' to be used, 0 otherwise.
9473:
9474: =cut
9475:
9476: ###############################################
9477: sub show_course {
9478: my $course = !$env{'user.adv'};
9479: if (!$env{'user.adv'}) {
9480: foreach my $env (keys(%env)) {
9481: next if ($env !~ m/^user\.priv\./);
9482: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9483: $course = 0;
9484: last;
9485: }
9486: }
9487: }
9488: return $course;
9489: }
9490:
9491: ###############################################
9492:
9493: =pod
9494:
1.542 raeburn 9495: =item * &check_user_status()
1.274 raeburn 9496:
9497: Determines current status of supplied role for a
9498: specific user. Roles can be active, previous or future.
9499:
9500: Inputs:
9501: user's domain, user's username, course's domain,
1.375 raeburn 9502: course's number, optional section ID.
1.274 raeburn 9503:
9504: Outputs:
9505: role status: active, previous or future.
9506:
9507: =cut
9508:
9509: sub check_user_status {
1.412 raeburn 9510: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9511: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9512: my @uroles = keys(%userinfo);
1.274 raeburn 9513: my $srchstr;
9514: my $active_chk = 'none';
1.412 raeburn 9515: my $now = time;
1.274 raeburn 9516: if (@uroles > 0) {
1.908 raeburn 9517: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9518: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9519: } else {
1.412 raeburn 9520: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9521: }
9522: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9523: my $role_end = 0;
9524: my $role_start = 0;
9525: $active_chk = 'active';
1.412 raeburn 9526: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9527: $role_end = $1;
9528: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9529: $role_start = $1;
1.274 raeburn 9530: }
9531: }
9532: if ($role_start > 0) {
1.412 raeburn 9533: if ($now < $role_start) {
1.274 raeburn 9534: $active_chk = 'future';
9535: }
9536: }
9537: if ($role_end > 0) {
1.412 raeburn 9538: if ($now > $role_end) {
1.274 raeburn 9539: $active_chk = 'previous';
9540: }
9541: }
9542: }
9543: }
9544: return $active_chk;
9545: }
9546:
9547: ###############################################
9548:
9549: =pod
9550:
1.405 albertel 9551: =item * &get_sections()
1.233 raeburn 9552:
9553: Determines all the sections for a course including
9554: sections with students and sections containing other roles.
1.419 raeburn 9555: Incoming parameters:
9556:
9557: 1. domain
9558: 2. course number
9559: 3. reference to array containing roles for which sections should
9560: be gathered (optional).
9561: 4. reference to array containing status types for which sections
9562: should be gathered (optional).
9563:
9564: If the third argument is undefined, sections are gathered for any role.
9565: If the fourth argument is undefined, sections are gathered for any status.
9566: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9567:
1.374 raeburn 9568: Returns section hash (keys are section IDs, values are
9569: number of users in each section), subject to the
1.419 raeburn 9570: optional roles filter, optional status filter
1.233 raeburn 9571:
9572: =cut
9573:
9574: ###############################################
9575: sub get_sections {
1.419 raeburn 9576: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9577: if (!defined($cdom) || !defined($cnum)) {
9578: my $cid = $env{'request.course.id'};
9579:
9580: return if (!defined($cid));
9581:
9582: $cdom = $env{'course.'.$cid.'.domain'};
9583: $cnum = $env{'course.'.$cid.'.num'};
9584: }
9585:
9586: my %sectioncount;
1.419 raeburn 9587: my $now = time;
1.240 albertel 9588:
1.1118 raeburn 9589: my $check_students = 1;
9590: my $only_students = 0;
9591: if (ref($possible_roles) eq 'ARRAY') {
9592: if (grep(/^st$/,@{$possible_roles})) {
9593: if (@{$possible_roles} == 1) {
9594: $only_students = 1;
9595: }
9596: } else {
9597: $check_students = 0;
9598: }
9599: }
9600:
9601: if ($check_students) {
1.276 albertel 9602: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9603: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9604: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9605: my $start_index = &Apache::loncoursedata::CL_START();
9606: my $end_index = &Apache::loncoursedata::CL_END();
9607: my $status;
1.366 albertel 9608: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9609: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9610: $data->[$status_index],
9611: $data->[$start_index],
9612: $data->[$end_index]);
9613: if ($stu_status eq 'Active') {
9614: $status = 'active';
9615: } elsif ($end < $now) {
9616: $status = 'previous';
9617: } elsif ($start > $now) {
9618: $status = 'future';
9619: }
9620: if ($section ne '-1' && $section !~ /^\s*$/) {
9621: if ((!defined($possible_status)) || (($status ne '') &&
9622: (grep/^\Q$status\E$/,@{$possible_status}))) {
9623: $sectioncount{$section}++;
9624: }
1.240 albertel 9625: }
9626: }
9627: }
1.1118 raeburn 9628: if ($only_students) {
9629: return %sectioncount;
9630: }
1.240 albertel 9631: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9632: foreach my $user (sort(keys(%courseroles))) {
9633: if ($user !~ /^(\w{2})/) { next; }
9634: my ($role) = ($user =~ /^(\w{2})/);
9635: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9636: my ($section,$status);
1.240 albertel 9637: if ($role eq 'cr' &&
9638: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9639: $section=$1;
9640: }
9641: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9642: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9643: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9644: if ($end == -1 && $start == -1) {
9645: next; #deleted role
9646: }
9647: if (!defined($possible_status)) {
9648: $sectioncount{$section}++;
9649: } else {
9650: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9651: $status = 'active';
9652: } elsif ($end < $now) {
9653: $status = 'future';
9654: } elsif ($start > $now) {
9655: $status = 'previous';
9656: }
9657: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9658: $sectioncount{$section}++;
9659: }
9660: }
1.233 raeburn 9661: }
1.366 albertel 9662: return %sectioncount;
1.233 raeburn 9663: }
9664:
1.274 raeburn 9665: ###############################################
1.294 raeburn 9666:
9667: =pod
1.405 albertel 9668:
9669: =item * &get_course_users()
9670:
1.275 raeburn 9671: Retrieves usernames:domains for users in the specified course
9672: with specific role(s), and access status.
9673:
9674: Incoming parameters:
1.277 albertel 9675: 1. course domain
9676: 2. course number
9677: 3. access status: users must have - either active,
1.275 raeburn 9678: previous, future, or all.
1.277 albertel 9679: 4. reference to array of permissible roles
1.288 raeburn 9680: 5. reference to array of section restrictions (optional)
9681: 6. reference to results object (hash of hashes).
9682: 7. reference to optional userdata hash
1.609 raeburn 9683: 8. reference to optional statushash
1.630 raeburn 9684: 9. flag if privileged users (except those set to unhide in
9685: course settings) should be excluded
1.609 raeburn 9686: Keys of top level results hash are roles.
1.275 raeburn 9687: Keys of inner hashes are username:domain, with
9688: values set to access type.
1.288 raeburn 9689: Optional userdata hash returns an array with arguments in the
9690: same order as loncoursedata::get_classlist() for student data.
9691:
1.609 raeburn 9692: Optional statushash returns
9693:
1.288 raeburn 9694: Entries for end, start, section and status are blank because
9695: of the possibility of multiple values for non-student roles.
9696:
1.275 raeburn 9697: =cut
1.405 albertel 9698:
1.275 raeburn 9699: ###############################################
1.405 albertel 9700:
1.275 raeburn 9701: sub get_course_users {
1.630 raeburn 9702: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9703: my %idx = ();
1.419 raeburn 9704: my %seclists;
1.288 raeburn 9705:
9706: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9707: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9708: $idx{end} = &Apache::loncoursedata::CL_END();
9709: $idx{start} = &Apache::loncoursedata::CL_START();
9710: $idx{id} = &Apache::loncoursedata::CL_ID();
9711: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9712: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9713: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9714:
1.290 albertel 9715: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9716: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9717: my $now = time;
1.277 albertel 9718: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9719: my $match = 0;
1.412 raeburn 9720: my $secmatch = 0;
1.419 raeburn 9721: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9722: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9723: if ($section eq '') {
9724: $section = 'none';
9725: }
1.291 albertel 9726: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9727: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9728: $secmatch = 1;
9729: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9730: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9731: $secmatch = 1;
9732: }
9733: } else {
1.419 raeburn 9734: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9735: $secmatch = 1;
9736: }
1.290 albertel 9737: }
1.412 raeburn 9738: if (!$secmatch) {
9739: next;
9740: }
1.419 raeburn 9741: }
1.275 raeburn 9742: if (defined($$types{'active'})) {
1.288 raeburn 9743: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9744: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9745: $match = 1;
1.275 raeburn 9746: }
9747: }
9748: if (defined($$types{'previous'})) {
1.609 raeburn 9749: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9750: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9751: $match = 1;
1.275 raeburn 9752: }
9753: }
9754: if (defined($$types{'future'})) {
1.609 raeburn 9755: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9756: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9757: $match = 1;
1.275 raeburn 9758: }
9759: }
1.609 raeburn 9760: if ($match) {
9761: push(@{$seclists{$student}},$section);
9762: if (ref($userdata) eq 'HASH') {
9763: $$userdata{$student} = $$classlist{$student};
9764: }
9765: if (ref($statushash) eq 'HASH') {
9766: $statushash->{$student}{'st'}{$section} = $status;
9767: }
1.288 raeburn 9768: }
1.275 raeburn 9769: }
9770: }
1.412 raeburn 9771: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9772: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9773: my $now = time;
1.609 raeburn 9774: my %displaystatus = ( previous => 'Expired',
9775: active => 'Active',
9776: future => 'Future',
9777: );
1.1121 raeburn 9778: my (%nothide,@possdoms);
1.630 raeburn 9779: if ($hidepriv) {
9780: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9781: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9782: if ($user !~ /:/) {
9783: $nothide{join(':',split(/[\@]/,$user))}=1;
9784: } else {
9785: $nothide{$user} = 1;
9786: }
9787: }
1.1121 raeburn 9788: my @possdoms = ($cdom);
9789: if ($coursehash{'checkforpriv'}) {
9790: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9791: }
1.630 raeburn 9792: }
1.439 raeburn 9793: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9794: my $match = 0;
1.412 raeburn 9795: my $secmatch = 0;
1.439 raeburn 9796: my $status;
1.412 raeburn 9797: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9798: $user =~ s/:$//;
1.439 raeburn 9799: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9800: if ($end == -1 || $start == -1) {
9801: next;
9802: }
9803: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9804: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9805: my ($uname,$udom) = split(/:/,$user);
9806: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9807: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9808: $secmatch = 1;
9809: } elsif ($usec eq '') {
1.420 albertel 9810: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9811: $secmatch = 1;
9812: }
9813: } else {
9814: if (grep(/^\Q$usec\E$/,@{$sections})) {
9815: $secmatch = 1;
9816: }
9817: }
9818: if (!$secmatch) {
9819: next;
9820: }
1.288 raeburn 9821: }
1.419 raeburn 9822: if ($usec eq '') {
9823: $usec = 'none';
9824: }
1.275 raeburn 9825: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9826: if ($hidepriv) {
1.1121 raeburn 9827: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9828: (!$nothide{$uname.':'.$udom})) {
9829: next;
9830: }
9831: }
1.503 raeburn 9832: if ($end > 0 && $end < $now) {
1.439 raeburn 9833: $status = 'previous';
9834: } elsif ($start > $now) {
9835: $status = 'future';
9836: } else {
9837: $status = 'active';
9838: }
1.277 albertel 9839: foreach my $type (keys(%{$types})) {
1.275 raeburn 9840: if ($status eq $type) {
1.420 albertel 9841: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9842: push(@{$$users{$role}{$user}},$type);
9843: }
1.288 raeburn 9844: $match = 1;
9845: }
9846: }
1.419 raeburn 9847: if (($match) && (ref($userdata) eq 'HASH')) {
9848: if (!exists($$userdata{$uname.':'.$udom})) {
9849: &get_user_info($udom,$uname,\%idx,$userdata);
9850: }
1.420 albertel 9851: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9852: push(@{$seclists{$uname.':'.$udom}},$usec);
9853: }
1.609 raeburn 9854: if (ref($statushash) eq 'HASH') {
9855: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9856: }
1.275 raeburn 9857: }
9858: }
9859: }
9860: }
1.290 albertel 9861: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9862: if ((defined($cdom)) && (defined($cnum))) {
9863: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9864: if ( defined($csettings{'internal.courseowner'}) ) {
9865: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9866: next if ($owner eq '');
9867: my ($ownername,$ownerdom);
9868: if ($owner =~ /^([^:]+):([^:]+)$/) {
9869: $ownername = $1;
9870: $ownerdom = $2;
9871: } else {
9872: $ownername = $owner;
9873: $ownerdom = $cdom;
9874: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9875: }
9876: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9877: if (defined($userdata) &&
1.609 raeburn 9878: !exists($$userdata{$owner})) {
9879: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9880: if (!grep(/^none$/,@{$seclists{$owner}})) {
9881: push(@{$seclists{$owner}},'none');
9882: }
9883: if (ref($statushash) eq 'HASH') {
9884: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9885: }
1.290 albertel 9886: }
1.279 raeburn 9887: }
9888: }
9889: }
1.419 raeburn 9890: foreach my $user (keys(%seclists)) {
9891: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9892: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9893: }
1.275 raeburn 9894: }
9895: return;
9896: }
9897:
1.288 raeburn 9898: sub get_user_info {
9899: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9900: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9901: &plainname($uname,$udom,'lastname');
1.291 albertel 9902: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9903: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9904: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9905: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9906: return;
9907: }
1.275 raeburn 9908:
1.472 raeburn 9909: ###############################################
9910:
9911: =pod
9912:
9913: =item * &get_user_quota()
9914:
1.1134 raeburn 9915: Retrieves quota assigned for storage of user files.
9916: Default is to report quota for portfolio files.
1.472 raeburn 9917:
9918: Incoming parameters:
9919: 1. user's username
9920: 2. user's domain
1.1134 raeburn 9921: 3. quota name - portfolio, author, or course
1.1136 raeburn 9922: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9923: 4. crstype - official, unofficial, textbook, placement or community,
9924: if quota name is course
1.472 raeburn 9925:
9926: Returns:
1.1163 raeburn 9927: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9928: 2. (Optional) Type of setting: custom or default
9929: (individually assigned or default for user's
9930: institutional status).
9931: 3. (Optional) - User's institutional status (e.g., faculty, staff
9932: or student - types as defined in localenroll::inst_usertypes
9933: for user's domain, which determines default quota for user.
9934: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9935:
9936: If a value has been stored in the user's environment,
1.536 raeburn 9937: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9938: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9939:
9940: =cut
9941:
9942: ###############################################
9943:
9944:
9945: sub get_user_quota {
1.1136 raeburn 9946: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9947: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9948: if (!defined($udom)) {
9949: $udom = $env{'user.domain'};
9950: }
9951: if (!defined($uname)) {
9952: $uname = $env{'user.name'};
9953: }
9954: if (($udom eq '' || $uname eq '') ||
9955: ($udom eq 'public') && ($uname eq 'public')) {
9956: $quota = 0;
1.536 raeburn 9957: $quotatype = 'default';
9958: $defquota = 0;
1.472 raeburn 9959: } else {
1.536 raeburn 9960: my $inststatus;
1.1134 raeburn 9961: if ($quotaname eq 'course') {
9962: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9963: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9964: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9965: } else {
9966: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9967: $quota = $cenv{'internal.uploadquota'};
9968: }
1.536 raeburn 9969: } else {
1.1134 raeburn 9970: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9971: if ($quotaname eq 'author') {
9972: $quota = $env{'environment.authorquota'};
9973: } else {
9974: $quota = $env{'environment.portfolioquota'};
9975: }
9976: $inststatus = $env{'environment.inststatus'};
9977: } else {
9978: my %userenv =
9979: &Apache::lonnet::get('environment',['portfolioquota',
9980: 'authorquota','inststatus'],$udom,$uname);
9981: my ($tmp) = keys(%userenv);
9982: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9983: if ($quotaname eq 'author') {
9984: $quota = $userenv{'authorquota'};
9985: } else {
9986: $quota = $userenv{'portfolioquota'};
9987: }
9988: $inststatus = $userenv{'inststatus'};
9989: } else {
9990: undef(%userenv);
9991: }
9992: }
9993: }
9994: if ($quota eq '' || wantarray) {
9995: if ($quotaname eq 'course') {
9996: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9997: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9998: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9999: ($crstype eq 'placement')) {
1.1136 raeburn 10000: $defquota = $domdefs{$crstype.'quota'};
10001: }
10002: if ($defquota eq '') {
10003: $defquota = 500;
10004: }
1.1134 raeburn 10005: } else {
10006: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10007: }
10008: if ($quota eq '') {
10009: $quota = $defquota;
10010: $quotatype = 'default';
10011: } else {
10012: $quotatype = 'custom';
10013: }
1.472 raeburn 10014: }
10015: }
1.536 raeburn 10016: if (wantarray) {
10017: return ($quota,$quotatype,$settingstatus,$defquota);
10018: } else {
10019: return $quota;
10020: }
1.472 raeburn 10021: }
10022:
10023: ###############################################
10024:
10025: =pod
10026:
10027: =item * &default_quota()
10028:
1.536 raeburn 10029: Retrieves default quota assigned for storage of user portfolio files,
10030: given an (optional) user's institutional status.
1.472 raeburn 10031:
10032: Incoming parameters:
1.1142 raeburn 10033:
1.472 raeburn 10034: 1. domain
1.536 raeburn 10035: 2. (Optional) institutional status(es). This is a : separated list of
10036: status types (e.g., faculty, staff, student etc.)
10037: which apply to the user for whom the default is being retrieved.
10038: If the institutional status string in undefined, the domain
1.1134 raeburn 10039: default quota will be returned.
10040: 3. quota name - portfolio, author, or course
10041: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10042:
10043: Returns:
1.1142 raeburn 10044:
1.1163 raeburn 10045: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10046: 2. (Optional) institutional type which determined the value of the
10047: default quota.
1.472 raeburn 10048:
10049: If a value has been stored in the domain's configuration db,
10050: it will return that, otherwise it returns 20 (for backwards
10051: compatibility with domains which have not set up a configuration
1.1163 raeburn 10052: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10053:
1.536 raeburn 10054: If the user's status includes multiple types (e.g., staff and student),
10055: the largest default quota which applies to the user determines the
10056: default quota returned.
10057:
1.472 raeburn 10058: =cut
10059:
10060: ###############################################
10061:
10062:
10063: sub default_quota {
1.1134 raeburn 10064: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10065: my ($defquota,$settingstatus);
10066: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10067: ['quotas'],$udom);
1.1134 raeburn 10068: my $key = 'defaultquota';
10069: if ($quotaname eq 'author') {
10070: $key = 'authorquota';
10071: }
1.622 raeburn 10072: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10073: if ($inststatus ne '') {
1.765 raeburn 10074: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10075: foreach my $item (@statuses) {
1.1134 raeburn 10076: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10077: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10078: if ($defquota eq '') {
1.1134 raeburn 10079: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10080: $settingstatus = $item;
1.1134 raeburn 10081: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10082: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10083: $settingstatus = $item;
10084: }
10085: }
1.1134 raeburn 10086: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10087: if ($quotahash{'quotas'}{$item} ne '') {
10088: if ($defquota eq '') {
10089: $defquota = $quotahash{'quotas'}{$item};
10090: $settingstatus = $item;
10091: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10092: $defquota = $quotahash{'quotas'}{$item};
10093: $settingstatus = $item;
10094: }
1.536 raeburn 10095: }
10096: }
10097: }
10098: }
10099: if ($defquota eq '') {
1.1134 raeburn 10100: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10101: $defquota = $quotahash{'quotas'}{$key}{'default'};
10102: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10103: $defquota = $quotahash{'quotas'}{'default'};
10104: }
1.536 raeburn 10105: $settingstatus = 'default';
1.1139 raeburn 10106: if ($defquota eq '') {
10107: if ($quotaname eq 'author') {
10108: $defquota = 500;
10109: }
10110: }
1.536 raeburn 10111: }
10112: } else {
10113: $settingstatus = 'default';
1.1134 raeburn 10114: if ($quotaname eq 'author') {
10115: $defquota = 500;
10116: } else {
10117: $defquota = 20;
10118: }
1.536 raeburn 10119: }
10120: if (wantarray) {
10121: return ($defquota,$settingstatus);
1.472 raeburn 10122: } else {
1.536 raeburn 10123: return $defquota;
1.472 raeburn 10124: }
10125: }
10126:
1.1135 raeburn 10127: ###############################################
10128:
10129: =pod
10130:
1.1136 raeburn 10131: =item * &excess_filesize_warning()
1.1135 raeburn 10132:
10133: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10134: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10135: space to be exceeded.
1.1136 raeburn 10136:
10137: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 10138: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10139:
1.1165 raeburn 10140: Inputs: 7
1.1136 raeburn 10141: 1. username or coursenum
1.1135 raeburn 10142: 2. domain
1.1136 raeburn 10143: 3. context ('author' or 'course')
1.1135 raeburn 10144: 4. filename of file for which action is being requested
10145: 5. filesize (kB) of file
10146: 6. action being taken: copy or upload.
1.1237 raeburn 10147: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10148:
10149: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10150: otherwise return null.
10151:
10152: =back
1.1135 raeburn 10153:
10154: =cut
10155:
1.1136 raeburn 10156: sub excess_filesize_warning {
1.1165 raeburn 10157: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10158: my $current_disk_usage = 0;
1.1165 raeburn 10159: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10160: if ($context eq 'author') {
10161: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10162: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10163: } else {
10164: foreach my $subdir ('docs','supplemental') {
10165: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10166: }
10167: }
1.1135 raeburn 10168: $disk_quota = int($disk_quota * 1000);
10169: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10170: return '<p class="LC_warning">'.
1.1135 raeburn 10171: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10172: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10173: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10174: $disk_quota,$current_disk_usage).
10175: '</p>';
10176: }
10177: return;
10178: }
10179:
10180: ###############################################
10181:
10182:
1.1136 raeburn 10183:
10184:
1.384 raeburn 10185: sub get_secgrprole_info {
10186: my ($cdom,$cnum,$needroles,$type) = @_;
10187: my %sections_count = &get_sections($cdom,$cnum);
10188: my @sections = (sort {$a <=> $b} keys(%sections_count));
10189: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10190: my @groups = sort(keys(%curr_groups));
10191: my $allroles = [];
10192: my $rolehash;
10193: my $accesshash = {
10194: active => 'Currently has access',
10195: future => 'Will have future access',
10196: previous => 'Previously had access',
10197: };
10198: if ($needroles) {
10199: $rolehash = {'all' => 'all'};
1.385 albertel 10200: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10201: if (&Apache::lonnet::error(%user_roles)) {
10202: undef(%user_roles);
10203: }
10204: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10205: my ($role)=split(/\:/,$item,2);
10206: if ($role eq 'cr') { next; }
10207: if ($role =~ /^cr/) {
10208: $$rolehash{$role} = (split('/',$role))[3];
10209: } else {
10210: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10211: }
10212: }
10213: foreach my $key (sort(keys(%{$rolehash}))) {
10214: push(@{$allroles},$key);
10215: }
10216: push (@{$allroles},'st');
10217: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10218: }
10219: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10220: }
10221:
1.555 raeburn 10222: sub user_picker {
1.1279 raeburn 10223: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10224: my $currdom = $dom;
1.1253 raeburn 10225: my @alldoms = &Apache::lonnet::all_domains();
10226: if (@alldoms == 1) {
10227: my %domsrch = &Apache::lonnet::get_dom('configuration',
10228: ['directorysrch'],$alldoms[0]);
10229: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10230: my $showdom = $domdesc;
10231: if ($showdom eq '') {
10232: $showdom = $dom;
10233: }
10234: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10235: if ((!$domsrch{'directorysrch'}{'available'}) &&
10236: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10237: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10238: }
10239: }
10240: }
1.555 raeburn 10241: my %curr_selected = (
10242: srchin => 'dom',
1.580 raeburn 10243: srchby => 'lastname',
1.555 raeburn 10244: );
10245: my $srchterm;
1.625 raeburn 10246: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10247: if ($srch->{'srchby'} ne '') {
10248: $curr_selected{'srchby'} = $srch->{'srchby'};
10249: }
10250: if ($srch->{'srchin'} ne '') {
10251: $curr_selected{'srchin'} = $srch->{'srchin'};
10252: }
10253: if ($srch->{'srchtype'} ne '') {
10254: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10255: }
10256: if ($srch->{'srchdomain'} ne '') {
10257: $currdom = $srch->{'srchdomain'};
10258: }
10259: $srchterm = $srch->{'srchterm'};
10260: }
1.1222 damieng 10261: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10262: 'usr' => 'Search criteria',
1.563 raeburn 10263: 'doma' => 'Domain/institution to search',
1.558 albertel 10264: 'uname' => 'username',
10265: 'lastname' => 'last name',
1.555 raeburn 10266: 'lastfirst' => 'last name, first name',
1.558 albertel 10267: 'crs' => 'in this course',
1.576 raeburn 10268: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10269: 'alc' => 'all LON-CAPA',
1.573 raeburn 10270: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10271: 'exact' => 'is',
10272: 'contains' => 'contains',
1.569 raeburn 10273: 'begins' => 'begins with',
1.1222 damieng 10274: );
10275: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10276: 'youm' => "You must include some text to search for.",
10277: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10278: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10279: 'yomc' => "You must choose a domain when using an institutional directory search.",
10280: 'ymcd' => "You must choose a domain when using a domain search.",
10281: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10282: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10283: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10284: );
1.1222 damieng 10285: &html_escape(\%html_lt);
10286: &js_escape(\%js_lt);
1.1255 raeburn 10287: my $domform;
1.1277 raeburn 10288: my $allow_blank = 1;
1.1255 raeburn 10289: if ($fixeddom) {
1.1277 raeburn 10290: $allow_blank = 0;
10291: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 10292: } else {
1.1287 raeburn 10293: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 10294: my ($trusted,$untrusted);
1.1287 raeburn 10295: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 10296: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 10297: } elsif ($context eq 'author') {
1.1288 raeburn 10298: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 10299: } elsif ($context eq 'domain') {
1.1288 raeburn 10300: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 10301: }
1.1288 raeburn 10302: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 10303: }
1.563 raeburn 10304: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10305:
10306: my @srchins = ('crs','dom','alc','instd');
10307:
10308: foreach my $option (@srchins) {
10309: # FIXME 'alc' option unavailable until
10310: # loncreateuser::print_user_query_page()
10311: # has been completed.
10312: next if ($option eq 'alc');
1.880 raeburn 10313: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10314: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 10315: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10316: if ($curr_selected{'srchin'} eq $option) {
10317: $srchinsel .= '
1.1222 damieng 10318: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10319: } else {
10320: $srchinsel .= '
1.1222 damieng 10321: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10322: }
1.555 raeburn 10323: }
1.563 raeburn 10324: $srchinsel .= "\n </select>\n";
1.555 raeburn 10325:
10326: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10327: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10328: if ($curr_selected{'srchby'} eq $option) {
10329: $srchbysel .= '
1.1222 damieng 10330: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10331: } else {
10332: $srchbysel .= '
1.1222 damieng 10333: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10334: }
10335: }
10336: $srchbysel .= "\n </select>\n";
10337:
10338: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10339: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10340: if ($curr_selected{'srchtype'} eq $option) {
10341: $srchtypesel .= '
1.1222 damieng 10342: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10343: } else {
10344: $srchtypesel .= '
1.1222 damieng 10345: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10346: }
10347: }
10348: $srchtypesel .= "\n </select>\n";
10349:
1.558 albertel 10350: my ($newuserscript,$new_user_create);
1.994 raeburn 10351: my $context_dom = $env{'request.role.domain'};
10352: if ($context eq 'requestcrs') {
10353: if ($env{'form.coursedom'} ne '') {
10354: $context_dom = $env{'form.coursedom'};
10355: }
10356: }
1.556 raeburn 10357: if ($forcenewuser) {
1.576 raeburn 10358: if (ref($srch) eq 'HASH') {
1.994 raeburn 10359: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10360: if ($cancreate) {
10361: $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>';
10362: } else {
1.799 bisitz 10363: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10364: my %usertypetext = (
10365: official => 'institutional',
10366: unofficial => 'non-institutional',
10367: );
1.799 bisitz 10368: $new_user_create = '<p class="LC_warning">'
10369: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10370: .' '
10371: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10372: ,'<a href="'.$helplink.'">','</a>')
10373: .'</p><br />';
1.627 raeburn 10374: }
1.576 raeburn 10375: }
10376: }
10377:
1.556 raeburn 10378: $newuserscript = <<"ENDSCRIPT";
10379:
1.570 raeburn 10380: function setSearch(createnew,callingForm) {
1.556 raeburn 10381: if (createnew == 1) {
1.570 raeburn 10382: for (var i=0; i<callingForm.srchby.length; i++) {
10383: if (callingForm.srchby.options[i].value == 'uname') {
10384: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10385: }
10386: }
1.570 raeburn 10387: for (var i=0; i<callingForm.srchin.length; i++) {
10388: if ( callingForm.srchin.options[i].value == 'dom') {
10389: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10390: }
10391: }
1.570 raeburn 10392: for (var i=0; i<callingForm.srchtype.length; i++) {
10393: if (callingForm.srchtype.options[i].value == 'exact') {
10394: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10395: }
10396: }
1.570 raeburn 10397: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10398: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10399: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10400: }
10401: }
10402: }
10403: }
10404: ENDSCRIPT
1.558 albertel 10405:
1.556 raeburn 10406: }
10407:
1.555 raeburn 10408: my $output = <<"END_BLOCK";
1.556 raeburn 10409: <script type="text/javascript">
1.824 bisitz 10410: // <![CDATA[
1.570 raeburn 10411: function validateEntry(callingForm) {
1.558 albertel 10412:
1.556 raeburn 10413: var checkok = 1;
1.558 albertel 10414: var srchin;
1.570 raeburn 10415: for (var i=0; i<callingForm.srchin.length; i++) {
10416: if ( callingForm.srchin[i].checked ) {
10417: srchin = callingForm.srchin[i].value;
1.558 albertel 10418: }
10419: }
10420:
1.570 raeburn 10421: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10422: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10423: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10424: var srchterm = callingForm.srchterm.value;
10425: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10426: var msg = "";
10427:
10428: if (srchterm == "") {
10429: checkok = 0;
1.1222 damieng 10430: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10431: }
10432:
1.569 raeburn 10433: if (srchtype== 'begins') {
10434: if (srchterm.length < 2) {
10435: checkok = 0;
1.1222 damieng 10436: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10437: }
10438: }
10439:
1.556 raeburn 10440: if (srchtype== 'contains') {
10441: if (srchterm.length < 3) {
10442: checkok = 0;
1.1222 damieng 10443: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10444: }
10445: }
10446: if (srchin == 'instd') {
10447: if (srchdomain == '') {
10448: checkok = 0;
1.1222 damieng 10449: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10450: }
10451: }
10452: if (srchin == 'dom') {
10453: if (srchdomain == '') {
10454: checkok = 0;
1.1222 damieng 10455: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10456: }
10457: }
10458: if (srchby == 'lastfirst') {
10459: if (srchterm.indexOf(",") == -1) {
10460: checkok = 0;
1.1222 damieng 10461: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10462: }
10463: if (srchterm.indexOf(",") == srchterm.length -1) {
10464: checkok = 0;
1.1222 damieng 10465: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10466: }
10467: }
10468: if (checkok == 0) {
1.1222 damieng 10469: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10470: return;
10471: }
10472: if (checkok == 1) {
1.570 raeburn 10473: callingForm.submit();
1.556 raeburn 10474: }
10475: }
10476:
10477: $newuserscript
10478:
1.824 bisitz 10479: // ]]>
1.556 raeburn 10480: </script>
1.558 albertel 10481:
10482: $new_user_create
10483:
1.555 raeburn 10484: END_BLOCK
1.558 albertel 10485:
1.876 raeburn 10486: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10487: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10488: $domform.
10489: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10490: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10491: $srchbysel.
10492: $srchtypesel.
10493: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10494: $srchinsel.
10495: &Apache::lonhtmlcommon::row_closure(1).
10496: &Apache::lonhtmlcommon::end_pick_box().
10497: '<br />';
1.1253 raeburn 10498: return ($output,1);
1.555 raeburn 10499: }
10500:
1.612 raeburn 10501: sub user_rule_check {
1.615 raeburn 10502: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10503: my ($response,%inst_response);
1.612 raeburn 10504: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10505: if (keys(%{$usershash}) > 1) {
10506: my (%by_username,%by_id,%userdoms);
10507: my $checkid;
10508: if (ref($checks) eq 'HASH') {
10509: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10510: $checkid = 1;
10511: }
10512: }
10513: foreach my $user (keys(%{$usershash})) {
10514: my ($uname,$udom) = split(/:/,$user);
10515: if ($checkid) {
10516: if (ref($usershash->{$user}) eq 'HASH') {
10517: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10518: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10519: $userdoms{$udom} = 1;
1.1227 raeburn 10520: if (ref($inst_results) eq 'HASH') {
10521: $inst_results->{$uname.':'.$udom} = {};
10522: }
1.1226 raeburn 10523: }
10524: }
10525: } else {
10526: $by_username{$udom}{$uname} = 1;
10527: $userdoms{$udom} = 1;
1.1227 raeburn 10528: if (ref($inst_results) eq 'HASH') {
10529: $inst_results->{$uname.':'.$udom} = {};
10530: }
1.1226 raeburn 10531: }
10532: }
10533: foreach my $udom (keys(%userdoms)) {
10534: if (!$got_rules->{$udom}) {
10535: my %domconfig = &Apache::lonnet::get_dom('configuration',
10536: ['usercreation'],$udom);
10537: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10538: foreach my $item ('username','id') {
10539: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10540: $$curr_rules{$udom}{$item} =
10541: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10542: }
10543: }
10544: }
10545: $got_rules->{$udom} = 1;
10546: }
1.612 raeburn 10547: }
1.1226 raeburn 10548: if ($checkid) {
10549: foreach my $udom (keys(%by_id)) {
10550: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10551: if ($outcome eq 'ok') {
1.1227 raeburn 10552: foreach my $id (keys(%{$by_id{$udom}})) {
10553: my $uname = $by_id{$udom}{$id};
10554: $inst_response{$uname.':'.$udom} = $outcome;
10555: }
1.1226 raeburn 10556: if (ref($results) eq 'HASH') {
10557: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10558: if (exists($inst_response{$uname.':'.$udom})) {
10559: $inst_response{$uname.':'.$udom} = $outcome;
10560: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10561: }
1.1226 raeburn 10562: }
10563: }
10564: }
1.612 raeburn 10565: }
1.615 raeburn 10566: } else {
1.1226 raeburn 10567: foreach my $udom (keys(%by_username)) {
10568: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10569: if ($outcome eq 'ok') {
1.1227 raeburn 10570: foreach my $uname (keys(%{$by_username{$udom}})) {
10571: $inst_response{$uname.':'.$udom} = $outcome;
10572: }
1.1226 raeburn 10573: if (ref($results) eq 'HASH') {
10574: foreach my $uname (keys(%{$results})) {
10575: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10576: }
10577: }
10578: }
10579: }
1.612 raeburn 10580: }
1.1226 raeburn 10581: } elsif (keys(%{$usershash}) == 1) {
10582: my $user = (keys(%{$usershash}))[0];
10583: my ($uname,$udom) = split(/:/,$user);
10584: if (($udom ne '') && ($uname ne '')) {
10585: if (ref($usershash->{$user}) eq 'HASH') {
10586: if (ref($checks) eq 'HASH') {
10587: if (defined($checks->{'username'})) {
10588: ($inst_response{$user},%{$inst_results->{$user}}) =
10589: &Apache::lonnet::get_instuser($udom,$uname);
10590: } elsif (defined($checks->{'id'})) {
10591: if ($usershash->{$user}->{'id'} ne '') {
10592: ($inst_response{$user},%{$inst_results->{$user}}) =
10593: &Apache::lonnet::get_instuser($udom,undef,
10594: $usershash->{$user}->{'id'});
10595: } else {
10596: ($inst_response{$user},%{$inst_results->{$user}}) =
10597: &Apache::lonnet::get_instuser($udom,$uname);
10598: }
1.585 raeburn 10599: }
1.1226 raeburn 10600: } else {
10601: ($inst_response{$user},%{$inst_results->{$user}}) =
10602: &Apache::lonnet::get_instuser($udom,$uname);
10603: return;
10604: }
10605: if (!$got_rules->{$udom}) {
10606: my %domconfig = &Apache::lonnet::get_dom('configuration',
10607: ['usercreation'],$udom);
10608: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10609: foreach my $item ('username','id') {
10610: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10611: $$curr_rules{$udom}{$item} =
10612: $domconfig{'usercreation'}{$item.'_rule'};
10613: }
10614: }
10615: }
10616: $got_rules->{$udom} = 1;
1.585 raeburn 10617: }
10618: }
1.1226 raeburn 10619: } else {
10620: return;
10621: }
10622: } else {
10623: return;
10624: }
10625: foreach my $user (keys(%{$usershash})) {
10626: my ($uname,$udom) = split(/:/,$user);
10627: next if (($udom eq '') || ($uname eq ''));
10628: my $id;
1.1227 raeburn 10629: if (ref($inst_results) eq 'HASH') {
10630: if (ref($inst_results->{$user}) eq 'HASH') {
10631: $id = $inst_results->{$user}->{'id'};
10632: }
10633: }
10634: if ($id eq '') {
10635: if (ref($usershash->{$user})) {
10636: $id = $usershash->{$user}->{'id'};
10637: }
1.585 raeburn 10638: }
1.612 raeburn 10639: foreach my $item (keys(%{$checks})) {
10640: if (ref($$curr_rules{$udom}) eq 'HASH') {
10641: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10642: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10643: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10644: $$curr_rules{$udom}{$item});
1.612 raeburn 10645: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10646: if ($rule_check{$rule}) {
10647: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10648: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10649: if (ref($inst_results) eq 'HASH') {
10650: if (ref($inst_results->{$user}) eq 'HASH') {
10651: if (keys(%{$inst_results->{$user}}) == 0) {
10652: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10653: } elsif ($item eq 'id') {
10654: if ($inst_results->{$user}->{'id'} eq '') {
10655: $$alerts{$item}{$udom}{$uname} = 1;
10656: }
1.615 raeburn 10657: }
1.612 raeburn 10658: }
10659: }
1.615 raeburn 10660: }
10661: last;
1.585 raeburn 10662: }
10663: }
10664: }
10665: }
10666: }
10667: }
10668: }
10669: }
1.612 raeburn 10670: return;
10671: }
10672:
10673: sub user_rule_formats {
10674: my ($domain,$domdesc,$curr_rules,$check) = @_;
10675: my %text = (
10676: 'username' => 'Usernames',
10677: 'id' => 'IDs',
10678: );
10679: my $output;
10680: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10681: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10682: if (@{$ruleorder} > 0) {
1.1102 raeburn 10683: $output = '<br />'.
10684: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10685: '<span class="LC_cusr_emph">','</span>',$domdesc).
10686: ' <ul>';
1.612 raeburn 10687: foreach my $rule (@{$ruleorder}) {
10688: if (ref($curr_rules) eq 'ARRAY') {
10689: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10690: if (ref($rules->{$rule}) eq 'HASH') {
10691: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10692: $rules->{$rule}{'desc'}.'</li>';
10693: }
10694: }
10695: }
10696: }
10697: $output .= '</ul>';
10698: }
10699: }
10700: return $output;
10701: }
10702:
10703: sub instrule_disallow_msg {
1.615 raeburn 10704: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10705: my $response;
10706: my %text = (
10707: item => 'username',
10708: items => 'usernames',
10709: match => 'matches',
10710: do => 'does',
10711: action => 'a username',
10712: one => 'one',
10713: );
10714: if ($count > 1) {
10715: $text{'item'} = 'usernames';
10716: $text{'match'} ='match';
10717: $text{'do'} = 'do';
10718: $text{'action'} = 'usernames',
10719: $text{'one'} = 'ones';
10720: }
10721: if ($checkitem eq 'id') {
10722: $text{'items'} = 'IDs';
10723: $text{'item'} = 'ID';
10724: $text{'action'} = 'an ID';
1.615 raeburn 10725: if ($count > 1) {
10726: $text{'item'} = 'IDs';
10727: $text{'action'} = 'IDs';
10728: }
1.612 raeburn 10729: }
1.674 bisitz 10730: $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 10731: if ($mode eq 'upload') {
10732: if ($checkitem eq 'username') {
10733: $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'}.");
10734: } elsif ($checkitem eq 'id') {
1.674 bisitz 10735: $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 10736: }
1.669 raeburn 10737: } elsif ($mode eq 'selfcreate') {
10738: if ($checkitem eq 'id') {
10739: $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.");
10740: }
1.615 raeburn 10741: } else {
10742: if ($checkitem eq 'username') {
10743: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10744: } elsif ($checkitem eq 'id') {
10745: $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.");
10746: }
1.612 raeburn 10747: }
10748: return $response;
1.585 raeburn 10749: }
10750:
1.624 raeburn 10751: sub personal_data_fieldtitles {
10752: my %fieldtitles = &Apache::lonlocal::texthash (
10753: id => 'Student/Employee ID',
10754: permanentemail => 'E-mail address',
10755: lastname => 'Last Name',
10756: firstname => 'First Name',
10757: middlename => 'Middle Name',
10758: generation => 'Generation',
10759: gen => 'Generation',
1.765 raeburn 10760: inststatus => 'Affiliation',
1.624 raeburn 10761: );
10762: return %fieldtitles;
10763: }
10764:
1.642 raeburn 10765: sub sorted_inst_types {
10766: my ($dom) = @_;
1.1185 raeburn 10767: my ($usertypes,$order);
10768: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10769: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10770: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10771: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10772: } else {
10773: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10774: }
1.642 raeburn 10775: my $othertitle = &mt('All users');
10776: if ($env{'request.course.id'}) {
1.668 raeburn 10777: $othertitle = &mt('Any users');
1.642 raeburn 10778: }
10779: my @types;
10780: if (ref($order) eq 'ARRAY') {
10781: @types = @{$order};
10782: }
10783: if (@types == 0) {
10784: if (ref($usertypes) eq 'HASH') {
10785: @types = sort(keys(%{$usertypes}));
10786: }
10787: }
10788: if (keys(%{$usertypes}) > 0) {
10789: $othertitle = &mt('Other users');
10790: }
10791: return ($othertitle,$usertypes,\@types);
10792: }
10793:
1.645 raeburn 10794: sub get_institutional_codes {
10795: my ($settings,$allcourses,$LC_code) = @_;
10796: # Get complete list of course sections to update
10797: my @currsections = ();
10798: my @currxlists = ();
10799: my $coursecode = $$settings{'internal.coursecode'};
10800:
10801: if ($$settings{'internal.sectionnums'} ne '') {
10802: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10803: }
10804:
10805: if ($$settings{'internal.crosslistings'} ne '') {
10806: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10807: }
10808:
10809: if (@currxlists > 0) {
10810: foreach (@currxlists) {
10811: if (m/^([^:]+):(\w*)$/) {
10812: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 10813: push(@{$allcourses},$1);
1.645 raeburn 10814: $$LC_code{$1} = $2;
10815: }
10816: }
10817: }
10818: }
10819:
10820: if (@currsections > 0) {
10821: foreach (@currsections) {
10822: if (m/^(\w+):(\w*)$/) {
10823: my $sec = $coursecode.$1;
10824: my $lc_sec = $2;
10825: unless (grep/^$sec$/,@{$allcourses}) {
1.1263 raeburn 10826: push(@{$allcourses},$sec);
1.645 raeburn 10827: $$LC_code{$sec} = $lc_sec;
10828: }
10829: }
10830: }
10831: }
10832: return;
10833: }
10834:
1.971 raeburn 10835: sub get_standard_codeitems {
10836: return ('Year','Semester','Department','Number','Section');
10837: }
10838:
1.112 bowersj2 10839: =pod
10840:
1.780 raeburn 10841: =head1 Slot Helpers
10842:
10843: =over 4
10844:
10845: =item * sorted_slots()
10846:
1.1040 raeburn 10847: Sorts an array of slot names in order of an optional sort key,
10848: default sort is by slot start time (earliest first).
1.780 raeburn 10849:
10850: Inputs:
10851:
10852: =over 4
10853:
10854: slotsarr - Reference to array of unsorted slot names.
10855:
10856: slots - Reference to hash of hash, where outer hash keys are slot names.
10857:
1.1040 raeburn 10858: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10859:
1.549 albertel 10860: =back
10861:
1.780 raeburn 10862: Returns:
10863:
10864: =over 4
10865:
1.1040 raeburn 10866: sorted - An array of slot names sorted by a specified sort key
10867: (default sort key is start time of the slot).
1.780 raeburn 10868:
10869: =back
10870:
10871: =cut
10872:
10873:
10874: sub sorted_slots {
1.1040 raeburn 10875: my ($slotsarr,$slots,$sortkey) = @_;
10876: if ($sortkey eq '') {
10877: $sortkey = 'starttime';
10878: }
1.780 raeburn 10879: my @sorted;
10880: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10881: @sorted =
10882: sort {
10883: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10884: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10885: }
10886: if (ref($slots->{$a})) { return -1;}
10887: if (ref($slots->{$b})) { return 1;}
10888: return 0;
10889: } @{$slotsarr};
10890: }
10891: return @sorted;
10892: }
10893:
1.1040 raeburn 10894: =pod
10895:
10896: =item * get_future_slots()
10897:
10898: Inputs:
10899:
10900: =over 4
10901:
10902: cnum - course number
10903:
10904: cdom - course domain
10905:
10906: now - current UNIX time
10907:
10908: symb - optional symb
10909:
10910: =back
10911:
10912: Returns:
10913:
10914: =over 4
10915:
10916: sorted_reservable - ref to array of student_schedulable slots currently
10917: reservable, ordered by end date of reservation period.
10918:
10919: reservable_now - ref to hash of student_schedulable slots currently
10920: reservable.
10921:
10922: Keys in inner hash are:
10923: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10924: (b) endreserve: end date of reservation period.
10925: (c) uniqueperiod: start,end dates when slot is to be uniquely
10926: selected.
1.1040 raeburn 10927:
10928: sorted_future - ref to array of student_schedulable slots reservable in
10929: the future, ordered by start date of reservation period.
10930:
10931: future_reservable - ref to hash of student_schedulable slots reservable
10932: in the future.
10933:
10934: Keys in inner hash are:
10935: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10936: (b) startreserve: start date of reservation period.
10937: (c) uniqueperiod: start,end dates when slot is to be uniquely
10938: selected.
1.1040 raeburn 10939:
10940: =back
10941:
10942: =cut
10943:
10944: sub get_future_slots {
10945: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10946: my $map;
10947: if ($symb) {
10948: ($map) = &Apache::lonnet::decode_symb($symb);
10949: }
1.1040 raeburn 10950: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10951: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10952: foreach my $slot (keys(%slots)) {
10953: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10954: if ($symb) {
1.1229 raeburn 10955: if ($slots{$slot}->{'symb'} ne '') {
10956: my $canuse;
10957: my %oksymbs;
10958: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10959: map { $oksymbs{$_} = 1; } @slotsymbs;
10960: if ($oksymbs{$symb}) {
10961: $canuse = 1;
10962: } else {
10963: foreach my $item (@slotsymbs) {
10964: if ($item =~ /\.(page|sequence)$/) {
10965: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10966: if (($map ne '') && ($map eq $sloturl)) {
10967: $canuse = 1;
10968: last;
10969: }
10970: }
10971: }
10972: }
10973: next unless ($canuse);
10974: }
1.1040 raeburn 10975: }
10976: if (($slots{$slot}->{'starttime'} > $now) &&
10977: ($slots{$slot}->{'endtime'} > $now)) {
10978: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10979: my $userallowed = 0;
10980: if ($slots{$slot}->{'allowedsections'}) {
10981: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10982: if (!defined($env{'request.role.sec'})
10983: && grep(/^No section assigned$/,@allowed_sec)) {
10984: $userallowed=1;
10985: } else {
10986: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10987: $userallowed=1;
10988: }
10989: }
10990: unless ($userallowed) {
10991: if (defined($env{'request.course.groups'})) {
10992: my @groups = split(/:/,$env{'request.course.groups'});
10993: foreach my $group (@groups) {
10994: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10995: $userallowed=1;
10996: last;
10997: }
10998: }
10999: }
11000: }
11001: }
11002: if ($slots{$slot}->{'allowedusers'}) {
11003: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11004: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11005: if (grep(/^\Q$user\E$/,@allowed_users)) {
11006: $userallowed = 1;
11007: }
11008: }
11009: next unless($userallowed);
11010: }
11011: my $startreserve = $slots{$slot}->{'startreserve'};
11012: my $endreserve = $slots{$slot}->{'endreserve'};
11013: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 11014: my $uniqueperiod;
11015: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11016: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11017: }
1.1040 raeburn 11018: if (($startreserve < $now) &&
11019: (!$endreserve || $endreserve > $now)) {
11020: my $lastres = $endreserve;
11021: if (!$lastres) {
11022: $lastres = $slots{$slot}->{'starttime'};
11023: }
11024: $reservable_now{$slot} = {
11025: symb => $symb,
1.1250 raeburn 11026: endreserve => $lastres,
11027: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11028: };
11029: } elsif (($startreserve > $now) &&
11030: (!$endreserve || $endreserve > $startreserve)) {
11031: $future_reservable{$slot} = {
11032: symb => $symb,
1.1250 raeburn 11033: startreserve => $startreserve,
11034: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11035: };
11036: }
11037: }
11038: }
11039: my @unsorted_reservable = keys(%reservable_now);
11040: if (@unsorted_reservable > 0) {
11041: @sorted_reservable =
11042: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11043: }
11044: my @unsorted_future = keys(%future_reservable);
11045: if (@unsorted_future > 0) {
11046: @sorted_future =
11047: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11048: }
11049: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11050: }
1.780 raeburn 11051:
11052: =pod
11053:
1.1057 foxr 11054: =back
11055:
1.549 albertel 11056: =head1 HTTP Helpers
11057:
11058: =over 4
11059:
1.648 raeburn 11060: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11061:
1.258 albertel 11062: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11063: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11064: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11065:
11066: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11067: $possible_names is an ref to an array of form element names. As an example:
11068: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11069: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11070:
11071: =cut
1.1 albertel 11072:
1.6 albertel 11073: sub get_unprocessed_cgi {
1.25 albertel 11074: my ($query,$possible_names)= @_;
1.26 matthew 11075: # $Apache::lonxml::debug=1;
1.356 albertel 11076: foreach my $pair (split(/&/,$query)) {
11077: my ($name, $value) = split(/=/,$pair);
1.369 www 11078: $name = &unescape($name);
1.25 albertel 11079: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11080: $value =~ tr/+/ /;
11081: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11082: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11083: }
1.16 harris41 11084: }
1.6 albertel 11085: }
11086:
1.112 bowersj2 11087: =pod
11088:
1.648 raeburn 11089: =item * &cacheheader()
1.112 bowersj2 11090:
11091: returns cache-controlling header code
11092:
11093: =cut
11094:
1.7 albertel 11095: sub cacheheader {
1.258 albertel 11096: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11097: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11098: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11099: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11100: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11101: return $output;
1.7 albertel 11102: }
11103:
1.112 bowersj2 11104: =pod
11105:
1.648 raeburn 11106: =item * &no_cache($r)
1.112 bowersj2 11107:
11108: specifies header code to not have cache
11109:
11110: =cut
11111:
1.9 albertel 11112: sub no_cache {
1.216 albertel 11113: my ($r) = @_;
11114: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11115: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11116: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11117: $r->no_cache(1);
11118: $r->header_out("Expires" => $date);
11119: $r->header_out("Pragma" => "no-cache");
1.123 www 11120: }
11121:
11122: sub content_type {
1.181 albertel 11123: my ($r,$type,$charset) = @_;
1.299 foxr 11124: if ($r) {
11125: # Note that printout.pl calls this with undef for $r.
11126: &no_cache($r);
11127: }
1.258 albertel 11128: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11129: unless ($charset) {
11130: $charset=&Apache::lonlocal::current_encoding;
11131: }
11132: if ($charset) { $type.='; charset='.$charset; }
11133: if ($r) {
11134: $r->content_type($type);
11135: } else {
11136: print("Content-type: $type\n\n");
11137: }
1.9 albertel 11138: }
1.25 albertel 11139:
1.112 bowersj2 11140: =pod
11141:
1.648 raeburn 11142: =item * &add_to_env($name,$value)
1.112 bowersj2 11143:
1.258 albertel 11144: adds $name to the %env hash with value
1.112 bowersj2 11145: $value, if $name already exists, the entry is converted to an array
11146: reference and $value is added to the array.
11147:
11148: =cut
11149:
1.25 albertel 11150: sub add_to_env {
11151: my ($name,$value)=@_;
1.258 albertel 11152: if (defined($env{$name})) {
11153: if (ref($env{$name})) {
1.25 albertel 11154: #already have multiple values
1.258 albertel 11155: push(@{ $env{$name} },$value);
1.25 albertel 11156: } else {
11157: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11158: my $first=$env{$name};
11159: undef($env{$name});
11160: push(@{ $env{$name} },$first,$value);
1.25 albertel 11161: }
11162: } else {
1.258 albertel 11163: $env{$name}=$value;
1.25 albertel 11164: }
1.31 albertel 11165: }
1.149 albertel 11166:
11167: =pod
11168:
1.648 raeburn 11169: =item * &get_env_multiple($name)
1.149 albertel 11170:
1.258 albertel 11171: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11172: values may be defined and end up as an array ref.
11173:
11174: returns an array of values
11175:
11176: =cut
11177:
11178: sub get_env_multiple {
11179: my ($name) = @_;
11180: my @values;
1.258 albertel 11181: if (defined($env{$name})) {
1.149 albertel 11182: # exists is it an array
1.258 albertel 11183: if (ref($env{$name})) {
11184: @values=@{ $env{$name} };
1.149 albertel 11185: } else {
1.258 albertel 11186: $values[0]=$env{$name};
1.149 albertel 11187: }
11188: }
11189: return(@values);
11190: }
11191:
1.1249 damieng 11192: # Looks at given dependencies, and returns something depending on the context.
11193: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11194: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11195: # For all other contexts, returns ($output, $counter, $numpathchg).
11196: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11197: # $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.
11198: # $numpathchg: integer with the number of cleaned up dependency paths.
11199: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11200: # \%mapping: hash reference clean path -> original path for all dependencies.
11201: # @param {string} actionurl - The path to the handler, indicative of the context.
11202: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11203: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11204: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11205: # @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)
11206: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11207: sub ask_for_embedded_content {
1.1249 damieng 11208: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11209: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11210: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11211: %currsubfile,%unused,$rem);
1.1071 raeburn 11212: my $counter = 0;
11213: my $numnew = 0;
1.987 raeburn 11214: my $numremref = 0;
11215: my $numinvalid = 0;
11216: my $numpathchg = 0;
11217: my $numexisting = 0;
1.1071 raeburn 11218: my $numunused = 0;
11219: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11220: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11221: my $heading = &mt('Upload embedded files');
11222: my $buttontext = &mt('Upload');
11223:
1.1249 damieng 11224: # fills these variables based on the context:
11225: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11226: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11227: if ($env{'request.course.id'}) {
1.1123 raeburn 11228: if ($actionurl eq '/adm/dependencies') {
11229: $navmap = Apache::lonnavmaps::navmap->new();
11230: }
11231: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11232: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11233: }
1.1123 raeburn 11234: if (($actionurl eq '/adm/portfolio') ||
11235: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11236: my $current_path='/';
11237: if ($env{'form.currentpath'}) {
11238: $current_path = $env{'form.currentpath'};
11239: }
11240: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11241: $udom = $cdom;
11242: $uname = $cnum;
1.984 raeburn 11243: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11244: } else {
11245: $udom = $env{'user.domain'};
11246: $uname = $env{'user.name'};
11247: $url = '/userfiles/portfolio';
11248: }
1.987 raeburn 11249: $toplevel = $url.'/';
1.984 raeburn 11250: $url .= $current_path;
11251: $getpropath = 1;
1.987 raeburn 11252: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11253: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11254: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11255: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11256: $toplevel = $url;
1.984 raeburn 11257: if ($rest ne '') {
1.987 raeburn 11258: $url .= $rest;
11259: }
11260: } elsif ($actionurl eq '/adm/coursedocs') {
11261: if (ref($args) eq 'HASH') {
1.1071 raeburn 11262: $url = $args->{'docs_url'};
11263: $toplevel = $url;
1.1084 raeburn 11264: if ($args->{'context'} eq 'paste') {
11265: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11266: ($path) =
11267: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11268: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11269: $fileloc =~ s{^/}{};
11270: }
1.1071 raeburn 11271: }
1.1084 raeburn 11272: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 11273: if ($env{'request.course.id'} ne '') {
11274: if (ref($args) eq 'HASH') {
11275: $url = $args->{'docs_url'};
11276: $title = $args->{'docs_title'};
1.1126 raeburn 11277: $toplevel = $url;
11278: unless ($toplevel =~ m{^/}) {
11279: $toplevel = "/$url";
11280: }
1.1085 raeburn 11281: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11282: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11283: $path = $1;
11284: } else {
11285: ($path) =
11286: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11287: }
1.1195 raeburn 11288: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11289: $fileloc = $toplevel;
11290: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11291: my ($udom,$uname,$fname) =
11292: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11293: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11294: } else {
11295: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11296: }
1.1071 raeburn 11297: $fileloc =~ s{^/}{};
11298: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11299: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11300: }
1.987 raeburn 11301: }
1.1123 raeburn 11302: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11303: $udom = $cdom;
11304: $uname = $cnum;
11305: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11306: $toplevel = $url;
11307: $path = $url;
11308: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11309: $fileloc =~ s{^/}{};
1.987 raeburn 11310: }
1.1249 damieng 11311:
11312: # parses the dependency paths to get some info
11313: # fills $newfiles, $mapping, $subdependencies, $dependencies
11314: # $newfiles: hash URL -> 1 for new files or external URLs
11315: # (will be completed later)
11316: # $mapping:
11317: # for external URLs: external URL -> external URL
11318: # for relative paths: clean path -> original path
11319: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11320: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11321: foreach my $file (keys(%{$allfiles})) {
11322: my $embed_file;
11323: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11324: $embed_file = $1;
11325: } else {
11326: $embed_file = $file;
11327: }
1.1158 raeburn 11328: my ($absolutepath,$cleaned_file);
11329: if ($embed_file =~ m{^\w+://}) {
11330: $cleaned_file = $embed_file;
1.1147 raeburn 11331: $newfiles{$cleaned_file} = 1;
11332: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11333: } else {
1.1158 raeburn 11334: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11335: if ($embed_file =~ m{^/}) {
11336: $absolutepath = $embed_file;
11337: }
1.1147 raeburn 11338: if ($cleaned_file =~ m{/}) {
11339: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11340: $path = &check_for_traversal($path,$url,$toplevel);
11341: my $item = $fname;
11342: if ($path ne '') {
11343: $item = $path.'/'.$fname;
11344: $subdependencies{$path}{$fname} = 1;
11345: } else {
11346: $dependencies{$item} = 1;
11347: }
11348: if ($absolutepath) {
11349: $mapping{$item} = $absolutepath;
11350: } else {
11351: $mapping{$item} = $embed_file;
11352: }
11353: } else {
11354: $dependencies{$embed_file} = 1;
11355: if ($absolutepath) {
1.1147 raeburn 11356: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11357: } else {
1.1147 raeburn 11358: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11359: }
11360: }
1.984 raeburn 11361: }
11362: }
1.1249 damieng 11363:
11364: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11365: # and lists
11366: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11367: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11368: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11369: # the path had to be cleaned up
11370: # $existing: hash clean path -> 1 if the file exists
11371: # $numexisting: number of keys in $existing
11372: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11373: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11374: # dependency subdirectories that are
11375: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11376: my $dirptr = 16384;
1.984 raeburn 11377: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11378: $currsubfile{$path} = {};
1.1123 raeburn 11379: if (($actionurl eq '/adm/portfolio') ||
11380: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11381: my ($sublistref,$listerror) =
11382: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11383: if (ref($sublistref) eq 'ARRAY') {
11384: foreach my $line (@{$sublistref}) {
11385: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11386: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11387: }
1.984 raeburn 11388: }
1.987 raeburn 11389: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11390: if (opendir(my $dir,$url.'/'.$path)) {
11391: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11392: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11393: }
1.1084 raeburn 11394: } elsif (($actionurl eq '/adm/dependencies') ||
11395: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11396: ($args->{'context'} eq 'paste')) ||
11397: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11398: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11399: my $dir;
11400: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11401: $dir = $fileloc;
11402: } else {
11403: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11404: }
1.1071 raeburn 11405: if ($dir ne '') {
11406: my ($sublistref,$listerror) =
11407: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11408: if (ref($sublistref) eq 'ARRAY') {
11409: foreach my $line (@{$sublistref}) {
11410: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11411: undef,$mtime)=split(/\&/,$line,12);
11412: unless (($testdir&$dirptr) ||
11413: ($file_name =~ /^\.\.?$/)) {
11414: $currsubfile{$path}{$file_name} = [$size,$mtime];
11415: }
11416: }
11417: }
11418: }
1.984 raeburn 11419: }
11420: }
11421: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11422: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11423: my $item = $path.'/'.$file;
11424: unless ($mapping{$item} eq $item) {
11425: $pathchanges{$item} = 1;
11426: }
11427: $existing{$item} = 1;
11428: $numexisting ++;
11429: } else {
11430: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11431: }
11432: }
1.1071 raeburn 11433: if ($actionurl eq '/adm/dependencies') {
11434: foreach my $path (keys(%currsubfile)) {
11435: if (ref($currsubfile{$path}) eq 'HASH') {
11436: foreach my $file (keys(%{$currsubfile{$path}})) {
11437: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11438: next if (($rem ne '') &&
11439: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11440: (ref($navmap) &&
11441: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11442: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11443: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11444: $unused{$path.'/'.$file} = 1;
11445: }
11446: }
11447: }
11448: }
11449: }
1.984 raeburn 11450: }
1.1249 damieng 11451:
11452: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11453: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11454: my %currfile;
1.1123 raeburn 11455: if (($actionurl eq '/adm/portfolio') ||
11456: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11457: my ($dirlistref,$listerror) =
11458: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11459: if (ref($dirlistref) eq 'ARRAY') {
11460: foreach my $line (@{$dirlistref}) {
11461: my ($file_name,$rest) = split(/\&/,$line,2);
11462: $currfile{$file_name} = 1;
11463: }
1.984 raeburn 11464: }
1.987 raeburn 11465: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11466: if (opendir(my $dir,$url)) {
1.987 raeburn 11467: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11468: map {$currfile{$_} = 1;} @dir_list;
11469: }
1.1084 raeburn 11470: } elsif (($actionurl eq '/adm/dependencies') ||
11471: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11472: ($args->{'context'} eq 'paste')) ||
11473: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11474: if ($env{'request.course.id'} ne '') {
11475: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11476: if ($dir ne '') {
11477: my ($dirlistref,$listerror) =
11478: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11479: if (ref($dirlistref) eq 'ARRAY') {
11480: foreach my $line (@{$dirlistref}) {
11481: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11482: $size,undef,$mtime)=split(/\&/,$line,12);
11483: unless (($testdir&$dirptr) ||
11484: ($file_name =~ /^\.\.?$/)) {
11485: $currfile{$file_name} = [$size,$mtime];
11486: }
11487: }
11488: }
11489: }
11490: }
1.984 raeburn 11491: }
1.1249 damieng 11492: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11493: # are not in subdirectories, using $currfile
1.984 raeburn 11494: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11495: if (exists($currfile{$file})) {
1.987 raeburn 11496: unless ($mapping{$file} eq $file) {
11497: $pathchanges{$file} = 1;
11498: }
11499: $existing{$file} = 1;
11500: $numexisting ++;
11501: } else {
1.984 raeburn 11502: $newfiles{$file} = 1;
11503: }
11504: }
1.1071 raeburn 11505: foreach my $file (keys(%currfile)) {
11506: unless (($file eq $filename) ||
11507: ($file eq $filename.'.bak') ||
11508: ($dependencies{$file})) {
1.1085 raeburn 11509: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11510: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11511: next if (($rem ne '') &&
11512: (($env{"httpref.$rem".$file} ne '') ||
11513: (ref($navmap) &&
11514: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11515: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11516: ($navmap->getResourceByUrl($rem.$1)))))));
11517: }
1.1085 raeburn 11518: }
1.1071 raeburn 11519: $unused{$file} = 1;
11520: }
11521: }
1.1249 damieng 11522:
11523: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11524: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11525: ($args->{'context'} eq 'paste')) {
11526: $counter = scalar(keys(%existing));
11527: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11528: return ($output,$counter,$numpathchg,\%existing);
11529: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11530: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11531: $counter = scalar(keys(%existing));
11532: $numpathchg = scalar(keys(%pathchanges));
11533: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11534: }
1.1249 damieng 11535:
11536: # returns HTML otherwise, with dependency results and to ask for more uploads
11537:
11538: # $upload_output: missing dependencies (with upload form)
11539: # $modify_output: uploaded dependencies (in use)
11540: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11541: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11542: if ($actionurl eq '/adm/dependencies') {
11543: next if ($embed_file =~ m{^\w+://});
11544: }
1.660 raeburn 11545: $upload_output .= &start_data_table_row().
1.1123 raeburn 11546: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11547: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11548: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11549: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11550: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11551: }
1.1123 raeburn 11552: $upload_output .= '</td>';
1.1071 raeburn 11553: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11554: $upload_output.='<td align="right">'.
11555: '<span class="LC_info LC_fontsize_medium">'.
11556: &mt("URL points to web address").'</span>';
1.987 raeburn 11557: $numremref++;
1.660 raeburn 11558: } elsif ($args->{'error_on_invalid_names'}
11559: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11560: $upload_output.='<td align="right"><span class="LC_warning">'.
11561: &mt('Invalid characters').'</span>';
1.987 raeburn 11562: $numinvalid++;
1.660 raeburn 11563: } else {
1.1123 raeburn 11564: $upload_output .= '<td>'.
11565: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11566: $embed_file,\%mapping,
1.1071 raeburn 11567: $allfiles,$codebase,'upload');
11568: $counter ++;
11569: $numnew ++;
1.987 raeburn 11570: }
11571: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11572: }
11573: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11574: if ($actionurl eq '/adm/dependencies') {
11575: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11576: $modify_output .= &start_data_table_row().
11577: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11578: '<img src="'.&icon($embed_file).'" border="0" />'.
11579: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11580: '<td>'.$size.'</td>'.
11581: '<td>'.$mtime.'</td>'.
11582: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11583: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11584: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11585: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11586: &embedded_file_element('upload_embedded',$counter,
11587: $embed_file,\%mapping,
11588: $allfiles,$codebase,'modify').
11589: '</div></td>'.
11590: &end_data_table_row()."\n";
11591: $counter ++;
11592: } else {
11593: $upload_output .= &start_data_table_row().
1.1123 raeburn 11594: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11595: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11596: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11597: &Apache::loncommon::end_data_table_row()."\n";
11598: }
11599: }
11600: my $delidx = $counter;
11601: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11602: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11603: $delete_output .= &start_data_table_row().
11604: '<td><img src="'.&icon($oldfile).'" />'.
11605: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11606: '<td>'.$size.'</td>'.
11607: '<td>'.$mtime.'</td>'.
11608: '<td><label><input type="checkbox" name="del_upload_dep" '.
11609: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11610: &embedded_file_element('upload_embedded',$delidx,
11611: $oldfile,\%mapping,$allfiles,
11612: $codebase,'delete').'</td>'.
11613: &end_data_table_row()."\n";
11614: $numunused ++;
11615: $delidx ++;
1.987 raeburn 11616: }
11617: if ($upload_output) {
11618: $upload_output = &start_data_table().
11619: $upload_output.
11620: &end_data_table()."\n";
11621: }
1.1071 raeburn 11622: if ($modify_output) {
11623: $modify_output = &start_data_table().
11624: &start_data_table_header_row().
11625: '<th>'.&mt('File').'</th>'.
11626: '<th>'.&mt('Size (KB)').'</th>'.
11627: '<th>'.&mt('Modified').'</th>'.
11628: '<th>'.&mt('Upload replacement?').'</th>'.
11629: &end_data_table_header_row().
11630: $modify_output.
11631: &end_data_table()."\n";
11632: }
11633: if ($delete_output) {
11634: $delete_output = &start_data_table().
11635: &start_data_table_header_row().
11636: '<th>'.&mt('File').'</th>'.
11637: '<th>'.&mt('Size (KB)').'</th>'.
11638: '<th>'.&mt('Modified').'</th>'.
11639: '<th>'.&mt('Delete?').'</th>'.
11640: &end_data_table_header_row().
11641: $delete_output.
11642: &end_data_table()."\n";
11643: }
1.987 raeburn 11644: my $applies = 0;
11645: if ($numremref) {
11646: $applies ++;
11647: }
11648: if ($numinvalid) {
11649: $applies ++;
11650: }
11651: if ($numexisting) {
11652: $applies ++;
11653: }
1.1071 raeburn 11654: if ($counter || $numunused) {
1.987 raeburn 11655: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11656: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11657: $state.'<h3>'.$heading.'</h3>';
11658: if ($actionurl eq '/adm/dependencies') {
11659: if ($numnew) {
11660: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11661: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11662: $upload_output.'<br />'."\n";
11663: }
11664: if ($numexisting) {
11665: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11666: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11667: $modify_output.'<br />'."\n";
11668: $buttontext = &mt('Save changes');
11669: }
11670: if ($numunused) {
11671: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11672: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11673: $delete_output.'<br />'."\n";
11674: $buttontext = &mt('Save changes');
11675: }
11676: } else {
11677: $output .= $upload_output.'<br />'."\n";
11678: }
11679: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11680: $counter.'" />'."\n";
11681: if ($actionurl eq '/adm/dependencies') {
11682: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11683: $numnew.'" />'."\n";
11684: } elsif ($actionurl eq '') {
1.987 raeburn 11685: $output .= '<input type="hidden" name="phase" value="three" />';
11686: }
11687: } elsif ($applies) {
11688: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11689: if ($applies > 1) {
11690: $output .=
1.1123 raeburn 11691: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11692: if ($numremref) {
11693: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11694: }
11695: if ($numinvalid) {
11696: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11697: }
11698: if ($numexisting) {
11699: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11700: }
11701: $output .= '</ul><br />';
11702: } elsif ($numremref) {
11703: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11704: } elsif ($numinvalid) {
11705: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11706: } elsif ($numexisting) {
11707: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11708: }
11709: $output .= $upload_output.'<br />';
11710: }
11711: my ($pathchange_output,$chgcount);
1.1071 raeburn 11712: $chgcount = $counter;
1.987 raeburn 11713: if (keys(%pathchanges) > 0) {
11714: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11715: if ($counter) {
1.987 raeburn 11716: $output .= &embedded_file_element('pathchange',$chgcount,
11717: $embed_file,\%mapping,
1.1071 raeburn 11718: $allfiles,$codebase,'change');
1.987 raeburn 11719: } else {
11720: $pathchange_output .=
11721: &start_data_table_row().
11722: '<td><input type ="checkbox" name="namechange" value="'.
11723: $chgcount.'" checked="checked" /></td>'.
11724: '<td>'.$mapping{$embed_file}.'</td>'.
11725: '<td>'.$embed_file.
11726: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11727: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11728: '</td>'.&end_data_table_row();
1.660 raeburn 11729: }
1.987 raeburn 11730: $numpathchg ++;
11731: $chgcount ++;
1.660 raeburn 11732: }
11733: }
1.1127 raeburn 11734: if (($counter) || ($numunused)) {
1.987 raeburn 11735: if ($numpathchg) {
11736: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11737: $numpathchg.'" />'."\n";
11738: }
11739: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11740: ($actionurl eq '/adm/imsimport')) {
11741: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11742: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11743: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11744: } elsif ($actionurl eq '/adm/dependencies') {
11745: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11746: }
1.1123 raeburn 11747: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11748: } elsif ($numpathchg) {
11749: my %pathchange = ();
11750: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11751: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11752: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11753: }
1.987 raeburn 11754: }
1.1071 raeburn 11755: return ($output,$counter,$numpathchg);
1.987 raeburn 11756: }
11757:
1.1147 raeburn 11758: =pod
11759:
11760: =item * clean_path($name)
11761:
11762: Performs clean-up of directories, subdirectories and filename in an
11763: embedded object, referenced in an HTML file which is being uploaded
11764: to a course or portfolio, where
11765: "Upload embedded images/multimedia files if HTML file" checkbox was
11766: checked.
11767:
11768: Clean-up is similar to replacements in lonnet::clean_filename()
11769: except each / between sub-directory and next level is preserved.
11770:
11771: =cut
11772:
11773: sub clean_path {
11774: my ($embed_file) = @_;
11775: $embed_file =~s{^/+}{};
11776: my @contents;
11777: if ($embed_file =~ m{/}) {
11778: @contents = split(/\//,$embed_file);
11779: } else {
11780: @contents = ($embed_file);
11781: }
11782: my $lastidx = scalar(@contents)-1;
11783: for (my $i=0; $i<=$lastidx; $i++) {
11784: $contents[$i]=~s{\\}{/}g;
11785: $contents[$i]=~s/\s+/\_/g;
11786: $contents[$i]=~s{[^/\w\.\-]}{}g;
11787: if ($i == $lastidx) {
11788: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11789: }
11790: }
11791: if ($lastidx > 0) {
11792: return join('/',@contents);
11793: } else {
11794: return $contents[0];
11795: }
11796: }
11797:
1.987 raeburn 11798: sub embedded_file_element {
1.1071 raeburn 11799: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11800: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11801: (ref($codebase) eq 'HASH'));
11802: my $output;
1.1071 raeburn 11803: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11804: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11805: }
11806: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11807: &escape($embed_file).'" />';
11808: unless (($context eq 'upload_embedded') &&
11809: ($mapping->{$embed_file} eq $embed_file)) {
11810: $output .='
11811: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11812: }
11813: my $attrib;
11814: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11815: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11816: }
11817: $output .=
11818: "\n\t\t".
11819: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11820: $attrib.'" />';
11821: if (exists($codebase->{$mapping->{$embed_file}})) {
11822: $output .=
11823: "\n\t\t".
11824: '<input name="codebase_'.$num.'" type="hidden" value="'.
11825: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11826: }
1.987 raeburn 11827: return $output;
1.660 raeburn 11828: }
11829:
1.1071 raeburn 11830: sub get_dependency_details {
11831: my ($currfile,$currsubfile,$embed_file) = @_;
11832: my ($size,$mtime,$showsize,$showmtime);
11833: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11834: if ($embed_file =~ m{/}) {
11835: my ($path,$fname) = split(/\//,$embed_file);
11836: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11837: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11838: }
11839: } else {
11840: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11841: ($size,$mtime) = @{$currfile->{$embed_file}};
11842: }
11843: }
11844: $showsize = $size/1024.0;
11845: $showsize = sprintf("%.1f",$showsize);
11846: if ($mtime > 0) {
11847: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11848: }
11849: }
11850: return ($showsize,$showmtime);
11851: }
11852:
11853: sub ask_embedded_js {
11854: return <<"END";
11855: <script type="text/javascript"">
11856: // <![CDATA[
11857: function toggleBrowse(counter) {
11858: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11859: var fileid = document.getElementById('embedded_item_'+counter);
11860: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11861: if (chkboxid.checked == true) {
11862: uploaddivid.style.display='block';
11863: } else {
11864: uploaddivid.style.display='none';
11865: fileid.value = '';
11866: }
11867: }
11868: // ]]>
11869: </script>
11870:
11871: END
11872: }
11873:
1.661 raeburn 11874: sub upload_embedded {
11875: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11876: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11877: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11878: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11879: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11880: my $orig_uploaded_filename =
11881: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11882: foreach my $type ('orig','ref','attrib','codebase') {
11883: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11884: $env{'form.embedded_'.$type.'_'.$i} =
11885: &unescape($env{'form.embedded_'.$type.'_'.$i});
11886: }
11887: }
1.661 raeburn 11888: my ($path,$fname) =
11889: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11890: # no path, whole string is fname
11891: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11892: $fname = &Apache::lonnet::clean_filename($fname);
11893: # See if there is anything left
11894: next if ($fname eq '');
11895:
11896: # Check if file already exists as a file or directory.
11897: my ($state,$msg);
11898: if ($context eq 'portfolio') {
11899: my $port_path = $dirpath;
11900: if ($group ne '') {
11901: $port_path = "groups/$group/$port_path";
11902: }
1.987 raeburn 11903: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11904: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11905: $dir_root,$port_path,$disk_quota,
11906: $current_disk_usage,$uname,$udom);
11907: if ($state eq 'will_exceed_quota'
1.984 raeburn 11908: || $state eq 'file_locked') {
1.661 raeburn 11909: $output .= $msg;
11910: next;
11911: }
11912: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11913: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11914: if ($state eq 'exists') {
11915: $output .= $msg;
11916: next;
11917: }
11918: }
11919: # Check if extension is valid
11920: if (($fname =~ /\.(\w+)$/) &&
11921: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11922: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11923: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11924: next;
11925: } elsif (($fname =~ /\.(\w+)$/) &&
11926: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11927: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11928: next;
11929: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11930: $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 11931: next;
11932: }
11933: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11934: my $subdir = $path;
11935: $subdir =~ s{/+$}{};
1.661 raeburn 11936: if ($context eq 'portfolio') {
1.984 raeburn 11937: my $result;
11938: if ($state eq 'existingfile') {
11939: $result=
11940: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11941: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11942: } else {
1.984 raeburn 11943: $result=
11944: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11945: $dirpath.
1.1123 raeburn 11946: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11947: if ($result !~ m|^/uploaded/|) {
11948: $output .= '<span class="LC_error">'
11949: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11950: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11951: .'</span><br />';
11952: next;
11953: } else {
1.987 raeburn 11954: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11955: $path.$fname.'</span>').'<br />';
1.984 raeburn 11956: }
1.661 raeburn 11957: }
1.1123 raeburn 11958: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11959: my $extendedsubdir = $dirpath.'/'.$subdir;
11960: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11961: my $result =
1.1126 raeburn 11962: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11963: if ($result !~ m|^/uploaded/|) {
11964: $output .= '<span class="LC_error">'
11965: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11966: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11967: .'</span><br />';
11968: next;
11969: } else {
11970: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11971: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11972: if ($context eq 'syllabus') {
11973: &Apache::lonnet::make_public_indefinitely($result);
11974: }
1.987 raeburn 11975: }
1.661 raeburn 11976: } else {
11977: # Save the file
11978: my $target = $env{'form.embedded_item_'.$i};
11979: my $fullpath = $dir_root.$dirpath.'/'.$path;
11980: my $dest = $fullpath.$fname;
11981: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11982: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11983: my $count;
11984: my $filepath = $dir_root;
1.1027 raeburn 11985: foreach my $subdir (@parts) {
11986: $filepath .= "/$subdir";
11987: if (!-e $filepath) {
1.661 raeburn 11988: mkdir($filepath,0770);
11989: }
11990: }
11991: my $fh;
11992: if (!open($fh,'>'.$dest)) {
11993: &Apache::lonnet::logthis('Failed to create '.$dest);
11994: $output .= '<span class="LC_error">'.
1.1071 raeburn 11995: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11996: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11997: '</span><br />';
11998: } else {
11999: if (!print $fh $env{'form.embedded_item_'.$i}) {
12000: &Apache::lonnet::logthis('Failed to write to '.$dest);
12001: $output .= '<span class="LC_error">'.
1.1071 raeburn 12002: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12003: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12004: '</span><br />';
12005: } else {
1.987 raeburn 12006: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12007: $url.'</span>').'<br />';
12008: unless ($context eq 'testbank') {
12009: $footer .= &mt('View embedded file: [_1]',
12010: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12011: }
12012: }
12013: close($fh);
12014: }
12015: }
12016: if ($env{'form.embedded_ref_'.$i}) {
12017: $pathchange{$i} = 1;
12018: }
12019: }
12020: if ($output) {
12021: $output = '<p>'.$output.'</p>';
12022: }
12023: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12024: $returnflag = 'ok';
1.1071 raeburn 12025: my $numpathchgs = scalar(keys(%pathchange));
12026: if ($numpathchgs > 0) {
1.987 raeburn 12027: if ($context eq 'portfolio') {
12028: $output .= '<p>'.&mt('or').'</p>';
12029: } elsif ($context eq 'testbank') {
1.1071 raeburn 12030: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12031: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12032: $returnflag = 'modify_orightml';
12033: }
12034: }
1.1071 raeburn 12035: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12036: }
12037:
12038: sub modify_html_form {
12039: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12040: my $end = 0;
12041: my $modifyform;
12042: if ($context eq 'upload_embedded') {
12043: return unless (ref($pathchange) eq 'HASH');
12044: if ($env{'form.number_embedded_items'}) {
12045: $end += $env{'form.number_embedded_items'};
12046: }
12047: if ($env{'form.number_pathchange_items'}) {
12048: $end += $env{'form.number_pathchange_items'};
12049: }
12050: if ($end) {
12051: for (my $i=0; $i<$end; $i++) {
12052: if ($i < $env{'form.number_embedded_items'}) {
12053: next unless($pathchange->{$i});
12054: }
12055: $modifyform .=
12056: &start_data_table_row().
12057: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12058: 'checked="checked" /></td>'.
12059: '<td>'.$env{'form.embedded_ref_'.$i}.
12060: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12061: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12062: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12063: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12064: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12065: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12066: '<td>'.$env{'form.embedded_orig_'.$i}.
12067: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12068: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12069: &end_data_table_row();
1.1071 raeburn 12070: }
1.987 raeburn 12071: }
12072: } else {
12073: $modifyform = $pathchgtable;
12074: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12075: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12076: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12077: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12078: }
12079: }
12080: if ($modifyform) {
1.1071 raeburn 12081: if ($actionurl eq '/adm/dependencies') {
12082: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12083: }
1.987 raeburn 12084: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12085: '<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".
12086: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12087: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12088: '</ol></p>'."\n".'<p>'.
12089: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12090: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12091: &start_data_table()."\n".
12092: &start_data_table_header_row().
12093: '<th>'.&mt('Change?').'</th>'.
12094: '<th>'.&mt('Current reference').'</th>'.
12095: '<th>'.&mt('Required reference').'</th>'.
12096: &end_data_table_header_row()."\n".
12097: $modifyform.
12098: &end_data_table().'<br />'."\n".$hiddenstate.
12099: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12100: '</form>'."\n";
12101: }
12102: return;
12103: }
12104:
12105: sub modify_html_refs {
1.1123 raeburn 12106: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12107: my $container;
12108: if ($context eq 'portfolio') {
12109: $container = $env{'form.container'};
12110: } elsif ($context eq 'coursedoc') {
12111: $container = $env{'form.primaryurl'};
1.1071 raeburn 12112: } elsif ($context eq 'manage_dependencies') {
12113: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12114: $container = "/$container";
1.1123 raeburn 12115: } elsif ($context eq 'syllabus') {
12116: $container = $url;
1.987 raeburn 12117: } else {
1.1027 raeburn 12118: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12119: }
12120: my (%allfiles,%codebase,$output,$content);
12121: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 12122: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12123: if (wantarray) {
12124: return ('',0,0);
12125: } else {
12126: return;
12127: }
12128: }
12129: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12130: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12131: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12132: if (wantarray) {
12133: return ('',0,0);
12134: } else {
12135: return;
12136: }
12137: }
1.987 raeburn 12138: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12139: if ($content eq '-1') {
12140: if (wantarray) {
12141: return ('',0,0);
12142: } else {
12143: return;
12144: }
12145: }
1.987 raeburn 12146: } else {
1.1071 raeburn 12147: unless ($container =~ /^\Q$dir_root\E/) {
12148: if (wantarray) {
12149: return ('',0,0);
12150: } else {
12151: return;
12152: }
12153: }
1.987 raeburn 12154: if (open(my $fh,"<$container")) {
12155: $content = join('', <$fh>);
12156: close($fh);
12157: } else {
1.1071 raeburn 12158: if (wantarray) {
12159: return ('',0,0);
12160: } else {
12161: return;
12162: }
1.987 raeburn 12163: }
12164: }
12165: my ($count,$codebasecount) = (0,0);
12166: my $mm = new File::MMagic;
12167: my $mime_type = $mm->checktype_contents($content);
12168: if ($mime_type eq 'text/html') {
12169: my $parse_result =
12170: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12171: \%codebase,\$content);
12172: if ($parse_result eq 'ok') {
12173: foreach my $i (@changes) {
12174: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12175: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12176: if ($allfiles{$ref}) {
12177: my $newname = $orig;
12178: my ($attrib_regexp,$codebase);
1.1006 raeburn 12179: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12180: if ($attrib_regexp =~ /:/) {
12181: $attrib_regexp =~ s/\:/|/g;
12182: }
12183: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12184: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12185: $count += $numchg;
1.1123 raeburn 12186: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12187: delete($allfiles{$ref});
1.987 raeburn 12188: }
12189: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12190: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12191: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12192: $codebasecount ++;
12193: }
12194: }
12195: }
1.1123 raeburn 12196: my $skiprewrites;
1.987 raeburn 12197: if ($count || $codebasecount) {
12198: my $saveresult;
1.1071 raeburn 12199: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12200: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12201: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12202: if ($url eq $container) {
12203: my ($fname) = ($container =~ m{/([^/]+)$});
12204: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12205: $count,'<span class="LC_filename">'.
1.1071 raeburn 12206: $fname.'</span>').'</p>';
1.987 raeburn 12207: } else {
12208: $output = '<p class="LC_error">'.
12209: &mt('Error: update failed for: [_1].',
12210: '<span class="LC_filename">'.
12211: $container.'</span>').'</p>';
12212: }
1.1123 raeburn 12213: if ($context eq 'syllabus') {
12214: unless ($saveresult eq 'ok') {
12215: $skiprewrites = 1;
12216: }
12217: }
1.987 raeburn 12218: } else {
12219: if (open(my $fh,">$container")) {
12220: print $fh $content;
12221: close($fh);
12222: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12223: $count,'<span class="LC_filename">'.
12224: $container.'</span>').'</p>';
1.661 raeburn 12225: } else {
1.987 raeburn 12226: $output = '<p class="LC_error">'.
12227: &mt('Error: could not update [_1].',
12228: '<span class="LC_filename">'.
12229: $container.'</span>').'</p>';
1.661 raeburn 12230: }
12231: }
12232: }
1.1123 raeburn 12233: if (($context eq 'syllabus') && (!$skiprewrites)) {
12234: my ($actionurl,$state);
12235: $actionurl = "/public/$udom/$uname/syllabus";
12236: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12237: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12238: \%codebase,
12239: {'context' => 'rewrites',
12240: 'ignore_remote_references' => 1,});
12241: if (ref($mapping) eq 'HASH') {
12242: my $rewrites = 0;
12243: foreach my $key (keys(%{$mapping})) {
12244: next if ($key =~ m{^https?://});
12245: my $ref = $mapping->{$key};
12246: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12247: my $attrib;
12248: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12249: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12250: }
12251: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12252: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12253: $rewrites += $numchg;
12254: }
12255: }
12256: if ($rewrites) {
12257: my $saveresult;
12258: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12259: if ($url eq $container) {
12260: my ($fname) = ($container =~ m{/([^/]+)$});
12261: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12262: $count,'<span class="LC_filename">'.
12263: $fname.'</span>').'</p>';
12264: } else {
12265: $output .= '<p class="LC_error">'.
12266: &mt('Error: could not update links in [_1].',
12267: '<span class="LC_filename">'.
12268: $container.'</span>').'</p>';
12269:
12270: }
12271: }
12272: }
12273: }
1.987 raeburn 12274: } else {
12275: &logthis('Failed to parse '.$container.
12276: ' to modify references: '.$parse_result);
1.661 raeburn 12277: }
12278: }
1.1071 raeburn 12279: if (wantarray) {
12280: return ($output,$count,$codebasecount);
12281: } else {
12282: return $output;
12283: }
1.661 raeburn 12284: }
12285:
12286: sub check_for_existing {
12287: my ($path,$fname,$element) = @_;
12288: my ($state,$msg);
12289: if (-d $path.'/'.$fname) {
12290: $state = 'exists';
12291: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12292: } elsif (-e $path.'/'.$fname) {
12293: $state = 'exists';
12294: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12295: }
12296: if ($state eq 'exists') {
12297: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12298: }
12299: return ($state,$msg);
12300: }
12301:
12302: sub check_for_upload {
12303: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12304: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12305: my $filesize = length($env{'form.'.$element});
12306: if (!$filesize) {
12307: my $msg = '<span class="LC_error">'.
12308: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12309: '<span class="LC_filename">'.$fname.'</span>',
12310: $filesize).'<br />'.
1.1007 raeburn 12311: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12312: '</span>';
12313: return ('zero_bytes',$msg);
12314: }
12315: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12316: my $getpropath = 1;
1.1021 raeburn 12317: my ($dirlistref,$listerror) =
12318: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12319: my $found_file = 0;
12320: my $locked_file = 0;
1.991 raeburn 12321: my @lockers;
12322: my $navmap;
12323: if ($env{'request.course.id'}) {
12324: $navmap = Apache::lonnavmaps::navmap->new();
12325: }
1.1021 raeburn 12326: if (ref($dirlistref) eq 'ARRAY') {
12327: foreach my $line (@{$dirlistref}) {
12328: my ($file_name,$rest)=split(/\&/,$line,2);
12329: if ($file_name eq $fname){
12330: $file_name = $path.$file_name;
12331: if ($group ne '') {
12332: $file_name = $group.$file_name;
12333: }
12334: $found_file = 1;
12335: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12336: foreach my $lock (@lockers) {
12337: if (ref($lock) eq 'ARRAY') {
12338: my ($symb,$crsid) = @{$lock};
12339: if ($crsid eq $env{'request.course.id'}) {
12340: if (ref($navmap)) {
12341: my $res = $navmap->getBySymb($symb);
12342: foreach my $part (@{$res->parts()}) {
12343: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12344: unless (($slot_status == $res->RESERVED) ||
12345: ($slot_status == $res->RESERVED_LOCATION)) {
12346: $locked_file = 1;
12347: }
1.991 raeburn 12348: }
1.1021 raeburn 12349: } else {
12350: $locked_file = 1;
1.991 raeburn 12351: }
12352: } else {
12353: $locked_file = 1;
12354: }
12355: }
1.1021 raeburn 12356: }
12357: } else {
12358: my @info = split(/\&/,$rest);
12359: my $currsize = $info[6]/1000;
12360: if ($currsize < $filesize) {
12361: my $extra = $filesize - $currsize;
12362: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12363: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12364: &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 12365: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12366: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12367: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12368: return ('will_exceed_quota',$msg);
12369: }
1.984 raeburn 12370: }
12371: }
1.661 raeburn 12372: }
12373: }
12374: }
12375: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12376: my $msg = '<p class="LC_warning">'.
12377: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12378: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12379: return ('will_exceed_quota',$msg);
12380: } elsif ($found_file) {
12381: if ($locked_file) {
1.1179 bisitz 12382: my $msg = '<p class="LC_warning">';
1.661 raeburn 12383: $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 12384: $msg .= '</p>';
1.661 raeburn 12385: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12386: return ('file_locked',$msg);
12387: } else {
1.1179 bisitz 12388: my $msg = '<p class="LC_error">';
1.984 raeburn 12389: $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 12390: $msg .= '</p>';
1.984 raeburn 12391: return ('existingfile',$msg);
1.661 raeburn 12392: }
12393: }
12394: }
12395:
1.987 raeburn 12396: sub check_for_traversal {
12397: my ($path,$url,$toplevel) = @_;
12398: my @parts=split(/\//,$path);
12399: my $cleanpath;
12400: my $fullpath = $url;
12401: for (my $i=0;$i<@parts;$i++) {
12402: next if ($parts[$i] eq '.');
12403: if ($parts[$i] eq '..') {
12404: $fullpath =~ s{([^/]+/)$}{};
12405: } else {
12406: $fullpath .= $parts[$i].'/';
12407: }
12408: }
12409: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12410: $cleanpath = $1;
12411: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12412: my $curr_toprel = $1;
12413: my @parts = split(/\//,$curr_toprel);
12414: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12415: my @urlparts = split(/\//,$url_toprel);
12416: my $doubledots;
12417: my $startdiff = -1;
12418: for (my $i=0; $i<@urlparts; $i++) {
12419: if ($startdiff == -1) {
12420: unless ($urlparts[$i] eq $parts[$i]) {
12421: $startdiff = $i;
12422: $doubledots .= '../';
12423: }
12424: } else {
12425: $doubledots .= '../';
12426: }
12427: }
12428: if ($startdiff > -1) {
12429: $cleanpath = $doubledots;
12430: for (my $i=$startdiff; $i<@parts; $i++) {
12431: $cleanpath .= $parts[$i].'/';
12432: }
12433: }
12434: }
12435: $cleanpath =~ s{(/)$}{};
12436: return $cleanpath;
12437: }
1.31 albertel 12438:
1.1053 raeburn 12439: sub is_archive_file {
12440: my ($mimetype) = @_;
12441: if (($mimetype eq 'application/octet-stream') ||
12442: ($mimetype eq 'application/x-stuffit') ||
12443: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12444: return 1;
12445: }
12446: return;
12447: }
12448:
12449: sub decompress_form {
1.1065 raeburn 12450: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12451: my %lt = &Apache::lonlocal::texthash (
12452: this => 'This file is an archive file.',
1.1067 raeburn 12453: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12454: itsc => 'Its contents are as follows:',
1.1053 raeburn 12455: youm => 'You may wish to extract its contents.',
12456: extr => 'Extract contents',
1.1067 raeburn 12457: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12458: proa => 'Process automatically?',
1.1053 raeburn 12459: yes => 'Yes',
12460: no => 'No',
1.1067 raeburn 12461: fold => 'Title for folder containing movie',
12462: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12463: );
1.1065 raeburn 12464: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12465: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12466: my $info = &list_archive_contents($fileloc,\@paths);
12467: if (@paths) {
12468: foreach my $path (@paths) {
12469: $path =~ s{^/}{};
1.1067 raeburn 12470: if ($path =~ m{^([^/]+)/$}) {
12471: $topdir = $1;
12472: }
1.1065 raeburn 12473: if ($path =~ m{^([^/]+)/}) {
12474: $toplevel{$1} = $path;
12475: } else {
12476: $toplevel{$path} = $path;
12477: }
12478: }
12479: }
1.1067 raeburn 12480: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12481: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12482: "$topdir/media/",
12483: "$topdir/media/$topdir.mp4",
12484: "$topdir/media/FirstFrame.png",
12485: "$topdir/media/player.swf",
12486: "$topdir/media/swfobject.js",
12487: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12488: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12489: "$topdir/$topdir.mp4",
12490: "$topdir/$topdir\_config.xml",
12491: "$topdir/$topdir\_controller.swf",
12492: "$topdir/$topdir\_embed.css",
12493: "$topdir/$topdir\_First_Frame.png",
12494: "$topdir/$topdir\_player.html",
12495: "$topdir/$topdir\_Thumbnails.png",
12496: "$topdir/playerProductInstall.swf",
12497: "$topdir/scripts/",
12498: "$topdir/scripts/config_xml.js",
12499: "$topdir/scripts/handlebars.js",
12500: "$topdir/scripts/jquery-1.7.1.min.js",
12501: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12502: "$topdir/scripts/modernizr.js",
12503: "$topdir/scripts/player-min.js",
12504: "$topdir/scripts/swfobject.js",
12505: "$topdir/skins/",
12506: "$topdir/skins/configuration_express.xml",
12507: "$topdir/skins/express_show/",
12508: "$topdir/skins/express_show/player-min.css",
12509: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12510: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12511: "$topdir/$topdir.mp4",
12512: "$topdir/$topdir\_config.xml",
12513: "$topdir/$topdir\_controller.swf",
12514: "$topdir/$topdir\_embed.css",
12515: "$topdir/$topdir\_First_Frame.png",
12516: "$topdir/$topdir\_player.html",
12517: "$topdir/$topdir\_Thumbnails.png",
12518: "$topdir/playerProductInstall.swf",
12519: "$topdir/scripts/",
12520: "$topdir/scripts/config_xml.js",
12521: "$topdir/scripts/techsmith-smart-player.min.js",
12522: "$topdir/skins/",
12523: "$topdir/skins/configuration_express.xml",
12524: "$topdir/skins/express_show/",
12525: "$topdir/skins/express_show/spritesheet.min.css",
12526: "$topdir/skins/express_show/spritesheet.png",
12527: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12528: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12529: if (@diffs == 0) {
1.1164 raeburn 12530: $is_camtasia = 6;
12531: } else {
1.1197 raeburn 12532: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12533: if (@diffs == 0) {
12534: $is_camtasia = 8;
1.1197 raeburn 12535: } else {
12536: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12537: if (@diffs == 0) {
12538: $is_camtasia = 8;
12539: }
1.1164 raeburn 12540: }
1.1067 raeburn 12541: }
12542: }
12543: my $output;
12544: if ($is_camtasia) {
12545: $output = <<"ENDCAM";
12546: <script type="text/javascript" language="Javascript">
12547: // <![CDATA[
12548:
12549: function camtasiaToggle() {
12550: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12551: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12552: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12553: document.getElementById('camtasia_titles').style.display='block';
12554: } else {
12555: document.getElementById('camtasia_titles').style.display='none';
12556: }
12557: }
12558: }
12559: return;
12560: }
12561:
12562: // ]]>
12563: </script>
12564: <p>$lt{'camt'}</p>
12565: ENDCAM
1.1065 raeburn 12566: } else {
1.1067 raeburn 12567: $output = '<p>'.$lt{'this'};
12568: if ($info eq '') {
12569: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12570: } else {
12571: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12572: '<div><pre>'.$info.'</pre></div>';
12573: }
1.1065 raeburn 12574: }
1.1067 raeburn 12575: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12576: my $duplicates;
12577: my $num = 0;
12578: if (ref($dirlist) eq 'ARRAY') {
12579: foreach my $item (@{$dirlist}) {
12580: if (ref($item) eq 'ARRAY') {
12581: if (exists($toplevel{$item->[0]})) {
12582: $duplicates .=
12583: &start_data_table_row().
12584: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12585: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12586: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12587: 'value="1" />'.&mt('Yes').'</label>'.
12588: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12589: '<td>'.$item->[0].'</td>';
12590: if ($item->[2]) {
12591: $duplicates .= '<td>'.&mt('Directory').'</td>';
12592: } else {
12593: $duplicates .= '<td>'.&mt('File').'</td>';
12594: }
12595: $duplicates .= '<td>'.$item->[3].'</td>'.
12596: '<td>'.
12597: &Apache::lonlocal::locallocaltime($item->[4]).
12598: '</td>'.
12599: &end_data_table_row();
12600: $num ++;
12601: }
12602: }
12603: }
12604: }
12605: my $itemcount;
12606: if (@paths > 0) {
12607: $itemcount = scalar(@paths);
12608: } else {
12609: $itemcount = 1;
12610: }
1.1067 raeburn 12611: if ($is_camtasia) {
12612: $output .= $lt{'auto'}.'<br />'.
12613: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12614: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12615: $lt{'yes'}.'</label> <label>'.
12616: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12617: $lt{'no'}.'</label></span><br />'.
12618: '<div id="camtasia_titles" style="display:block">'.
12619: &Apache::lonhtmlcommon::start_pick_box().
12620: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12621: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12622: &Apache::lonhtmlcommon::row_closure().
12623: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12624: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12625: &Apache::lonhtmlcommon::row_closure(1).
12626: &Apache::lonhtmlcommon::end_pick_box().
12627: '</div>';
12628: }
1.1065 raeburn 12629: $output .=
12630: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12631: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12632: "\n";
1.1065 raeburn 12633: if ($duplicates ne '') {
12634: $output .= '<p><span class="LC_warning">'.
12635: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12636: &start_data_table().
12637: &start_data_table_header_row().
12638: '<th>'.&mt('Overwrite?').'</th>'.
12639: '<th>'.&mt('Name').'</th>'.
12640: '<th>'.&mt('Type').'</th>'.
12641: '<th>'.&mt('Size').'</th>'.
12642: '<th>'.&mt('Last modified').'</th>'.
12643: &end_data_table_header_row().
12644: $duplicates.
12645: &end_data_table().
12646: '</p>';
12647: }
1.1067 raeburn 12648: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12649: if (ref($hiddenelements) eq 'HASH') {
12650: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12651: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12652: }
12653: }
12654: $output .= <<"END";
1.1067 raeburn 12655: <br />
1.1053 raeburn 12656: <input type="submit" name="decompress" value="$lt{'extr'}" />
12657: </form>
12658: $noextract
12659: END
12660: return $output;
12661: }
12662:
1.1065 raeburn 12663: sub decompression_utility {
12664: my ($program) = @_;
12665: my @utilities = ('tar','gunzip','bunzip2','unzip');
12666: my $location;
12667: if (grep(/^\Q$program\E$/,@utilities)) {
12668: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12669: '/usr/sbin/') {
12670: if (-x $dir.$program) {
12671: $location = $dir.$program;
12672: last;
12673: }
12674: }
12675: }
12676: return $location;
12677: }
12678:
12679: sub list_archive_contents {
12680: my ($file,$pathsref) = @_;
12681: my (@cmd,$output);
12682: my $needsregexp;
12683: if ($file =~ /\.zip$/) {
12684: @cmd = (&decompression_utility('unzip'),"-l");
12685: $needsregexp = 1;
12686: } elsif (($file =~ m/\.tar\.gz$/) ||
12687: ($file =~ /\.tgz$/)) {
12688: @cmd = (&decompression_utility('tar'),"-ztf");
12689: } elsif ($file =~ /\.tar\.bz2$/) {
12690: @cmd = (&decompression_utility('tar'),"-jtf");
12691: } elsif ($file =~ m|\.tar$|) {
12692: @cmd = (&decompression_utility('tar'),"-tf");
12693: }
12694: if (@cmd) {
12695: undef($!);
12696: undef($@);
12697: if (open(my $fh,"-|", @cmd, $file)) {
12698: while (my $line = <$fh>) {
12699: $output .= $line;
12700: chomp($line);
12701: my $item;
12702: if ($needsregexp) {
12703: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12704: } else {
12705: $item = $line;
12706: }
12707: if ($item ne '') {
12708: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12709: push(@{$pathsref},$item);
12710: }
12711: }
12712: }
12713: close($fh);
12714: }
12715: }
12716: return $output;
12717: }
12718:
1.1053 raeburn 12719: sub decompress_uploaded_file {
12720: my ($file,$dir) = @_;
12721: &Apache::lonnet::appenv({'cgi.file' => $file});
12722: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12723: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12724: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12725: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12726: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12727: my $decompressed = $env{'cgi.decompressed'};
12728: &Apache::lonnet::delenv('cgi.file');
12729: &Apache::lonnet::delenv('cgi.dir');
12730: &Apache::lonnet::delenv('cgi.decompressed');
12731: return ($decompressed,$result);
12732: }
12733:
1.1055 raeburn 12734: sub process_decompression {
12735: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 12736: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12737: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12738: &mt('Unexpected file path.').'</p>'."\n";
12739: }
12740: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12741: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12742: &mt('Unexpected course context.').'</p>'."\n";
12743: }
1.1293 raeburn 12744: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 12745: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12746: &mt('Filename contained unexpected characters.').'</p>'."\n";
12747: }
1.1055 raeburn 12748: my ($dir,$error,$warning,$output);
1.1180 raeburn 12749: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12750: $error = &mt('Filename not a supported archive file type.').
12751: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12752: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12753: } else {
12754: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12755: if ($docuhome eq 'no_host') {
12756: $error = &mt('Could not determine home server for course.');
12757: } else {
12758: my @ids=&Apache::lonnet::current_machine_ids();
12759: my $currdir = "$dir_root/$destination";
12760: if (grep(/^\Q$docuhome\E$/,@ids)) {
12761: $dir = &LONCAPA::propath($docudom,$docuname).
12762: "$dir_root/$destination";
12763: } else {
12764: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12765: "$dir_root/$docudom/$docuname/$destination";
12766: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12767: $error = &mt('Archive file not found.');
12768: }
12769: }
1.1065 raeburn 12770: my (@to_overwrite,@to_skip);
12771: if ($env{'form.archive_overwrite_total'} > 0) {
12772: my $total = $env{'form.archive_overwrite_total'};
12773: for (my $i=0; $i<$total; $i++) {
12774: if ($env{'form.archive_overwrite_'.$i} == 1) {
12775: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12776: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12777: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12778: }
12779: }
12780: }
12781: my $numskip = scalar(@to_skip);
1.1292 raeburn 12782: my $numoverwrite = scalar(@to_overwrite);
12783: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12784: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12785: } elsif ($dir eq '') {
1.1055 raeburn 12786: $error = &mt('Directory containing archive file unavailable.');
12787: } elsif (!$error) {
1.1065 raeburn 12788: my ($decompressed,$display);
1.1292 raeburn 12789: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12790: my $tempdir = time.'_'.$$.int(rand(10000));
12791: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 12792: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12793: ($decompressed,$display) =
12794: &decompress_uploaded_file($file,"$dir/$tempdir");
12795: foreach my $item (@to_skip) {
12796: if (($item ne '') && ($item !~ /\.\./)) {
12797: if (-f "$dir/$tempdir/$item") {
12798: unlink("$dir/$tempdir/$item");
12799: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 12800: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 12801: }
12802: }
12803: }
12804: foreach my $item (@to_overwrite) {
12805: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
12806: if (($item ne '') && ($item !~ /\.\./)) {
12807: if (-f "$dir/$item") {
12808: unlink("$dir/$item");
12809: } elsif (-d "$dir/$item") {
1.1300 raeburn 12810: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 12811: }
12812: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
12813: }
1.1065 raeburn 12814: }
12815: }
1.1292 raeburn 12816: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 12817: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 12818: }
1.1065 raeburn 12819: }
12820: } else {
12821: ($decompressed,$display) =
12822: &decompress_uploaded_file($file,$dir);
12823: }
1.1055 raeburn 12824: if ($decompressed eq 'ok') {
1.1065 raeburn 12825: $output = '<p class="LC_info">'.
12826: &mt('Files extracted successfully from archive.').
12827: '</p>'."\n";
1.1055 raeburn 12828: my ($warning,$result,@contents);
12829: my ($newdirlistref,$newlisterror) =
12830: &Apache::lonnet::dirlist($currdir,$docudom,
12831: $docuname,1);
12832: my (%is_dir,%changes,@newitems);
12833: my $dirptr = 16384;
1.1065 raeburn 12834: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12835: foreach my $dir_line (@{$newdirlistref}) {
12836: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 12837: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 12838: push(@newitems,$item);
12839: if ($dirptr&$testdir) {
12840: $is_dir{$item} = 1;
12841: }
12842: $changes{$item} = 1;
12843: }
12844: }
12845: }
12846: if (keys(%changes) > 0) {
12847: foreach my $item (sort(@newitems)) {
12848: if ($changes{$item}) {
12849: push(@contents,$item);
12850: }
12851: }
12852: }
12853: if (@contents > 0) {
1.1067 raeburn 12854: my $wantform;
12855: unless ($env{'form.autoextract_camtasia'}) {
12856: $wantform = 1;
12857: }
1.1056 raeburn 12858: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12859: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12860: $currdir,\%is_dir,
12861: \%children,\%parent,
1.1056 raeburn 12862: \@contents,\%dirorder,
12863: \%titles,$wantform);
1.1055 raeburn 12864: if ($datatable ne '') {
12865: $output .= &archive_options_form('decompressed',$datatable,
12866: $count,$hiddenelem);
1.1065 raeburn 12867: my $startcount = 6;
1.1055 raeburn 12868: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12869: \%titles,\%children);
1.1055 raeburn 12870: }
1.1067 raeburn 12871: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12872: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12873: my %displayed;
12874: my $total = 1;
12875: $env{'form.archive_directory'} = [];
12876: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12877: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12878: $path =~ s{/$}{};
12879: my $item;
12880: if ($path ne '') {
12881: $item = "$path/$titles{$i}";
12882: } else {
12883: $item = $titles{$i};
12884: }
12885: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12886: if ($item eq $contents[0]) {
12887: push(@{$env{'form.archive_directory'}},$i);
12888: $env{'form.archive_'.$i} = 'display';
12889: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12890: $displayed{'folder'} = $i;
1.1164 raeburn 12891: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12892: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12893: $env{'form.archive_'.$i} = 'display';
12894: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12895: $displayed{'web'} = $i;
12896: } else {
1.1164 raeburn 12897: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12898: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12899: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12900: push(@{$env{'form.archive_directory'}},$i);
12901: }
12902: $env{'form.archive_'.$i} = 'dependency';
12903: }
12904: $total ++;
12905: }
12906: for (my $i=1; $i<$total; $i++) {
12907: next if ($i == $displayed{'web'});
12908: next if ($i == $displayed{'folder'});
12909: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12910: }
12911: $env{'form.phase'} = 'decompress_cleanup';
12912: $env{'form.archivedelete'} = 1;
12913: $env{'form.archive_count'} = $total-1;
12914: $output .=
12915: &process_extracted_files('coursedocs',$docudom,
12916: $docuname,$destination,
12917: $dir_root,$hiddenelem);
12918: }
1.1055 raeburn 12919: } else {
12920: $warning = &mt('No new items extracted from archive file.');
12921: }
12922: } else {
12923: $output = $display;
12924: $error = &mt('An error occurred during extraction from the archive file.');
12925: }
12926: }
12927: }
12928: }
12929: if ($error) {
12930: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12931: $error.'</p>'."\n";
12932: }
12933: if ($warning) {
12934: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12935: }
12936: return $output;
12937: }
12938:
12939: sub get_extracted {
1.1056 raeburn 12940: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12941: $titles,$wantform) = @_;
1.1055 raeburn 12942: my $count = 0;
12943: my $depth = 0;
12944: my $datatable;
1.1056 raeburn 12945: my @hierarchy;
1.1055 raeburn 12946: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12947: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12948: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12949: foreach my $item (@{$contents}) {
12950: $count ++;
1.1056 raeburn 12951: @{$dirorder->{$count}} = @hierarchy;
12952: $titles->{$count} = $item;
1.1055 raeburn 12953: &archive_hierarchy($depth,$count,$parent,$children);
12954: if ($wantform) {
12955: $datatable .= &archive_row($is_dir->{$item},$item,
12956: $currdir,$depth,$count);
12957: }
12958: if ($is_dir->{$item}) {
12959: $depth ++;
1.1056 raeburn 12960: push(@hierarchy,$count);
12961: $parent->{$depth} = $count;
1.1055 raeburn 12962: $datatable .=
12963: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12964: \$depth,\$count,\@hierarchy,$dirorder,
12965: $children,$parent,$titles,$wantform);
1.1055 raeburn 12966: $depth --;
1.1056 raeburn 12967: pop(@hierarchy);
1.1055 raeburn 12968: }
12969: }
12970: return ($count,$datatable);
12971: }
12972:
12973: sub recurse_extracted_archive {
1.1056 raeburn 12974: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12975: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12976: my $result='';
1.1056 raeburn 12977: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12978: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12979: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12980: return $result;
12981: }
12982: my $dirptr = 16384;
12983: my ($newdirlistref,$newlisterror) =
12984: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12985: if (ref($newdirlistref) eq 'ARRAY') {
12986: foreach my $dir_line (@{$newdirlistref}) {
12987: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12988: unless ($item =~ /^\.+$/) {
12989: $$count ++;
1.1056 raeburn 12990: @{$dirorder->{$$count}} = @{$hierarchy};
12991: $titles->{$$count} = $item;
1.1055 raeburn 12992: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12993:
1.1055 raeburn 12994: my $is_dir;
12995: if ($dirptr&$testdir) {
12996: $is_dir = 1;
12997: }
12998: if ($wantform) {
12999: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13000: }
13001: if ($is_dir) {
13002: $$depth ++;
1.1056 raeburn 13003: push(@{$hierarchy},$$count);
13004: $parent->{$$depth} = $$count;
1.1055 raeburn 13005: $result .=
13006: &recurse_extracted_archive("$currdir/$item",$docudom,
13007: $docuname,$depth,$count,
1.1056 raeburn 13008: $hierarchy,$dirorder,$children,
13009: $parent,$titles,$wantform);
1.1055 raeburn 13010: $$depth --;
1.1056 raeburn 13011: pop(@{$hierarchy});
1.1055 raeburn 13012: }
13013: }
13014: }
13015: }
13016: return $result;
13017: }
13018:
13019: sub archive_hierarchy {
13020: my ($depth,$count,$parent,$children) =@_;
13021: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13022: if (exists($parent->{$depth})) {
13023: $children->{$parent->{$depth}} .= $count.':';
13024: }
13025: }
13026: return;
13027: }
13028:
13029: sub archive_row {
13030: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13031: my ($name) = ($item =~ m{([^/]+)$});
13032: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13033: 'display' => 'Add as file',
1.1055 raeburn 13034: 'dependency' => 'Include as dependency',
13035: 'discard' => 'Discard',
13036: );
13037: if ($is_dir) {
1.1059 raeburn 13038: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13039: }
1.1056 raeburn 13040: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13041: my $offset = 0;
1.1055 raeburn 13042: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13043: $offset ++;
1.1065 raeburn 13044: if ($action ne 'display') {
13045: $offset ++;
13046: }
1.1055 raeburn 13047: $output .= '<td><span class="LC_nobreak">'.
13048: '<label><input type="radio" name="archive_'.$count.
13049: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13050: my $text = $choices{$action};
13051: if ($is_dir) {
13052: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13053: if ($action eq 'display') {
1.1059 raeburn 13054: $text = &mt('Add as folder');
1.1055 raeburn 13055: }
1.1056 raeburn 13056: } else {
13057: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13058:
13059: }
13060: $output .= ' /> '.$choices{$action}.'</label></span>';
13061: if ($action eq 'dependency') {
13062: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13063: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13064: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13065: '<option value=""></option>'."\n".
13066: '</select>'."\n".
13067: '</div>';
1.1059 raeburn 13068: } elsif ($action eq 'display') {
13069: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13070: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13071: '</div>';
1.1055 raeburn 13072: }
1.1056 raeburn 13073: $output .= '</td>';
1.1055 raeburn 13074: }
13075: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13076: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13077: for (my $i=0; $i<$depth; $i++) {
13078: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13079: }
13080: if ($is_dir) {
13081: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13082: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13083: } else {
13084: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13085: }
13086: $output .= ' '.$name.'</td>'."\n".
13087: &end_data_table_row();
13088: return $output;
13089: }
13090:
13091: sub archive_options_form {
1.1065 raeburn 13092: my ($form,$display,$count,$hiddenelem) = @_;
13093: my %lt = &Apache::lonlocal::texthash(
13094: perm => 'Permanently remove archive file?',
13095: hows => 'How should each extracted item be incorporated in the course?',
13096: cont => 'Content actions for all',
13097: addf => 'Add as folder/file',
13098: incd => 'Include as dependency for a displayed file',
13099: disc => 'Discard',
13100: no => 'No',
13101: yes => 'Yes',
13102: save => 'Save',
13103: );
13104: my $output = <<"END";
13105: <form name="$form" method="post" action="">
13106: <p><span class="LC_nobreak">$lt{'perm'}
13107: <label>
13108: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13109: </label>
13110:
13111: <label>
13112: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13113: </span>
13114: </p>
13115: <input type="hidden" name="phase" value="decompress_cleanup" />
13116: <br />$lt{'hows'}
13117: <div class="LC_columnSection">
13118: <fieldset>
13119: <legend>$lt{'cont'}</legend>
13120: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13121: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13122: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13123: </fieldset>
13124: </div>
13125: END
13126: return $output.
1.1055 raeburn 13127: &start_data_table()."\n".
1.1065 raeburn 13128: $display."\n".
1.1055 raeburn 13129: &end_data_table()."\n".
13130: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13131: $hiddenelem.
1.1065 raeburn 13132: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13133: '</form>';
13134: }
13135:
13136: sub archive_javascript {
1.1056 raeburn 13137: my ($startcount,$numitems,$titles,$children) = @_;
13138: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13139: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13140: my $scripttag = <<START;
13141: <script type="text/javascript">
13142: // <![CDATA[
13143:
13144: function checkAll(form,prefix) {
13145: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13146: for (var i=0; i < form.elements.length; i++) {
13147: var id = form.elements[i].id;
13148: if ((id != '') && (id != undefined)) {
13149: if (idstr.test(id)) {
13150: if (form.elements[i].type == 'radio') {
13151: form.elements[i].checked = true;
1.1056 raeburn 13152: var nostart = i-$startcount;
1.1059 raeburn 13153: var offset = nostart%7;
13154: var count = (nostart-offset)/7;
1.1056 raeburn 13155: dependencyCheck(form,count,offset);
1.1055 raeburn 13156: }
13157: }
13158: }
13159: }
13160: }
13161:
13162: function propagateCheck(form,count) {
13163: if (count > 0) {
1.1059 raeburn 13164: var startelement = $startcount + ((count-1) * 7);
13165: for (var j=1; j<6; j++) {
13166: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13167: var item = startelement + j;
13168: if (form.elements[item].type == 'radio') {
13169: if (form.elements[item].checked) {
13170: containerCheck(form,count,j);
13171: break;
13172: }
1.1055 raeburn 13173: }
13174: }
13175: }
13176: }
13177: }
13178:
13179: numitems = $numitems
1.1056 raeburn 13180: var titles = new Array(numitems);
13181: var parents = new Array(numitems);
1.1055 raeburn 13182: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13183: parents[i] = new Array;
1.1055 raeburn 13184: }
1.1059 raeburn 13185: var maintitle = '$maintitle';
1.1055 raeburn 13186:
13187: START
13188:
1.1056 raeburn 13189: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13190: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13191: for (my $i=0; $i<@contents; $i ++) {
13192: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13193: }
13194: }
13195:
1.1056 raeburn 13196: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13197: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13198: }
13199:
1.1055 raeburn 13200: $scripttag .= <<END;
13201:
13202: function containerCheck(form,count,offset) {
13203: if (count > 0) {
1.1056 raeburn 13204: dependencyCheck(form,count,offset);
1.1059 raeburn 13205: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13206: form.elements[item].checked = true;
13207: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13208: if (parents[count].length > 0) {
13209: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13210: containerCheck(form,parents[count][j],offset);
13211: }
13212: }
13213: }
13214: }
13215: }
13216:
13217: function dependencyCheck(form,count,offset) {
13218: if (count > 0) {
1.1059 raeburn 13219: var chosen = (offset+$startcount)+7*(count-1);
13220: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13221: var currtype = form.elements[depitem].type;
13222: if (form.elements[chosen].value == 'dependency') {
13223: document.getElementById('arc_depon_'+count).style.display='block';
13224: form.elements[depitem].options.length = 0;
13225: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13226: for (var i=1; i<=numitems; i++) {
13227: if (i == count) {
13228: continue;
13229: }
1.1059 raeburn 13230: var startelement = $startcount + (i-1) * 7;
13231: for (var j=1; j<6; j++) {
13232: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13233: var item = startelement + j;
13234: if (form.elements[item].type == 'radio') {
13235: if (form.elements[item].checked) {
13236: if (form.elements[item].value == 'display') {
13237: var n = form.elements[depitem].options.length;
13238: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13239: }
13240: }
13241: }
13242: }
13243: }
13244: }
13245: } else {
13246: document.getElementById('arc_depon_'+count).style.display='none';
13247: form.elements[depitem].options.length = 0;
13248: form.elements[depitem].options[0] = new Option('Select','',true,true);
13249: }
1.1059 raeburn 13250: titleCheck(form,count,offset);
1.1056 raeburn 13251: }
13252: }
13253:
13254: function propagateSelect(form,count,offset) {
13255: if (count > 0) {
1.1065 raeburn 13256: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13257: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13258: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13259: if (parents[count].length > 0) {
13260: for (var j=0; j<parents[count].length; j++) {
13261: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13262: }
13263: }
13264: }
13265: }
13266: }
1.1056 raeburn 13267:
13268: function containerSelect(form,count,offset,picked) {
13269: if (count > 0) {
1.1065 raeburn 13270: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13271: if (form.elements[item].type == 'radio') {
13272: if (form.elements[item].value == 'dependency') {
13273: if (form.elements[item+1].type == 'select-one') {
13274: for (var i=0; i<form.elements[item+1].options.length; i++) {
13275: if (form.elements[item+1].options[i].value == picked) {
13276: form.elements[item+1].selectedIndex = i;
13277: break;
13278: }
13279: }
13280: }
13281: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13282: if (parents[count].length > 0) {
13283: for (var j=0; j<parents[count].length; j++) {
13284: containerSelect(form,parents[count][j],offset,picked);
13285: }
13286: }
13287: }
13288: }
13289: }
13290: }
13291: }
13292:
1.1059 raeburn 13293: function titleCheck(form,count,offset) {
13294: if (count > 0) {
13295: var chosen = (offset+$startcount)+7*(count-1);
13296: var depitem = $startcount + ((count-1) * 7) + 2;
13297: var currtype = form.elements[depitem].type;
13298: if (form.elements[chosen].value == 'display') {
13299: document.getElementById('arc_title_'+count).style.display='block';
13300: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13301: document.getElementById('archive_title_'+count).value=maintitle;
13302: }
13303: } else {
13304: document.getElementById('arc_title_'+count).style.display='none';
13305: if (currtype == 'text') {
13306: document.getElementById('archive_title_'+count).value='';
13307: }
13308: }
13309: }
13310: return;
13311: }
13312:
1.1055 raeburn 13313: // ]]>
13314: </script>
13315: END
13316: return $scripttag;
13317: }
13318:
13319: sub process_extracted_files {
1.1067 raeburn 13320: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13321: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 13322: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 13323: my @ids=&Apache::lonnet::current_machine_ids();
13324: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13325: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13326: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13327: if (grep(/^\Q$docuhome\E$/,@ids)) {
13328: $prefix = &LONCAPA::propath($docudom,$docuname);
13329: $pathtocheck = "$dir_root/$destination";
13330: $dir = $dir_root;
13331: $ishome = 1;
13332: } else {
13333: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13334: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 13335: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 13336: }
13337: my $currdir = "$dir_root/$destination";
13338: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13339: if ($env{'form.folderpath'}) {
13340: my @items = split('&',$env{'form.folderpath'});
13341: $folders{'0'} = $items[-2];
1.1099 raeburn 13342: if ($env{'form.folderpath'} =~ /\:1$/) {
13343: $containers{'0'}='page';
13344: } else {
13345: $containers{'0'}='sequence';
13346: }
1.1055 raeburn 13347: }
13348: my @archdirs = &get_env_multiple('form.archive_directory');
13349: if ($numitems) {
13350: for (my $i=1; $i<=$numitems; $i++) {
13351: my $path = $env{'form.archive_content_'.$i};
13352: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13353: my $item = $1;
13354: $toplevelitems{$item} = $i;
13355: if (grep(/^\Q$i\E$/,@archdirs)) {
13356: $is_dir{$item} = 1;
13357: }
13358: }
13359: }
13360: }
1.1067 raeburn 13361: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13362: if (keys(%toplevelitems) > 0) {
13363: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13364: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13365: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13366: }
1.1066 raeburn 13367: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13368: if ($numitems) {
13369: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13370: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13371: my $path = $env{'form.archive_content_'.$i};
13372: if ($path =~ /^\Q$pathtocheck\E/) {
13373: if ($env{'form.archive_'.$i} eq 'discard') {
13374: if ($prefix ne '' && $path ne '') {
13375: if (-e $prefix.$path) {
1.1066 raeburn 13376: if ((@archdirs > 0) &&
13377: (grep(/^\Q$i\E$/,@archdirs))) {
13378: $todeletedir{$prefix.$path} = 1;
13379: } else {
13380: $todelete{$prefix.$path} = 1;
13381: }
1.1055 raeburn 13382: }
13383: }
13384: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13385: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13386: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13387: $docstitle = $env{'form.archive_title_'.$i};
13388: if ($docstitle eq '') {
13389: $docstitle = $title;
13390: }
1.1055 raeburn 13391: $outer = 0;
1.1056 raeburn 13392: if (ref($dirorder{$i}) eq 'ARRAY') {
13393: if (@{$dirorder{$i}} > 0) {
13394: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13395: if ($env{'form.archive_'.$item} eq 'display') {
13396: $outer = $item;
13397: last;
13398: }
13399: }
13400: }
13401: }
13402: my ($errtext,$fatal) =
13403: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13404: '/'.$folders{$outer}.'.'.
13405: $containers{$outer});
13406: next if ($fatal);
13407: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13408: if ($context eq 'coursedocs') {
1.1056 raeburn 13409: $mapinner{$i} = time;
1.1055 raeburn 13410: $folders{$i} = 'default_'.$mapinner{$i};
13411: $containers{$i} = 'sequence';
13412: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13413: $folders{$i}.'.'.$containers{$i};
13414: my $newidx = &LONCAPA::map::getresidx();
13415: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13416: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13417: push(@LONCAPA::map::order,$newidx);
13418: my ($outtext,$errtext) =
13419: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13420: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13421: '.'.$containers{$outer},1,1);
1.1056 raeburn 13422: $newseqid{$i} = $newidx;
1.1067 raeburn 13423: unless ($errtext) {
1.1294 raeburn 13424: $result .= '<li>'.&mt('Folder: [_1] added to course',
13425: &HTML::Entities::encode($docstitle,'<>&"')).
13426: '</li>'."\n";
1.1067 raeburn 13427: }
1.1055 raeburn 13428: }
13429: } else {
13430: if ($context eq 'coursedocs') {
13431: my $newidx=&LONCAPA::map::getresidx();
13432: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13433: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13434: $title;
1.1294 raeburn 13435: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
13436: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13437: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13438: }
13439: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13440: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13441: }
13442: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13443: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
13444: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
13445: unless ($ishome) {
13446: my $fetch = "$newdest{$i}/$title";
13447: $fetch =~ s/^\Q$prefix$dir\E//;
13448: $prompttofetch{$fetch} = 1;
13449: }
1.1292 raeburn 13450: }
1.1067 raeburn 13451: }
1.1294 raeburn 13452: $LONCAPA::map::resources[$newidx]=
13453: $docstitle.':'.$url.':false:normal:res';
13454: push(@LONCAPA::map::order, $newidx);
13455: my ($outtext,$errtext)=
13456: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13457: $docuname.'/'.$folders{$outer}.
13458: '.'.$containers{$outer},1,1);
13459: unless ($errtext) {
13460: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13461: $result .= '<li>'.&mt('File: [_1] added to course',
13462: &HTML::Entities::encode($docstitle,'<>&"')).
13463: '</li>'."\n";
13464: }
1.1067 raeburn 13465: }
1.1294 raeburn 13466: } else {
13467: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13468: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 13469: }
1.1055 raeburn 13470: }
13471: }
1.1086 raeburn 13472: }
13473: } else {
1.1294 raeburn 13474: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13475: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 13476: }
13477: }
13478: for (my $i=1; $i<=$numitems; $i++) {
13479: next unless ($env{'form.archive_'.$i} eq 'dependency');
13480: my $path = $env{'form.archive_content_'.$i};
13481: if ($path =~ /^\Q$pathtocheck\E/) {
13482: my ($title) = ($path =~ m{/([^/]+)$});
13483: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13484: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13485: if (ref($dirorder{$i}) eq 'ARRAY') {
13486: my ($itemidx,$fullpath,$relpath);
13487: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13488: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13489: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13490: if ($dirorder{$i}->[$j] eq $container) {
13491: $itemidx = $j;
1.1056 raeburn 13492: }
13493: }
1.1086 raeburn 13494: }
13495: if ($itemidx eq '') {
13496: $itemidx = 0;
13497: }
13498: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13499: if ($mapinner{$referrer{$i}}) {
13500: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13501: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13502: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13503: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13504: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13505: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13506: if (!-e $fullpath) {
13507: mkdir($fullpath,0755);
1.1056 raeburn 13508: }
13509: }
1.1086 raeburn 13510: } else {
13511: last;
1.1056 raeburn 13512: }
1.1086 raeburn 13513: }
13514: }
13515: } elsif ($newdest{$referrer{$i}}) {
13516: $fullpath = $newdest{$referrer{$i}};
13517: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13518: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13519: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13520: last;
13521: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13522: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13523: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13524: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13525: if (!-e $fullpath) {
13526: mkdir($fullpath,0755);
1.1056 raeburn 13527: }
13528: }
1.1086 raeburn 13529: } else {
13530: last;
1.1056 raeburn 13531: }
1.1055 raeburn 13532: }
13533: }
1.1086 raeburn 13534: if ($fullpath ne '') {
13535: if (-e "$prefix$path") {
1.1292 raeburn 13536: unless (rename("$prefix$path","$fullpath/$title")) {
13537: $warning .= &mt('Failed to rename dependency').'<br />';
13538: }
1.1086 raeburn 13539: }
13540: if (-e "$fullpath/$title") {
13541: my $showpath;
13542: if ($relpath ne '') {
13543: $showpath = "$relpath/$title";
13544: } else {
13545: $showpath = "/$title";
13546: }
1.1294 raeburn 13547: $result .= '<li>'.&mt('[_1] included as a dependency',
13548: &HTML::Entities::encode($showpath,'<>&"')).
13549: '</li>'."\n";
1.1292 raeburn 13550: unless ($ishome) {
13551: my $fetch = "$fullpath/$title";
13552: $fetch =~ s/^\Q$prefix$dir\E//;
13553: $prompttofetch{$fetch} = 1;
13554: }
1.1086 raeburn 13555: }
13556: }
1.1055 raeburn 13557: }
1.1086 raeburn 13558: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13559: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 13560: &HTML::Entities::encode($path,'<>&"'),
13561: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13562: '<br />';
1.1055 raeburn 13563: }
13564: } else {
1.1294 raeburn 13565: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 13566: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13567: }
13568: }
13569: if (keys(%todelete)) {
13570: foreach my $key (keys(%todelete)) {
13571: unlink($key);
1.1066 raeburn 13572: }
13573: }
13574: if (keys(%todeletedir)) {
13575: foreach my $key (keys(%todeletedir)) {
13576: rmdir($key);
13577: }
13578: }
13579: foreach my $dir (sort(keys(%is_dir))) {
13580: if (($pathtocheck ne '') && ($dir ne '')) {
13581: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13582: }
13583: }
1.1067 raeburn 13584: if ($result ne '') {
13585: $output .= '<ul>'."\n".
13586: $result."\n".
13587: '</ul>';
13588: }
13589: unless ($ishome) {
13590: my $replicationfail;
13591: foreach my $item (keys(%prompttofetch)) {
13592: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13593: unless ($fetchresult eq 'ok') {
13594: $replicationfail .= '<li>'.$item.'</li>'."\n";
13595: }
13596: }
13597: if ($replicationfail) {
13598: $output .= '<p class="LC_error">'.
13599: &mt('Course home server failed to retrieve:').'<ul>'.
13600: $replicationfail.
13601: '</ul></p>';
13602: }
13603: }
1.1055 raeburn 13604: } else {
13605: $warning = &mt('No items found in archive.');
13606: }
13607: if ($error) {
13608: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13609: $error.'</p>'."\n";
13610: }
13611: if ($warning) {
13612: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13613: }
13614: return $output;
13615: }
13616:
1.1066 raeburn 13617: sub cleanup_empty_dirs {
13618: my ($path) = @_;
13619: if (($path ne '') && (-d $path)) {
13620: if (opendir(my $dirh,$path)) {
13621: my @dircontents = grep(!/^\./,readdir($dirh));
13622: my $numitems = 0;
13623: foreach my $item (@dircontents) {
13624: if (-d "$path/$item") {
1.1111 raeburn 13625: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13626: if (-e "$path/$item") {
13627: $numitems ++;
13628: }
13629: } else {
13630: $numitems ++;
13631: }
13632: }
13633: if ($numitems == 0) {
13634: rmdir($path);
13635: }
13636: closedir($dirh);
13637: }
13638: }
13639: return;
13640: }
13641:
1.41 ng 13642: =pod
1.45 matthew 13643:
1.1162 raeburn 13644: =item * &get_folder_hierarchy()
1.1068 raeburn 13645:
13646: Provides hierarchy of names of folders/sub-folders containing the current
13647: item,
13648:
13649: Inputs: 3
13650: - $navmap - navmaps object
13651:
13652: - $map - url for map (either the trigger itself, or map containing
13653: the resource, which is the trigger).
13654:
13655: - $showitem - 1 => show title for map itself; 0 => do not show.
13656:
13657: Outputs: 1 @pathitems - array of folder/subfolder names.
13658:
13659: =cut
13660:
13661: sub get_folder_hierarchy {
13662: my ($navmap,$map,$showitem) = @_;
13663: my @pathitems;
13664: if (ref($navmap)) {
13665: my $mapres = $navmap->getResourceByUrl($map);
13666: if (ref($mapres)) {
13667: my $pcslist = $mapres->map_hierarchy();
13668: if ($pcslist ne '') {
13669: my @pcs = split(/,/,$pcslist);
13670: foreach my $pc (@pcs) {
13671: if ($pc == 1) {
1.1129 raeburn 13672: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13673: } else {
13674: my $res = $navmap->getByMapPc($pc);
13675: if (ref($res)) {
13676: my $title = $res->compTitle();
13677: $title =~ s/\W+/_/g;
13678: if ($title ne '') {
13679: push(@pathitems,$title);
13680: }
13681: }
13682: }
13683: }
13684: }
1.1071 raeburn 13685: if ($showitem) {
13686: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13687: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13688: } else {
13689: my $maptitle = $mapres->compTitle();
13690: $maptitle =~ s/\W+/_/g;
13691: if ($maptitle ne '') {
13692: push(@pathitems,$maptitle);
13693: }
1.1068 raeburn 13694: }
13695: }
13696: }
13697: }
13698: return @pathitems;
13699: }
13700:
13701: =pod
13702:
1.1015 raeburn 13703: =item * &get_turnedin_filepath()
13704:
13705: Determines path in a user's portfolio file for storage of files uploaded
13706: to a specific essayresponse or dropbox item.
13707:
13708: Inputs: 3 required + 1 optional.
13709: $symb is symb for resource, $uname and $udom are for current user (required).
13710: $caller is optional (can be "submission", if routine is called when storing
13711: an upoaded file when "Submit Answer" button was pressed).
13712:
13713: Returns array containing $path and $multiresp.
13714: $path is path in portfolio. $multiresp is 1 if this resource contains more
13715: than one file upload item. Callers of routine should append partid as a
13716: subdirectory to $path in cases where $multiresp is 1.
13717:
13718: Called by: homework/essayresponse.pm and homework/structuretags.pm
13719:
13720: =cut
13721:
13722: sub get_turnedin_filepath {
13723: my ($symb,$uname,$udom,$caller) = @_;
13724: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13725: my $turnindir;
13726: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13727: $turnindir = $userhash{'turnindir'};
13728: my ($path,$multiresp);
13729: if ($turnindir eq '') {
13730: if ($caller eq 'submission') {
13731: $turnindir = &mt('turned in');
13732: $turnindir =~ s/\W+/_/g;
13733: my %newhash = (
13734: 'turnindir' => $turnindir,
13735: );
13736: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13737: }
13738: }
13739: if ($turnindir ne '') {
13740: $path = '/'.$turnindir.'/';
13741: my ($multipart,$turnin,@pathitems);
13742: my $navmap = Apache::lonnavmaps::navmap->new();
13743: if (defined($navmap)) {
13744: my $mapres = $navmap->getResourceByUrl($map);
13745: if (ref($mapres)) {
13746: my $pcslist = $mapres->map_hierarchy();
13747: if ($pcslist ne '') {
13748: foreach my $pc (split(/,/,$pcslist)) {
13749: my $res = $navmap->getByMapPc($pc);
13750: if (ref($res)) {
13751: my $title = $res->compTitle();
13752: $title =~ s/\W+/_/g;
13753: if ($title ne '') {
1.1149 raeburn 13754: if (($pc > 1) && (length($title) > 12)) {
13755: $title = substr($title,0,12);
13756: }
1.1015 raeburn 13757: push(@pathitems,$title);
13758: }
13759: }
13760: }
13761: }
13762: my $maptitle = $mapres->compTitle();
13763: $maptitle =~ s/\W+/_/g;
13764: if ($maptitle ne '') {
1.1149 raeburn 13765: if (length($maptitle) > 12) {
13766: $maptitle = substr($maptitle,0,12);
13767: }
1.1015 raeburn 13768: push(@pathitems,$maptitle);
13769: }
13770: unless ($env{'request.state'} eq 'construct') {
13771: my $res = $navmap->getBySymb($symb);
13772: if (ref($res)) {
13773: my $partlist = $res->parts();
13774: my $totaluploads = 0;
13775: if (ref($partlist) eq 'ARRAY') {
13776: foreach my $part (@{$partlist}) {
13777: my @types = $res->responseType($part);
13778: my @ids = $res->responseIds($part);
13779: for (my $i=0; $i < scalar(@ids); $i++) {
13780: if ($types[$i] eq 'essay') {
13781: my $partid = $part.'_'.$ids[$i];
13782: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13783: $totaluploads ++;
13784: }
13785: }
13786: }
13787: }
13788: if ($totaluploads > 1) {
13789: $multiresp = 1;
13790: }
13791: }
13792: }
13793: }
13794: } else {
13795: return;
13796: }
13797: } else {
13798: return;
13799: }
13800: my $restitle=&Apache::lonnet::gettitle($symb);
13801: $restitle =~ s/\W+/_/g;
13802: if ($restitle eq '') {
13803: $restitle = ($resurl =~ m{/[^/]+$});
13804: if ($restitle eq '') {
13805: $restitle = time;
13806: }
13807: }
1.1149 raeburn 13808: if (length($restitle) > 12) {
13809: $restitle = substr($restitle,0,12);
13810: }
1.1015 raeburn 13811: push(@pathitems,$restitle);
13812: $path .= join('/',@pathitems);
13813: }
13814: return ($path,$multiresp);
13815: }
13816:
13817: =pod
13818:
1.464 albertel 13819: =back
1.41 ng 13820:
1.112 bowersj2 13821: =head1 CSV Upload/Handling functions
1.38 albertel 13822:
1.41 ng 13823: =over 4
13824:
1.648 raeburn 13825: =item * &upfile_store($r)
1.41 ng 13826:
13827: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13828: needs $env{'form.upfile'}
1.41 ng 13829: returns $datatoken to be put into hidden field
13830:
13831: =cut
1.31 albertel 13832:
13833: sub upfile_store {
13834: my $r=shift;
1.258 albertel 13835: $env{'form.upfile'}=~s/\r/\n/gs;
13836: $env{'form.upfile'}=~s/\f/\n/gs;
13837: $env{'form.upfile'}=~s/\n+/\n/gs;
13838: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13839:
1.1299 raeburn 13840: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
13841: '_enroll_'.$env{'request.course.id'}.'_'.
13842: time.'_'.$$);
13843: return if ($datatoken eq '');
13844:
1.31 albertel 13845: {
1.158 raeburn 13846: my $datafile = $r->dir_config('lonDaemons').
13847: '/tmp/'.$datatoken.'.tmp';
13848: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13849: print $fh $env{'form.upfile'};
1.158 raeburn 13850: close($fh);
13851: }
1.31 albertel 13852: }
13853: return $datatoken;
13854: }
13855:
1.56 matthew 13856: =pod
13857:
1.1290 raeburn 13858: =item * &load_tmp_file($r,$datatoken)
1.41 ng 13859:
13860: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 13861: $datatoken is the name to assign to the temporary file.
1.258 albertel 13862: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13863:
13864: =cut
1.31 albertel 13865:
13866: sub load_tmp_file {
1.1290 raeburn 13867: my ($r,$datatoken) = @_;
13868: return if ($datatoken eq '');
1.31 albertel 13869: my @studentdata=();
13870: {
1.158 raeburn 13871: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 13872: '/tmp/'.$datatoken.'.tmp';
1.158 raeburn 13873: if ( open(my $fh,"<$studentfile") ) {
13874: @studentdata=<$fh>;
13875: close($fh);
13876: }
1.31 albertel 13877: }
1.258 albertel 13878: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13879: }
13880:
1.1290 raeburn 13881: sub valid_datatoken {
13882: my ($datatoken) = @_;
1.1291 raeburn 13883: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {
1.1290 raeburn 13884: return $datatoken;
13885: }
13886: return;
13887: }
13888:
1.56 matthew 13889: =pod
13890:
1.648 raeburn 13891: =item * &upfile_record_sep()
1.41 ng 13892:
13893: Separate uploaded file into records
13894: returns array of records,
1.258 albertel 13895: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13896:
13897: =cut
1.31 albertel 13898:
13899: sub upfile_record_sep {
1.258 albertel 13900: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13901: } else {
1.248 albertel 13902: my @records;
1.258 albertel 13903: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13904: if ($line=~/^\s*$/) { next; }
13905: push(@records,$line);
13906: }
13907: return @records;
1.31 albertel 13908: }
13909: }
13910:
1.56 matthew 13911: =pod
13912:
1.648 raeburn 13913: =item * &record_sep($record)
1.41 ng 13914:
1.258 albertel 13915: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13916:
13917: =cut
13918:
1.263 www 13919: sub takeleft {
13920: my $index=shift;
13921: return substr('0000'.$index,-4,4);
13922: }
13923:
1.31 albertel 13924: sub record_sep {
13925: my $record=shift;
13926: my %components=();
1.258 albertel 13927: if ($env{'form.upfiletype'} eq 'xml') {
13928: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13929: my $i=0;
1.356 albertel 13930: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13931: $field=~s/^(\"|\')//;
13932: $field=~s/(\"|\')$//;
1.263 www 13933: $components{&takeleft($i)}=$field;
1.31 albertel 13934: $i++;
13935: }
1.258 albertel 13936: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13937: my $i=0;
1.356 albertel 13938: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13939: $field=~s/^(\"|\')//;
13940: $field=~s/(\"|\')$//;
1.263 www 13941: $components{&takeleft($i)}=$field;
1.31 albertel 13942: $i++;
13943: }
13944: } else {
1.561 www 13945: my $separator=',';
1.480 banghart 13946: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13947: $separator=';';
1.480 banghart 13948: }
1.31 albertel 13949: my $i=0;
1.561 www 13950: # the character we are looking for to indicate the end of a quote or a record
13951: my $looking_for=$separator;
13952: # do not add the characters to the fields
13953: my $ignore=0;
13954: # we just encountered a separator (or the beginning of the record)
13955: my $just_found_separator=1;
13956: # store the field we are working on here
13957: my $field='';
13958: # work our way through all characters in record
13959: foreach my $character ($record=~/(.)/g) {
13960: if ($character eq $looking_for) {
13961: if ($character ne $separator) {
13962: # Found the end of a quote, again looking for separator
13963: $looking_for=$separator;
13964: $ignore=1;
13965: } else {
13966: # Found a separator, store away what we got
13967: $components{&takeleft($i)}=$field;
13968: $i++;
13969: $just_found_separator=1;
13970: $ignore=0;
13971: $field='';
13972: }
13973: next;
13974: }
13975: # single or double quotation marks after a separator indicate beginning of a quote
13976: # we are now looking for the end of the quote and need to ignore separators
13977: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13978: $looking_for=$character;
13979: next;
13980: }
13981: # ignore would be true after we reached the end of a quote
13982: if ($ignore) { next; }
13983: if (($just_found_separator) && ($character=~/\s/)) { next; }
13984: $field.=$character;
13985: $just_found_separator=0;
1.31 albertel 13986: }
1.561 www 13987: # catch the very last entry, since we never encountered the separator
13988: $components{&takeleft($i)}=$field;
1.31 albertel 13989: }
13990: return %components;
13991: }
13992:
1.144 matthew 13993: ######################################################
13994: ######################################################
13995:
1.56 matthew 13996: =pod
13997:
1.648 raeburn 13998: =item * &upfile_select_html()
1.41 ng 13999:
1.144 matthew 14000: Return HTML code to select a file from the users machine and specify
14001: the file type.
1.41 ng 14002:
14003: =cut
14004:
1.144 matthew 14005: ######################################################
14006: ######################################################
1.31 albertel 14007: sub upfile_select_html {
1.144 matthew 14008: my %Types = (
14009: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14010: semisv => &mt('Semicolon separated values'),
1.144 matthew 14011: space => &mt('Space separated'),
14012: tab => &mt('Tabulator separated'),
14013: # xml => &mt('HTML/XML'),
14014: );
14015: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14016: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14017: foreach my $type (sort(keys(%Types))) {
14018: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14019: }
14020: $Str .= "</select>\n";
14021: return $Str;
1.31 albertel 14022: }
14023:
1.301 albertel 14024: sub get_samples {
14025: my ($records,$toget) = @_;
14026: my @samples=({});
14027: my $got=0;
14028: foreach my $rec (@$records) {
14029: my %temp = &record_sep($rec);
14030: if (! grep(/\S/, values(%temp))) { next; }
14031: if (%temp) {
14032: $samples[$got]=\%temp;
14033: $got++;
14034: if ($got == $toget) { last; }
14035: }
14036: }
14037: return \@samples;
14038: }
14039:
1.144 matthew 14040: ######################################################
14041: ######################################################
14042:
1.56 matthew 14043: =pod
14044:
1.648 raeburn 14045: =item * &csv_print_samples($r,$records)
1.41 ng 14046:
14047: Prints a table of sample values from each column uploaded $r is an
14048: Apache Request ref, $records is an arrayref from
14049: &Apache::loncommon::upfile_record_sep
14050:
14051: =cut
14052:
1.144 matthew 14053: ######################################################
14054: ######################################################
1.31 albertel 14055: sub csv_print_samples {
14056: my ($r,$records) = @_;
1.662 bisitz 14057: my $samples = &get_samples($records,5);
1.301 albertel 14058:
1.594 raeburn 14059: $r->print(&mt('Samples').'<br />'.&start_data_table().
14060: &start_data_table_header_row());
1.356 albertel 14061: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14062: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14063: $r->print(&end_data_table_header_row());
1.301 albertel 14064: foreach my $hash (@$samples) {
1.594 raeburn 14065: $r->print(&start_data_table_row());
1.356 albertel 14066: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14067: $r->print('<td>');
1.356 albertel 14068: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14069: $r->print('</td>');
14070: }
1.594 raeburn 14071: $r->print(&end_data_table_row());
1.31 albertel 14072: }
1.594 raeburn 14073: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14074: }
14075:
1.144 matthew 14076: ######################################################
14077: ######################################################
14078:
1.56 matthew 14079: =pod
14080:
1.648 raeburn 14081: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14082:
14083: Prints a table to create associations between values and table columns.
1.144 matthew 14084:
1.41 ng 14085: $r is an Apache Request ref,
14086: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14087: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14088:
14089: =cut
14090:
1.144 matthew 14091: ######################################################
14092: ######################################################
1.31 albertel 14093: sub csv_print_select_table {
14094: my ($r,$records,$d) = @_;
1.301 albertel 14095: my $i=0;
14096: my $samples = &get_samples($records,1);
1.144 matthew 14097: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14098: &start_data_table().&start_data_table_header_row().
1.144 matthew 14099: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14100: '<th>'.&mt('Column').'</th>'.
14101: &end_data_table_header_row()."\n");
1.356 albertel 14102: foreach my $array_ref (@$d) {
14103: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14104: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14105:
1.875 bisitz 14106: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14107: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14108: $r->print('<option value="none"></option>');
1.356 albertel 14109: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14110: $r->print('<option value="'.$sample.'"'.
14111: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14112: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14113: }
1.594 raeburn 14114: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14115: $i++;
14116: }
1.594 raeburn 14117: $r->print(&end_data_table());
1.31 albertel 14118: $i--;
14119: return $i;
14120: }
1.56 matthew 14121:
1.144 matthew 14122: ######################################################
14123: ######################################################
14124:
1.56 matthew 14125: =pod
1.31 albertel 14126:
1.648 raeburn 14127: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14128:
14129: Prints a table of sample values from the upload and can make associate samples to internal names.
14130:
14131: $r is an Apache Request ref,
14132: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14133: $d is an array of 2 element arrays (internal name, displayed name)
14134:
14135: =cut
14136:
1.144 matthew 14137: ######################################################
14138: ######################################################
1.31 albertel 14139: sub csv_samples_select_table {
14140: my ($r,$records,$d) = @_;
14141: my $i=0;
1.144 matthew 14142: #
1.662 bisitz 14143: my $max_samples = 5;
14144: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14145: $r->print(&start_data_table().
14146: &start_data_table_header_row().'<th>'.
14147: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14148: &end_data_table_header_row());
1.301 albertel 14149:
14150: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14151: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14152: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14153: foreach my $option (@$d) {
14154: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14155: $r->print('<option value="'.$value.'"'.
1.253 albertel 14156: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14157: $display.'</option>');
1.31 albertel 14158: }
14159: $r->print('</select></td><td>');
1.662 bisitz 14160: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14161: if (defined($samples->[$line]{$key})) {
14162: $r->print($samples->[$line]{$key}."<br />\n");
14163: }
14164: }
1.594 raeburn 14165: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14166: $i++;
14167: }
1.594 raeburn 14168: $r->print(&end_data_table());
1.31 albertel 14169: $i--;
14170: return($i);
1.115 matthew 14171: }
14172:
1.144 matthew 14173: ######################################################
14174: ######################################################
14175:
1.115 matthew 14176: =pod
14177:
1.648 raeburn 14178: =item * &clean_excel_name($name)
1.115 matthew 14179:
14180: Returns a replacement for $name which does not contain any illegal characters.
14181:
14182: =cut
14183:
1.144 matthew 14184: ######################################################
14185: ######################################################
1.115 matthew 14186: sub clean_excel_name {
14187: my ($name) = @_;
14188: $name =~ s/[:\*\?\/\\]//g;
14189: if (length($name) > 31) {
14190: $name = substr($name,0,31);
14191: }
14192: return $name;
1.25 albertel 14193: }
1.84 albertel 14194:
1.85 albertel 14195: =pod
14196:
1.648 raeburn 14197: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14198:
14199: Returns either 1 or undef
14200:
14201: 1 if the part is to be hidden, undef if it is to be shown
14202:
14203: Arguments are:
14204:
14205: $id the id of the part to be checked
14206: $symb, optional the symb of the resource to check
14207: $udom, optional the domain of the user to check for
14208: $uname, optional the username of the user to check for
14209:
14210: =cut
1.84 albertel 14211:
14212: sub check_if_partid_hidden {
14213: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14214: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14215: $symb,$udom,$uname);
1.141 albertel 14216: my $truth=1;
14217: #if the string starts with !, then the list is the list to show not hide
14218: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14219: my @hiddenlist=split(/,/,$hiddenparts);
14220: foreach my $checkid (@hiddenlist) {
1.141 albertel 14221: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14222: }
1.141 albertel 14223: return !$truth;
1.84 albertel 14224: }
1.127 matthew 14225:
1.138 matthew 14226:
14227: ############################################################
14228: ############################################################
14229:
14230: =pod
14231:
1.157 matthew 14232: =back
14233:
1.138 matthew 14234: =head1 cgi-bin script and graphing routines
14235:
1.157 matthew 14236: =over 4
14237:
1.648 raeburn 14238: =item * &get_cgi_id()
1.138 matthew 14239:
14240: Inputs: none
14241:
14242: Returns an id which can be used to pass environment variables
14243: to various cgi-bin scripts. These environment variables will
14244: be removed from the users environment after a given time by
14245: the routine &Apache::lonnet::transfer_profile_to_env.
14246:
14247: =cut
14248:
14249: ############################################################
14250: ############################################################
1.152 albertel 14251: my $uniq=0;
1.136 matthew 14252: sub get_cgi_id {
1.154 albertel 14253: $uniq=($uniq+1)%100000;
1.280 albertel 14254: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14255: }
14256:
1.127 matthew 14257: ############################################################
14258: ############################################################
14259:
14260: =pod
14261:
1.648 raeburn 14262: =item * &DrawBarGraph()
1.127 matthew 14263:
1.138 matthew 14264: Facilitates the plotting of data in a (stacked) bar graph.
14265: Puts plot definition data into the users environment in order for
14266: graph.png to plot it. Returns an <img> tag for the plot.
14267: The bars on the plot are labeled '1','2',...,'n'.
14268:
14269: Inputs:
14270:
14271: =over 4
14272:
14273: =item $Title: string, the title of the plot
14274:
14275: =item $xlabel: string, text describing the X-axis of the plot
14276:
14277: =item $ylabel: string, text describing the Y-axis of the plot
14278:
14279: =item $Max: scalar, the maximum Y value to use in the plot
14280: If $Max is < any data point, the graph will not be rendered.
14281:
1.140 matthew 14282: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14283: they are plotted. If undefined, default values will be used.
14284:
1.178 matthew 14285: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14286:
1.138 matthew 14287: =item @Values: An array of array references. Each array reference holds data
14288: to be plotted in a stacked bar chart.
14289:
1.239 matthew 14290: =item If the final element of @Values is a hash reference the key/value
14291: pairs will be added to the graph definition.
14292:
1.138 matthew 14293: =back
14294:
14295: Returns:
14296:
14297: An <img> tag which references graph.png and the appropriate identifying
14298: information for the plot.
14299:
1.127 matthew 14300: =cut
14301:
14302: ############################################################
14303: ############################################################
1.134 matthew 14304: sub DrawBarGraph {
1.178 matthew 14305: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14306: #
14307: if (! defined($colors)) {
14308: $colors = ['#33ff00',
14309: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14310: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14311: ];
14312: }
1.228 matthew 14313: my $extra_settings = {};
14314: if (ref($Values[-1]) eq 'HASH') {
14315: $extra_settings = pop(@Values);
14316: }
1.127 matthew 14317: #
1.136 matthew 14318: my $identifier = &get_cgi_id();
14319: my $id = 'cgi.'.$identifier;
1.129 matthew 14320: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14321: return '';
14322: }
1.225 matthew 14323: #
14324: my @Labels;
14325: if (defined($labels)) {
14326: @Labels = @$labels;
14327: } else {
14328: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 14329: push(@Labels,$i+1);
1.225 matthew 14330: }
14331: }
14332: #
1.129 matthew 14333: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14334: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14335: my %ValuesHash;
14336: my $NumSets=1;
14337: foreach my $array (@Values) {
14338: next if (! ref($array));
1.136 matthew 14339: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14340: join(',',@$array);
1.129 matthew 14341: }
1.127 matthew 14342: #
1.136 matthew 14343: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14344: if ($NumBars < 3) {
14345: $width = 120+$NumBars*32;
1.220 matthew 14346: $xskip = 1;
1.225 matthew 14347: $bar_width = 30;
14348: } elsif ($NumBars < 5) {
14349: $width = 120+$NumBars*20;
14350: $xskip = 1;
14351: $bar_width = 20;
1.220 matthew 14352: } elsif ($NumBars < 10) {
1.136 matthew 14353: $width = 120+$NumBars*15;
14354: $xskip = 1;
14355: $bar_width = 15;
14356: } elsif ($NumBars <= 25) {
14357: $width = 120+$NumBars*11;
14358: $xskip = 5;
14359: $bar_width = 8;
14360: } elsif ($NumBars <= 50) {
14361: $width = 120+$NumBars*8;
14362: $xskip = 5;
14363: $bar_width = 4;
14364: } else {
14365: $width = 120+$NumBars*8;
14366: $xskip = 5;
14367: $bar_width = 4;
14368: }
14369: #
1.137 matthew 14370: $Max = 1 if ($Max < 1);
14371: if ( int($Max) < $Max ) {
14372: $Max++;
14373: $Max = int($Max);
14374: }
1.127 matthew 14375: $Title = '' if (! defined($Title));
14376: $xlabel = '' if (! defined($xlabel));
14377: $ylabel = '' if (! defined($ylabel));
1.369 www 14378: $ValuesHash{$id.'.title'} = &escape($Title);
14379: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14380: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14381: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14382: $ValuesHash{$id.'.NumBars'} = $NumBars;
14383: $ValuesHash{$id.'.NumSets'} = $NumSets;
14384: $ValuesHash{$id.'.PlotType'} = 'bar';
14385: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14386: $ValuesHash{$id.'.height'} = $height;
14387: $ValuesHash{$id.'.width'} = $width;
14388: $ValuesHash{$id.'.xskip'} = $xskip;
14389: $ValuesHash{$id.'.bar_width'} = $bar_width;
14390: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14391: #
1.228 matthew 14392: # Deal with other parameters
14393: while (my ($key,$value) = each(%$extra_settings)) {
14394: $ValuesHash{$id.'.'.$key} = $value;
14395: }
14396: #
1.646 raeburn 14397: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14398: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14399: }
14400:
14401: ############################################################
14402: ############################################################
14403:
14404: =pod
14405:
1.648 raeburn 14406: =item * &DrawXYGraph()
1.137 matthew 14407:
1.138 matthew 14408: Facilitates the plotting of data in an XY graph.
14409: Puts plot definition data into the users environment in order for
14410: graph.png to plot it. Returns an <img> tag for the plot.
14411:
14412: Inputs:
14413:
14414: =over 4
14415:
14416: =item $Title: string, the title of the plot
14417:
14418: =item $xlabel: string, text describing the X-axis of the plot
14419:
14420: =item $ylabel: string, text describing the Y-axis of the plot
14421:
14422: =item $Max: scalar, the maximum Y value to use in the plot
14423: If $Max is < any data point, the graph will not be rendered.
14424:
14425: =item $colors: Array ref containing the hex color codes for the data to be
14426: plotted in. If undefined, default values will be used.
14427:
14428: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14429:
14430: =item $Ydata: Array ref containing Array refs.
1.185 www 14431: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14432:
14433: =item %Values: hash indicating or overriding any default values which are
14434: passed to graph.png.
14435: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14436:
14437: =back
14438:
14439: Returns:
14440:
14441: An <img> tag which references graph.png and the appropriate identifying
14442: information for the plot.
14443:
1.137 matthew 14444: =cut
14445:
14446: ############################################################
14447: ############################################################
14448: sub DrawXYGraph {
14449: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14450: #
14451: # Create the identifier for the graph
14452: my $identifier = &get_cgi_id();
14453: my $id = 'cgi.'.$identifier;
14454: #
14455: $Title = '' if (! defined($Title));
14456: $xlabel = '' if (! defined($xlabel));
14457: $ylabel = '' if (! defined($ylabel));
14458: my %ValuesHash =
14459: (
1.369 www 14460: $id.'.title' => &escape($Title),
14461: $id.'.xlabel' => &escape($xlabel),
14462: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14463: $id.'.y_max_value'=> $Max,
14464: $id.'.labels' => join(',',@$Xlabels),
14465: $id.'.PlotType' => 'XY',
14466: );
14467: #
14468: if (defined($colors) && ref($colors) eq 'ARRAY') {
14469: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14470: }
14471: #
14472: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14473: return '';
14474: }
14475: my $NumSets=1;
1.138 matthew 14476: foreach my $array (@{$Ydata}){
1.137 matthew 14477: next if (! ref($array));
14478: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14479: }
1.138 matthew 14480: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14481: #
14482: # Deal with other parameters
14483: while (my ($key,$value) = each(%Values)) {
14484: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14485: }
14486: #
1.646 raeburn 14487: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14488: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14489: }
14490:
14491: ############################################################
14492: ############################################################
14493:
14494: =pod
14495:
1.648 raeburn 14496: =item * &DrawXYYGraph()
1.138 matthew 14497:
14498: Facilitates the plotting of data in an XY graph with two Y axes.
14499: Puts plot definition data into the users environment in order for
14500: graph.png to plot it. Returns an <img> tag for the plot.
14501:
14502: Inputs:
14503:
14504: =over 4
14505:
14506: =item $Title: string, the title of the plot
14507:
14508: =item $xlabel: string, text describing the X-axis of the plot
14509:
14510: =item $ylabel: string, text describing the Y-axis of the plot
14511:
14512: =item $colors: Array ref containing the hex color codes for the data to be
14513: plotted in. If undefined, default values will be used.
14514:
14515: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14516:
14517: =item $Ydata1: The first data set
14518:
14519: =item $Min1: The minimum value of the left Y-axis
14520:
14521: =item $Max1: The maximum value of the left Y-axis
14522:
14523: =item $Ydata2: The second data set
14524:
14525: =item $Min2: The minimum value of the right Y-axis
14526:
14527: =item $Max2: The maximum value of the left Y-axis
14528:
14529: =item %Values: hash indicating or overriding any default values which are
14530: passed to graph.png.
14531: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14532:
14533: =back
14534:
14535: Returns:
14536:
14537: An <img> tag which references graph.png and the appropriate identifying
14538: information for the plot.
1.136 matthew 14539:
14540: =cut
14541:
14542: ############################################################
14543: ############################################################
1.137 matthew 14544: sub DrawXYYGraph {
14545: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14546: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14547: #
14548: # Create the identifier for the graph
14549: my $identifier = &get_cgi_id();
14550: my $id = 'cgi.'.$identifier;
14551: #
14552: $Title = '' if (! defined($Title));
14553: $xlabel = '' if (! defined($xlabel));
14554: $ylabel = '' if (! defined($ylabel));
14555: my %ValuesHash =
14556: (
1.369 www 14557: $id.'.title' => &escape($Title),
14558: $id.'.xlabel' => &escape($xlabel),
14559: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14560: $id.'.labels' => join(',',@$Xlabels),
14561: $id.'.PlotType' => 'XY',
14562: $id.'.NumSets' => 2,
1.137 matthew 14563: $id.'.two_axes' => 1,
14564: $id.'.y1_max_value' => $Max1,
14565: $id.'.y1_min_value' => $Min1,
14566: $id.'.y2_max_value' => $Max2,
14567: $id.'.y2_min_value' => $Min2,
1.136 matthew 14568: );
14569: #
1.137 matthew 14570: if (defined($colors) && ref($colors) eq 'ARRAY') {
14571: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14572: }
14573: #
14574: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14575: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14576: return '';
14577: }
14578: my $NumSets=1;
1.137 matthew 14579: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14580: next if (! ref($array));
14581: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14582: }
14583: #
14584: # Deal with other parameters
14585: while (my ($key,$value) = each(%Values)) {
14586: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14587: }
14588: #
1.646 raeburn 14589: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14590: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14591: }
14592:
14593: ############################################################
14594: ############################################################
14595:
14596: =pod
14597:
1.157 matthew 14598: =back
14599:
1.139 matthew 14600: =head1 Statistics helper routines?
14601:
14602: Bad place for them but what the hell.
14603:
1.157 matthew 14604: =over 4
14605:
1.648 raeburn 14606: =item * &chartlink()
1.139 matthew 14607:
14608: Returns a link to the chart for a specific student.
14609:
14610: Inputs:
14611:
14612: =over 4
14613:
14614: =item $linktext: The text of the link
14615:
14616: =item $sname: The students username
14617:
14618: =item $sdomain: The students domain
14619:
14620: =back
14621:
1.157 matthew 14622: =back
14623:
1.139 matthew 14624: =cut
14625:
14626: ############################################################
14627: ############################################################
14628: sub chartlink {
14629: my ($linktext, $sname, $sdomain) = @_;
14630: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14631: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14632: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14633: '">'.$linktext.'</a>';
1.153 matthew 14634: }
14635:
14636: #######################################################
14637: #######################################################
14638:
14639: =pod
14640:
14641: =head1 Course Environment Routines
1.157 matthew 14642:
14643: =over 4
1.153 matthew 14644:
1.648 raeburn 14645: =item * &restore_course_settings()
1.153 matthew 14646:
1.648 raeburn 14647: =item * &store_course_settings()
1.153 matthew 14648:
14649: Restores/Store indicated form parameters from the course environment.
14650: Will not overwrite existing values of the form parameters.
14651:
14652: Inputs:
14653: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14654:
14655: a hash ref describing the data to be stored. For example:
14656:
14657: %Save_Parameters = ('Status' => 'scalar',
14658: 'chartoutputmode' => 'scalar',
14659: 'chartoutputdata' => 'scalar',
14660: 'Section' => 'array',
1.373 raeburn 14661: 'Group' => 'array',
1.153 matthew 14662: 'StudentData' => 'array',
14663: 'Maps' => 'array');
14664:
14665: Returns: both routines return nothing
14666:
1.631 raeburn 14667: =back
14668:
1.153 matthew 14669: =cut
14670:
14671: #######################################################
14672: #######################################################
14673: sub store_course_settings {
1.496 albertel 14674: return &store_settings($env{'request.course.id'},@_);
14675: }
14676:
14677: sub store_settings {
1.153 matthew 14678: # save to the environment
14679: # appenv the same items, just to be safe
1.300 albertel 14680: my $udom = $env{'user.domain'};
14681: my $uname = $env{'user.name'};
1.496 albertel 14682: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14683: my %SaveHash;
14684: my %AppHash;
14685: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14686: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14687: my $envname = 'environment.'.$basename;
1.258 albertel 14688: if (exists($env{'form.'.$setting})) {
1.153 matthew 14689: # Save this value away
14690: if ($type eq 'scalar' &&
1.258 albertel 14691: (! exists($env{$envname}) ||
14692: $env{$envname} ne $env{'form.'.$setting})) {
14693: $SaveHash{$basename} = $env{'form.'.$setting};
14694: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14695: } elsif ($type eq 'array') {
14696: my $stored_form;
1.258 albertel 14697: if (ref($env{'form.'.$setting})) {
1.153 matthew 14698: $stored_form = join(',',
14699: map {
1.369 www 14700: &escape($_);
1.258 albertel 14701: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14702: } else {
14703: $stored_form =
1.369 www 14704: &escape($env{'form.'.$setting});
1.153 matthew 14705: }
14706: # Determine if the array contents are the same.
1.258 albertel 14707: if ($stored_form ne $env{$envname}) {
1.153 matthew 14708: $SaveHash{$basename} = $stored_form;
14709: $AppHash{$envname} = $stored_form;
14710: }
14711: }
14712: }
14713: }
14714: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14715: $udom,$uname);
1.153 matthew 14716: if ($put_result !~ /^(ok|delayed)/) {
14717: &Apache::lonnet::logthis('unable to save form parameters, '.
14718: 'got error:'.$put_result);
14719: }
14720: # Make sure these settings stick around in this session, too
1.646 raeburn 14721: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14722: return;
14723: }
14724:
14725: sub restore_course_settings {
1.499 albertel 14726: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14727: }
14728:
14729: sub restore_settings {
14730: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14731: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14732: next if (exists($env{'form.'.$setting}));
1.496 albertel 14733: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14734: '.'.$setting;
1.258 albertel 14735: if (exists($env{$envname})) {
1.153 matthew 14736: if ($type eq 'scalar') {
1.258 albertel 14737: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14738: } elsif ($type eq 'array') {
1.258 albertel 14739: $env{'form.'.$setting} = [
1.153 matthew 14740: map {
1.369 www 14741: &unescape($_);
1.258 albertel 14742: } split(',',$env{$envname})
1.153 matthew 14743: ];
14744: }
14745: }
14746: }
1.127 matthew 14747: }
14748:
1.618 raeburn 14749: #######################################################
14750: #######################################################
14751:
14752: =pod
14753:
14754: =head1 Domain E-mail Routines
14755:
14756: =over 4
14757:
1.648 raeburn 14758: =item * &build_recipient_list()
1.618 raeburn 14759:
1.1144 raeburn 14760: Build recipient lists for following types of e-mail:
1.766 raeburn 14761: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14762: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14763: module change checking, student/employee ID conflict checks, as
14764: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14765: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14766:
14767: Inputs:
1.619 raeburn 14768: defmail (scalar - email address of default recipient),
1.1144 raeburn 14769: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14770: requestsmail, updatesmail, or idconflictsmail).
14771:
1.619 raeburn 14772: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14773:
1.619 raeburn 14774: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 14775: i.e., predates configuration by DC via domainprefs.pm
14776:
14777: $requname username of requester (if mailing type is helpdeskmail)
14778:
14779: $requdom domain of requester (if mailing type is helpdeskmail)
14780:
14781: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14782:
1.618 raeburn 14783:
1.655 raeburn 14784: Returns: comma separated list of addresses to which to send e-mail.
14785:
14786: =back
1.618 raeburn 14787:
14788: =cut
14789:
14790: ############################################################
14791: ############################################################
14792: sub build_recipient_list {
1.1297 raeburn 14793: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14794: my @recipients;
1.1270 raeburn 14795: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14796: my %domconfig =
1.1270 raeburn 14797: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14798: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14799: if (exists($domconfig{'contacts'}{$mailing})) {
14800: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14801: my @contacts = ('adminemail','supportemail');
14802: foreach my $item (@contacts) {
14803: if ($domconfig{'contacts'}{$mailing}{$item}) {
14804: my $addr = $domconfig{'contacts'}{$item};
14805: if (!grep(/^\Q$addr\E$/,@recipients)) {
14806: push(@recipients,$addr);
14807: }
1.619 raeburn 14808: }
1.1270 raeburn 14809: }
14810: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14811: if ($mailing eq 'helpdeskmail') {
14812: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14813: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14814: my @ok_bccs;
14815: foreach my $bcc (@bccs) {
14816: $bcc =~ s/^\s+//g;
14817: $bcc =~ s/\s+$//g;
14818: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14819: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14820: push(@ok_bccs,$bcc);
14821: }
14822: }
14823: }
14824: if (@ok_bccs > 0) {
14825: $allbcc = join(', ',@ok_bccs);
14826: }
14827: }
14828: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14829: }
14830: }
1.766 raeburn 14831: } elsif ($origmail ne '') {
1.1270 raeburn 14832: $lastresort = $origmail;
1.618 raeburn 14833: }
1.1297 raeburn 14834: if ($mailing eq 'helpdeskmail') {
14835: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
14836: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
14837: my ($inststatus,$inststatus_checked);
14838: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
14839: ($env{'user.domain'} ne 'public')) {
14840: $inststatus_checked = 1;
14841: $inststatus = $env{'environment.inststatus'};
14842: }
14843: unless ($inststatus_checked) {
14844: if (($requname ne '') && ($requdom ne '')) {
14845: if (($requname =~ /^$match_username$/) &&
14846: ($requdom =~ /^$match_domain$/) &&
14847: (&Apache::lonnet::domain($requdom))) {
14848: my $requhome = &Apache::lonnet::homeserver($requname,
14849: $requdom);
14850: unless ($requhome eq 'no_host') {
14851: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
14852: $inststatus = $userenv{'inststatus'};
14853: $inststatus_checked = 1;
14854: }
14855: }
14856: }
14857: }
14858: unless ($inststatus_checked) {
14859: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
14860: my %srch = (srchby => 'email',
14861: srchdomain => $defdom,
14862: srchterm => $reqemail,
14863: srchtype => 'exact');
14864: my %srch_results = &Apache::lonnet::usersearch(\%srch);
14865: foreach my $uname (keys(%srch_results)) {
14866: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14867: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14868: $inststatus_checked = 1;
14869: last;
14870: }
14871: }
14872: unless ($inststatus_checked) {
14873: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
14874: if ($dirsrchres eq 'ok') {
14875: foreach my $uname (keys(%srch_results)) {
14876: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14877: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14878: $inststatus_checked = 1;
14879: last;
14880: }
14881: }
14882: }
14883: }
14884: }
14885: }
14886: if ($inststatus ne '') {
14887: foreach my $status (split(/\:/,$inststatus)) {
14888: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
14889: my @contacts = ('adminemail','supportemail');
14890: foreach my $item (@contacts) {
14891: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
14892: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
14893: if (!grep(/^\Q$addr\E$/,@recipients)) {
14894: push(@recipients,$addr);
14895: }
14896: }
14897: }
14898: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
14899: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
14900: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
14901: my @ok_bccs;
14902: foreach my $bcc (@bccs) {
14903: $bcc =~ s/^\s+//g;
14904: $bcc =~ s/\s+$//g;
14905: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14906: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14907: push(@ok_bccs,$bcc);
14908: }
14909: }
14910: }
14911: if (@ok_bccs > 0) {
14912: $allbcc = join(', ',@ok_bccs);
14913: }
14914: }
14915: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
14916: last;
14917: }
14918: }
14919: }
14920: }
14921: }
1.619 raeburn 14922: } elsif ($origmail ne '') {
1.1270 raeburn 14923: $lastresort = $origmail;
14924: }
1.1297 raeburn 14925: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 14926: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
14927: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
14928: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
14929: my %what = (
14930: perlvar => 1,
14931: );
14932: my $primary = &Apache::lonnet::domain($defdom,'primary');
14933: if ($primary) {
14934: my $gotaddr;
14935: my ($result,$returnhash) =
14936: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
14937: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
14938: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
14939: $lastresort = $returnhash->{'lonSupportEMail'};
14940: $gotaddr = 1;
14941: }
14942: }
14943: unless ($gotaddr) {
14944: my $uintdom = &Apache::lonnet::internet_dom($primary);
14945: my $intdom = &Apache::lonnet::internet_dom($lonhost);
14946: unless ($uintdom eq $intdom) {
14947: my %domconfig =
14948: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
14949: if (ref($domconfig{'contacts'}) eq 'HASH') {
14950: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
14951: my @contacts = ('adminemail','supportemail');
14952: foreach my $item (@contacts) {
14953: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
14954: my $addr = $domconfig{'contacts'}{$item};
14955: if (!grep(/^\Q$addr\E$/,@recipients)) {
14956: push(@recipients,$addr);
14957: }
14958: }
14959: }
14960: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
14961: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
14962: }
14963: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
14964: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
14965: my @ok_bccs;
14966: foreach my $bcc (@bccs) {
14967: $bcc =~ s/^\s+//g;
14968: $bcc =~ s/\s+$//g;
14969: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14970: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14971: push(@ok_bccs,$bcc);
14972: }
14973: }
14974: }
14975: if (@ok_bccs > 0) {
14976: $allbcc = join(', ',@ok_bccs);
14977: }
14978: }
14979: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
14980: }
14981: }
14982: }
14983: }
14984: }
14985: }
1.618 raeburn 14986: }
1.688 raeburn 14987: if (defined($defmail)) {
14988: if ($defmail ne '') {
14989: push(@recipients,$defmail);
14990: }
1.618 raeburn 14991: }
14992: if ($otheremails) {
1.619 raeburn 14993: my @others;
14994: if ($otheremails =~ /,/) {
14995: @others = split(/,/,$otheremails);
1.618 raeburn 14996: } else {
1.619 raeburn 14997: push(@others,$otheremails);
14998: }
14999: foreach my $addr (@others) {
15000: if (!grep(/^\Q$addr\E$/,@recipients)) {
15001: push(@recipients,$addr);
15002: }
1.618 raeburn 15003: }
15004: }
1.1298 raeburn 15005: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 15006: if ((!@recipients) && ($lastresort ne '')) {
15007: push(@recipients,$lastresort);
15008: }
15009: } elsif ($lastresort ne '') {
15010: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15011: push(@recipients,$lastresort);
15012: }
15013: }
1.1271 raeburn 15014: my $recipientlist = join(',',@recipients);
1.1270 raeburn 15015: if (wantarray) {
15016: return ($recipientlist,$allbcc,$addtext);
15017: } else {
15018: return $recipientlist;
15019: }
1.618 raeburn 15020: }
15021:
1.127 matthew 15022: ############################################################
15023: ############################################################
1.154 albertel 15024:
1.655 raeburn 15025: =pod
15026:
1.1224 musolffc 15027: =over 4
15028:
1.1223 musolffc 15029: =item * &mime_email()
15030:
15031: Sends an email with a possible attachment
15032:
15033: Inputs:
15034:
15035: =over 4
15036:
15037: from - Sender's email address
15038:
15039: to - Email address of recipient
15040:
15041: subject - Subject of email
15042:
15043: body - Body of email
15044:
15045: cc_string - Carbon copy email address
15046:
15047: bcc - Blind carbon copy email address
15048:
15049: type - File type of attachment
15050:
15051: attachment_path - Path of file to be attached
15052:
15053: file_name - Name of file to be attached
15054:
15055: attachment_text - The body of an attachment of type "TEXT"
15056:
15057: =back
15058:
15059: =back
15060:
15061: =cut
15062:
15063: ############################################################
15064: ############################################################
15065:
15066: sub mime_email {
15067: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
15068: $file_name, $attachment_text) = @_;
15069: my $msg = MIME::Lite->new(
15070: From => $from,
15071: To => $to,
15072: Subject => $subject,
15073: Type =>'TEXT',
15074: Data => $body,
15075: );
15076: if ($cc_string ne '') {
15077: $msg->add("Cc" => $cc_string);
15078: }
15079: if ($bcc ne '') {
15080: $msg->add("Bcc" => $bcc);
15081: }
15082: $msg->attr("content-type" => "text/plain");
15083: $msg->attr("content-type.charset" => "UTF-8");
15084: # Attach file if given
15085: if ($attachment_path) {
15086: unless ($file_name) {
15087: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15088: }
15089: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15090: $msg->attach(Type => $type,
15091: Path => $attachment_path,
15092: Filename => $file_name
15093: );
15094: # Otherwise attach text if given
15095: } elsif ($attachment_text) {
15096: $msg->attach(Type => 'TEXT',
15097: Data => $attachment_text);
15098: }
15099: # Send it
15100: $msg->send('sendmail');
15101: }
15102:
15103: ############################################################
15104: ############################################################
15105:
15106: =pod
15107:
1.655 raeburn 15108: =head1 Course Catalog Routines
15109:
15110: =over 4
15111:
15112: =item * &gather_categories()
15113:
15114: Converts category definitions - keys of categories hash stored in
15115: coursecategories in configuration.db on the primary library server in a
15116: domain - to an array. Also generates javascript and idx hash used to
15117: generate Domain Coordinator interface for editing Course Categories.
15118:
15119: Inputs:
1.663 raeburn 15120:
1.655 raeburn 15121: categories (reference to hash of category definitions).
1.663 raeburn 15122:
1.655 raeburn 15123: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15124: categories and subcategories).
1.663 raeburn 15125:
1.655 raeburn 15126: idx (reference to hash of counters used in Domain Coordinator interface for
15127: editing Course Categories).
1.663 raeburn 15128:
1.655 raeburn 15129: jsarray (reference to array of categories used to create Javascript arrays for
15130: Domain Coordinator interface for editing Course Categories).
15131:
15132: Returns: nothing
15133:
15134: Side effects: populates cats, idx and jsarray.
15135:
15136: =cut
15137:
15138: sub gather_categories {
15139: my ($categories,$cats,$idx,$jsarray) = @_;
15140: my %counters;
15141: my $num = 0;
15142: foreach my $item (keys(%{$categories})) {
15143: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15144: if ($container eq '' && $depth == 0) {
15145: $cats->[$depth][$categories->{$item}] = $cat;
15146: } else {
15147: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15148: }
15149: my ($escitem,$tail) = split(/:/,$item,2);
15150: if ($counters{$tail} eq '') {
15151: $counters{$tail} = $num;
15152: $num ++;
15153: }
15154: if (ref($idx) eq 'HASH') {
15155: $idx->{$item} = $counters{$tail};
15156: }
15157: if (ref($jsarray) eq 'ARRAY') {
15158: push(@{$jsarray->[$counters{$tail}]},$item);
15159: }
15160: }
15161: return;
15162: }
15163:
15164: =pod
15165:
15166: =item * &extract_categories()
15167:
15168: Used to generate breadcrumb trails for course categories.
15169:
15170: Inputs:
1.663 raeburn 15171:
1.655 raeburn 15172: categories (reference to hash of category definitions).
1.663 raeburn 15173:
1.655 raeburn 15174: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15175: categories and subcategories).
1.663 raeburn 15176:
1.655 raeburn 15177: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15178:
1.655 raeburn 15179: allitems (reference to hash - key is category key
15180: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15181:
1.655 raeburn 15182: idx (reference to hash of counters used in Domain Coordinator interface for
15183: editing Course Categories).
1.663 raeburn 15184:
1.655 raeburn 15185: jsarray (reference to array of categories used to create Javascript arrays for
15186: Domain Coordinator interface for editing Course Categories).
15187:
1.665 raeburn 15188: subcats (reference to hash of arrays containing all subcategories within each
15189: category, -recursive)
15190:
1.655 raeburn 15191: Returns: nothing
15192:
15193: Side effects: populates trails and allitems hash references.
15194:
15195: =cut
15196:
15197: sub extract_categories {
1.665 raeburn 15198: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 15199: if (ref($categories) eq 'HASH') {
15200: &gather_categories($categories,$cats,$idx,$jsarray);
15201: if (ref($cats->[0]) eq 'ARRAY') {
15202: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15203: my $name = $cats->[0][$i];
15204: my $item = &escape($name).'::0';
15205: my $trailstr;
15206: if ($name eq 'instcode') {
15207: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15208: } elsif ($name eq 'communities') {
15209: $trailstr = &mt('Communities');
1.1239 raeburn 15210: } elsif ($name eq 'placement') {
15211: $trailstr = &mt('Placement Tests');
1.655 raeburn 15212: } else {
15213: $trailstr = $name;
15214: }
15215: if ($allitems->{$item} eq '') {
15216: push(@{$trails},$trailstr);
15217: $allitems->{$item} = scalar(@{$trails})-1;
15218: }
15219: my @parents = ($name);
15220: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15221: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15222: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15223: if (ref($subcats) eq 'HASH') {
15224: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15225: }
15226: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
15227: }
15228: } else {
15229: if (ref($subcats) eq 'HASH') {
15230: $subcats->{$item} = [];
1.655 raeburn 15231: }
15232: }
15233: }
15234: }
15235: }
15236: return;
15237: }
15238:
15239: =pod
15240:
1.1162 raeburn 15241: =item * &recurse_categories()
1.655 raeburn 15242:
15243: Recursively used to generate breadcrumb trails for course categories.
15244:
15245: Inputs:
1.663 raeburn 15246:
1.655 raeburn 15247: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15248: categories and subcategories).
1.663 raeburn 15249:
1.655 raeburn 15250: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 15251:
15252: category (current course category, for which breadcrumb trail is being generated).
15253:
15254: trails (reference to array of breadcrumb trails for each category).
15255:
1.655 raeburn 15256: allitems (reference to hash - key is category key
15257: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15258:
1.655 raeburn 15259: parents (array containing containers directories for current category,
15260: back to top level).
15261:
15262: Returns: nothing
15263:
15264: Side effects: populates trails and allitems hash references
15265:
15266: =cut
15267:
15268: sub recurse_categories {
1.665 raeburn 15269: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 15270: my $shallower = $depth - 1;
15271: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
15272: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
15273: my $name = $cats->[$depth]{$category}[$k];
15274: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
15275: my $trailstr = join(' -> ',(@{$parents},$category));
15276: if ($allitems->{$item} eq '') {
15277: push(@{$trails},$trailstr);
15278: $allitems->{$item} = scalar(@{$trails})-1;
15279: }
15280: my $deeper = $depth+1;
15281: push(@{$parents},$category);
1.665 raeburn 15282: if (ref($subcats) eq 'HASH') {
15283: my $subcat = &escape($name).':'.$category.':'.$depth;
15284: for (my $j=@{$parents}; $j>=0; $j--) {
15285: my $higher;
15286: if ($j > 0) {
15287: $higher = &escape($parents->[$j]).':'.
15288: &escape($parents->[$j-1]).':'.$j;
15289: } else {
15290: $higher = &escape($parents->[$j]).'::'.$j;
15291: }
15292: push(@{$subcats->{$higher}},$subcat);
15293: }
15294: }
15295: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
15296: $subcats);
1.655 raeburn 15297: pop(@{$parents});
15298: }
15299: } else {
15300: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
15301: my $trailstr = join(' -> ',(@{$parents},$category));
15302: if ($allitems->{$item} eq '') {
15303: push(@{$trails},$trailstr);
15304: $allitems->{$item} = scalar(@{$trails})-1;
15305: }
15306: }
15307: return;
15308: }
15309:
1.663 raeburn 15310: =pod
15311:
1.1162 raeburn 15312: =item * &assign_categories_table()
1.663 raeburn 15313:
15314: Create a datatable for display of hierarchical categories in a domain,
15315: with checkboxes to allow a course to be categorized.
15316:
15317: Inputs:
15318:
15319: cathash - reference to hash of categories defined for the domain (from
15320: configuration.db)
15321:
15322: currcat - scalar with an & separated list of categories assigned to a course.
15323:
1.919 raeburn 15324: type - scalar contains course type (Course or Community).
15325:
1.1260 raeburn 15326: disabled - scalar (optional) contains disabled="disabled" if input elements are
15327: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15328:
1.663 raeburn 15329: Returns: $output (markup to be displayed)
15330:
15331: =cut
15332:
15333: sub assign_categories_table {
1.1259 raeburn 15334: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15335: my $output;
15336: if (ref($cathash) eq 'HASH') {
15337: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
15338: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
15339: $maxdepth = scalar(@cats);
15340: if (@cats > 0) {
15341: my $itemcount = 0;
15342: if (ref($cats[0]) eq 'ARRAY') {
15343: my @currcategories;
15344: if ($currcat ne '') {
15345: @currcategories = split('&',$currcat);
15346: }
1.919 raeburn 15347: my $table;
1.663 raeburn 15348: for (my $i=0; $i<@{$cats[0]}; $i++) {
15349: my $parent = $cats[0][$i];
1.919 raeburn 15350: next if ($parent eq 'instcode');
15351: if ($type eq 'Community') {
15352: next unless ($parent eq 'communities');
1.1239 raeburn 15353: } elsif ($type eq 'Placement') {
15354: next unless ($parent eq 'placement');
1.919 raeburn 15355: } else {
1.1239 raeburn 15356: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 15357: }
1.663 raeburn 15358: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15359: my $item = &escape($parent).'::0';
15360: my $checked = '';
15361: if (@currcategories > 0) {
15362: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15363: $checked = ' checked="checked"';
1.663 raeburn 15364: }
15365: }
1.919 raeburn 15366: my $parent_title = $parent;
15367: if ($parent eq 'communities') {
15368: $parent_title = &mt('Communities');
1.1239 raeburn 15369: } elsif ($parent eq 'placement') {
15370: $parent_title = &mt('Placement Tests');
1.919 raeburn 15371: }
15372: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15373: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15374: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15375: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15376: my $depth = 1;
15377: push(@path,$parent);
1.1259 raeburn 15378: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15379: pop(@path);
1.919 raeburn 15380: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15381: $itemcount ++;
15382: }
1.919 raeburn 15383: if ($itemcount) {
15384: $output = &Apache::loncommon::start_data_table().
15385: $table.
15386: &Apache::loncommon::end_data_table();
15387: }
1.663 raeburn 15388: }
15389: }
15390: }
15391: return $output;
15392: }
15393:
15394: =pod
15395:
1.1162 raeburn 15396: =item * &assign_category_rows()
1.663 raeburn 15397:
15398: Create a datatable row for display of nested categories in a domain,
15399: with checkboxes to allow a course to be categorized,called recursively.
15400:
15401: Inputs:
15402:
15403: itemcount - track row number for alternating colors
15404:
15405: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15406: categories and subcategories.
15407:
15408: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15409:
15410: parent - parent of current category item
15411:
15412: path - Array containing all categories back up through the hierarchy from the
15413: current category to the top level.
15414:
15415: currcategories - reference to array of current categories assigned to the course
15416:
1.1260 raeburn 15417: disabled - scalar (optional) contains disabled="disabled" if input elements are
15418: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15419:
1.663 raeburn 15420: Returns: $output (markup to be displayed).
15421:
15422: =cut
15423:
15424: sub assign_category_rows {
1.1259 raeburn 15425: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15426: my ($text,$name,$item,$chgstr);
15427: if (ref($cats) eq 'ARRAY') {
15428: my $maxdepth = scalar(@{$cats});
15429: if (ref($cats->[$depth]) eq 'HASH') {
15430: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15431: my $numchildren = @{$cats->[$depth]{$parent}};
15432: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 15433: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15434: for (my $j=0; $j<$numchildren; $j++) {
15435: $name = $cats->[$depth]{$parent}[$j];
15436: $item = &escape($name).':'.&escape($parent).':'.$depth;
15437: my $deeper = $depth+1;
15438: my $checked = '';
15439: if (ref($currcategories) eq 'ARRAY') {
15440: if (@{$currcategories} > 0) {
15441: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15442: $checked = ' checked="checked"';
1.663 raeburn 15443: }
15444: }
15445: }
1.664 raeburn 15446: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15447: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15448: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15449: '<input type="hidden" name="catname" value="'.$name.'" />'.
15450: '</td><td>';
1.663 raeburn 15451: if (ref($path) eq 'ARRAY') {
15452: push(@{$path},$name);
1.1259 raeburn 15453: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15454: pop(@{$path});
15455: }
15456: $text .= '</td></tr>';
15457: }
15458: $text .= '</table></td>';
15459: }
15460: }
15461: }
15462: return $text;
15463: }
15464:
1.1181 raeburn 15465: =pod
15466:
15467: =back
15468:
15469: =cut
15470:
1.655 raeburn 15471: ############################################################
15472: ############################################################
15473:
15474:
1.443 albertel 15475: sub commit_customrole {
1.664 raeburn 15476: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15477: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15478: ($start?', '.&mt('starting').' '.localtime($start):'').
15479: ($end?', ending '.localtime($end):'').': <b>'.
15480: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15481: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15482: '</b><br />';
15483: return $output;
15484: }
15485:
15486: sub commit_standardrole {
1.1116 raeburn 15487: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15488: my ($output,$logmsg,$linefeed);
15489: if ($context eq 'auto') {
15490: $linefeed = "\n";
15491: } else {
15492: $linefeed = "<br />\n";
15493: }
1.443 albertel 15494: if ($three eq 'st') {
1.541 raeburn 15495: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 15496: $one,$two,$sec,$context,$credits);
1.541 raeburn 15497: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15498: ($result eq 'unknown_course') || ($result eq 'refused')) {
15499: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15500: } else {
1.541 raeburn 15501: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15502: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15503: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15504: if ($context eq 'auto') {
15505: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15506: } else {
15507: $output .= '<b>'.$result.'</b>'.$linefeed.
15508: &mt('Add to classlist').': <b>ok</b>';
15509: }
15510: $output .= $linefeed;
1.443 albertel 15511: }
15512: } else {
15513: $output = &mt('Assigning').' '.$three.' in '.$url.
15514: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15515: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15516: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15517: if ($context eq 'auto') {
15518: $output .= $result.$linefeed;
15519: } else {
15520: $output .= '<b>'.$result.'</b>'.$linefeed;
15521: }
1.443 albertel 15522: }
15523: return $output;
15524: }
15525:
15526: sub commit_studentrole {
1.1116 raeburn 15527: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15528: $credits) = @_;
1.626 raeburn 15529: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15530: if ($context eq 'auto') {
15531: $linefeed = "\n";
15532: } else {
15533: $linefeed = '<br />'."\n";
15534: }
1.443 albertel 15535: if (defined($one) && defined($two)) {
15536: my $cid=$one.'_'.$two;
15537: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15538: my $secchange = 0;
15539: my $expire_role_result;
15540: my $modify_section_result;
1.628 raeburn 15541: if ($oldsec ne '-1') {
15542: if ($oldsec ne $sec) {
1.443 albertel 15543: $secchange = 1;
1.628 raeburn 15544: my $now = time;
1.443 albertel 15545: my $uurl='/'.$cid;
15546: $uurl=~s/\_/\//g;
15547: if ($oldsec) {
15548: $uurl.='/'.$oldsec;
15549: }
1.626 raeburn 15550: $oldsecurl = $uurl;
1.628 raeburn 15551: $expire_role_result =
1.652 raeburn 15552: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15553: if ($env{'request.course.sec'} ne '') {
15554: if ($expire_role_result eq 'refused') {
15555: my @roles = ('st');
15556: my @statuses = ('previous');
15557: my @roledoms = ($one);
15558: my $withsec = 1;
15559: my %roleshash =
15560: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15561: \@statuses,\@roles,\@roledoms,$withsec);
15562: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15563: my ($oldstart,$oldend) =
15564: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15565: if ($oldend > 0 && $oldend <= $now) {
15566: $expire_role_result = 'ok';
15567: }
15568: }
15569: }
15570: }
1.443 albertel 15571: $result = $expire_role_result;
15572: }
15573: }
15574: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15575: $modify_section_result =
15576: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15577: undef,undef,undef,$sec,
15578: $end,$start,'','',$cid,
15579: '',$context,$credits);
1.443 albertel 15580: if ($modify_section_result =~ /^ok/) {
15581: if ($secchange == 1) {
1.628 raeburn 15582: if ($sec eq '') {
15583: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15584: } else {
15585: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15586: }
1.443 albertel 15587: } elsif ($oldsec eq '-1') {
1.628 raeburn 15588: if ($sec eq '') {
15589: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15590: } else {
15591: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15592: }
1.443 albertel 15593: } else {
1.628 raeburn 15594: if ($sec eq '') {
15595: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15596: } else {
15597: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15598: }
1.443 albertel 15599: }
15600: } else {
1.1115 raeburn 15601: if ($secchange) {
1.628 raeburn 15602: $$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;
15603: } else {
15604: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15605: }
1.443 albertel 15606: }
15607: $result = $modify_section_result;
15608: } elsif ($secchange == 1) {
1.628 raeburn 15609: if ($oldsec eq '') {
1.1103 raeburn 15610: $$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 15611: } else {
15612: $$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;
15613: }
1.626 raeburn 15614: if ($expire_role_result eq 'refused') {
15615: my $newsecurl = '/'.$cid;
15616: $newsecurl =~ s/\_/\//g;
15617: if ($sec ne '') {
15618: $newsecurl.='/'.$sec;
15619: }
15620: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15621: if ($sec eq '') {
15622: $$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;
15623: } else {
15624: $$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;
15625: }
15626: }
15627: }
1.443 albertel 15628: }
15629: } else {
1.626 raeburn 15630: $$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 15631: $result = "error: incomplete course id\n";
15632: }
15633: return $result;
15634: }
15635:
1.1108 raeburn 15636: sub show_role_extent {
15637: my ($scope,$context,$role) = @_;
15638: $scope =~ s{^/}{};
15639: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15640: push(@courseroles,'co');
15641: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15642: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15643: $scope =~ s{/}{_};
15644: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15645: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15646: my ($audom,$auname) = split(/\//,$scope);
15647: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15648: &Apache::loncommon::plainname($auname,$audom).'</span>');
15649: } else {
15650: $scope =~ s{/$}{};
15651: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15652: &Apache::lonnet::domain($scope,'description').'</span>');
15653: }
15654: }
15655:
1.443 albertel 15656: ############################################################
15657: ############################################################
15658:
1.566 albertel 15659: sub check_clone {
1.578 raeburn 15660: my ($args,$linefeed) = @_;
1.566 albertel 15661: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15662: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15663: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15664: my $clonemsg;
15665: my $can_clone = 0;
1.944 raeburn 15666: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15667: if ($lctype ne 'community') {
15668: $lctype = 'course';
15669: }
1.566 albertel 15670: if ($clonehome eq 'no_host') {
1.944 raeburn 15671: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15672: $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'});
15673: } else {
15674: $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'});
15675: }
1.566 albertel 15676: } else {
15677: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15678: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15679: if ($clonedesc{'type'} ne 'Community') {
1.1262 raeburn 15680: $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 15681: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15682: }
15683: }
1.1262 raeburn 15684: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15685: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15686: $can_clone = 1;
15687: } else {
1.1221 raeburn 15688: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15689: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15690: if ($clonehash{'cloners'} eq '') {
15691: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15692: if ($domdefs{'canclone'}) {
15693: unless ($domdefs{'canclone'} eq 'none') {
15694: if ($domdefs{'canclone'} eq 'domain') {
15695: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15696: $can_clone = 1;
15697: }
15698: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15699: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15700: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15701: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15702: $can_clone = 1;
15703: }
15704: }
15705: }
15706: }
1.578 raeburn 15707: } else {
1.1221 raeburn 15708: my @cloners = split(/,/,$clonehash{'cloners'});
15709: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15710: $can_clone = 1;
1.1221 raeburn 15711: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15712: $can_clone = 1;
1.1225 raeburn 15713: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15714: $can_clone = 1;
1.1221 raeburn 15715: }
15716: unless ($can_clone) {
1.1225 raeburn 15717: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15718: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15719: my (%gotdomdefaults,%gotcodedefaults);
15720: foreach my $cloner (@cloners) {
15721: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15722: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15723: my (%codedefaults,@code_order);
15724: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15725: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15726: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15727: }
15728: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15729: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15730: }
15731: } else {
15732: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15733: \%codedefaults,
15734: \@code_order);
15735: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15736: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15737: }
15738: if (@code_order > 0) {
15739: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15740: $cloner,$clonehash{'internal.coursecode'},
15741: $args->{'crscode'})) {
15742: $can_clone = 1;
15743: last;
15744: }
15745: }
15746: }
15747: }
15748: }
1.1225 raeburn 15749: }
15750: }
15751: unless ($can_clone) {
15752: my $ccrole = 'cc';
15753: if ($args->{'crstype'} eq 'Community') {
15754: $ccrole = 'co';
15755: }
15756: my %roleshash =
15757: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15758: $args->{'ccdomain'},
15759: 'userroles',['active'],[$ccrole],
15760: [$args->{'clonedomain'}]);
15761: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15762: $can_clone = 1;
15763: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15764: $args->{'ccuname'},$args->{'ccdomain'})) {
15765: $can_clone = 1;
1.1221 raeburn 15766: }
15767: }
15768: unless ($can_clone) {
15769: if ($args->{'crstype'} eq 'Community') {
15770: $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 15771: } else {
1.1221 raeburn 15772: $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'});
15773: }
1.566 albertel 15774: }
1.578 raeburn 15775: }
1.566 albertel 15776: }
15777: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15778: }
15779:
1.444 albertel 15780: sub construct_course {
1.1262 raeburn 15781: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
15782: $cnum,$category,$coderef) = @_;
1.444 albertel 15783: my $outcome;
1.541 raeburn 15784: my $linefeed = '<br />'."\n";
15785: if ($context eq 'auto') {
15786: $linefeed = "\n";
15787: }
1.566 albertel 15788:
15789: #
15790: # Are we cloning?
15791: #
15792: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15793: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15794: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15795: if ($context ne 'auto') {
1.578 raeburn 15796: if ($clonemsg ne '') {
15797: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15798: }
1.566 albertel 15799: }
15800: $outcome .= $clonemsg.$linefeed;
15801:
15802: if (!$can_clone) {
15803: return (0,$outcome);
15804: }
15805: }
15806:
1.444 albertel 15807: #
15808: # Open course
15809: #
1.1239 raeburn 15810: my $showncrstype;
15811: if ($args->{'crstype'} eq 'Placement') {
15812: $showncrstype = 'placement test';
15813: } else {
15814: $showncrstype = lc($args->{'crstype'});
15815: }
1.444 albertel 15816: my %cenv=();
15817: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15818: $args->{'cdescr'},
15819: $args->{'curl'},
15820: $args->{'course_home'},
15821: $args->{'nonstandard'},
15822: $args->{'crscode'},
15823: $args->{'ccuname'}.':'.
15824: $args->{'ccdomain'},
1.882 raeburn 15825: $args->{'crstype'},
1.885 raeburn 15826: $cnum,$context,$category);
1.444 albertel 15827:
15828: # Note: The testing routines depend on this being output; see
15829: # Utils::Course. This needs to at least be output as a comment
15830: # if anyone ever decides to not show this, and Utils::Course::new
15831: # will need to be suitably modified.
1.1239 raeburn 15832: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 15833: if ($$courseid =~ /^error:/) {
15834: return (0,$outcome);
15835: }
15836:
1.444 albertel 15837: #
15838: # Check if created correctly
15839: #
1.479 albertel 15840: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15841: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15842: if ($crsuhome eq 'no_host') {
15843: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15844: return (0,$outcome);
15845: }
1.541 raeburn 15846: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15847:
1.444 albertel 15848: #
1.566 albertel 15849: # Do the cloning
15850: #
15851: if ($can_clone && $cloneid) {
1.1239 raeburn 15852: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 15853: if ($context ne 'auto') {
15854: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15855: }
15856: $outcome .= $clonemsg.$linefeed;
15857: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15858: # Copy all files
1.637 www 15859: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15860: # Restore URL
1.566 albertel 15861: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15862: # Restore title
1.566 albertel 15863: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15864: # Restore creation date, creator and creation context.
15865: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15866: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15867: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15868: # Mark as cloned
1.566 albertel 15869: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15870: # Need to clone grading mode
15871: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15872: $cenv{'grading'}=$newenv{'grading'};
15873: # Do not clone these environment entries
15874: &Apache::lonnet::del('environment',
15875: ['default_enrollment_start_date',
15876: 'default_enrollment_end_date',
15877: 'question.email',
15878: 'policy.email',
15879: 'comment.email',
15880: 'pch.users.denied',
1.725 raeburn 15881: 'plc.users.denied',
15882: 'hidefromcat',
1.1121 raeburn 15883: 'checkforpriv',
1.1166 raeburn 15884: 'categories',
15885: 'internal.uniquecode'],
1.638 www 15886: $$crsudom,$$crsunum);
1.1170 raeburn 15887: if ($args->{'textbook'}) {
15888: $cenv{'internal.textbook'} = $args->{'textbook'};
15889: }
1.444 albertel 15890: }
1.566 albertel 15891:
1.444 albertel 15892: #
15893: # Set environment (will override cloned, if existing)
15894: #
15895: my @sections = ();
15896: my @xlists = ();
15897: if ($args->{'crstype'}) {
15898: $cenv{'type'}=$args->{'crstype'};
15899: }
15900: if ($args->{'crsid'}) {
15901: $cenv{'courseid'}=$args->{'crsid'};
15902: }
15903: if ($args->{'crscode'}) {
15904: $cenv{'internal.coursecode'}=$args->{'crscode'};
15905: }
15906: if ($args->{'crsquota'} ne '') {
15907: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15908: } else {
15909: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15910: }
15911: if ($args->{'ccuname'}) {
15912: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15913: ':'.$args->{'ccdomain'};
15914: } else {
15915: $cenv{'internal.courseowner'} = $args->{'curruser'};
15916: }
1.1116 raeburn 15917: if ($args->{'defaultcredits'}) {
15918: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15919: }
1.444 albertel 15920: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15921: if ($args->{'crssections'}) {
15922: $cenv{'internal.sectionnums'} = '';
15923: if ($args->{'crssections'} =~ m/,/) {
15924: @sections = split/,/,$args->{'crssections'};
15925: } else {
15926: $sections[0] = $args->{'crssections'};
15927: }
15928: if (@sections > 0) {
15929: foreach my $item (@sections) {
15930: my ($sec,$gp) = split/:/,$item;
15931: my $class = $args->{'crscode'}.$sec;
15932: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15933: $cenv{'internal.sectionnums'} .= $item.',';
15934: unless ($addcheck eq 'ok') {
1.1263 raeburn 15935: push(@badclasses,$class);
1.444 albertel 15936: }
15937: }
15938: $cenv{'internal.sectionnums'} =~ s/,$//;
15939: }
15940: }
15941: # do not hide course coordinator from staff listing,
15942: # even if privileged
15943: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15944: # add course coordinator's domain to domains to check for privileged users
15945: # if different to course domain
15946: if ($$crsudom ne $args->{'ccdomain'}) {
15947: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15948: }
1.444 albertel 15949: # add crosslistings
15950: if ($args->{'crsxlist'}) {
15951: $cenv{'internal.crosslistings'}='';
15952: if ($args->{'crsxlist'} =~ m/,/) {
15953: @xlists = split/,/,$args->{'crsxlist'};
15954: } else {
15955: $xlists[0] = $args->{'crsxlist'};
15956: }
15957: if (@xlists > 0) {
15958: foreach my $item (@xlists) {
15959: my ($xl,$gp) = split/:/,$item;
15960: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15961: $cenv{'internal.crosslistings'} .= $item.',';
15962: unless ($addcheck eq 'ok') {
1.1263 raeburn 15963: push(@badclasses,$xl);
1.444 albertel 15964: }
15965: }
15966: $cenv{'internal.crosslistings'} =~ s/,$//;
15967: }
15968: }
15969: if ($args->{'autoadds'}) {
15970: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15971: }
15972: if ($args->{'autodrops'}) {
15973: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15974: }
15975: # check for notification of enrollment changes
15976: my @notified = ();
15977: if ($args->{'notify_owner'}) {
15978: if ($args->{'ccuname'} ne '') {
15979: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15980: }
15981: }
15982: if ($args->{'notify_dc'}) {
15983: if ($uname ne '') {
1.630 raeburn 15984: push(@notified,$uname.':'.$udom);
1.444 albertel 15985: }
15986: }
15987: if (@notified > 0) {
15988: my $notifylist;
15989: if (@notified > 1) {
15990: $notifylist = join(',',@notified);
15991: } else {
15992: $notifylist = $notified[0];
15993: }
15994: $cenv{'internal.notifylist'} = $notifylist;
15995: }
15996: if (@badclasses > 0) {
15997: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 15998: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
15999: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16000: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16001: );
1.1264 raeburn 16002: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16003: &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 16004: if ($context eq 'auto') {
16005: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 16006: } else {
1.566 albertel 16007: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 16008: }
16009: foreach my $item (@badclasses) {
1.541 raeburn 16010: if ($context eq 'auto') {
1.1261 raeburn 16011: $outcome .= " - $item\n";
1.541 raeburn 16012: } else {
1.1261 raeburn 16013: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16014: }
1.1261 raeburn 16015: }
16016: if ($context eq 'auto') {
16017: $outcome .= $linefeed;
16018: } else {
16019: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 16020: }
1.444 albertel 16021: }
16022: if ($args->{'no_end_date'}) {
16023: $args->{'endaccess'} = 0;
16024: }
16025: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16026: $cenv{'internal.autoend'}=$args->{'enrollend'};
16027: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16028: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16029: if ($args->{'showphotos'}) {
16030: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16031: }
16032: $cenv{'internal.authtype'} = $args->{'authtype'};
16033: $cenv{'internal.autharg'} = $args->{'autharg'};
16034: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16035: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16036: 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');
16037: if ($context eq 'auto') {
16038: $outcome .= $krb_msg;
16039: } else {
1.566 albertel 16040: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16041: }
16042: $outcome .= $linefeed;
1.444 albertel 16043: }
16044: }
16045: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16046: if ($args->{'setpolicy'}) {
16047: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16048: }
16049: if ($args->{'setcontent'}) {
16050: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16051: }
1.1251 raeburn 16052: if ($args->{'setcomment'}) {
16053: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16054: }
1.444 albertel 16055: }
16056: if ($args->{'reshome'}) {
16057: $cenv{'reshome'}=$args->{'reshome'}.'/';
16058: $cenv{'reshome'}=~s/\/+$/\//;
16059: }
16060: #
16061: # course has keyed access
16062: #
16063: if ($args->{'setkeys'}) {
16064: $cenv{'keyaccess'}='yes';
16065: }
16066: # if specified, key authority is not course, but user
16067: # only active if keyaccess is yes
16068: if ($args->{'keyauth'}) {
1.487 albertel 16069: my ($user,$domain) = split(':',$args->{'keyauth'});
16070: $user = &LONCAPA::clean_username($user);
16071: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16072: if ($user ne '' && $domain ne '') {
1.487 albertel 16073: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16074: }
16075: }
16076:
1.1166 raeburn 16077: #
1.1167 raeburn 16078: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 16079: #
16080: if ($args->{'uniquecode'}) {
16081: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16082: if ($code) {
16083: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 16084: my %crsinfo =
16085: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16086: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16087: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16088: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16089: }
1.1166 raeburn 16090: if (ref($coderef)) {
16091: $$coderef = $code;
16092: }
16093: }
16094: }
16095:
1.444 albertel 16096: if ($args->{'disresdis'}) {
16097: $cenv{'pch.roles.denied'}='st';
16098: }
16099: if ($args->{'disablechat'}) {
16100: $cenv{'plc.roles.denied'}='st';
16101: }
16102:
16103: # Record we've not yet viewed the Course Initialization Helper for this
16104: # course
16105: $cenv{'course.helper.not.run'} = 1;
16106: #
16107: # Use new Randomseed
16108: #
16109: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16110: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16111: #
16112: # The encryption code and receipt prefix for this course
16113: #
16114: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16115: $cenv{'internal.encpref'}=100+int(9*rand(99));
16116: #
16117: # By default, use standard grading
16118: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16119:
1.541 raeburn 16120: $outcome .= $linefeed.&mt('Setting environment').': '.
16121: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16122: #
16123: # Open all assignments
16124: #
16125: if ($args->{'openall'}) {
16126: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
16127: my %storecontent = ($storeunder => time,
16128: $storeunder.'.type' => 'date_start');
16129:
16130: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 16131: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16132: }
16133: #
16134: # Set first page
16135: #
16136: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16137: || ($cloneid)) {
1.445 albertel 16138: use LONCAPA::map;
1.444 albertel 16139: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16140:
16141: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16142: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16143:
1.444 albertel 16144: $outcome .= ($fatal?$errtext:'read ok').' - ';
16145: my $title; my $url;
16146: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16147: $title=&mt('Syllabus');
1.444 albertel 16148: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16149: } else {
1.963 raeburn 16150: $title=&mt('Table of Contents');
1.444 albertel 16151: $url='/adm/navmaps';
16152: }
1.445 albertel 16153:
16154: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16155: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16156:
16157: if ($errtext) { $fatal=2; }
1.541 raeburn 16158: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16159: }
1.566 albertel 16160:
1.1237 raeburn 16161: #
16162: # Set params for Placement Tests
16163: #
1.1239 raeburn 16164: if ($args->{'crstype'} eq 'Placement') {
16165: my %storecontent;
16166: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
16167: my %defaults = (
16168: buttonshide => { value => 'yes',
16169: type => 'string_yesno',},
16170: type => { value => 'randomizetry',
16171: type => 'string_questiontype',},
16172: maxtries => { value => 1,
16173: type => 'int_pos',},
16174: problemstatus => { value => 'no',
16175: type => 'string_problemstatus',},
16176: );
16177: foreach my $key (keys(%defaults)) {
16178: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
16179: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
16180: }
1.1237 raeburn 16181: &Apache::lonnet::cput
16182: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
16183: }
16184:
1.566 albertel 16185: return (1,$outcome);
1.444 albertel 16186: }
16187:
1.1166 raeburn 16188: sub make_unique_code {
16189: my ($cdom,$cnum) = @_;
16190: # get lock on uniquecodes db
16191: my $lockhash = {
16192: $cnum."\0".'uniquecodes' => $env{'user.name'}.
16193: ':'.$env{'user.domain'},
16194: };
16195: my $tries = 0;
16196: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16197: my ($code,$error);
16198:
16199: while (($gotlock ne 'ok') && ($tries<3)) {
16200: $tries ++;
16201: sleep 1;
16202: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16203: }
16204: if ($gotlock eq 'ok') {
16205: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
16206: my $gotcode;
16207: my $attempts = 0;
16208: while ((!$gotcode) && ($attempts < 100)) {
16209: $code = &generate_code();
16210: if (!exists($currcodes{$code})) {
16211: $gotcode = 1;
16212: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
16213: $error = 'nostore';
16214: }
16215: }
16216: $attempts ++;
16217: }
16218: my @del_lock = ($cnum."\0".'uniquecodes');
16219: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
16220: } else {
16221: $error = 'nolock';
16222: }
16223: return ($code,$error);
16224: }
16225:
16226: sub generate_code {
16227: my $code;
16228: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
16229: for (my $i=0; $i<6; $i++) {
16230: my $lettnum = int (rand 2);
16231: my $item = '';
16232: if ($lettnum) {
16233: $item = $letts[int( rand(18) )];
16234: } else {
16235: $item = 1+int( rand(8) );
16236: }
16237: $code .= $item;
16238: }
16239: return $code;
16240: }
16241:
1.444 albertel 16242: ############################################################
16243: ############################################################
16244:
1.1237 raeburn 16245: # Community, Course and Placement Test
1.378 raeburn 16246: sub course_type {
16247: my ($cid) = @_;
16248: if (!defined($cid)) {
16249: $cid = $env{'request.course.id'};
16250: }
1.404 albertel 16251: if (defined($env{'course.'.$cid.'.type'})) {
16252: return $env{'course.'.$cid.'.type'};
1.378 raeburn 16253: } else {
16254: return 'Course';
1.377 raeburn 16255: }
16256: }
1.156 albertel 16257:
1.406 raeburn 16258: sub group_term {
16259: my $crstype = &course_type();
16260: my %names = (
16261: 'Course' => 'group',
1.865 raeburn 16262: 'Community' => 'group',
1.1237 raeburn 16263: 'Placement' => 'group',
1.406 raeburn 16264: );
16265: return $names{$crstype};
16266: }
16267:
1.902 raeburn 16268: sub course_types {
1.1310 raeburn 16269: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 16270: my %typename = (
16271: official => 'Official course',
16272: unofficial => 'Unofficial course',
16273: community => 'Community',
1.1165 raeburn 16274: textbook => 'Textbook course',
1.1237 raeburn 16275: placement => 'Placement test',
1.1310 raeburn 16276: lti => 'LTI provider',
1.902 raeburn 16277: );
16278: return (\@types,\%typename);
16279: }
16280:
1.156 albertel 16281: sub icon {
16282: my ($file)=@_;
1.505 albertel 16283: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 16284: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 16285: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 16286: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
16287: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
16288: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16289: $curfext.".gif") {
16290: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16291: $curfext.".gif";
16292: }
16293: }
1.249 albertel 16294: return &lonhttpdurl($iconname);
1.154 albertel 16295: }
1.84 albertel 16296:
1.575 albertel 16297: sub lonhttpdurl {
1.692 www 16298: #
16299: # Had been used for "small fry" static images on separate port 8080.
16300: # Modify here if lightweight http functionality desired again.
16301: # Currently eliminated due to increasing firewall issues.
16302: #
1.575 albertel 16303: my ($url)=@_;
1.692 www 16304: return $url;
1.215 albertel 16305: }
16306:
1.213 albertel 16307: sub connection_aborted {
16308: my ($r)=@_;
16309: $r->print(" ");$r->rflush();
16310: my $c = $r->connection;
16311: return $c->aborted();
16312: }
16313:
1.221 foxr 16314: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16315: # strings as 'strings'.
16316: sub escape_single {
1.221 foxr 16317: my ($input) = @_;
1.223 albertel 16318: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16319: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16320: return $input;
16321: }
1.223 albertel 16322:
1.222 foxr 16323: # Same as escape_single, but escape's "'s This
16324: # can be used for "strings"
16325: sub escape_double {
16326: my ($input) = @_;
16327: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16328: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16329: return $input;
16330: }
1.223 albertel 16331:
1.222 foxr 16332: # Escapes the last element of a full URL.
16333: sub escape_url {
16334: my ($url) = @_;
1.238 raeburn 16335: my @urlslices = split(/\//, $url,-1);
1.369 www 16336: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 16337: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16338: }
1.462 albertel 16339:
1.820 raeburn 16340: sub compare_arrays {
16341: my ($arrayref1,$arrayref2) = @_;
16342: my (@difference,%count);
16343: @difference = ();
16344: %count = ();
16345: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16346: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16347: foreach my $element (keys(%count)) {
16348: if ($count{$element} == 1) {
16349: push(@difference,$element);
16350: }
16351: }
16352: }
16353: return @difference;
16354: }
16355:
1.817 bisitz 16356: # -------------------------------------------------------- Initialize user login
1.462 albertel 16357: sub init_user_environment {
1.463 albertel 16358: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16359: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16360:
16361: my $public=($username eq 'public' && $domain eq 'public');
16362:
1.1062 raeburn 16363: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16364: my $now=time;
16365:
16366: if ($public) {
16367: my $max_public=100;
16368: my $oldest;
16369: my $oldest_time=0;
16370: for(my $next=1;$next<=$max_public;$next++) {
16371: if (-e $lonids."/publicuser_$next.id") {
16372: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16373: if ($mtime<$oldest_time || !$oldest_time) {
16374: $oldest_time=$mtime;
16375: $oldest=$next;
16376: }
16377: } else {
16378: $cookie="publicuser_$next";
16379: last;
16380: }
16381: }
16382: if (!$cookie) { $cookie="publicuser_$oldest"; }
16383: } else {
1.1275 raeburn 16384: # See if old ID present, if so, remove if this isn't a robot,
16385: # killing any existing non-robot sessions
1.463 albertel 16386: if (!$args->{'robot'}) {
16387: opendir(DIR,$lonids);
16388: while ($filename=readdir(DIR)) {
16389: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1295 raeburn 16390: if ($ENV{'SERVER_PORT'} == 443) {
16391: my $linkedfile;
16392: if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id",
16393: &GDBM_READER(),0640)) {
16394: if (exists($oldenv{'user.linkedenv'})) {
16395: $linkedfile = $oldenv{'user.linkedenv'};
16396: }
16397: untie(%oldenv);
16398: }
16399: if (unlink($lonids.'/'.$filename)) {
16400: if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) {
16401: unlink($lonids.'/'.$linkedfile);
16402: }
16403: }
16404: } else {
16405: unlink($lonids.'/'.$filename);
16406: }
1.463 albertel 16407: }
1.462 albertel 16408: }
1.463 albertel 16409: closedir(DIR);
1.1204 raeburn 16410: # If there is a undeleted lockfile for the user's paste buffer remove it.
16411: my $namespace = 'nohist_courseeditor';
16412: my $lockingkey = 'paste'."\0".'locked_num';
16413: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16414: $domain,$username);
16415: if (exists($lockhash{$lockingkey})) {
16416: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16417: unless ($delresult eq 'ok') {
16418: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16419: }
16420: }
1.462 albertel 16421: }
16422: # Give them a new cookie
1.463 albertel 16423: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16424: : $now.$$.int(rand(10000)));
1.463 albertel 16425: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16426:
16427: # Initialize roles
16428:
1.1062 raeburn 16429: ($userroles,$firstaccenv,$timerintenv) =
16430: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16431: }
16432: # ------------------------------------ Check browser type and MathML capability
16433:
1.1194 raeburn 16434: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16435: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16436:
16437: # ------------------------------------------------------------- Get environment
16438:
16439: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16440: my ($tmp) = keys(%userenv);
1.1275 raeburn 16441: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 16442: undef(%userenv);
16443: }
16444: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16445: $form->{'interface'}=$userenv{'interface'};
16446: }
16447: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16448:
16449: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16450: foreach my $option ('interface','localpath','localres') {
16451: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16452: }
16453: # --------------------------------------------------------- Write first profile
16454:
16455: {
16456: my %initial_env =
16457: ("user.name" => $username,
16458: "user.domain" => $domain,
16459: "user.home" => $authhost,
16460: "browser.type" => $clientbrowser,
16461: "browser.version" => $clientversion,
16462: "browser.mathml" => $clientmathml,
16463: "browser.unicode" => $clientunicode,
16464: "browser.os" => $clientos,
1.1137 raeburn 16465: "browser.mobile" => $clientmobile,
1.1141 raeburn 16466: "browser.info" => $clientinfo,
1.1194 raeburn 16467: "browser.osversion" => $clientosversion,
1.462 albertel 16468: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16469: "request.course.fn" => '',
16470: "request.course.uri" => '',
16471: "request.course.sec" => '',
16472: "request.role" => 'cm',
16473: "request.role.adv" => $env{'user.adv'},
16474: "request.host" => $ENV{'REMOTE_ADDR'},);
16475:
16476: if ($form->{'localpath'}) {
16477: $initial_env{"browser.localpath"} = $form->{'localpath'};
16478: $initial_env{"browser.localres"} = $form->{'localres'};
16479: }
16480:
16481: if ($form->{'interface'}) {
16482: $form->{'interface'}=~s/\W//gs;
16483: $initial_env{"browser.interface"} = $form->{'interface'};
16484: $env{'browser.interface'}=$form->{'interface'};
16485: }
16486:
1.1157 raeburn 16487: if ($form->{'iptoken'}) {
16488: my $lonhost = $r->dir_config('lonHostID');
16489: $initial_env{"user.noloadbalance"} = $lonhost;
16490: $env{'user.noloadbalance'} = $lonhost;
16491: }
16492:
1.1268 raeburn 16493: if ($form->{'noloadbalance'}) {
16494: my @hosts = &Apache::lonnet::current_machine_ids();
16495: my $hosthere = $form->{'noloadbalance'};
16496: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16497: $initial_env{"user.noloadbalance"} = $hosthere;
16498: $env{'user.noloadbalance'} = $hosthere;
16499: }
16500: }
16501:
1.1016 raeburn 16502: unless ($domain eq 'public') {
1.1273 raeburn 16503: my %is_adv = ( is_adv => $env{'user.adv'} );
16504: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
16505:
16506: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16507: $userenv{'availabletools.'.$tool} =
16508: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16509: undef,\%userenv,\%domdef,\%is_adv);
16510: }
1.980 raeburn 16511:
1.1311 raeburn 16512: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 16513: $userenv{'canrequest.'.$crstype} =
16514: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16515: 'reload','requestcourses',
16516: \%userenv,\%domdef,\%is_adv);
16517: }
1.724 raeburn 16518:
1.1273 raeburn 16519: $userenv{'canrequest.author'} =
16520: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16521: 'reload','requestauthor',
1.980 raeburn 16522: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 16523: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16524: $domain,$username);
16525: my $reqstatus = $reqauthor{'author_status'};
16526: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16527: if (ref($reqauthor{'author'}) eq 'HASH') {
16528: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16529: $reqauthor{'author'}{'timestamp'};
16530: }
1.1092 raeburn 16531: }
1.1287 raeburn 16532: my ($types,$typename) = &course_types();
16533: if (ref($types) eq 'ARRAY') {
16534: my @options = ('approval','validate','autolimit');
16535: my $optregex = join('|',@options);
16536: my (%willtrust,%trustchecked);
16537: foreach my $type (@{$types}) {
16538: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
16539: if ($dom_str ne '') {
16540: my $updatedstr = '';
16541: my @possdomains = split(',',$dom_str);
16542: foreach my $entry (@possdomains) {
16543: my ($extdom,$extopt) = split(':',$entry);
16544: unless ($trustchecked{$extdom}) {
16545: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
16546: $trustchecked{$extdom} = 1;
16547: }
16548: if ($willtrust{$extdom}) {
16549: $updatedstr .= $entry.',';
16550: }
16551: }
16552: $updatedstr =~ s/,$//;
16553: if ($updatedstr) {
16554: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
16555: } else {
16556: delete($userenv{'reqcrsotherdom.'.$type});
16557: }
16558: }
16559: }
16560: }
1.1092 raeburn 16561: }
1.462 albertel 16562: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16563:
1.462 albertel 16564: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16565: &GDBM_WRCREAT(),0640)) {
16566: &_add_to_env(\%disk_env,\%initial_env);
16567: &_add_to_env(\%disk_env,\%userenv,'environment.');
16568: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16569: if (ref($firstaccenv) eq 'HASH') {
16570: &_add_to_env(\%disk_env,$firstaccenv);
16571: }
16572: if (ref($timerintenv) eq 'HASH') {
16573: &_add_to_env(\%disk_env,$timerintenv);
16574: }
1.463 albertel 16575: if (ref($args->{'extra_env'})) {
16576: &_add_to_env(\%disk_env,$args->{'extra_env'});
16577: }
1.462 albertel 16578: untie(%disk_env);
16579: } else {
1.705 tempelho 16580: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16581: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16582: return 'error: '.$!;
16583: }
16584: }
16585: $env{'request.role'}='cm';
16586: $env{'request.role.adv'}=$env{'user.adv'};
16587: $env{'browser.type'}=$clientbrowser;
16588:
16589: return $cookie;
16590:
16591: }
16592:
16593: sub _add_to_env {
16594: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16595: if (ref($env_data) eq 'HASH') {
16596: while (my ($key,$value) = each(%$env_data)) {
16597: $idf->{$prefix.$key} = $value;
16598: $env{$prefix.$key} = $value;
16599: }
1.462 albertel 16600: }
16601: }
16602:
1.685 tempelho 16603: # --- Get the symbolic name of a problem and the url
16604: sub get_symb {
16605: my ($request,$silent) = @_;
1.726 raeburn 16606: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16607: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16608: if ($symb eq '') {
16609: if (!$silent) {
1.1071 raeburn 16610: if (ref($request)) {
16611: $request->print("Unable to handle ambiguous references:$url:.");
16612: }
1.685 tempelho 16613: return ();
16614: }
16615: }
16616: &Apache::lonenc::check_decrypt(\$symb);
16617: return ($symb);
16618: }
16619:
16620: # --------------------------------------------------------------Get annotation
16621:
16622: sub get_annotation {
16623: my ($symb,$enc) = @_;
16624:
16625: my $key = $symb;
16626: if (!$enc) {
16627: $key =
16628: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16629: }
16630: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16631: return $annotation{$key};
16632: }
16633:
16634: sub clean_symb {
1.731 raeburn 16635: my ($symb,$delete_enc) = @_;
1.685 tempelho 16636:
16637: &Apache::lonenc::check_decrypt(\$symb);
16638: my $enc = $env{'request.enc'};
1.731 raeburn 16639: if ($delete_enc) {
1.730 raeburn 16640: delete($env{'request.enc'});
16641: }
1.685 tempelho 16642:
16643: return ($symb,$enc);
16644: }
1.462 albertel 16645:
1.1181 raeburn 16646: ############################################################
16647: ############################################################
16648:
16649: =pod
16650:
16651: =head1 Routines for building display used to search for courses
16652:
16653:
16654: =over 4
16655:
16656: =item * &build_filters()
16657:
16658: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16659: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16660: and quotacheck.pl
16661:
1.1181 raeburn 16662:
16663: Inputs:
16664:
16665: filterlist - anonymous array of fields to include as potential filters
16666:
16667: crstype - course type
16668:
16669: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16670: to pop-open a course selector (will contain "extra element").
16671:
16672: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16673:
16674: filter - anonymous hash of criteria and their values
16675:
16676: action - form action
16677:
16678: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16679:
1.1182 raeburn 16680: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16681:
16682: cloneruname - username of owner of new course who wants to clone
16683:
16684: clonerudom - domain of owner of new course who wants to clone
16685:
16686: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16687:
16688: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16689:
16690: codedom - domain
16691:
16692: formname - value of form element named "form".
16693:
16694: fixeddom - domain, if fixed.
16695:
16696: prevphase - value to assign to form element named "phase" when going back to the previous screen
16697:
16698: cnameelement - name of form element in form on opener page which will receive title of selected course
16699:
16700: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16701:
16702: cdomelement - name of form element in form on opener page which will receive domain of selected course
16703:
16704: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16705:
16706: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16707:
16708: clonewarning - warning message about missing information for intended course owner when DC creates a course
16709:
1.1182 raeburn 16710:
1.1181 raeburn 16711: Returns: $output - HTML for display of search criteria, and hidden form elements.
16712:
1.1182 raeburn 16713:
1.1181 raeburn 16714: Side Effects: None
16715:
16716: =cut
16717:
16718: # ---------------------------------------------- search for courses based on last activity etc.
16719:
16720: sub build_filters {
16721: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16722: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16723: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16724: $cnameelement,$cnumelement,$cdomelement,$setroles,
16725: $clonetext,$clonewarning) = @_;
1.1182 raeburn 16726: my ($list,$jscript);
1.1181 raeburn 16727: my $onchange = 'javascript:updateFilters(this)';
16728: my ($domainselectform,$sincefilterform,$createdfilterform,
16729: $ownerdomselectform,$persondomselectform,$instcodeform,
16730: $typeselectform,$instcodetitle);
16731: if ($formname eq '') {
16732: $formname = $caller;
16733: }
16734: foreach my $item (@{$filterlist}) {
16735: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16736: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16737: if ($item eq 'domainfilter') {
16738: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16739: } elsif ($item eq 'coursefilter') {
16740: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16741: } elsif ($item eq 'ownerfilter') {
16742: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16743: } elsif ($item eq 'ownerdomfilter') {
16744: $filter->{'ownerdomfilter'} =
16745: &LONCAPA::clean_domain($filter->{$item});
16746: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16747: 'ownerdomfilter',1);
16748: } elsif ($item eq 'personfilter') {
16749: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16750: } elsif ($item eq 'persondomfilter') {
16751: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16752: 'persondomfilter',1);
16753: } else {
16754: $filter->{$item} =~ s/\W//g;
16755: }
16756: if (!$filter->{$item}) {
16757: $filter->{$item} = '';
16758: }
16759: }
16760: if ($item eq 'domainfilter') {
16761: my $allow_blank = 1;
16762: if ($formname eq 'portform') {
16763: $allow_blank=0;
16764: } elsif ($formname eq 'studentform') {
16765: $allow_blank=0;
16766: }
16767: if ($fixeddom) {
16768: $domainselectform = '<input type="hidden" name="domainfilter"'.
16769: ' value="'.$codedom.'" />'.
16770: &Apache::lonnet::domain($codedom,'description');
16771: } else {
16772: $domainselectform = &select_dom_form($filter->{$item},
16773: 'domainfilter',
16774: $allow_blank,'',$onchange);
16775: }
16776: } else {
16777: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16778: }
16779: }
16780:
16781: # last course activity filter and selection
16782: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16783:
16784: # course created filter and selection
16785: if (exists($filter->{'createdfilter'})) {
16786: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16787: }
16788:
1.1239 raeburn 16789: my $prefix = $crstype;
16790: if ($crstype eq 'Placement') {
16791: $prefix = 'Placement Test'
16792: }
1.1181 raeburn 16793: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 16794: 'cac' => "$prefix Activity",
16795: 'ccr' => "$prefix Created",
16796: 'cde' => "$prefix Title",
16797: 'cdo' => "$prefix Domain",
1.1181 raeburn 16798: 'ins' => 'Institutional Code',
16799: 'inc' => 'Institutional Categorization',
1.1239 raeburn 16800: 'cow' => "$prefix Owner/Co-owner",
16801: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 16802: 'cog' => 'Type',
16803: );
16804:
16805: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16806: my $typeval = 'Course';
16807: if ($crstype eq 'Community') {
16808: $typeval = 'Community';
1.1239 raeburn 16809: } elsif ($crstype eq 'Placement') {
16810: $typeval = 'Placement';
1.1181 raeburn 16811: }
16812: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16813: } else {
16814: $typeselectform = '<select name="type" size="1"';
16815: if ($onchange) {
16816: $typeselectform .= ' onchange="'.$onchange.'"';
16817: }
16818: $typeselectform .= '>'."\n";
1.1237 raeburn 16819: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 16820: my $shown;
16821: if ($posstype eq 'Placement') {
16822: $shown = &mt('Placement Test');
16823: } else {
16824: $shown = &mt($posstype);
16825: }
1.1181 raeburn 16826: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 16827: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 16828: }
16829: $typeselectform.="</select>";
16830: }
16831:
16832: my ($cloneableonlyform,$cloneabletitle);
16833: if (exists($filter->{'cloneableonly'})) {
16834: my $cloneableon = '';
16835: my $cloneableoff = ' checked="checked"';
16836: if ($filter->{'cloneableonly'}) {
16837: $cloneableon = $cloneableoff;
16838: $cloneableoff = '';
16839: }
16840: $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>';
16841: if ($formname eq 'ccrs') {
1.1187 bisitz 16842: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 16843: } else {
16844: $cloneabletitle = &mt('Cloneable by you');
16845: }
16846: }
16847: my $officialjs;
16848: if ($crstype eq 'Course') {
16849: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 16850: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16851: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16852: if ($codedom) {
1.1181 raeburn 16853: $officialjs = 1;
16854: ($instcodeform,$jscript,$$numtitlesref) =
16855: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16856: $officialjs,$codetitlesref);
16857: if ($jscript) {
1.1182 raeburn 16858: $jscript = '<script type="text/javascript">'."\n".
16859: '// <![CDATA['."\n".
16860: $jscript."\n".
16861: '// ]]>'."\n".
16862: '</script>'."\n";
1.1181 raeburn 16863: }
16864: }
16865: if ($instcodeform eq '') {
16866: $instcodeform =
16867: '<input type="text" name="instcodefilter" size="10" value="'.
16868: $list->{'instcodefilter'}.'" />';
16869: $instcodetitle = $lt{'ins'};
16870: } else {
16871: $instcodetitle = $lt{'inc'};
16872: }
16873: if ($fixeddom) {
16874: $instcodetitle .= '<br />('.$codedom.')';
16875: }
16876: }
16877: }
16878: my $output = qq|
16879: <form method="post" name="filterpicker" action="$action">
16880: <input type="hidden" name="form" value="$formname" />
16881: |;
16882: if ($formname eq 'modifycourse') {
16883: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16884: '<input type="hidden" name="prevphase" value="'.
16885: $prevphase.'" />'."\n";
1.1198 musolffc 16886: } elsif ($formname eq 'quotacheck') {
16887: $output .= qq|
16888: <input type="hidden" name="sortby" value="" />
16889: <input type="hidden" name="sortorder" value="" />
16890: |;
16891: } else {
1.1181 raeburn 16892: my $name_input;
16893: if ($cnameelement ne '') {
16894: $name_input = '<input type="hidden" name="cnameelement" value="'.
16895: $cnameelement.'" />';
16896: }
16897: $output .= qq|
1.1182 raeburn 16898: <input type="hidden" name="cnumelement" value="$cnumelement" />
16899: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 16900: $name_input
16901: $roleelement
16902: $multelement
16903: $typeelement
16904: |;
16905: if ($formname eq 'portform') {
16906: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16907: }
16908: }
16909: if ($fixeddom) {
16910: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16911: }
16912: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16913: if ($sincefilterform) {
16914: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16915: .$sincefilterform
16916: .&Apache::lonhtmlcommon::row_closure();
16917: }
16918: if ($createdfilterform) {
16919: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16920: .$createdfilterform
16921: .&Apache::lonhtmlcommon::row_closure();
16922: }
16923: if ($domainselectform) {
16924: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16925: .$domainselectform
16926: .&Apache::lonhtmlcommon::row_closure();
16927: }
16928: if ($typeselectform) {
16929: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16930: $output .= $typeselectform;
16931: } else {
16932: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16933: .$typeselectform
16934: .&Apache::lonhtmlcommon::row_closure();
16935: }
16936: }
16937: if ($instcodeform) {
16938: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16939: .$instcodeform
16940: .&Apache::lonhtmlcommon::row_closure();
16941: }
16942: if (exists($filter->{'ownerfilter'})) {
16943: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16944: '<table><tr><td>'.&mt('Username').'<br />'.
16945: '<input type="text" name="ownerfilter" size="20" value="'.
16946: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16947: $ownerdomselectform.'</td></tr></table>'.
16948: &Apache::lonhtmlcommon::row_closure();
16949: }
16950: if (exists($filter->{'personfilter'})) {
16951: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16952: '<table><tr><td>'.&mt('Username').'<br />'.
16953: '<input type="text" name="personfilter" size="20" value="'.
16954: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16955: $persondomselectform.'</td></tr></table>'.
16956: &Apache::lonhtmlcommon::row_closure();
16957: }
16958: if (exists($filter->{'coursefilter'})) {
16959: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16960: .'<input type="text" name="coursefilter" size="25" value="'
16961: .$list->{'coursefilter'}.'" />'
16962: .&Apache::lonhtmlcommon::row_closure();
16963: }
16964: if ($cloneableonlyform) {
16965: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16966: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16967: }
16968: if (exists($filter->{'descriptfilter'})) {
16969: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16970: .'<input type="text" name="descriptfilter" size="40" value="'
16971: .$list->{'descriptfilter'}.'" />'
16972: .&Apache::lonhtmlcommon::row_closure(1);
16973: }
16974: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16975: '<input type="hidden" name="updater" value="" />'."\n".
16976: '<input type="submit" name="gosearch" value="'.
16977: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16978: return $jscript.$clonewarning.$output;
16979: }
16980:
16981: =pod
16982:
16983: =item * &timebased_select_form()
16984:
1.1182 raeburn 16985: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 16986: filter e.g., Course Activity, Course Created, when searching for courses
16987: or communities
16988:
16989: Inputs:
16990:
16991: item - name of form element (sincefilter or createdfilter)
16992:
16993: filter - anonymous hash of criteria and their values
16994:
16995: Returns: HTML for a select box contained a blank, then six time selections,
16996: with value set in incoming form variables currently selected.
16997:
16998: Side Effects: None
16999:
17000: =cut
17001:
17002: sub timebased_select_form {
17003: my ($item,$filter) = @_;
17004: if (ref($filter) eq 'HASH') {
17005: $filter->{$item} =~ s/[^\d-]//g;
17006: if (!$filter->{$item}) { $filter->{$item}=-1; }
17007: return &select_form(
17008: $filter->{$item},
17009: $item,
17010: { '-1' => '',
17011: '86400' => &mt('today'),
17012: '604800' => &mt('last week'),
17013: '2592000' => &mt('last month'),
17014: '7776000' => &mt('last three months'),
17015: '15552000' => &mt('last six months'),
17016: '31104000' => &mt('last year'),
17017: 'select_form_order' =>
17018: ['-1','86400','604800','2592000','7776000',
17019: '15552000','31104000']});
17020: }
17021: }
17022:
17023: =pod
17024:
17025: =item * &js_changer()
17026:
17027: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 17028: when course type or domain is changed, and also to hide 'Searching ...' on
17029: page load completion for page showing search result.
1.1181 raeburn 17030:
17031: Inputs: None
17032:
1.1183 raeburn 17033: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 17034:
17035: Side Effects: None
17036:
17037: =cut
17038:
17039: sub js_changer {
17040: return <<ENDJS;
17041: <script type="text/javascript">
17042: // <![CDATA[
17043: function updateFilters(caller) {
17044: if (typeof(caller) != "undefined") {
17045: document.filterpicker.updater.value = caller.name;
17046: }
17047: document.filterpicker.submit();
17048: }
1.1183 raeburn 17049:
17050: function hideSearching() {
17051: if (document.getElementById('searching')) {
17052: document.getElementById('searching').style.display = 'none';
17053: }
17054: return;
17055: }
17056:
1.1181 raeburn 17057: // ]]>
17058: </script>
17059:
17060: ENDJS
17061: }
17062:
17063: =pod
17064:
1.1182 raeburn 17065: =item * &search_courses()
17066:
17067: Process selected filters form course search form and pass to lonnet::courseiddump
17068: to retrieve a hash for which keys are courseIDs which match the selected filters.
17069:
17070: Inputs:
17071:
17072: dom - domain being searched
17073:
17074: type - course type ('Course' or 'Community' or '.' if any).
17075:
17076: filter - anonymous hash of criteria and their values
17077:
17078: numtitles - for institutional codes - number of categories
17079:
17080: cloneruname - optional username of new course owner
17081:
17082: clonerudom - optional domain of new course owner
17083:
1.1221 raeburn 17084: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 17085: (used when DC is using course creation form)
17086:
17087: codetitles - reference to array of titles of components in institutional codes (official courses).
17088:
1.1221 raeburn 17089: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17090: (and so can clone automatically)
17091:
17092: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17093:
17094: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17095: courses to clone
1.1182 raeburn 17096:
17097: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17098:
17099:
17100: Side Effects: None
17101:
17102: =cut
17103:
17104:
17105: sub search_courses {
1.1221 raeburn 17106: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17107: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 17108: my (%courses,%showcourses,$cloner);
17109: if (($filter->{'ownerfilter'} ne '') ||
17110: ($filter->{'ownerdomfilter'} ne '')) {
17111: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17112: $filter->{'ownerdomfilter'};
17113: }
17114: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17115: if (!$filter->{$item}) {
17116: $filter->{$item}='.';
17117: }
17118: }
17119: my $now = time;
17120: my $timefilter =
17121: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17122: my ($createdbefore,$createdafter);
17123: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17124: $createdbefore = $now;
17125: $createdafter = $now-$filter->{'createdfilter'};
17126: }
17127: my ($instcodefilter,$regexpok);
17128: if ($numtitles) {
17129: if ($env{'form.official'} eq 'on') {
17130: $instcodefilter =
17131: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17132: $regexpok = 1;
17133: } elsif ($env{'form.official'} eq 'off') {
17134: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17135: unless ($instcodefilter eq '') {
17136: $regexpok = -1;
17137: }
17138: }
17139: } else {
17140: $instcodefilter = $filter->{'instcodefilter'};
17141: }
17142: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17143: if ($type eq '') { $type = '.'; }
17144:
17145: if (($clonerudom ne '') && ($cloneruname ne '')) {
17146: $cloner = $cloneruname.':'.$clonerudom;
17147: }
17148: %courses = &Apache::lonnet::courseiddump($dom,
17149: $filter->{'descriptfilter'},
17150: $timefilter,
17151: $instcodefilter,
17152: $filter->{'combownerfilter'},
17153: $filter->{'coursefilter'},
17154: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 17155: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 17156: $filter->{'cloneableonly'},
17157: $createdbefore,$createdafter,undef,
1.1221 raeburn 17158: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 17159: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
17160: my $ccrole;
17161: if ($type eq 'Community') {
17162: $ccrole = 'co';
17163: } else {
17164: $ccrole = 'cc';
17165: }
17166: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
17167: $filter->{'persondomfilter'},
17168: 'userroles',undef,
17169: [$ccrole,'in','ad','ep','ta','cr'],
17170: $dom);
17171: foreach my $role (keys(%rolehash)) {
17172: my ($cnum,$cdom,$courserole) = split(':',$role);
17173: my $cid = $cdom.'_'.$cnum;
17174: if (exists($courses{$cid})) {
17175: if (ref($courses{$cid}) eq 'HASH') {
17176: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
17177: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 17178: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 17179: }
17180: } else {
17181: $courses{$cid}{roles} = [$courserole];
17182: }
17183: $showcourses{$cid} = $courses{$cid};
17184: }
17185: }
17186: }
17187: %courses = %showcourses;
17188: }
17189: return %courses;
17190: }
17191:
17192: =pod
17193:
1.1181 raeburn 17194: =back
17195:
1.1207 raeburn 17196: =head1 Routines for version requirements for current course.
17197:
17198: =over 4
17199:
17200: =item * &check_release_required()
17201:
17202: Compares required LON-CAPA version with version on server, and
17203: if required version is newer looks for a server with the required version.
17204:
17205: Looks first at servers in user's owen domain; if none suitable, looks at
17206: servers in course's domain are permitted to host sessions for user's domain.
17207:
17208: Inputs:
17209:
17210: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17211:
17212: $courseid - Course ID of current course
17213:
17214: $rolecode - User's current role in course (for switchserver query string).
17215:
17216: $required - LON-CAPA version needed by course (format: Major.Minor).
17217:
17218:
17219: Returns:
17220:
17221: $switchserver - query string tp append to /adm/switchserver call (if
17222: current server's LON-CAPA version is too old.
17223:
17224: $warning - Message is displayed if no suitable server could be found.
17225:
17226: =cut
17227:
17228: sub check_release_required {
17229: my ($loncaparev,$courseid,$rolecode,$required) = @_;
17230: my ($switchserver,$warning);
17231: if ($required ne '') {
17232: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
17233: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17234: if ($reqdmajor ne '' && $reqdminor ne '') {
17235: my $otherserver;
17236: if (($major eq '' && $minor eq '') ||
17237: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
17238: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
17239: my $switchlcrev =
17240: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
17241: $userdomserver);
17242: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17243: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
17244: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
17245: my $cdom = $env{'course.'.$courseid.'.domain'};
17246: if ($cdom ne $env{'user.domain'}) {
17247: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
17248: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
17249: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17250: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
17251: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
17252: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
17253: my $canhost =
17254: &Apache::lonnet::can_host_session($env{'user.domain'},
17255: $coursedomserver,
17256: $remoterev,
17257: $udomdefaults{'remotesessions'},
17258: $defdomdefaults{'hostedsessions'});
17259:
17260: if ($canhost) {
17261: $otherserver = $coursedomserver;
17262: } else {
17263: $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.");
17264: }
17265: } else {
17266: $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).");
17267: }
17268: } else {
17269: $otherserver = $userdomserver;
17270: }
17271: }
17272: if ($otherserver ne '') {
17273: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
17274: }
17275: }
17276: }
17277: return ($switchserver,$warning);
17278: }
17279:
17280: =pod
17281:
17282: =item * &check_release_result()
17283:
17284: Inputs:
17285:
17286: $switchwarning - Warning message if no suitable server found to host session.
17287:
17288: $switchserver - query string to append to /adm/switchserver containing lonHostID
17289: and current role.
17290:
17291: Returns: HTML to display with information about requirement to switch server.
17292: Either displaying warning with link to Roles/Courses screen or
17293: display link to switchserver.
17294:
1.1181 raeburn 17295: =cut
17296:
1.1207 raeburn 17297: sub check_release_result {
17298: my ($switchwarning,$switchserver) = @_;
17299: my $output = &start_page('Selected course unavailable on this server').
17300: '<p class="LC_warning">';
17301: if ($switchwarning) {
17302: $output .= $switchwarning.'<br /><a href="/adm/roles">';
17303: if (&show_course()) {
17304: $output .= &mt('Display courses');
17305: } else {
17306: $output .= &mt('Display roles');
17307: }
17308: $output .= '</a>';
17309: } elsif ($switchserver) {
17310: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17311: '<br />'.
17312: '<a href="/adm/switchserver?'.$switchserver.'">'.
17313: &mt('Switch Server').
17314: '</a>';
17315: }
17316: $output .= '</p>'.&end_page();
17317: return $output;
17318: }
17319:
17320: =pod
17321:
17322: =item * &needs_coursereinit()
17323:
17324: Determine if course contents stored for user's session needs to be
17325: refreshed, because content has changed since "Big Hash" last tied.
17326:
17327: Check for change is made if time last checked is more than 10 minutes ago
17328: (by default).
17329:
17330: Inputs:
17331:
17332: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17333:
17334: $interval (optional) - Time which may elapse (in s) between last check for content
17335: change in current course. (default: 600 s).
17336:
17337: Returns: an array; first element is:
17338:
17339: =over 4
17340:
17341: 'switch' - if content updates mean user's session
17342: needs to be switched to a server running a newer LON-CAPA version
17343:
17344: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17345: on current server hosting user's session
17346:
17347: '' - if no action required.
17348:
17349: =back
17350:
17351: If first item element is 'switch':
17352:
17353: second item is $switchwarning - Warning message if no suitable server found to host session.
17354:
17355: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17356: and current role.
17357:
17358: otherwise: no other elements returned.
17359:
17360: =back
17361:
17362: =cut
17363:
17364: sub needs_coursereinit {
17365: my ($loncaparev,$interval) = @_;
17366: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17367: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17368: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17369: my $now = time;
17370: if ($interval eq '') {
17371: $interval = 600;
17372: }
17373: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 17374: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1283 raeburn 17375: my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
1.1282 raeburn 17376: if ($blocked) {
17377: return ();
17378: }
1.1207 raeburn 17379: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
17380: if ($lastchange > $env{'request.course.tied'}) {
17381: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17382: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17383: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17384: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17385: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17386: $curr_reqd_hash{'internal.releaserequired'}});
17387: my ($switchserver,$switchwarning) =
17388: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17389: $curr_reqd_hash{'internal.releaserequired'});
17390: if ($switchwarning ne '' || $switchserver ne '') {
17391: return ('switch',$switchwarning,$switchserver);
17392: }
17393: }
17394: }
17395: return ('update');
17396: }
17397: }
17398: return ();
17399: }
1.1181 raeburn 17400:
1.1083 raeburn 17401: sub update_content_constraints {
17402: my ($cdom,$cnum,$chome,$cid) = @_;
17403: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17404: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 17405: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 17406: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 17407: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 17408: if ($item eq 'resourcetag') {
17409: if ($name eq 'responsetype') {
17410: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17411: }
1.1307 raeburn 17412: } elsif ($item eq 'course') {
17413: if ($name eq 'courserestype') {
17414: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
17415: }
1.1083 raeburn 17416: }
17417: }
17418: my $navmap = Apache::lonnavmaps::navmap->new();
17419: if (defined($navmap)) {
1.1307 raeburn 17420: my (%allresponses,%allcrsrestypes);
17421: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
17422: if ($res->is_tool()) {
17423: if ($allcrsrestypes{'exttool'}) {
17424: $allcrsrestypes{'exttool'} ++;
17425: } else {
17426: $allcrsrestypes{'exttool'} = 1;
17427: }
17428: next;
17429: }
1.1083 raeburn 17430: my %responses = $res->responseTypes();
17431: foreach my $key (keys(%responses)) {
17432: next unless(exists($checkresponsetypes{$key}));
17433: $allresponses{$key} += $responses{$key};
17434: }
17435: }
17436: foreach my $key (keys(%allresponses)) {
17437: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17438: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17439: ($reqdmajor,$reqdminor) = ($major,$minor);
17440: }
17441: }
1.1307 raeburn 17442: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 17443: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 17444: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17445: ($reqdmajor,$reqdminor) = ($major,$minor);
17446: }
17447: }
1.1083 raeburn 17448: undef($navmap);
17449: }
1.1308 raeburn 17450: my $suppmap = 'supplemental.sequence';
17451: my ($suppcount,$supptools,$errors) = (0,0,0);
17452: ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
17453: $suppcount,$supptools,$errors);
17454: if ($supptools) {
17455: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
17456: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17457: ($reqdmajor,$reqdminor) = ($major,$minor);
17458: }
17459: }
1.1083 raeburn 17460: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17461: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17462: }
17463: return;
17464: }
17465:
1.1110 raeburn 17466: sub allmaps_incourse {
17467: my ($cdom,$cnum,$chome,$cid) = @_;
17468: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17469: $cid = $env{'request.course.id'};
17470: $cdom = $env{'course.'.$cid.'.domain'};
17471: $cnum = $env{'course.'.$cid.'.num'};
17472: $chome = $env{'course.'.$cid.'.home'};
17473: }
17474: my %allmaps = ();
17475: my $lastchange =
17476: &Apache::lonnet::get_coursechange($cdom,$cnum);
17477: if ($lastchange > $env{'request.course.tied'}) {
17478: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17479: unless ($ferr) {
17480: &update_content_constraints($cdom,$cnum,$chome,$cid);
17481: }
17482: }
17483: my $navmap = Apache::lonnavmaps::navmap->new();
17484: if (defined($navmap)) {
17485: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17486: $allmaps{$res->src()} = 1;
17487: }
17488: }
17489: return \%allmaps;
17490: }
17491:
1.1083 raeburn 17492: sub parse_supplemental_title {
17493: my ($title) = @_;
17494:
17495: my ($foldertitle,$renametitle);
17496: if ($title =~ /&&&/) {
17497: $title = &HTML::Entites::decode($title);
17498: }
17499: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17500: $renametitle=$4;
17501: my ($time,$uname,$udom) = ($1,$2,$3);
17502: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17503: my $name = &plainname($uname,$udom);
17504: $name = &HTML::Entities::encode($name,'"<>&\'');
17505: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17506: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17507: $name.': <br />'.$foldertitle;
17508: }
17509: if (wantarray) {
17510: return ($title,$foldertitle,$renametitle);
17511: }
17512: return $title;
17513: }
17514:
1.1143 raeburn 17515: sub recurse_supplemental {
1.1308 raeburn 17516: my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
1.1143 raeburn 17517: if ($suppmap) {
17518: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17519: if ($fatal) {
17520: $errors ++;
17521: } else {
17522: if ($#LONCAPA::map::resources > 0) {
17523: foreach my $res (@LONCAPA::map::resources) {
17524: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
17525: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 17526: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1308 raeburn 17527: ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
17528: $numfiles,$numexttools,$errors);
1.1143 raeburn 17529: } else {
1.1308 raeburn 17530: if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
17531: $numexttools ++;
17532: }
1.1143 raeburn 17533: $numfiles ++;
17534: }
17535: }
17536: }
17537: }
17538: }
17539: }
1.1308 raeburn 17540: return ($numfiles,$numexttools,$errors);
1.1143 raeburn 17541: }
17542:
1.1101 raeburn 17543: sub symb_to_docspath {
1.1267 raeburn 17544: my ($symb,$navmapref) = @_;
17545: return unless ($symb && ref($navmapref));
1.1101 raeburn 17546: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17547: if ($resurl=~/\.(sequence|page)$/) {
17548: $mapurl=$resurl;
17549: } elsif ($resurl eq 'adm/navmaps') {
17550: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17551: }
17552: my $mapresobj;
1.1267 raeburn 17553: unless (ref($$navmapref)) {
17554: $$navmapref = Apache::lonnavmaps::navmap->new();
17555: }
17556: if (ref($$navmapref)) {
17557: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 17558: }
17559: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17560: my $type=$2;
17561: my $path;
17562: if (ref($mapresobj)) {
17563: my $pcslist = $mapresobj->map_hierarchy();
17564: if ($pcslist ne '') {
17565: foreach my $pc (split(/,/,$pcslist)) {
17566: next if ($pc <= 1);
1.1267 raeburn 17567: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 17568: if (ref($res)) {
17569: my $thisurl = $res->src();
17570: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17571: my $thistitle = $res->title();
17572: $path .= '&'.
17573: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 17574: &escape($thistitle).
1.1101 raeburn 17575: ':'.$res->randompick().
17576: ':'.$res->randomout().
17577: ':'.$res->encrypted().
17578: ':'.$res->randomorder().
17579: ':'.$res->is_page();
17580: }
17581: }
17582: }
17583: $path =~ s/^\&//;
17584: my $maptitle = $mapresobj->title();
17585: if ($mapurl eq 'default') {
1.1129 raeburn 17586: $maptitle = 'Main Content';
1.1101 raeburn 17587: }
17588: $path .= (($path ne '')? '&' : '').
17589: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17590: &escape($maptitle).
1.1101 raeburn 17591: ':'.$mapresobj->randompick().
17592: ':'.$mapresobj->randomout().
17593: ':'.$mapresobj->encrypted().
17594: ':'.$mapresobj->randomorder().
17595: ':'.$mapresobj->is_page();
17596: } else {
17597: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17598: my $ispage = (($type eq 'page')? 1 : '');
17599: if ($mapurl eq 'default') {
1.1129 raeburn 17600: $maptitle = 'Main Content';
1.1101 raeburn 17601: }
17602: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17603: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 17604: }
17605: unless ($mapurl eq 'default') {
17606: $path = 'default&'.
1.1146 raeburn 17607: &escape('Main Content').
1.1101 raeburn 17608: ':::::&'.$path;
17609: }
17610: return $path;
17611: }
17612:
1.1094 raeburn 17613: sub captcha_display {
17614: my ($context,$lonhost) = @_;
17615: my ($output,$error);
1.1234 raeburn 17616: my ($captcha,$pubkey,$privkey,$version) =
17617: &get_captcha_config($context,$lonhost);
1.1095 raeburn 17618: if ($captcha eq 'original') {
1.1094 raeburn 17619: $output = &create_captcha();
17620: unless ($output) {
1.1172 raeburn 17621: $error = 'captcha';
1.1094 raeburn 17622: }
17623: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17624: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17625: unless ($output) {
1.1172 raeburn 17626: $error = 'recaptcha';
1.1094 raeburn 17627: }
17628: }
1.1234 raeburn 17629: return ($output,$error,$captcha,$version);
1.1094 raeburn 17630: }
17631:
17632: sub captcha_response {
17633: my ($context,$lonhost) = @_;
17634: my ($captcha_chk,$captcha_error);
1.1234 raeburn 17635: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 17636: if ($captcha eq 'original') {
1.1094 raeburn 17637: ($captcha_chk,$captcha_error) = &check_captcha();
17638: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17639: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17640: } else {
17641: $captcha_chk = 1;
17642: }
17643: return ($captcha_chk,$captcha_error);
17644: }
17645:
17646: sub get_captcha_config {
17647: my ($context,$lonhost) = @_;
1.1234 raeburn 17648: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17649: my $hostname = &Apache::lonnet::hostname($lonhost);
17650: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17651: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17652: if ($context eq 'usercreation') {
17653: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17654: if (ref($domconfig{$context}) eq 'HASH') {
17655: $hashtocheck = $domconfig{$context}{'cancreate'};
17656: if (ref($hashtocheck) eq 'HASH') {
17657: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17658: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17659: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17660: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17661: }
17662: if ($privkey && $pubkey) {
17663: $captcha = 'recaptcha';
1.1234 raeburn 17664: $version = $hashtocheck->{'recaptchaversion'};
17665: if ($version ne '2') {
17666: $version = 1;
17667: }
1.1095 raeburn 17668: } else {
17669: $captcha = 'original';
17670: }
17671: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17672: $captcha = 'original';
17673: }
1.1094 raeburn 17674: }
1.1095 raeburn 17675: } else {
17676: $captcha = 'captcha';
17677: }
17678: } elsif ($context eq 'login') {
17679: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17680: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17681: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17682: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17683: if ($privkey && $pubkey) {
17684: $captcha = 'recaptcha';
1.1234 raeburn 17685: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17686: if ($version ne '2') {
17687: $version = 1;
17688: }
1.1095 raeburn 17689: } else {
17690: $captcha = 'original';
1.1094 raeburn 17691: }
1.1095 raeburn 17692: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17693: $captcha = 'original';
1.1094 raeburn 17694: }
17695: }
1.1234 raeburn 17696: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 17697: }
17698:
17699: sub create_captcha {
17700: my %captcha_params = &captcha_settings();
17701: my ($output,$maxtries,$tries) = ('',10,0);
17702: while ($tries < $maxtries) {
17703: $tries ++;
17704: my $captcha = Authen::Captcha->new (
17705: output_folder => $captcha_params{'output_dir'},
17706: data_folder => $captcha_params{'db_dir'},
17707: );
17708: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17709:
17710: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17711: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
17712: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 17713: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
17714: '<br />'.
17715: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 17716: last;
17717: }
17718: }
17719: return $output;
17720: }
17721:
17722: sub captcha_settings {
17723: my %captcha_params = (
17724: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17725: www_output_dir => "/captchaspool",
17726: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17727: numchars => '5',
17728: );
17729: return %captcha_params;
17730: }
17731:
17732: sub check_captcha {
17733: my ($captcha_chk,$captcha_error);
17734: my $code = $env{'form.code'};
17735: my $md5sum = $env{'form.crypt'};
17736: my %captcha_params = &captcha_settings();
17737: my $captcha = Authen::Captcha->new(
17738: output_folder => $captcha_params{'output_dir'},
17739: data_folder => $captcha_params{'db_dir'},
17740: );
1.1109 raeburn 17741: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 17742: my %captcha_hash = (
17743: 0 => 'Code not checked (file error)',
17744: -1 => 'Failed: code expired',
17745: -2 => 'Failed: invalid code (not in database)',
17746: -3 => 'Failed: invalid code (code does not match crypt)',
17747: );
17748: if ($captcha_chk != 1) {
17749: $captcha_error = $captcha_hash{$captcha_chk}
17750: }
17751: return ($captcha_chk,$captcha_error);
17752: }
17753:
17754: sub create_recaptcha {
1.1234 raeburn 17755: my ($pubkey,$version) = @_;
17756: if ($version >= 2) {
17757: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17758: } else {
17759: my $use_ssl;
17760: if ($ENV{'SERVER_PORT'} == 443) {
17761: $use_ssl = 1;
17762: }
17763: my $captcha = Captcha::reCAPTCHA->new;
17764: return $captcha->get_options_setter({theme => 'white'})."\n".
17765: $captcha->get_html($pubkey,undef,$use_ssl).
17766: &mt('If the text is hard to read, [_1] will replace them.',
17767: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17768: '<br /><br />';
17769: }
1.1094 raeburn 17770: }
17771:
17772: sub check_recaptcha {
1.1234 raeburn 17773: my ($privkey,$version) = @_;
1.1094 raeburn 17774: my $captcha_chk;
1.1234 raeburn 17775: if ($version >= 2) {
17776: my %info = (
17777: secret => $privkey,
17778: response => $env{'form.g-recaptcha-response'},
17779: remoteip => $ENV{'REMOTE_ADDR'},
17780: );
1.1280 raeburn 17781: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
17782: $request->content(join('&',map {
17783: my $name = escape($_);
17784: "$name=" . ( ref($info{$_}) eq 'ARRAY'
17785: ? join("&$name=", map {escape($_) } @{$info{$_}})
17786: : &escape($info{$_}) );
17787: } keys(%info)));
17788: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 17789: if ($response->is_success) {
17790: my $data = JSON::DWIW->from_json($response->decoded_content);
17791: if (ref($data) eq 'HASH') {
17792: if ($data->{'success'}) {
17793: $captcha_chk = 1;
17794: }
17795: }
17796: }
17797: } else {
17798: my $captcha = Captcha::reCAPTCHA->new;
17799: my $captcha_result =
17800: $captcha->check_answer(
17801: $privkey,
17802: $ENV{'REMOTE_ADDR'},
17803: $env{'form.recaptcha_challenge_field'},
17804: $env{'form.recaptcha_response_field'},
17805: );
17806: if ($captcha_result->{is_valid}) {
17807: $captcha_chk = 1;
17808: }
1.1094 raeburn 17809: }
17810: return $captcha_chk;
17811: }
17812:
1.1174 raeburn 17813: sub emailusername_info {
1.1244 raeburn 17814: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 17815: my %titles = &Apache::lonlocal::texthash (
17816: lastname => 'Last Name',
17817: firstname => 'First Name',
17818: institution => 'School/college/university',
17819: location => "School's city, state/province, country",
17820: web => "School's web address",
17821: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 17822: id => 'Student/Employee ID',
1.1174 raeburn 17823: );
17824: return (\@fields,\%titles);
17825: }
17826:
1.1161 raeburn 17827: sub cleanup_html {
17828: my ($incoming) = @_;
17829: my $outgoing;
17830: if ($incoming ne '') {
17831: $outgoing = $incoming;
17832: $outgoing =~ s/;/;/g;
17833: $outgoing =~ s/\#/#/g;
17834: $outgoing =~ s/\&/&/g;
17835: $outgoing =~ s/</</g;
17836: $outgoing =~ s/>/>/g;
17837: $outgoing =~ s/\(/(/g;
17838: $outgoing =~ s/\)/)/g;
17839: $outgoing =~ s/"/"/g;
17840: $outgoing =~ s/'/'/g;
17841: $outgoing =~ s/\$/$/g;
17842: $outgoing =~ s{/}{/}g;
17843: $outgoing =~ s/=/=/g;
17844: $outgoing =~ s/\\/\/g
17845: }
17846: return $outgoing;
17847: }
17848:
1.1190 musolffc 17849: # Checks for critical messages and returns a redirect url if one exists.
17850: # $interval indicates how often to check for messages.
1.1282 raeburn 17851: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 17852: sub critical_redirect {
1.1282 raeburn 17853: my ($interval,$context) = @_;
1.1190 musolffc 17854: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 17855: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
17856: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17857: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17858: my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
17859: if ($blocked) {
17860: my $checkrole = "cm./$cdom/$cnum";
17861: if ($env{'request.course.sec'} ne '') {
17862: $checkrole .= "/$env{'request.course.sec'}";
17863: }
17864: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
17865: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
17866: return;
17867: }
17868: }
17869: }
1.1190 musolffc 17870: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17871: $env{'user.name'});
17872: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 17873: my $redirecturl;
1.1190 musolffc 17874: if ($what[0]) {
17875: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17876: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 17877: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17878: return (1, $url);
1.1190 musolffc 17879: }
1.1191 raeburn 17880: }
17881: }
17882: return ();
1.1190 musolffc 17883: }
17884:
1.1174 raeburn 17885: # Use:
17886: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17887: #
17888: ##################################################
17889: # password associated functions #
17890: ##################################################
17891: sub des_keys {
17892: # Make a new key for DES encryption.
17893: # Each key has two parts which are returned separately.
17894: # Please note: Each key must be passed through the &hex function
17895: # before it is output to the web browser. The hex versions cannot
17896: # be used to decrypt.
17897: my @hexstr=('0','1','2','3','4','5','6','7',
17898: '8','9','a','b','c','d','e','f');
17899: my $lkey='';
17900: for (0..7) {
17901: $lkey.=$hexstr[rand(15)];
17902: }
17903: my $ukey='';
17904: for (0..7) {
17905: $ukey.=$hexstr[rand(15)];
17906: }
17907: return ($lkey,$ukey);
17908: }
17909:
17910: sub des_decrypt {
17911: my ($key,$cyphertext) = @_;
17912: my $keybin=pack("H16",$key);
17913: my $cypher;
17914: if ($Crypt::DES::VERSION>=2.03) {
17915: $cypher=new Crypt::DES $keybin;
17916: } else {
17917: $cypher=new DES $keybin;
17918: }
1.1233 raeburn 17919: my $plaintext='';
17920: my $cypherlength = length($cyphertext);
17921: my $numchunks = int($cypherlength/32);
17922: for (my $j=0; $j<$numchunks; $j++) {
17923: my $start = $j*32;
17924: my $cypherblock = substr($cyphertext,$start,32);
17925: my $chunk =
17926: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17927: $chunk .=
17928: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17929: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17930: $plaintext .= $chunk;
17931: }
1.1174 raeburn 17932: return $plaintext;
17933: }
17934:
1.1309 raeburn 17935: sub make_short_symbs {
17936: my ($cdom,$cnum,$navmap) = @_;
17937: return unless (ref($navmap));
17938: my ($numnew,@errors);
17939: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
17940: if (@toshorten) {
17941: my (%maps,%resources,%titles);
17942: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
17943: 'shorturls',$cdom,$cnum);
17944: my %tocreate;
17945: if (keys(%resources)) {
17946: foreach my $item (sort {$a <=> $b} (@toshorten)) {
17947: my $symb = $resources{$item};
17948: if ($symb) {
17949: $tocreate{$cnum.'&'.$symb} = 1;
17950: }
17951: }
17952: }
17953: if (keys(%tocreate)) {
17954: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
17955: my $su = Short::URL->new(no_vowels => 1);
17956: my $init = '';
17957: my (%newunique,%addcourse,%courseonly,%failed);
17958: # get lock on tiny db
17959: my $now = time;
17960: my $lockhash = {
17961: "lock\0$now" => $env{'user.name'}.
17962: ':'.$env{'user.domain'},
17963: };
17964: my $tries = 0;
17965: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
17966: my ($code,$error);
17967: while (($gotlock ne 'ok') && ($tries<3)) {
17968: $tries ++;
17969: sleep 1;
17970: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17971: }
17972: if ($gotlock eq 'ok') {
17973: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
17974: \%addcourse,\%courseonly,\%failed);
17975: if (keys(%failed)) {
17976: my $numfailed = scalar(keys(%failed));
17977: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
17978: }
17979: if (keys(%newunique)) {
17980: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
17981: if ($putres eq 'ok') {
17982: $numnew = scalar(keys(%newunique));
17983: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
17984: unless ($newputres eq 'ok') {
17985: push(@errors,&mt('error: could not store course look-up of short URLs'));
17986: }
17987: } else {
17988: push(@errors,&mt('error: could not store unique six character URLs'));
17989: }
17990: }
17991: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
17992: unless ($dellockres eq 'ok') {
17993: push(@errors,&mt('error: could not release lockfile'));
17994: }
17995: } else {
17996: push(@errors,&mt('error: could not obtain lockfile'));
17997: }
17998: if (keys(%courseonly)) {
17999: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
18000: if ($result ne 'ok') {
18001: push(@errors,&mt('error: could not update course look-up of short URLs'));
18002: }
18003: }
18004: }
18005: }
18006: return ($numnew,\@errors);
18007: }
18008:
18009: sub shorten_symbs {
18010: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
18011: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
18012: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
18013: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
18014: my (%possibles,%collisions);
18015: foreach my $key (keys(%{$tocreate})) {
18016: my $num = String::CRC32::crc32($key);
18017: my $tiny = $su->encode($num,$init);
18018: if ($tiny) {
18019: $possibles{$tiny} = $key;
18020: }
18021: }
18022: if (!$init) {
18023: $init = 1;
18024: } else {
18025: $init ++;
18026: }
18027: if (keys(%possibles)) {
18028: my @posstiny = keys(%possibles);
18029: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
18030: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
18031: if (keys(%currtiny)) {
18032: foreach my $key (keys(%currtiny)) {
18033: next if ($currtiny{$key} eq '');
18034: if ($currtiny{$key} eq $possibles{$key}) {
18035: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
18036: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18037: $courseonly->{$tsymb} = $key;
18038: }
18039: } else {
18040: $collisions{$possibles{$key}} = 1;
18041: }
18042: delete($possibles{$key});
18043: }
18044: }
18045: foreach my $key (keys(%possibles)) {
18046: $newunique->{$key} = $possibles{$key};
18047: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
18048: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18049: $addcourse->{$tsymb} = $key;
18050: }
18051: }
18052: }
18053: if (keys(%collisions)) {
18054: if ($init <5) {
18055: if (!$init) {
18056: $init = 1;
18057: } else {
18058: $init ++;
18059: }
18060: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
18061: $newunique,$addcourse,$courseonly,$failed);
18062: } else {
18063: foreach my $key (keys(%collisions)) {
18064: $failed->{$key} = 1;
18065: }
18066: }
18067: }
18068: return $init;
18069: }
18070:
1.112 bowersj2 18071: 1;
18072: __END__;
1.41 ng 18073:
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