Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.141.2.1
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1075.2.141. .1(raebu 4:20): # $Id: loncommon.pm,v 1.1075.2.141 2020/01/10 05:15:29 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.1075.2.25 raeburn 70: use Apache::lonuserutils();
1.1075.2.27 raeburn 71: use Apache::lonuserstate();
1.1075.2.69 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.135 raeburn 74: use HTTP::Request;
1.657 raeburn 75: use DateTime::TimeZone;
1.1075.2.102 raeburn 76: use DateTime::Locale;
1.1075.2.94 raeburn 77: use Encode();
1.1075.2.14 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.1075.2.107 raeburn 80: use JSON::DWIW;
81: use LWP::UserAgent;
1.1075.2.64 raeburn 82: use Crypt::DES;
83: use DynaLoader; # for Crypt::DES version
1.1075.2.128 raeburn 84: use File::Copy();
85: use File::Path();
1.1075.2.141. .1(raebu 86:20): use String::CRC32();
87:20): use Short::URL();
1.117 www 88:
1.517 raeburn 89: # ---------------------------------------------- Designs
90: use vars qw(%defaultdesign);
91:
1.22 www 92: my $readit;
93:
1.517 raeburn 94:
1.157 matthew 95: ##
96: ## Global Variables
97: ##
1.46 matthew 98:
1.643 foxr 99:
100: # ----------------------------------------------- SSI with retries:
101: #
102:
103: =pod
104:
1.648 raeburn 105: =head1 Server Side include with retries:
1.643 foxr 106:
107: =over 4
108:
1.648 raeburn 109: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 110:
111: Performs an ssi with some number of retries. Retries continue either
112: until the result is ok or until the retry count supplied by the
113: caller is exhausted.
114:
115: Inputs:
1.648 raeburn 116:
117: =over 4
118:
1.643 foxr 119: resource - Identifies the resource to insert.
1.648 raeburn 120:
1.643 foxr 121: retries - Count of the number of retries allowed.
1.648 raeburn 122:
1.643 foxr 123: form - Hash that identifies the rendering options.
124:
1.648 raeburn 125: =back
126:
127: Returns:
128:
129: =over 4
130:
1.643 foxr 131: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 132:
1.643 foxr 133: response - The response from the last attempt (which may or may not have been successful.
134:
1.648 raeburn 135: =back
136:
137: =back
138:
1.643 foxr 139: =cut
140:
141: sub ssi_with_retries {
142: my ($resource, $retries, %form) = @_;
143:
144:
145: my $ok = 0; # True if we got a good response.
146: my $content;
147: my $response;
148:
149: # Try to get the ssi done. within the retries count:
150:
151: do {
152: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
153: $ok = $response->is_success;
1.650 www 154: if (!$ok) {
155: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
156: }
1.643 foxr 157: $retries--;
158: } while (!$ok && ($retries > 0));
159:
160: if (!$ok) {
161: $content = ''; # On error return an empty content.
162: }
163: return ($content, $response);
164:
165: }
166:
167:
168:
1.20 www 169: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 170: my %language;
1.124 www 171: my %supported_language;
1.1048 foxr 172: my %latex_language; # For choosing hyphenation in <transl..>
173: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 174: my %cprtag;
1.192 taceyjo1 175: my %scprtag;
1.351 www 176: my %fe; my %fd; my %fm;
1.41 ng 177: my %category_extensions;
1.12 harris41 178:
1.46 matthew 179: # ---------------------------------------------- Thesaurus variables
1.144 matthew 180: #
181: # %Keywords:
182: # A hash used by &keyword to determine if a word is considered a keyword.
183: # $thesaurus_db_file
184: # Scalar containing the full path to the thesaurus database.
1.46 matthew 185:
186: my %Keywords;
187: my $thesaurus_db_file;
188:
1.144 matthew 189: #
190: # Initialize values from language.tab, copyright.tab, filetypes.tab,
191: # thesaurus.tab, and filecategories.tab.
192: #
1.18 www 193: BEGIN {
1.46 matthew 194: # Variable initialization
195: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
196: #
1.22 www 197: unless ($readit) {
1.12 harris41 198: # ------------------------------------------------------------------- languages
199: {
1.158 raeburn 200: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
201: '/language.tab';
1.1075.2.128 raeburn 202: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 203: while (my $line = <$fh>) {
204: next if ($line=~/^\#/);
205: chomp($line);
1.1048 foxr 206: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 207: $language{$key}=$val.' - '.$enc;
208: if ($sup) {
209: $supported_language{$key}=$sup;
210: }
1.1048 foxr 211: if ($latex) {
212: $latex_language_bykey{$key} = $latex;
213: $latex_language{$two} = $latex;
214: }
1.158 raeburn 215: }
216: close($fh);
217: }
1.12 harris41 218: }
219: # ------------------------------------------------------------------ copyrights
220: {
1.158 raeburn 221: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
222: '/copyright.tab';
1.1075.2.128 raeburn 223: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line=~/^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 228: $cprtag{$key}=$val;
229: }
230: close($fh);
231: }
1.12 harris41 232: }
1.351 www 233: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 234: {
235: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
236: '/source_copyright.tab';
1.1075.2.128 raeburn 237: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 242: $scprtag{$key}=$val;
243: }
244: close($fh);
245: }
246: }
1.63 www 247:
1.517 raeburn 248: # -------------------------------------------------------------- default domain designs
1.63 www 249: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 250: my $designfile = $designdir.'/default.tab';
1.1075.2.128 raeburn 251: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 252: while (my $line = <$fh>) {
253: next if ($line =~ /^\#/);
254: chomp($line);
255: my ($key,$val)=(split(/\=/,$line));
256: if ($val) { $defaultdesign{$key}=$val; }
257: }
258: close($fh);
1.63 www 259: }
260:
1.15 harris41 261: # ------------------------------------------------------------- file categories
262: {
1.158 raeburn 263: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
264: '/filecategories.tab';
1.1075.2.128 raeburn 265: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 266: while (my $line = <$fh>) {
267: next if ($line =~ /^\#/);
268: chomp($line);
269: my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119 raeburn 270: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 271: }
272: close($fh);
273: }
274:
1.15 harris41 275: }
1.12 harris41 276: # ------------------------------------------------------------------ file types
277: {
1.158 raeburn 278: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
279: '/filetypes.tab';
1.1075.2.128 raeburn 280: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 281: while (my $line = <$fh>) {
282: next if ($line =~ /^\#/);
283: chomp($line);
284: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 285: if ($descr ne '') {
286: $fe{$ending}=lc($emb);
287: $fd{$ending}=$descr;
1.351 www 288: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 289: }
290: }
291: close($fh);
292: }
1.12 harris41 293: }
1.22 www 294: &Apache::lonnet::logthis(
1.705 tempelho 295: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 296: $readit=1;
1.46 matthew 297: } # end of unless($readit)
1.32 matthew 298:
299: }
1.112 bowersj2 300:
1.42 matthew 301: ###############################################################
302: ## HTML and Javascript Helper Functions ##
303: ###############################################################
304:
305: =pod
306:
1.112 bowersj2 307: =head1 HTML and Javascript Functions
1.42 matthew 308:
1.112 bowersj2 309: =over 4
310:
1.648 raeburn 311: =item * &browser_and_searcher_javascript()
1.112 bowersj2 312:
313: X<browsing, javascript>X<searching, javascript>Returns a string
314: containing javascript with two functions, C<openbrowser> and
315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
316: tags.
1.42 matthew 317:
1.648 raeburn 318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 319:
320: inputs: formname, elementname, only, omit
321:
322: formname and elementname indicate the name of the html form and name of
323: the element that the results of the browsing selection are to be placed in.
324:
325: Specifying 'only' will restrict the browser to displaying only files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 329: with the given extension. Can be a comma separated list.
1.42 matthew 330:
1.648 raeburn 331: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 332:
333: Inputs: formname, elementname
334:
335: formname and elementname specify the name of the html form and the name
336: of the element the selection from the search results will be placed in.
1.542 raeburn 337:
1.42 matthew 338: =cut
339:
340: sub browser_and_searcher_javascript {
1.199 albertel 341: my ($mode)=@_;
342: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 343: my $resurl=&escape_single(&lastresurl());
1.42 matthew 344: return <<END;
1.219 albertel 345: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 346: var editbrowser = null;
1.135 albertel 347: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 348: var url = '$resurl/?';
1.42 matthew 349: if (editbrowser == null) {
350: url += 'launch=1&';
351: }
352: url += 'catalogmode=interactive&';
1.199 albertel 353: url += 'mode=$mode&';
1.611 albertel 354: url += 'inhibitmenu=yes&';
1.42 matthew 355: url += 'form=' + formname + '&';
356: if (only != null) {
357: url += 'only=' + only + '&';
1.217 albertel 358: } else {
359: url += 'only=&';
360: }
1.42 matthew 361: if (omit != null) {
362: url += 'omit=' + omit + '&';
1.217 albertel 363: } else {
364: url += 'omit=&';
365: }
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Browser';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editbrowser = open(url,title,options,'1');
376: editbrowser.focus();
377: }
378: var editsearcher;
1.135 albertel 379: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 380: var url = '/adm/searchcat?';
381: if (editsearcher == null) {
382: url += 'launch=1&';
383: }
384: url += 'catalogmode=interactive&';
1.199 albertel 385: url += 'mode=$mode&';
1.42 matthew 386: url += 'form=' + formname + '&';
1.135 albertel 387: if (titleelement != null) {
388: url += 'titleelement=' + titleelement + '&';
1.217 albertel 389: } else {
390: url += 'titleelement=&';
391: }
1.42 matthew 392: url += 'element=' + elementname + '';
393: var title = 'Search';
1.435 albertel 394: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 395: options += ',width=700,height=600';
396: editsearcher = open(url,title,options,'1');
397: editsearcher.focus();
398: }
1.219 albertel 399: // END LON-CAPA Internal -->
1.42 matthew 400: END
1.170 www 401: }
402:
403: sub lastresurl {
1.258 albertel 404: if ($env{'environment.lastresurl'}) {
405: return $env{'environment.lastresurl'}
1.170 www 406: } else {
407: return '/res';
408: }
409: }
410:
411: sub storeresurl {
412: my $resurl=&Apache::lonnet::clutter(shift);
413: unless ($resurl=~/^\/res/) { return 0; }
414: $resurl=~s/\/$//;
415: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 416: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 417: return 1;
1.42 matthew 418: }
419:
1.74 www 420: sub studentbrowser_javascript {
1.111 www 421: unless (
1.258 albertel 422: (($env{'request.course.id'}) &&
1.302 albertel 423: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
424: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
425: '/'.$env{'request.course.sec'})
426: ))
1.258 albertel 427: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 428: ) { return ''; }
1.74 www 429: return (<<'ENDSTDBRW');
1.776 bisitz 430: <script type="text/javascript" language="Javascript">
1.824 bisitz 431: // <![CDATA[
1.74 www 432: var stdeditbrowser;
1.999 www 433: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 434: var url = '/adm/pickstudent?';
435: var filter;
1.558 albertel 436: if (!ignorefilter) {
437: eval('filter=document.'+formname+'.'+uname+'.value;');
438: }
1.74 www 439: if (filter != null) {
440: if (filter != '') {
441: url += 'filter='+filter+'&';
442: }
443: }
444: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 445: '&udomelement='+udom+
446: '&clicker='+clicker;
1.111 www 447: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 448: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 449: var title = 'Student_Browser';
1.74 www 450: var options = 'scrollbars=1,resizable=1,menubar=0';
451: options += ',width=700,height=600';
452: stdeditbrowser = open(url,title,options,'1');
453: stdeditbrowser.focus();
454: }
1.824 bisitz 455: // ]]>
1.74 www 456: </script>
457: ENDSTDBRW
458: }
1.42 matthew 459:
1.1003 www 460: sub resourcebrowser_javascript {
461: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 462: return (<<'ENDRESBRW');
1.1003 www 463: <script type="text/javascript" language="Javascript">
464: // <![CDATA[
465: var reseditbrowser;
1.1004 www 466: function openresbrowser(formname,reslink) {
1.1005 www 467: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 468: var title = 'Resource_Browser';
469: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 470: options += ',width=700,height=500';
1.1004 www 471: reseditbrowser = open(url,title,options,'1');
472: reseditbrowser.focus();
1.1003 www 473: }
474: // ]]>
475: </script>
1.1004 www 476: ENDRESBRW
1.1003 www 477: }
478:
1.74 www 479: sub selectstudent_link {
1.999 www 480: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
481: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
482: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
483: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 484: if ($env{'request.course.id'}) {
1.302 albertel 485: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
486: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
487: '/'.$env{'request.course.sec'})) {
1.111 www 488: return '';
489: }
1.999 www 490: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 491: if ($courseadvonly) {
492: $callargs .= ",'',1,1";
493: }
494: return '<span class="LC_nobreak">'.
495: '<a href="javascript:openstdbrowser('.$callargs.');">'.
496: &mt('Select User').'</a></span>';
1.74 www 497: }
1.258 albertel 498: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 499: $callargs .= ",'',1";
1.793 raeburn 500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openstdbrowser('.$callargs.');">'.
502: &mt('Select User').'</a></span>';
1.111 www 503: }
504: return '';
1.91 www 505: }
506:
1.1004 www 507: sub selectresource_link {
508: my ($form,$reslink,$arg)=@_;
509:
510: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
511: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
512: unless ($env{'request.course.id'}) { return $arg; }
513: return '<span class="LC_nobreak">'.
514: '<a href="javascript:openresbrowser('.$callargs.');">'.
515: $arg.'</a></span>';
516: }
517:
518:
519:
1.653 raeburn 520: sub authorbrowser_javascript {
521: return <<"ENDAUTHORBRW";
1.776 bisitz 522: <script type="text/javascript" language="JavaScript">
1.824 bisitz 523: // <![CDATA[
1.653 raeburn 524: var stdeditbrowser;
525:
526: function openauthorbrowser(formname,udom) {
527: var url = '/adm/pickauthor?';
528: url += 'form='+formname+'&roledom='+udom;
529: var title = 'Author_Browser';
530: var options = 'scrollbars=1,resizable=1,menubar=0';
531: options += ',width=700,height=600';
532: stdeditbrowser = open(url,title,options,'1');
533: stdeditbrowser.focus();
534: }
535:
1.824 bisitz 536: // ]]>
1.653 raeburn 537: </script>
538: ENDAUTHORBRW
539: }
540:
1.91 www 541: sub coursebrowser_javascript {
1.1075.2.31 raeburn 542: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95 raeburn 543: $credits_element,$instcode) = @_;
1.932 raeburn 544: my $wintitle = 'Course_Browser';
1.931 raeburn 545: if ($crstype eq 'Community') {
1.932 raeburn 546: $wintitle = 'Community_Browser';
1.909 raeburn 547: }
1.876 raeburn 548: my $id_functions = &javascript_index_functions();
549: my $output = '
1.776 bisitz 550: <script type="text/javascript" language="JavaScript">
1.824 bisitz 551: // <![CDATA[
1.468 raeburn 552: var stdeditbrowser;'."\n";
1.876 raeburn 553:
554: $output .= <<"ENDSTDBRW";
1.909 raeburn 555: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 556: var url = '/adm/pickcourse?';
1.895 raeburn 557: var formid = getFormIdByName(formname);
1.876 raeburn 558: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 559: if (domainfilter != null) {
560: if (domainfilter != '') {
561: url += 'domainfilter='+domainfilter+'&';
562: }
563: }
1.91 www 564: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 565: '&cdomelement='+udom+
566: '&cnameelement='+desc;
1.468 raeburn 567: if (extra_element !=null && extra_element != '') {
1.594 raeburn 568: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 569: url += '&roleelement='+extra_element;
570: if (domainfilter == null || domainfilter == '') {
571: url += '&domainfilter='+extra_element;
572: }
1.234 raeburn 573: }
1.468 raeburn 574: else {
575: if (formname == 'portform') {
576: url += '&setroles='+extra_element;
1.800 raeburn 577: } else {
578: if (formname == 'rules') {
579: url += '&fixeddom='+extra_element;
580: }
1.468 raeburn 581: }
582: }
1.230 raeburn 583: }
1.909 raeburn 584: if (type != null && type != '') {
585: url += '&type='+type;
586: }
587: if (type_elem != null && type_elem != '') {
588: url += '&typeelement='+type_elem;
589: }
1.872 raeburn 590: if (formname == 'ccrs') {
591: var ownername = document.forms[formid].ccuname.value;
592: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101 raeburn 593: url += '&cloner='+ownername+':'+ownerdom;
594: if (type == 'Course') {
595: url += '&crscode='+document.forms[formid].crscode.value;
596: }
1.1075.2.95 raeburn 597: }
598: if (formname == 'requestcrs') {
599: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 600: }
1.293 raeburn 601: if (multflag !=null && multflag != '') {
602: url += '&multiple='+multflag;
603: }
1.909 raeburn 604: var title = '$wintitle';
1.91 www 605: var options = 'scrollbars=1,resizable=1,menubar=0';
606: options += ',width=700,height=600';
607: stdeditbrowser = open(url,title,options,'1');
608: stdeditbrowser.focus();
609: }
1.876 raeburn 610: $id_functions
611: ENDSTDBRW
1.1075.2.31 raeburn 612: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
613: $output .= &setsec_javascript($sec_element,$formname,$role_element,
614: $credits_element);
1.876 raeburn 615: }
616: $output .= '
617: // ]]>
618: </script>';
619: return $output;
620: }
621:
622: sub javascript_index_functions {
623: return <<"ENDJS";
624:
625: function getFormIdByName(formname) {
626: for (var i=0;i<document.forms.length;i++) {
627: if (document.forms[i].name == formname) {
628: return i;
629: }
630: }
631: return -1;
632: }
633:
634: function getIndexByName(formid,item) {
635: for (var i=0;i<document.forms[formid].elements.length;i++) {
636: if (document.forms[formid].elements[i].name == item) {
637: return i;
638: }
639: }
640: return -1;
641: }
1.468 raeburn 642:
1.876 raeburn 643: function getDomainFromSelectbox(formname,udom) {
644: var userdom;
645: var formid = getFormIdByName(formname);
646: if (formid > -1) {
647: var domid = getIndexByName(formid,udom);
648: if (domid > -1) {
649: if (document.forms[formid].elements[domid].type == 'select-one') {
650: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
651: }
652: if (document.forms[formid].elements[domid].type == 'hidden') {
653: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 654: }
655: }
656: }
1.876 raeburn 657: return userdom;
658: }
659:
660: ENDJS
1.468 raeburn 661:
1.876 raeburn 662: }
663:
1.1017 raeburn 664: sub javascript_array_indexof {
1.1018 raeburn 665: return <<ENDJS;
1.1017 raeburn 666: <script type="text/javascript" language="JavaScript">
667: // <![CDATA[
668:
669: if (!Array.prototype.indexOf) {
670: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
671: "use strict";
672: if (this === void 0 || this === null) {
673: throw new TypeError();
674: }
675: var t = Object(this);
676: var len = t.length >>> 0;
677: if (len === 0) {
678: return -1;
679: }
680: var n = 0;
681: if (arguments.length > 0) {
682: n = Number(arguments[1]);
683: if (n !== n) { // shortcut for verifying if it's NaN
684: n = 0;
685: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
686: n = (n > 0 || -1) * Math.floor(Math.abs(n));
687: }
688: }
689: if (n >= len) {
690: return -1;
691: }
692: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
693: for (; k < len; k++) {
694: if (k in t && t[k] === searchElement) {
695: return k;
696: }
697: }
698: return -1;
699: }
700: }
701:
702: // ]]>
703: </script>
704:
705: ENDJS
706:
707: }
708:
1.876 raeburn 709: sub userbrowser_javascript {
710: my $id_functions = &javascript_index_functions();
711: return <<"ENDUSERBRW";
712:
1.888 raeburn 713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 714: var url = '/adm/pickuser?';
715: var userdom = getDomainFromSelectbox(formname,udom);
716: if (userdom != null) {
717: if (userdom != '') {
718: url += 'srchdom='+userdom+'&';
719: }
720: }
721: url += 'form=' + formname + '&unameelement='+uname+
722: '&udomelement='+udom+
723: '&ulastelement='+ulast+
724: '&ufirstelement='+ufirst+
725: '&uemailelement='+uemail+
1.881 raeburn 726: '&hideudomelement='+hideudom+
727: '&coursedom='+crsdom;
1.888 raeburn 728: if ((caller != null) && (caller != undefined)) {
729: url += '&caller='+caller;
730: }
1.876 raeburn 731: var title = 'User_Browser';
732: var options = 'scrollbars=1,resizable=1,menubar=0';
733: options += ',width=700,height=600';
734: var stdeditbrowser = open(url,title,options,'1');
735: stdeditbrowser.focus();
736: }
737:
1.888 raeburn 738: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 739: var formid = getFormIdByName(formname);
740: if (formid > -1) {
1.888 raeburn 741: var unameid = getIndexByName(formid,uname);
1.876 raeburn 742: var domid = getIndexByName(formid,udom);
743: var hidedomid = getIndexByName(formid,origdom);
744: if (hidedomid > -1) {
745: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 746: var unameval = document.forms[formid].elements[unameid].value;
747: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
748: if (domid > -1) {
749: var slct = document.forms[formid].elements[domid];
750: if (slct.type == 'select-one') {
751: var i;
752: for (i=0;i<slct.length;i++) {
753: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
754: }
755: }
756: if (slct.type == 'hidden') {
757: slct.value = fixeddom;
1.876 raeburn 758: }
759: }
1.468 raeburn 760: }
761: }
762: }
1.876 raeburn 763: return;
764: }
765:
766: $id_functions
767: ENDUSERBRW
1.468 raeburn 768: }
769:
770: sub setsec_javascript {
1.1075.2.31 raeburn 771: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 772: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
773: $communityrolestr);
774: if ($role_element ne '') {
775: my @allroles = ('st','ta','ep','in','ad');
776: foreach my $crstype ('Course','Community') {
777: if ($crstype eq 'Community') {
778: foreach my $role (@allroles) {
779: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
780: }
781: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
782: } else {
783: foreach my $role (@allroles) {
784: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
785: }
786: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
787: }
788: }
789: $rolestr = '"'.join('","',@allroles).'"';
790: $courserolestr = '"'.join('","',@courserolenames).'"';
791: $communityrolestr = '"'.join('","',@communityrolenames).'"';
792: }
1.468 raeburn 793: my $setsections = qq|
794: function setSect(sectionlist) {
1.629 raeburn 795: var sectionsArray = new Array();
796: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
797: sectionsArray = sectionlist.split(",");
798: }
1.468 raeburn 799: var numSections = sectionsArray.length;
800: document.$formname.$sec_element.length = 0;
801: if (numSections == 0) {
802: document.$formname.$sec_element.multiple=false;
803: document.$formname.$sec_element.size=1;
804: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
805: } else {
806: if (numSections == 1) {
807: document.$formname.$sec_element.multiple=false;
808: document.$formname.$sec_element.size=1;
809: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
810: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
811: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
812: } else {
813: for (var i=0; i<numSections; i++) {
814: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
815: }
816: document.$formname.$sec_element.multiple=true
817: if (numSections < 3) {
818: document.$formname.$sec_element.size=numSections;
819: } else {
820: document.$formname.$sec_element.size=3;
821: }
822: document.$formname.$sec_element.options[0].selected = false
823: }
824: }
1.91 www 825: }
1.905 raeburn 826:
827: function setRole(crstype) {
1.468 raeburn 828: |;
1.905 raeburn 829: if ($role_element eq '') {
830: $setsections .= ' return;
831: }
832: ';
833: } else {
834: $setsections .= qq|
835: var elementLength = document.$formname.$role_element.length;
836: var allroles = Array($rolestr);
837: var courserolenames = Array($courserolestr);
838: var communityrolenames = Array($communityrolestr);
839: if (elementLength != undefined) {
840: if (document.$formname.$role_element.options[5].value == 'cc') {
841: if (crstype == 'Course') {
842: return;
843: } else {
844: allroles[5] = 'co';
845: for (var i=0; i<6; i++) {
846: document.$formname.$role_element.options[i].value = allroles[i];
847: document.$formname.$role_element.options[i].text = communityrolenames[i];
848: }
849: }
850: } else {
851: if (crstype == 'Community') {
852: return;
853: } else {
854: allroles[5] = 'cc';
855: for (var i=0; i<6; i++) {
856: document.$formname.$role_element.options[i].value = allroles[i];
857: document.$formname.$role_element.options[i].text = courserolenames[i];
858: }
859: }
860: }
861: }
862: return;
863: }
864: |;
865: }
1.1075.2.31 raeburn 866: if ($credits_element) {
867: $setsections .= qq|
868: function setCredits(defaultcredits) {
869: document.$formname.$credits_element.value = defaultcredits;
870: return;
871: }
872: |;
873: }
1.468 raeburn 874: return $setsections;
875: }
876:
1.91 www 877: sub selectcourse_link {
1.909 raeburn 878: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
879: $typeelement) = @_;
880: my $type = $selecttype;
1.871 raeburn 881: my $linktext = &mt('Select Course');
882: if ($selecttype eq 'Community') {
1.909 raeburn 883: $linktext = &mt('Select Community');
1.906 raeburn 884: } elsif ($selecttype eq 'Course/Community') {
885: $linktext = &mt('Select Course/Community');
1.909 raeburn 886: $type = '';
1.1019 raeburn 887: } elsif ($selecttype eq 'Select') {
888: $linktext = &mt('Select');
889: $type = '';
1.871 raeburn 890: }
1.787 bisitz 891: return '<span class="LC_nobreak">'
892: ."<a href='"
893: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
894: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 895: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 896: ."'>".$linktext.'</a>'
1.787 bisitz 897: .'</span>';
1.74 www 898: }
1.42 matthew 899:
1.653 raeburn 900: sub selectauthor_link {
901: my ($form,$udom)=@_;
902: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
903: &mt('Select Author').'</a>';
904: }
905:
1.876 raeburn 906: sub selectuser_link {
1.881 raeburn 907: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 908: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 909: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 910: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 911: ');">'.$linktext.'</a>';
1.876 raeburn 912: }
913:
1.273 raeburn 914: sub check_uncheck_jscript {
915: my $jscript = <<"ENDSCRT";
916: function checkAll(field) {
917: if (field.length > 0) {
918: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 919: if (!field[i].disabled) {
920: field[i].checked = true;
921: }
1.273 raeburn 922: }
923: } else {
1.1075.2.14 raeburn 924: if (!field.disabled) {
925: field.checked = true;
926: }
1.273 raeburn 927: }
928: }
929:
930: function uncheckAll(field) {
931: if (field.length > 0) {
932: for (i = 0; i < field.length; i++) {
933: field[i].checked = false ;
1.543 albertel 934: }
935: } else {
1.273 raeburn 936: field.checked = false ;
937: }
938: }
939: ENDSCRT
940: return $jscript;
941: }
942:
1.656 www 943: sub select_timezone {
1.1075.2.115 raeburn 944: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
945: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 946: if ($includeempty) {
947: $output .= '<option value=""';
948: if (($selected eq '') || ($selected eq 'local')) {
949: $output .= ' selected="selected" ';
950: }
951: $output .= '> </option>';
952: }
1.657 raeburn 953: my @timezones = DateTime::TimeZone->all_names;
954: foreach my $tzone (@timezones) {
955: $output.= '<option value="'.$tzone.'"';
956: if ($tzone eq $selected) {
957: $output.=' selected="selected"';
958: }
959: $output.=">$tzone</option>\n";
1.656 www 960: }
961: $output.="</select>";
962: return $output;
963: }
1.273 raeburn 964:
1.687 raeburn 965: sub select_datelocale {
1.1075.2.115 raeburn 966: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
967: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 968: if ($includeempty) {
969: $output .= '<option value=""';
970: if ($selected eq '') {
971: $output .= ' selected="selected" ';
972: }
973: $output .= '> </option>';
974: }
1.1075.2.102 raeburn 975: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 976: my (@possibles,%locale_names);
1.1075.2.102 raeburn 977: my @locales = DateTime::Locale->ids();
978: foreach my $id (@locales) {
979: if ($id ne '') {
980: my ($en_terr,$native_terr);
981: my $loc = DateTime::Locale->load($id);
982: if (ref($loc)) {
983: $en_terr = $loc->name();
984: $native_terr = $loc->native_name();
1.687 raeburn 985: if (grep(/^en$/,@languages) || !@languages) {
986: if ($en_terr ne '') {
987: $locale_names{$id} = '('.$en_terr.')';
988: } elsif ($native_terr ne '') {
989: $locale_names{$id} = $native_terr;
990: }
991: } else {
992: if ($native_terr ne '') {
993: $locale_names{$id} = $native_terr.' ';
994: } elsif ($en_terr ne '') {
995: $locale_names{$id} = '('.$en_terr.')';
996: }
997: }
1.1075.2.94 raeburn 998: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102 raeburn 999: push(@possibles,$id);
1.687 raeburn 1000: }
1001: }
1002: }
1003: foreach my $item (sort(@possibles)) {
1004: $output.= '<option value="'.$item.'"';
1005: if ($item eq $selected) {
1006: $output.=' selected="selected"';
1007: }
1008: $output.=">$item";
1009: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1010: $output.=' '.$locale_names{$item};
1.687 raeburn 1011: }
1012: $output.="</option>\n";
1013: }
1014: $output.="</select>";
1015: return $output;
1016: }
1017:
1.792 raeburn 1018: sub select_language {
1.1075.2.115 raeburn 1019: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1020: my %langchoices;
1021: if ($includeempty) {
1.1075.2.32 raeburn 1022: %langchoices = ('' => 'No language preference');
1.792 raeburn 1023: }
1024: foreach my $id (&languageids()) {
1025: my $code = &supportedlanguagecode($id);
1026: if ($code) {
1027: $langchoices{$code} = &plainlanguagedescription($id);
1028: }
1029: }
1.1075.2.32 raeburn 1030: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115 raeburn 1031: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1032: }
1033:
1.42 matthew 1034: =pod
1.36 matthew 1035:
1.648 raeburn 1036: =item * &linked_select_forms(...)
1.36 matthew 1037:
1038: linked_select_forms returns a string containing a <script></script> block
1039: and html for two <select> menus. The select menus will be linked in that
1040: changing the value of the first menu will result in new values being placed
1041: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1042: order unless a defined order is provided.
1.36 matthew 1043:
1044: linked_select_forms takes the following ordered inputs:
1045:
1046: =over 4
1047:
1.112 bowersj2 1048: =item * $formname, the name of the <form> tag
1.36 matthew 1049:
1.112 bowersj2 1050: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1051:
1.112 bowersj2 1052: =item * $firstdefault, the default value for the first menu
1.36 matthew 1053:
1.112 bowersj2 1054: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1055:
1.112 bowersj2 1056: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1057:
1.112 bowersj2 1058: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1059:
1.609 raeburn 1060: =item * $menuorder, the order of values in the first menu
1061:
1.1075.2.31 raeburn 1062: =item * $onchangefirst, additional javascript call to execute for an onchange
1063: event for the first <select> tag
1064:
1065: =item * $onchangesecond, additional javascript call to execute for an onchange
1066: event for the second <select> tag
1067:
1.41 ng 1068: =back
1069:
1.36 matthew 1070: Below is an example of such a hash. Only the 'text', 'default', and
1071: 'select2' keys must appear as stated. keys(%menu) are the possible
1072: values for the first select menu. The text that coincides with the
1.41 ng 1073: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1074: and text for the second menu are given in the hash pointed to by
1075: $menu{$choice1}->{'select2'}.
1076:
1.112 bowersj2 1077: my %menu = ( A1 => { text =>"Choice A1" ,
1078: default => "B3",
1079: select2 => {
1080: B1 => "Choice B1",
1081: B2 => "Choice B2",
1082: B3 => "Choice B3",
1083: B4 => "Choice B4"
1.609 raeburn 1084: },
1085: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1086: },
1087: A2 => { text =>"Choice A2" ,
1088: default => "C2",
1089: select2 => {
1090: C1 => "Choice C1",
1091: C2 => "Choice C2",
1092: C3 => "Choice C3"
1.609 raeburn 1093: },
1094: order => ['C2','C1','C3'],
1.112 bowersj2 1095: },
1096: A3 => { text =>"Choice A3" ,
1097: default => "D6",
1098: select2 => {
1099: D1 => "Choice D1",
1100: D2 => "Choice D2",
1101: D3 => "Choice D3",
1102: D4 => "Choice D4",
1103: D5 => "Choice D5",
1104: D6 => "Choice D6",
1105: D7 => "Choice D7"
1.609 raeburn 1106: },
1107: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1108: }
1109: );
1.36 matthew 1110:
1111: =cut
1112:
1113: sub linked_select_forms {
1114: my ($formname,
1115: $middletext,
1116: $firstdefault,
1117: $firstselectname,
1118: $secondselectname,
1.609 raeburn 1119: $hashref,
1120: $menuorder,
1.1075.2.31 raeburn 1121: $onchangefirst,
1122: $onchangesecond
1.36 matthew 1123: ) = @_;
1124: my $second = "document.$formname.$secondselectname";
1125: my $first = "document.$formname.$firstselectname";
1126: # output the javascript to do the changing
1127: my $result = '';
1.776 bisitz 1128: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1129: $result.="// <![CDATA[\n";
1.36 matthew 1130: $result.="var select2data = new Object();\n";
1131: $" = '","';
1132: my $debug = '';
1133: foreach my $s1 (sort(keys(%$hashref))) {
1134: $result.="select2data.d_$s1 = new Object();\n";
1135: $result.="select2data.d_$s1.def = new String('".
1136: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1137: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1138: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1139: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1140: @s2values = @{$hashref->{$s1}->{'order'}};
1141: }
1.36 matthew 1142: $result.="\"@s2values\");\n";
1143: $result.="select2data.d_$s1.texts = new Array(";
1144: my @s2texts;
1145: foreach my $value (@s2values) {
1.1075.2.119 raeburn 1146: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1147: }
1148: $result.="\"@s2texts\");\n";
1149: }
1150: $"=' ';
1151: $result.= <<"END";
1152:
1153: function select1_changed() {
1154: // Determine new choice
1155: var newvalue = "d_" + $first.value;
1156: // update select2
1157: var values = select2data[newvalue].values;
1158: var texts = select2data[newvalue].texts;
1159: var select2def = select2data[newvalue].def;
1160: var i;
1161: // out with the old
1162: for (i = 0; i < $second.options.length; i++) {
1163: $second.options[i] = null;
1164: }
1165: // in with the nuclear
1166: for (i=0;i<values.length; i++) {
1167: $second.options[i] = new Option(values[i]);
1.143 matthew 1168: $second.options[i].value = values[i];
1.36 matthew 1169: $second.options[i].text = texts[i];
1170: if (values[i] == select2def) {
1171: $second.options[i].selected = true;
1172: }
1173: }
1174: }
1.824 bisitz 1175: // ]]>
1.36 matthew 1176: </script>
1177: END
1178: # output the initial values for the selection lists
1.1075.2.31 raeburn 1179: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1180: my @order = sort(keys(%{$hashref}));
1181: if (ref($menuorder) eq 'ARRAY') {
1182: @order = @{$menuorder};
1183: }
1184: foreach my $value (@order) {
1.36 matthew 1185: $result.=" <option value=\"$value\" ";
1.253 albertel 1186: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1187: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1188: }
1189: $result .= "</select>\n";
1190: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1191: $result .= $middletext;
1.1075.2.31 raeburn 1192: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1193: if ($onchangesecond) {
1194: $result .= ' onchange="'.$onchangesecond.'"';
1195: }
1196: $result .= ">\n";
1.36 matthew 1197: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1198:
1199: my @secondorder = sort(keys(%select2));
1200: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1201: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1202: }
1203: foreach my $value (@secondorder) {
1.36 matthew 1204: $result.=" <option value=\"$value\" ";
1.253 albertel 1205: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1206: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1207: }
1208: $result .= "</select>\n";
1209: # return $debug;
1210: return $result;
1211: } # end of sub linked_select_forms {
1212:
1.45 matthew 1213: =pod
1.44 bowersj2 1214:
1.973 raeburn 1215: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1216:
1.112 bowersj2 1217: Returns a string corresponding to an HTML link to the given help
1218: $topic, where $topic corresponds to the name of a .tex file in
1219: /home/httpd/html/adm/help/tex, with underscores replaced by
1220: spaces.
1221:
1222: $text will optionally be linked to the same topic, allowing you to
1223: link text in addition to the graphic. If you do not want to link
1224: text, but wish to specify one of the later parameters, pass an
1225: empty string.
1226:
1227: $stayOnPage is a value that will be interpreted as a boolean. If true,
1228: the link will not open a new window. If false, the link will open
1229: a new window using Javascript. (Default is false.)
1230:
1231: $width and $height are optional numerical parameters that will
1232: override the width and height of the popped up window, which may
1.973 raeburn 1233: be useful for certain help topics with big pictures included.
1234:
1235: $imgid is the id of the img tag used for the help icon. This may be
1236: used in a javascript call to switch the image src. See
1237: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1238:
1239: =cut
1240:
1241: sub help_open_topic {
1.973 raeburn 1242: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1243: $text = "" if (not defined $text);
1.44 bowersj2 1244: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1245: $width = 500 if (not defined $width);
1.44 bowersj2 1246: $height = 400 if (not defined $height);
1247: my $filename = $topic;
1248: $filename =~ s/ /_/g;
1249:
1.48 bowersj2 1250: my $template = "";
1251: my $link;
1.572 banghart 1252:
1.159 www 1253: $topic=~s/\W/\_/g;
1.44 bowersj2 1254:
1.572 banghart 1255: if (!$stayOnPage) {
1.1075.2.50 raeburn 1256: if ($env{'browser.mobile'}) {
1257: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1258: } else {
1259: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1260: }
1.1037 www 1261: } elsif ($stayOnPage eq 'popup') {
1262: $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 1263: } else {
1.48 bowersj2 1264: $link = "/adm/help/${filename}.hlp";
1265: }
1266:
1267: # Add the text
1.755 neumanie 1268: if ($text ne "") {
1.763 bisitz 1269: $template.='<span class="LC_help_open_topic">'
1270: .'<a target="_top" href="'.$link.'">'
1271: .$text.'</a>';
1.48 bowersj2 1272: }
1273:
1.763 bisitz 1274: # (Always) Add the graphic
1.179 matthew 1275: my $title = &mt('Online Help');
1.667 raeburn 1276: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1277: if ($imgid ne '') {
1278: $imgid = ' id="'.$imgid.'"';
1279: }
1.763 bisitz 1280: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1281: .'<img src="'.$helpicon.'" border="0"'
1282: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1283: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1284: .' /></a>';
1285: if ($text ne "") {
1286: $template.='</span>';
1287: }
1.44 bowersj2 1288: return $template;
1289:
1.106 bowersj2 1290: }
1291:
1292: # This is a quicky function for Latex cheatsheet editing, since it
1293: # appears in at least four places
1294: sub helpLatexCheatsheet {
1.1037 www 1295: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1296: my $out;
1.106 bowersj2 1297: my $addOther = '';
1.732 raeburn 1298: if ($topic) {
1.1037 www 1299: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1300: }
1301: $out = '<span>' # Start cheatsheet
1302: .$addOther
1303: .'<span>'
1.1037 www 1304: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1305: .'</span> <span>'
1.1037 www 1306: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1307: .'</span>';
1.732 raeburn 1308: unless ($not_author) {
1.763 bisitz 1309: $out .= ' <span>'
1.1037 www 1310: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1311: .'</span> <span>'
1.1075.2.78 raeburn 1312: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1313: .'</span>';
1.732 raeburn 1314: }
1.763 bisitz 1315: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1316: return $out;
1.172 www 1317: }
1318:
1.430 albertel 1319: sub general_help {
1320: my $helptopic='Student_Intro';
1321: if ($env{'request.role'}=~/^(ca|au)/) {
1322: $helptopic='Authoring_Intro';
1.907 raeburn 1323: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1324: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1325: } elsif ($env{'request.role'}=~/^dc/) {
1326: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1327: }
1328: return $helptopic;
1329: }
1330:
1331: sub update_help_link {
1332: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1333: my $origurl = $ENV{'REQUEST_URI'};
1334: $origurl=~s|^/~|/priv/|;
1335: my $timestamp = time;
1336: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1337: $$datum = &escape($$datum);
1338: }
1339:
1340: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1341: my $output .= <<"ENDOUTPUT";
1342: <script type="text/javascript">
1.824 bisitz 1343: // <![CDATA[
1.430 albertel 1344: banner_link = '$banner_link';
1.824 bisitz 1345: // ]]>
1.430 albertel 1346: </script>
1347: ENDOUTPUT
1348: return $output;
1349: }
1350:
1351: # now just updates the help link and generates a blue icon
1.193 raeburn 1352: sub help_open_menu {
1.430 albertel 1353: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1354: = @_;
1.949 droeschl 1355: $stayOnPage = 1;
1.430 albertel 1356: my $output;
1357: if ($component_help) {
1358: if (!$text) {
1359: $output=&help_open_topic($component_help,undef,$stayOnPage,
1360: $width,$height);
1361: } else {
1362: my $help_text;
1363: $help_text=&unescape($topic);
1364: $output='<table><tr><td>'.
1365: &help_open_topic($component_help,$help_text,$stayOnPage,
1366: $width,$height).'</td></tr></table>';
1367: }
1368: }
1369: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1370: return $output.$banner_link;
1371: }
1372:
1373: sub top_nav_help {
1374: my ($text) = @_;
1.436 albertel 1375: $text = &mt($text);
1.1075.2.60 raeburn 1376: my $stay_on_page;
1377: unless ($env{'environment.remote'} eq 'on') {
1378: $stay_on_page = 1;
1379: }
1.1075.2.61 raeburn 1380: my ($link,$banner_link);
1381: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1382: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1383: : "javascript:helpMenu('open')";
1384: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1385: }
1.201 raeburn 1386: my $title = &mt('Get help');
1.1075.2.61 raeburn 1387: if ($link) {
1388: return <<"END";
1.436 albertel 1389: $banner_link
1.1075.2.56 raeburn 1390: <a href="$link" title="$title">$text</a>
1.436 albertel 1391: END
1.1075.2.61 raeburn 1392: } else {
1393: return ' '.$text.' ';
1394: }
1.436 albertel 1395: }
1396:
1397: sub help_menu_js {
1.1075.2.52 raeburn 1398: my ($httphost) = @_;
1.949 droeschl 1399: my $stayOnPage = 1;
1.436 albertel 1400: my $width = 620;
1401: my $height = 600;
1.430 albertel 1402: my $helptopic=&general_help();
1.1075.2.52 raeburn 1403: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1404: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1405: my $start_page =
1406: &Apache::loncommon::start_page('Help Menu', undef,
1407: {'frameset' => 1,
1408: 'js_ready' => 1,
1.1075.2.136 raeburn 1409: 'use_absolute' => $httphost,
1.331 albertel 1410: 'add_entries' => {
1411: 'border' => '0',
1.579 raeburn 1412: 'rows' => "110,*",},});
1.331 albertel 1413: my $end_page =
1414: &Apache::loncommon::end_page({'frameset' => 1,
1415: 'js_ready' => 1,});
1416:
1.436 albertel 1417: my $template .= <<"ENDTEMPLATE";
1418: <script type="text/javascript">
1.877 bisitz 1419: // <![CDATA[
1.253 albertel 1420: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1421: var banner_link = '';
1.243 raeburn 1422: function helpMenu(target) {
1423: var caller = this;
1424: if (target == 'open') {
1425: var newWindow = null;
1426: try {
1.262 albertel 1427: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1428: }
1429: catch(error) {
1430: writeHelp(caller);
1431: return;
1432: }
1433: if (newWindow) {
1434: caller = newWindow;
1435: }
1.193 raeburn 1436: }
1.243 raeburn 1437: writeHelp(caller);
1438: return;
1439: }
1440: function writeHelp(caller) {
1.1075.2.61 raeburn 1441: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1442: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1443: caller.document.close();
1444: caller.focus();
1.193 raeburn 1445: }
1.877 bisitz 1446: // END LON-CAPA Internal -->
1.253 albertel 1447: // ]]>
1.436 albertel 1448: </script>
1.193 raeburn 1449: ENDTEMPLATE
1450: return $template;
1451: }
1452:
1.172 www 1453: sub help_open_bug {
1454: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1455: unless ($env{'user.adv'}) { return ''; }
1.172 www 1456: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1457: $text = "" if (not defined $text);
1458: $stayOnPage=1;
1.184 albertel 1459: $width = 600 if (not defined $width);
1460: $height = 600 if (not defined $height);
1.172 www 1461:
1462: $topic=~s/\W+/\+/g;
1463: my $link='';
1464: my $template='';
1.379 albertel 1465: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1466: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1467: if (!$stayOnPage)
1468: {
1469: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1470: }
1471: else
1472: {
1473: $link = $url;
1474: }
1475: # Add the text
1476: if ($text ne "")
1477: {
1478: $template .=
1479: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1480: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1481: }
1482:
1483: # Add the graphic
1.179 matthew 1484: my $title = &mt('Report a Bug');
1.215 albertel 1485: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1486: $template .= <<"ENDTEMPLATE";
1.436 albertel 1487: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1488: ENDTEMPLATE
1489: if ($text ne '') { $template.='</td></tr></table>' };
1490: return $template;
1491:
1492: }
1493:
1494: sub help_open_faq {
1495: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1496: unless ($env{'user.adv'}) { return ''; }
1.172 www 1497: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1498: $text = "" if (not defined $text);
1499: $stayOnPage=1;
1500: $width = 350 if (not defined $width);
1501: $height = 400 if (not defined $height);
1502:
1503: $topic=~s/\W+/\+/g;
1504: my $link='';
1505: my $template='';
1506: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1507: if (!$stayOnPage)
1508: {
1509: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1510: }
1511: else
1512: {
1513: $link = $url;
1514: }
1515:
1516: # Add the text
1517: if ($text ne "")
1518: {
1519: $template .=
1.173 www 1520: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1521: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1522: }
1523:
1524: # Add the graphic
1.179 matthew 1525: my $title = &mt('View the FAQ');
1.215 albertel 1526: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1527: $template .= <<"ENDTEMPLATE";
1.436 albertel 1528: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1529: ENDTEMPLATE
1530: if ($text ne '') { $template.='</td></tr></table>' };
1531: return $template;
1532:
1.44 bowersj2 1533: }
1.37 matthew 1534:
1.180 matthew 1535: ###############################################################
1536: ###############################################################
1537:
1.45 matthew 1538: =pod
1539:
1.648 raeburn 1540: =item * &change_content_javascript():
1.256 matthew 1541:
1542: This and the next function allow you to create small sections of an
1543: otherwise static HTML page that you can update on the fly with
1544: Javascript, even in Netscape 4.
1545:
1546: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1547: must be written to the HTML page once. It will prove the Javascript
1548: function "change(name, content)". Calling the change function with the
1549: name of the section
1550: you want to update, matching the name passed to C<changable_area>, and
1551: the new content you want to put in there, will put the content into
1552: that area.
1553:
1554: B<Note>: Netscape 4 only reserves enough space for the changable area
1555: to contain room for the original contents. You need to "make space"
1556: for whatever changes you wish to make, and be B<sure> to check your
1557: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1558: it's adequate for updating a one-line status display, but little more.
1559: This script will set the space to 100% width, so you only need to
1560: worry about height in Netscape 4.
1561:
1562: Modern browsers are much less limiting, and if you can commit to the
1563: user not using Netscape 4, this feature may be used freely with
1564: pretty much any HTML.
1565:
1566: =cut
1567:
1568: sub change_content_javascript {
1569: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1570: if ($env{'browser.type'} eq 'netscape' &&
1571: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1572: return (<<NETSCAPE4);
1573: function change(name, content) {
1574: doc = document.layers[name+"___escape"].layers[0].document;
1575: doc.open();
1576: doc.write(content);
1577: doc.close();
1578: }
1579: NETSCAPE4
1580: } else {
1581: # Otherwise, we need to use semi-standards-compliant code
1582: # (technically, "innerHTML" isn't standard but the equivalent
1583: # is really scary, and every useful browser supports it
1584: return (<<DOMBASED);
1585: function change(name, content) {
1586: element = document.getElementById(name);
1587: element.innerHTML = content;
1588: }
1589: DOMBASED
1590: }
1591: }
1592:
1593: =pod
1594:
1.648 raeburn 1595: =item * &changable_area($name,$origContent):
1.256 matthew 1596:
1597: This provides a "changable area" that can be modified on the fly via
1598: the Javascript code provided in C<change_content_javascript>. $name is
1599: the name you will use to reference the area later; do not repeat the
1600: same name on a given HTML page more then once. $origContent is what
1601: the area will originally contain, which can be left blank.
1602:
1603: =cut
1604:
1605: sub changable_area {
1606: my ($name, $origContent) = @_;
1607:
1.258 albertel 1608: if ($env{'browser.type'} eq 'netscape' &&
1609: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1610: # If this is netscape 4, we need to use the Layer tag
1611: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1612: } else {
1613: return "<span id='$name'>$origContent</span>";
1614: }
1615: }
1616:
1617: =pod
1618:
1.648 raeburn 1619: =item * &viewport_geometry_js
1.590 raeburn 1620:
1621: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1622:
1623: =cut
1624:
1625:
1626: sub viewport_geometry_js {
1627: return <<"GEOMETRY";
1628: var Geometry = {};
1629: function init_geometry() {
1630: if (Geometry.init) { return };
1631: Geometry.init=1;
1632: if (window.innerHeight) {
1633: Geometry.getViewportHeight = function() { return window.innerHeight; };
1634: Geometry.getViewportWidth = function() { return window.innerWidth; };
1635: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1636: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1637: }
1638: else if (document.documentElement && document.documentElement.clientHeight) {
1639: Geometry.getViewportHeight =
1640: function() { return document.documentElement.clientHeight; };
1641: Geometry.getViewportWidth =
1642: function() { return document.documentElement.clientWidth; };
1643:
1644: Geometry.getHorizontalScroll =
1645: function() { return document.documentElement.scrollLeft; };
1646: Geometry.getVerticalScroll =
1647: function() { return document.documentElement.scrollTop; };
1648: }
1649: else if (document.body.clientHeight) {
1650: Geometry.getViewportHeight =
1651: function() { return document.body.clientHeight; };
1652: Geometry.getViewportWidth =
1653: function() { return document.body.clientWidth; };
1654: Geometry.getHorizontalScroll =
1655: function() { return document.body.scrollLeft; };
1656: Geometry.getVerticalScroll =
1657: function() { return document.body.scrollTop; };
1658: }
1659: }
1660:
1661: GEOMETRY
1662: }
1663:
1664: =pod
1665:
1.648 raeburn 1666: =item * &viewport_size_js()
1.590 raeburn 1667:
1668: 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.
1669:
1670: =cut
1671:
1672: sub viewport_size_js {
1673: my $geometry = &viewport_geometry_js();
1674: return <<"DIMS";
1675:
1676: $geometry
1677:
1678: function getViewportDims(width,height) {
1679: init_geometry();
1680: width.value = Geometry.getViewportWidth();
1681: height.value = Geometry.getViewportHeight();
1682: return;
1683: }
1684:
1685: DIMS
1686: }
1687:
1688: =pod
1689:
1.648 raeburn 1690: =item * &resize_textarea_js()
1.565 albertel 1691:
1692: emits the needed javascript to resize a textarea to be as big as possible
1693:
1694: creates a function resize_textrea that takes two IDs first should be
1695: the id of the element to resize, second should be the id of a div that
1696: surrounds everything that comes after the textarea, this routine needs
1697: to be attached to the <body> for the onload and onresize events.
1698:
1.648 raeburn 1699: =back
1.565 albertel 1700:
1701: =cut
1702:
1703: sub resize_textarea_js {
1.590 raeburn 1704: my $geometry = &viewport_geometry_js();
1.565 albertel 1705: return <<"RESIZE";
1706: <script type="text/javascript">
1.824 bisitz 1707: // <![CDATA[
1.590 raeburn 1708: $geometry
1.565 albertel 1709:
1.588 albertel 1710: function getX(element) {
1711: var x = 0;
1712: while (element) {
1713: x += element.offsetLeft;
1714: element = element.offsetParent;
1715: }
1716: return x;
1717: }
1718: function getY(element) {
1719: var y = 0;
1720: while (element) {
1721: y += element.offsetTop;
1722: element = element.offsetParent;
1723: }
1724: return y;
1725: }
1726:
1727:
1.565 albertel 1728: function resize_textarea(textarea_id,bottom_id) {
1729: init_geometry();
1730: var textarea = document.getElementById(textarea_id);
1731: //alert(textarea);
1732:
1.588 albertel 1733: var textarea_top = getY(textarea);
1.565 albertel 1734: var textarea_height = textarea.offsetHeight;
1735: var bottom = document.getElementById(bottom_id);
1.588 albertel 1736: var bottom_top = getY(bottom);
1.565 albertel 1737: var bottom_height = bottom.offsetHeight;
1738: var window_height = Geometry.getViewportHeight();
1.588 albertel 1739: var fudge = 23;
1.565 albertel 1740: var new_height = window_height-fudge-textarea_top-bottom_height;
1741: if (new_height < 300) {
1742: new_height = 300;
1743: }
1744: textarea.style.height=new_height+'px';
1745: }
1.824 bisitz 1746: // ]]>
1.565 albertel 1747: </script>
1748: RESIZE
1749:
1750: }
1751:
1.1075.2.112 raeburn 1752: sub colorfuleditor_js {
1753: return <<"COLORFULEDIT"
1754: <script type="text/javascript">
1755: // <![CDATA[>
1756: function fold_box(curDepth, lastresource){
1757:
1758: // we need a list because there can be several blocks you need to fold in one tag
1759: var block = document.getElementsByName('foldblock_'+curDepth);
1760: // but there is only one folding button per tag
1761: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1762:
1763: if(block.item(0).style.display == 'none'){
1764:
1765: foldbutton.value = '@{[&mt("Hide")]}';
1766: for (i = 0; i < block.length; i++){
1767: block.item(i).style.display = '';
1768: }
1769: }else{
1770:
1771: foldbutton.value = '@{[&mt("Show")]}';
1772: for (i = 0; i < block.length; i++){
1773: // block.item(i).style.visibility = 'collapse';
1774: block.item(i).style.display = 'none';
1775: }
1776: };
1777: saveState(lastresource);
1778: }
1779:
1780: function saveState (lastresource) {
1781:
1782: var tag_list = getTagList();
1783: if(tag_list != null){
1784: var timestamp = new Date().getTime();
1785: var key = lastresource;
1786:
1787: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1788: // starting with timestamp
1789: var value = timestamp+';';
1790:
1791: // building the list of key-value pairs
1792: for(var i = 0; i < tag_list.length; i++){
1793: value += tag_list[i]+',';
1794: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1795: }
1796:
1797: // only iterate whole storage if nothing to override
1798: if(localStorage.getItem(key) == null){
1799:
1800: // prevent storage from growing large
1801: if(localStorage.length > 50){
1802: var regex_getTimestamp = /^(?:\d)+;/;
1803: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1804: var oldest_key;
1805:
1806: for(var i = 1; i < localStorage.length; i++){
1807: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1808: oldest_key = localStorage.key(i);
1809: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1810: }
1811: }
1812: localStorage.removeItem(oldest_key);
1813: }
1814: }
1815: localStorage.setItem(key,value);
1816: }
1817: }
1818:
1819: // restore folding status of blocks (on page load)
1820: function restoreState (lastresource) {
1821: if(localStorage.getItem(lastresource) != null){
1822: var key = lastresource;
1823: var value = localStorage.getItem(key);
1824: var regex_delTimestamp = /^\d+;/;
1825:
1826: value.replace(regex_delTimestamp, '');
1827:
1828: var valueArr = value.split(';');
1829: var pairs;
1830: var elements;
1831: for (var i = 0; i < valueArr.length; i++){
1832: pairs = valueArr[i].split(',');
1833: elements = document.getElementsByName(pairs[0]);
1834:
1835: for (var j = 0; j < elements.length; j++){
1836: elements[j].style.display = pairs[1];
1837: if (pairs[1] == "none"){
1838: var regex_id = /([_\\d]+)\$/;
1839: regex_id.exec(pairs[0]);
1840: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1841: }
1842: }
1843: }
1844: }
1845: }
1846:
1847: function getTagList () {
1848:
1849: var stringToSearch = document.lonhomework.innerHTML;
1850:
1851: var ret = new Array();
1852: var regex_findBlock = /(foldblock_.*?)"/g;
1853: var tag_list = stringToSearch.match(regex_findBlock);
1854:
1855: if(tag_list != null){
1856: for(var i = 0; i < tag_list.length; i++){
1857: ret.push(tag_list[i].replace(/"/, ''));
1858: }
1859: }
1860: return ret;
1861: }
1862:
1863: function saveScrollPosition (resource) {
1864: var tag_list = getTagList();
1865:
1866: // we dont always want to jump to the first block
1867: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1868: if(\$(window).scrollTop() > 170){
1869: if(tag_list != null){
1870: var result;
1871: for(var i = 0; i < tag_list.length; i++){
1872: if(isElementInViewport(tag_list[i])){
1873: result += tag_list[i]+';';
1874: }
1875: }
1876: sessionStorage.setItem('anchor_'+resource, result);
1877: }
1878: } else {
1879: // we dont need to save zero, just delete the item to leave everything tidy
1880: sessionStorage.removeItem('anchor_'+resource);
1881: }
1882: }
1883:
1884: function restoreScrollPosition(resource){
1885:
1886: var elem = sessionStorage.getItem('anchor_'+resource);
1887: if(elem != null){
1888: var tag_list = elem.split(';');
1889: var elem_list;
1890:
1891: for(var i = 0; i < tag_list.length; i++){
1892: elem_list = document.getElementsByName(tag_list[i]);
1893:
1894: if(elem_list.length > 0){
1895: elem = elem_list[0];
1896: break;
1897: }
1898: }
1899: elem.scrollIntoView();
1900: }
1901: }
1902:
1903: function isElementInViewport(el) {
1904:
1905: // change to last element instead of first
1906: var elem = document.getElementsByName(el);
1907: var rect = elem[0].getBoundingClientRect();
1908:
1909: return (
1910: rect.top >= 0 &&
1911: rect.left >= 0 &&
1912: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1913: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1914: );
1915: }
1916:
1917: function autosize(depth){
1918: var cmInst = window['cm'+depth];
1919: var fitsizeButton = document.getElementById('fitsize'+depth);
1920:
1921: // is fixed size, switching to dynamic
1922: if (sessionStorage.getItem("autosized_"+depth) == null) {
1923: cmInst.setSize("","auto");
1924: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1925: sessionStorage.setItem("autosized_"+depth, "yes");
1926:
1927: // is dynamic size, switching to fixed
1928: } else {
1929: cmInst.setSize("","300px");
1930: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1931: sessionStorage.removeItem("autosized_"+depth);
1932: }
1933: }
1934:
1935:
1936:
1937: // ]]>
1938: </script>
1939: COLORFULEDIT
1940: }
1941:
1942: sub xmleditor_js {
1943: return <<XMLEDIT
1944: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1945: <script type="text/javascript">
1946: // <![CDATA[>
1947:
1948: function saveScrollPosition (resource) {
1949:
1950: var scrollPos = \$(window).scrollTop();
1951: sessionStorage.setItem(resource,scrollPos);
1952: }
1953:
1954: function restoreScrollPosition(resource){
1955:
1956: var scrollPos = sessionStorage.getItem(resource);
1957: \$(window).scrollTop(scrollPos);
1958: }
1959:
1960: // unless internet explorer
1961: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1962:
1963: \$(document).ready(function() {
1964: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1965: });
1966: }
1967:
1968: // inserts text at cursor position into codemirror (xml editor only)
1969: function insertText(text){
1970: cm.focus();
1971: var curPos = cm.getCursor();
1972: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1973: }
1974: // ]]>
1975: </script>
1976: XMLEDIT
1977: }
1978:
1979: sub insert_folding_button {
1980: my $curDepth = $Apache::lonxml::curdepth;
1981: my $lastresource = $env{'request.ambiguous'};
1982:
1983: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
1984: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
1985: }
1986:
1987:
1.565 albertel 1988: =pod
1989:
1.256 matthew 1990: =head1 Excel and CSV file utility routines
1991:
1992: =cut
1993:
1994: ###############################################################
1995: ###############################################################
1996:
1997: =pod
1998:
1.1075.2.56 raeburn 1999: =over 4
2000:
1.648 raeburn 2001: =item * &csv_translate($text)
1.37 matthew 2002:
1.185 www 2003: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2004: format.
2005:
2006: =cut
2007:
1.180 matthew 2008: ###############################################################
2009: ###############################################################
1.37 matthew 2010: sub csv_translate {
2011: my $text = shift;
2012: $text =~ s/\"/\"\"/g;
1.209 albertel 2013: $text =~ s/\n/ /g;
1.37 matthew 2014: return $text;
2015: }
1.180 matthew 2016:
2017: ###############################################################
2018: ###############################################################
2019:
2020: =pod
2021:
1.648 raeburn 2022: =item * &define_excel_formats()
1.180 matthew 2023:
2024: Define some commonly used Excel cell formats.
2025:
2026: Currently supported formats:
2027:
2028: =over 4
2029:
2030: =item header
2031:
2032: =item bold
2033:
2034: =item h1
2035:
2036: =item h2
2037:
2038: =item h3
2039:
1.256 matthew 2040: =item h4
2041:
2042: =item i
2043:
1.180 matthew 2044: =item date
2045:
2046: =back
2047:
2048: Inputs: $workbook
2049:
2050: Returns: $format, a hash reference.
2051:
1.1057 foxr 2052:
1.180 matthew 2053: =cut
2054:
2055: ###############################################################
2056: ###############################################################
2057: sub define_excel_formats {
2058: my ($workbook) = @_;
2059: my $format;
2060: $format->{'header'} = $workbook->add_format(bold => 1,
2061: bottom => 1,
2062: align => 'center');
2063: $format->{'bold'} = $workbook->add_format(bold=>1);
2064: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2065: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2066: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2067: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2068: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2069: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2070: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2071: return $format;
2072: }
2073:
2074: ###############################################################
2075: ###############################################################
1.113 bowersj2 2076:
2077: =pod
2078:
1.648 raeburn 2079: =item * &create_workbook()
1.255 matthew 2080:
2081: Create an Excel worksheet. If it fails, output message on the
2082: request object and return undefs.
2083:
2084: Inputs: Apache request object
2085:
2086: Returns (undef) on failure,
2087: Excel worksheet object, scalar with filename, and formats
2088: from &Apache::loncommon::define_excel_formats on success
2089:
2090: =cut
2091:
2092: ###############################################################
2093: ###############################################################
2094: sub create_workbook {
2095: my ($r) = @_;
2096: #
2097: # Create the excel spreadsheet
2098: my $filename = '/prtspool/'.
1.258 albertel 2099: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2100: time.'_'.rand(1000000000).'.xls';
2101: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2102: if (! defined($workbook)) {
2103: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2104: $r->print(
2105: '<p class="LC_error">'
2106: .&mt('Problems occurred in creating the new Excel file.')
2107: .' '.&mt('This error has been logged.')
2108: .' '.&mt('Please alert your LON-CAPA administrator.')
2109: .'</p>'
2110: );
1.255 matthew 2111: return (undef);
2112: }
2113: #
1.1014 foxr 2114: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2115: #
2116: my $format = &Apache::loncommon::define_excel_formats($workbook);
2117: return ($workbook,$filename,$format);
2118: }
2119:
2120: ###############################################################
2121: ###############################################################
2122:
2123: =pod
2124:
1.648 raeburn 2125: =item * &create_text_file()
1.113 bowersj2 2126:
1.542 raeburn 2127: Create a file to write to and eventually make available to the user.
1.256 matthew 2128: If file creation fails, outputs an error message on the request object and
2129: return undefs.
1.113 bowersj2 2130:
1.256 matthew 2131: Inputs: Apache request object, and file suffix
1.113 bowersj2 2132:
1.256 matthew 2133: Returns (undef) on failure,
2134: Filehandle and filename on success.
1.113 bowersj2 2135:
2136: =cut
2137:
1.256 matthew 2138: ###############################################################
2139: ###############################################################
2140: sub create_text_file {
2141: my ($r,$suffix) = @_;
2142: if (! defined($suffix)) { $suffix = 'txt'; };
2143: my $fh;
2144: my $filename = '/prtspool/'.
1.258 albertel 2145: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2146: time.'_'.rand(1000000000).'.'.$suffix;
2147: $fh = Apache::File->new('>/home/httpd'.$filename);
2148: if (! defined($fh)) {
2149: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2150: $r->print(
2151: '<p class="LC_error">'
2152: .&mt('Problems occurred in creating the output file.')
2153: .' '.&mt('This error has been logged.')
2154: .' '.&mt('Please alert your LON-CAPA administrator.')
2155: .'</p>'
2156: );
1.113 bowersj2 2157: }
1.256 matthew 2158: return ($fh,$filename)
1.113 bowersj2 2159: }
2160:
2161:
1.256 matthew 2162: =pod
1.113 bowersj2 2163:
2164: =back
2165:
2166: =cut
1.37 matthew 2167:
2168: ###############################################################
1.33 matthew 2169: ## Home server <option> list generating code ##
2170: ###############################################################
1.35 matthew 2171:
1.169 www 2172: # ------------------------------------------
2173:
2174: sub domain_select {
2175: my ($name,$value,$multiple)=@_;
2176: my %domains=map {
1.514 albertel 2177: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2178: } &Apache::lonnet::all_domains();
1.169 www 2179: if ($multiple) {
2180: $domains{''}=&mt('Any domain');
1.550 albertel 2181: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2182: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2183: } else {
1.550 albertel 2184: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2185: return &select_form($name,$value,\%domains);
1.169 www 2186: }
2187: }
2188:
1.282 albertel 2189: #-------------------------------------------
2190:
2191: =pod
2192:
1.519 raeburn 2193: =head1 Routines for form select boxes
2194:
2195: =over 4
2196:
1.648 raeburn 2197: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2198:
2199: Returns a string containing a <select> element int multiple mode
2200:
2201:
2202: Args:
2203: $name - name of the <select> element
1.506 raeburn 2204: $value - scalar or array ref of values that should already be selected
1.282 albertel 2205: $size - number of rows long the select element is
1.283 albertel 2206: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2207: (shown text should already have been &mt())
1.506 raeburn 2208: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2209:
1.282 albertel 2210: =cut
2211:
2212: #-------------------------------------------
1.169 www 2213: sub multiple_select_form {
1.284 albertel 2214: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2215: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2216: my $output='';
1.191 matthew 2217: if (! defined($size)) {
2218: $size = 4;
1.283 albertel 2219: if (scalar(keys(%$hash))<4) {
2220: $size = scalar(keys(%$hash));
1.191 matthew 2221: }
2222: }
1.734 bisitz 2223: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2224: my @order;
1.506 raeburn 2225: if (ref($order) eq 'ARRAY') {
2226: @order = @{$order};
2227: } else {
2228: @order = sort(keys(%$hash));
1.501 banghart 2229: }
2230: if (exists($$hash{'select_form_order'})) {
2231: @order = @{$$hash{'select_form_order'}};
2232: }
2233:
1.284 albertel 2234: foreach my $key (@order) {
1.356 albertel 2235: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2236: $output.='selected="selected" ' if ($selected{$key});
2237: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2238: }
2239: $output.="</select>\n";
2240: return $output;
2241: }
2242:
1.88 www 2243: #-------------------------------------------
2244:
2245: =pod
2246:
1.1075.2.115 raeburn 2247: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2248:
2249: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2250: allow a user to select options from a ref to a hash containing:
2251: option_name => displayed text. An optional $onchange can include
1.1075.2.115 raeburn 2252: a javascript onchange item, e.g., onchange="this.form.submit();".
2253: An optional arg -- $readonly -- if true will cause the select form
2254: to be disabled, e.g., for the case where an instructor has a section-
2255: specific role, and is viewing/modifying parameters.
1.970 raeburn 2256:
1.88 www 2257: See lonrights.pm for an example invocation and use.
2258:
2259: =cut
2260:
2261: #-------------------------------------------
2262: sub select_form {
1.1075.2.115 raeburn 2263: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2264: return unless (ref($hashref) eq 'HASH');
2265: if ($onchange) {
2266: $onchange = ' onchange="'.$onchange.'"';
2267: }
1.1075.2.129 raeburn 2268: my $disabled;
2269: if ($readonly) {
2270: $disabled = ' disabled="disabled"';
2271: }
2272: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2273: my @keys;
1.970 raeburn 2274: if (exists($hashref->{'select_form_order'})) {
2275: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2276: } else {
1.970 raeburn 2277: @keys=sort(keys(%{$hashref}));
1.128 albertel 2278: }
1.356 albertel 2279: foreach my $key (@keys) {
2280: $selectform.=
2281: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2282: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2283: ">".$hashref->{$key}."</option>\n";
1.88 www 2284: }
2285: $selectform.="</select>";
2286: return $selectform;
2287: }
2288:
1.475 www 2289: # For display filters
2290:
2291: sub display_filter {
1.1074 raeburn 2292: my ($context) = @_;
1.475 www 2293: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2294: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2295: my $phraseinput = 'hidden';
2296: my $includeinput = 'hidden';
2297: my ($checked,$includetypestext);
2298: if ($env{'form.displayfilter'} eq 'containing') {
2299: $phraseinput = 'text';
2300: if ($context eq 'parmslog') {
2301: $includeinput = 'checkbox';
2302: if ($env{'form.includetypes'}) {
2303: $checked = ' checked="checked"';
2304: }
2305: $includetypestext = &mt('Include parameter types');
2306: }
2307: } else {
2308: $includetypestext = ' ';
2309: }
2310: my ($additional,$secondid,$thirdid);
2311: if ($context eq 'parmslog') {
2312: $additional =
2313: '<label><input type="'.$includeinput.'" name="includetypes"'.
2314: $checked.' name="includetypes" value="1" id="includetypes" />'.
2315: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2316: '</label>';
2317: $secondid = 'includetypes';
2318: $thirdid = 'includetypestext';
2319: }
2320: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2321: '$secondid','$thirdid')";
2322: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2323: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2324: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2325: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2326: &mt('Filter: [_1]',
1.477 www 2327: &select_form($env{'form.displayfilter'},
2328: 'displayfilter',
1.970 raeburn 2329: {'currentfolder' => 'Current folder/page',
1.477 www 2330: 'containing' => 'Containing phrase',
1.1074 raeburn 2331: 'none' => 'None'},$onchange)).' '.
2332: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2333: &HTML::Entities::encode($env{'form.containingphrase'}).
2334: '" />'.$additional;
2335: }
2336:
2337: sub display_filter_js {
2338: my $includetext = &mt('Include parameter types');
2339: return <<"ENDJS";
2340:
2341: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2342: var firstType = 'hidden';
2343: if (setter.options[setter.selectedIndex].value == 'containing') {
2344: firstType = 'text';
2345: }
2346: firstObject = document.getElementById(firstid);
2347: if (typeof(firstObject) == 'object') {
2348: if (firstObject.type != firstType) {
2349: changeInputType(firstObject,firstType);
2350: }
2351: }
2352: if (context == 'parmslog') {
2353: var secondType = 'hidden';
2354: if (firstType == 'text') {
2355: secondType = 'checkbox';
2356: }
2357: secondObject = document.getElementById(secondid);
2358: if (typeof(secondObject) == 'object') {
2359: if (secondObject.type != secondType) {
2360: changeInputType(secondObject,secondType);
2361: }
2362: }
2363: var textItem = document.getElementById(thirdid);
2364: var currtext = textItem.innerHTML;
2365: var newtext;
2366: if (firstType == 'text') {
2367: newtext = '$includetext';
2368: } else {
2369: newtext = ' ';
2370: }
2371: if (currtext != newtext) {
2372: textItem.innerHTML = newtext;
2373: }
2374: }
2375: return;
2376: }
2377:
2378: function changeInputType(oldObject,newType) {
2379: var newObject = document.createElement('input');
2380: newObject.type = newType;
2381: if (oldObject.size) {
2382: newObject.size = oldObject.size;
2383: }
2384: if (oldObject.value) {
2385: newObject.value = oldObject.value;
2386: }
2387: if (oldObject.name) {
2388: newObject.name = oldObject.name;
2389: }
2390: if (oldObject.id) {
2391: newObject.id = oldObject.id;
2392: }
2393: oldObject.parentNode.replaceChild(newObject,oldObject);
2394: return;
2395: }
2396:
2397: ENDJS
1.475 www 2398: }
2399:
1.167 www 2400: sub gradeleveldescription {
2401: my $gradelevel=shift;
2402: my %gradelevels=(0 => 'Not specified',
2403: 1 => 'Grade 1',
2404: 2 => 'Grade 2',
2405: 3 => 'Grade 3',
2406: 4 => 'Grade 4',
2407: 5 => 'Grade 5',
2408: 6 => 'Grade 6',
2409: 7 => 'Grade 7',
2410: 8 => 'Grade 8',
2411: 9 => 'Grade 9',
2412: 10 => 'Grade 10',
2413: 11 => 'Grade 11',
2414: 12 => 'Grade 12',
2415: 13 => 'Grade 13',
2416: 14 => '100 Level',
2417: 15 => '200 Level',
2418: 16 => '300 Level',
2419: 17 => '400 Level',
2420: 18 => 'Graduate Level');
2421: return &mt($gradelevels{$gradelevel});
2422: }
2423:
1.163 www 2424: sub select_level_form {
2425: my ($deflevel,$name)=@_;
2426: unless ($deflevel) { $deflevel=0; }
1.167 www 2427: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2428: for (my $i=0; $i<=18; $i++) {
2429: $selectform.="<option value=\"$i\" ".
1.253 albertel 2430: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2431: ">".&gradeleveldescription($i)."</option>\n";
2432: }
2433: $selectform.="</select>";
2434: return $selectform;
1.163 www 2435: }
1.167 www 2436:
1.35 matthew 2437: #-------------------------------------------
2438:
1.45 matthew 2439: =pod
2440:
1.1075.2.115 raeburn 2441: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2442:
2443: Returns a string containing a <select name='$name' size='1'> form to
2444: allow a user to select the domain to preform an operation in.
2445: See loncreateuser.pm for an example invocation and use.
2446:
1.90 www 2447: If the $includeempty flag is set, it also includes an empty choice ("no domain
2448: selected");
2449:
1.743 raeburn 2450: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2451:
1.910 raeburn 2452: 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.
2453:
1.1075.2.36 raeburn 2454: The optional $incdoms is a reference to an array of domains which will be the only available options.
2455:
1.1075.2.115 raeburn 2456: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
2457:
2458: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
1.563 raeburn 2459:
1.35 matthew 2460: =cut
2461:
2462: #-------------------------------------------
1.34 matthew 2463: sub select_dom_form {
1.1075.2.115 raeburn 2464: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2465: if ($onchange) {
1.874 raeburn 2466: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2467: }
1.1075.2.115 raeburn 2468: if ($disabled) {
2469: $disabled = ' disabled="disabled"';
2470: }
1.1075.2.36 raeburn 2471: my (@domains,%exclude);
1.910 raeburn 2472: if (ref($incdoms) eq 'ARRAY') {
2473: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2474: } else {
2475: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2476: }
1.90 www 2477: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2478: if (ref($excdoms) eq 'ARRAY') {
2479: map { $exclude{$_} = 1; } @{$excdoms};
2480: }
1.1075.2.115 raeburn 2481: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2482: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2483: next if ($exclude{$dom});
1.356 albertel 2484: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2485: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2486: if ($showdomdesc) {
2487: if ($dom ne '') {
2488: my $domdesc = &Apache::lonnet::domain($dom,'description');
2489: if ($domdesc ne '') {
2490: $selectdomain .= ' ('.$domdesc.')';
2491: }
2492: }
2493: }
2494: $selectdomain .= "</option>\n";
1.34 matthew 2495: }
2496: $selectdomain.="</select>";
2497: return $selectdomain;
2498: }
2499:
1.35 matthew 2500: #-------------------------------------------
2501:
1.45 matthew 2502: =pod
2503:
1.648 raeburn 2504: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2505:
1.586 raeburn 2506: input: 4 arguments (two required, two optional) -
2507: $domain - domain of new user
2508: $name - name of form element
2509: $default - Value of 'default' causes a default item to be first
2510: option, and selected by default.
2511: $hide - Value of 'hide' causes hiding of the name of the server,
2512: if 1 server found, or default, if 0 found.
1.594 raeburn 2513: output: returns 2 items:
1.586 raeburn 2514: (a) form element which contains either:
2515: (i) <select name="$name">
2516: <option value="$hostid1">$hostid $servers{$hostid}</option>
2517: <option value="$hostid2">$hostid $servers{$hostid}</option>
2518: </select>
2519: form item if there are multiple library servers in $domain, or
2520: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2521: if there is only one library server in $domain.
2522:
2523: (b) number of library servers found.
2524:
2525: See loncreateuser.pm for example of use.
1.35 matthew 2526:
2527: =cut
2528:
2529: #-------------------------------------------
1.586 raeburn 2530: sub home_server_form_item {
2531: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2532: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2533: my $result;
2534: my $numlib = keys(%servers);
2535: if ($numlib > 1) {
2536: $result .= '<select name="'.$name.'" />'."\n";
2537: if ($default) {
1.804 bisitz 2538: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2539: '</option>'."\n";
2540: }
2541: foreach my $hostid (sort(keys(%servers))) {
2542: $result.= '<option value="'.$hostid.'">'.
2543: $hostid.' '.$servers{$hostid}."</option>\n";
2544: }
2545: $result .= '</select>'."\n";
2546: } elsif ($numlib == 1) {
2547: my $hostid;
2548: foreach my $item (keys(%servers)) {
2549: $hostid = $item;
2550: }
2551: $result .= '<input type="hidden" name="'.$name.'" value="'.
2552: $hostid.'" />';
2553: if (!$hide) {
2554: $result .= $hostid.' '.$servers{$hostid};
2555: }
2556: $result .= "\n";
2557: } elsif ($default) {
2558: $result .= '<input type="hidden" name="'.$name.
2559: '" value="default" />';
2560: if (!$hide) {
2561: $result .= &mt('default');
2562: }
2563: $result .= "\n";
1.33 matthew 2564: }
1.586 raeburn 2565: return ($result,$numlib);
1.33 matthew 2566: }
1.112 bowersj2 2567:
2568: =pod
2569:
1.534 albertel 2570: =back
2571:
1.112 bowersj2 2572: =cut
1.87 matthew 2573:
2574: ###############################################################
1.112 bowersj2 2575: ## Decoding User Agent ##
1.87 matthew 2576: ###############################################################
2577:
2578: =pod
2579:
1.112 bowersj2 2580: =head1 Decoding the User Agent
2581:
2582: =over 4
2583:
2584: =item * &decode_user_agent()
1.87 matthew 2585:
2586: Inputs: $r
2587:
2588: Outputs:
2589:
2590: =over 4
2591:
1.112 bowersj2 2592: =item * $httpbrowser
1.87 matthew 2593:
1.112 bowersj2 2594: =item * $clientbrowser
1.87 matthew 2595:
1.112 bowersj2 2596: =item * $clientversion
1.87 matthew 2597:
1.112 bowersj2 2598: =item * $clientmathml
1.87 matthew 2599:
1.112 bowersj2 2600: =item * $clientunicode
1.87 matthew 2601:
1.112 bowersj2 2602: =item * $clientos
1.87 matthew 2603:
1.1075.2.42 raeburn 2604: =item * $clientmobile
2605:
2606: =item * $clientinfo
2607:
1.1075.2.77 raeburn 2608: =item * $clientosversion
2609:
1.87 matthew 2610: =back
2611:
1.157 matthew 2612: =back
2613:
1.87 matthew 2614: =cut
2615:
2616: ###############################################################
2617: ###############################################################
2618: sub decode_user_agent {
1.247 albertel 2619: my ($r)=@_;
1.87 matthew 2620: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2621: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2622: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2623: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2624: my $clientbrowser='unknown';
2625: my $clientversion='0';
2626: my $clientmathml='';
2627: my $clientunicode='0';
1.1075.2.42 raeburn 2628: my $clientmobile=0;
1.1075.2.77 raeburn 2629: my $clientosversion='';
1.87 matthew 2630: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2631: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2632: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2633: $clientbrowser=$bname;
2634: $httpbrowser=~/$vreg/i;
2635: $clientversion=$1;
2636: $clientmathml=($clientversion>=$minv);
2637: $clientunicode=($clientversion>=$univ);
2638: }
2639: }
2640: my $clientos='unknown';
1.1075.2.42 raeburn 2641: my $clientinfo;
1.87 matthew 2642: if (($httpbrowser=~/linux/i) ||
2643: ($httpbrowser=~/unix/i) ||
2644: ($httpbrowser=~/ux/i) ||
2645: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2646: if (($httpbrowser=~/vax/i) ||
2647: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2648: if ($httpbrowser=~/next/i) { $clientos='next'; }
2649: if (($httpbrowser=~/mac/i) ||
2650: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2651: if ($httpbrowser=~/win/i) {
2652: $clientos='win';
2653: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2654: $clientosversion = $1;
2655: }
2656: }
1.87 matthew 2657: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2658: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2659: $clientmobile=lc($1);
2660: }
2661: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2662: $clientinfo = 'firefox-'.$1;
2663: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2664: $clientinfo = 'chromeframe-'.$1;
2665: }
1.87 matthew 2666: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2667: $clientunicode,$clientos,$clientmobile,$clientinfo,
2668: $clientosversion);
1.87 matthew 2669: }
2670:
1.32 matthew 2671: ###############################################################
2672: ## Authentication changing form generation subroutines ##
2673: ###############################################################
2674: ##
2675: ## All of the authform_xxxxxxx subroutines take their inputs in a
2676: ## hash, and have reasonable default values.
2677: ##
2678: ## formname = the name given in the <form> tag.
1.35 matthew 2679: #-------------------------------------------
2680:
1.45 matthew 2681: =pod
2682:
1.112 bowersj2 2683: =head1 Authentication Routines
2684:
2685: =over 4
2686:
1.648 raeburn 2687: =item * &authform_xxxxxx()
1.35 matthew 2688:
2689: The authform_xxxxxx subroutines provide javascript and html forms which
2690: handle some of the conveniences required for authentication forms.
2691: This is not an optimal method, but it works.
2692:
2693: =over 4
2694:
1.112 bowersj2 2695: =item * authform_header
1.35 matthew 2696:
1.112 bowersj2 2697: =item * authform_authorwarning
1.35 matthew 2698:
1.112 bowersj2 2699: =item * authform_nochange
1.35 matthew 2700:
1.112 bowersj2 2701: =item * authform_kerberos
1.35 matthew 2702:
1.112 bowersj2 2703: =item * authform_internal
1.35 matthew 2704:
1.112 bowersj2 2705: =item * authform_filesystem
1.35 matthew 2706:
2707: =back
2708:
1.648 raeburn 2709: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2710:
1.35 matthew 2711: =cut
2712:
2713: #-------------------------------------------
1.32 matthew 2714: sub authform_header{
2715: my %in = (
2716: formname => 'cu',
1.80 albertel 2717: kerb_def_dom => '',
1.32 matthew 2718: @_,
2719: );
2720: $in{'formname'} = 'document.' . $in{'formname'};
2721: my $result='';
1.80 albertel 2722:
2723: #---------------------------------------------- Code for upper case translation
2724: my $Javascript_toUpperCase;
2725: unless ($in{kerb_def_dom}) {
2726: $Javascript_toUpperCase =<<"END";
2727: switch (choice) {
2728: case 'krb': currentform.elements[choicearg].value =
2729: currentform.elements[choicearg].value.toUpperCase();
2730: break;
2731: default:
2732: }
2733: END
2734: } else {
2735: $Javascript_toUpperCase = "";
2736: }
2737:
1.165 raeburn 2738: my $radioval = "'nochange'";
1.591 raeburn 2739: if (defined($in{'curr_authtype'})) {
2740: if ($in{'curr_authtype'} ne '') {
2741: $radioval = "'".$in{'curr_authtype'}."arg'";
2742: }
1.174 matthew 2743: }
1.165 raeburn 2744: my $argfield = 'null';
1.591 raeburn 2745: if (defined($in{'mode'})) {
1.165 raeburn 2746: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2747: if (defined($in{'curr_autharg'})) {
2748: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2749: $argfield = "'$in{'curr_autharg'}'";
2750: }
2751: }
2752: }
2753: }
2754:
1.32 matthew 2755: $result.=<<"END";
2756: var current = new Object();
1.165 raeburn 2757: current.radiovalue = $radioval;
2758: current.argfield = $argfield;
1.32 matthew 2759:
2760: function changed_radio(choice,currentform) {
2761: var choicearg = choice + 'arg';
2762: // If a radio button in changed, we need to change the argfield
2763: if (current.radiovalue != choice) {
2764: current.radiovalue = choice;
2765: if (current.argfield != null) {
2766: currentform.elements[current.argfield].value = '';
2767: }
2768: if (choice == 'nochange') {
2769: current.argfield = null;
2770: } else {
2771: current.argfield = choicearg;
2772: switch(choice) {
2773: case 'krb':
2774: currentform.elements[current.argfield].value =
2775: "$in{'kerb_def_dom'}";
2776: break;
2777: default:
2778: break;
2779: }
2780: }
2781: }
2782: return;
2783: }
1.22 www 2784:
1.32 matthew 2785: function changed_text(choice,currentform) {
2786: var choicearg = choice + 'arg';
2787: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2788: $Javascript_toUpperCase
1.32 matthew 2789: // clear old field
2790: if ((current.argfield != choicearg) && (current.argfield != null)) {
2791: currentform.elements[current.argfield].value = '';
2792: }
2793: current.argfield = choicearg;
2794: }
2795: set_auth_radio_buttons(choice,currentform);
2796: return;
1.20 www 2797: }
1.32 matthew 2798:
2799: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2800: var numauthchoices = currentform.login.length;
2801: if (typeof numauthchoices == "undefined") {
2802: return;
2803: }
1.32 matthew 2804: var i=0;
1.986 raeburn 2805: while (i < numauthchoices) {
1.32 matthew 2806: if (currentform.login[i].value == newvalue) { break; }
2807: i++;
2808: }
1.986 raeburn 2809: if (i == numauthchoices) {
1.32 matthew 2810: return;
2811: }
2812: current.radiovalue = newvalue;
2813: currentform.login[i].checked = true;
2814: return;
2815: }
2816: END
2817: return $result;
2818: }
2819:
1.1075.2.20 raeburn 2820: sub authform_authorwarning {
1.32 matthew 2821: my $result='';
1.144 matthew 2822: $result='<i>'.
2823: &mt('As a general rule, only authors or co-authors should be '.
2824: 'filesystem authenticated '.
2825: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2826: return $result;
2827: }
2828:
1.1075.2.20 raeburn 2829: sub authform_nochange {
1.32 matthew 2830: my %in = (
2831: formname => 'document.cu',
2832: kerb_def_dom => 'MSU.EDU',
2833: @_,
2834: );
1.1075.2.20 raeburn 2835: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2836: my $result;
1.1075.2.20 raeburn 2837: if (!$authnum) {
2838: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2839: } else {
2840: $result = '<label>'.&mt('[_1] Do not change login data',
2841: '<input type="radio" name="login" value="nochange" '.
2842: 'checked="checked" onclick="'.
1.281 albertel 2843: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2844: '</label>';
1.586 raeburn 2845: }
1.32 matthew 2846: return $result;
2847: }
2848:
1.591 raeburn 2849: sub authform_kerberos {
1.32 matthew 2850: my %in = (
2851: formname => 'document.cu',
2852: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2853: kerb_def_auth => 'krb4',
1.32 matthew 2854: @_,
2855: );
1.586 raeburn 2856: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117 raeburn 2857: $autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2858: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2859: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2860: $check5 = ' checked="checked"';
1.80 albertel 2861: } else {
1.772 bisitz 2862: $check4 = ' checked="checked"';
1.80 albertel 2863: }
1.1075.2.117 raeburn 2864: if ($in{'readonly'}) {
2865: $disabled = ' disabled="disabled"';
2866: }
1.165 raeburn 2867: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2868: if (defined($in{'curr_authtype'})) {
2869: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2870: $krbcheck = ' checked="checked"';
1.623 raeburn 2871: if (defined($in{'mode'})) {
2872: if ($in{'mode'} eq 'modifyuser') {
2873: $krbcheck = '';
2874: }
2875: }
1.591 raeburn 2876: if (defined($in{'curr_kerb_ver'})) {
2877: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2878: $check5 = ' checked="checked"';
1.591 raeburn 2879: $check4 = '';
2880: } else {
1.772 bisitz 2881: $check4 = ' checked="checked"';
1.591 raeburn 2882: $check5 = '';
2883: }
1.586 raeburn 2884: }
1.591 raeburn 2885: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2886: $krbarg = $in{'curr_autharg'};
2887: }
1.586 raeburn 2888: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2889: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2890: $result =
2891: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2892: $in{'curr_autharg'},$krbver);
2893: } else {
2894: $result =
2895: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2896: }
2897: return $result;
2898: }
2899: }
2900: } else {
2901: if ($authnum == 1) {
1.784 bisitz 2902: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2903: }
2904: }
1.586 raeburn 2905: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2906: return;
1.587 raeburn 2907: } elsif ($authtype eq '') {
1.591 raeburn 2908: if (defined($in{'mode'})) {
1.587 raeburn 2909: if ($in{'mode'} eq 'modifycourse') {
2910: if ($authnum == 1) {
1.1075.2.117 raeburn 2911: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 2912: }
2913: }
2914: }
1.586 raeburn 2915: }
2916: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2917: if ($authtype eq '') {
2918: $authtype = '<input type="radio" name="login" value="krb" '.
2919: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117 raeburn 2920: $krbcheck.$disabled.' />';
1.586 raeburn 2921: }
2922: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2923: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2924: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2925: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2926: $in{'curr_authtype'} eq 'krb4')) {
2927: $result .= &mt
1.144 matthew 2928: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2929: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2930: '<label>'.$authtype,
1.281 albertel 2931: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2932: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2933: 'onchange="'.$jscall.'"'.$disabled.' />',
2934: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
2935: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 2936: '</label>');
1.586 raeburn 2937: } elsif ($can_assign{'krb4'}) {
2938: $result .= &mt
2939: ('[_1] Kerberos authenticated with domain [_2] '.
2940: '[_3] Version 4 [_4]',
2941: '<label>'.$authtype,
2942: '</label><input type="text" size="10" name="krbarg" '.
2943: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2944: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2945: '<label><input type="hidden" name="krbver" value="4" />',
2946: '</label>');
2947: } elsif ($can_assign{'krb5'}) {
2948: $result .= &mt
2949: ('[_1] Kerberos authenticated with domain [_2] '.
2950: '[_3] Version 5 [_4]',
2951: '<label>'.$authtype,
2952: '</label><input type="text" size="10" name="krbarg" '.
2953: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2954: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2955: '<label><input type="hidden" name="krbver" value="5" />',
2956: '</label>');
2957: }
1.32 matthew 2958: return $result;
2959: }
2960:
1.1075.2.20 raeburn 2961: sub authform_internal {
1.586 raeburn 2962: my %in = (
1.32 matthew 2963: formname => 'document.cu',
2964: kerb_def_dom => 'MSU.EDU',
2965: @_,
2966: );
1.1075.2.117 raeburn 2967: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2968: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 2969: if ($in{'readonly'}) {
2970: $disabled = ' disabled="disabled"';
2971: }
1.591 raeburn 2972: if (defined($in{'curr_authtype'})) {
2973: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2974: if ($can_assign{'int'}) {
1.772 bisitz 2975: $intcheck = 'checked="checked" ';
1.623 raeburn 2976: if (defined($in{'mode'})) {
2977: if ($in{'mode'} eq 'modifyuser') {
2978: $intcheck = '';
2979: }
2980: }
1.591 raeburn 2981: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2982: $intarg = $in{'curr_autharg'};
2983: }
2984: } else {
2985: $result = &mt('Currently internally authenticated.');
2986: return $result;
1.165 raeburn 2987: }
2988: }
1.586 raeburn 2989: } else {
2990: if ($authnum == 1) {
1.784 bisitz 2991: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2992: }
2993: }
2994: if (!$can_assign{'int'}) {
2995: return;
1.587 raeburn 2996: } elsif ($authtype eq '') {
1.591 raeburn 2997: if (defined($in{'mode'})) {
1.587 raeburn 2998: if ($in{'mode'} eq 'modifycourse') {
2999: if ($authnum == 1) {
1.1075.2.117 raeburn 3000: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3001: }
3002: }
3003: }
1.165 raeburn 3004: }
1.586 raeburn 3005: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3006: if ($authtype eq '') {
3007: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117 raeburn 3008: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3009: }
1.605 bisitz 3010: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117 raeburn 3011: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3012: $result = &mt
1.144 matthew 3013: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3014: '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118 raeburn 3015: $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 3016: return $result;
3017: }
3018:
1.1075.2.20 raeburn 3019: sub authform_local {
1.32 matthew 3020: my %in = (
3021: formname => 'document.cu',
3022: kerb_def_dom => 'MSU.EDU',
3023: @_,
3024: );
1.1075.2.117 raeburn 3025: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3026: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3027: if ($in{'readonly'}) {
3028: $disabled = ' disabled="disabled"';
3029: }
1.591 raeburn 3030: if (defined($in{'curr_authtype'})) {
3031: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3032: if ($can_assign{'loc'}) {
1.772 bisitz 3033: $loccheck = 'checked="checked" ';
1.623 raeburn 3034: if (defined($in{'mode'})) {
3035: if ($in{'mode'} eq 'modifyuser') {
3036: $loccheck = '';
3037: }
3038: }
1.591 raeburn 3039: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3040: $locarg = $in{'curr_autharg'};
3041: }
3042: } else {
3043: $result = &mt('Currently using local (institutional) authentication.');
3044: return $result;
1.165 raeburn 3045: }
3046: }
1.586 raeburn 3047: } else {
3048: if ($authnum == 1) {
1.784 bisitz 3049: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3050: }
3051: }
3052: if (!$can_assign{'loc'}) {
3053: return;
1.587 raeburn 3054: } elsif ($authtype eq '') {
1.591 raeburn 3055: if (defined($in{'mode'})) {
1.587 raeburn 3056: if ($in{'mode'} eq 'modifycourse') {
3057: if ($authnum == 1) {
1.1075.2.117 raeburn 3058: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3059: }
3060: }
3061: }
1.165 raeburn 3062: }
1.586 raeburn 3063: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3064: if ($authtype eq '') {
3065: $authtype = '<input type="radio" name="login" value="loc" '.
3066: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3067: $jscall.'"'.$disabled.' />';
1.586 raeburn 3068: }
3069: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117 raeburn 3070: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3071: $result = &mt('[_1] Local Authentication with argument [_2]',
3072: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3073: return $result;
3074: }
3075:
1.1075.2.20 raeburn 3076: sub authform_filesystem {
1.32 matthew 3077: my %in = (
3078: formname => 'document.cu',
3079: kerb_def_dom => 'MSU.EDU',
3080: @_,
3081: );
1.1075.2.117 raeburn 3082: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3083: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3084: if ($in{'readonly'}) {
3085: $disabled = ' disabled="disabled"';
3086: }
1.591 raeburn 3087: if (defined($in{'curr_authtype'})) {
3088: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3089: if ($can_assign{'fsys'}) {
1.772 bisitz 3090: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3091: if (defined($in{'mode'})) {
3092: if ($in{'mode'} eq 'modifyuser') {
3093: $fsyscheck = '';
3094: }
3095: }
1.586 raeburn 3096: } else {
3097: $result = &mt('Currently Filesystem Authenticated.');
3098: return $result;
3099: }
3100: }
3101: } else {
3102: if ($authnum == 1) {
1.784 bisitz 3103: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3104: }
3105: }
3106: if (!$can_assign{'fsys'}) {
3107: return;
1.587 raeburn 3108: } elsif ($authtype eq '') {
1.591 raeburn 3109: if (defined($in{'mode'})) {
1.587 raeburn 3110: if ($in{'mode'} eq 'modifycourse') {
3111: if ($authnum == 1) {
1.1075.2.117 raeburn 3112: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3113: }
3114: }
3115: }
1.586 raeburn 3116: }
3117: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3118: if ($authtype eq '') {
3119: $authtype = '<input type="radio" name="login" value="fsys" '.
3120: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3121: $jscall.'"'.$disabled.' />';
1.586 raeburn 3122: }
3123: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
1.1075.2.117 raeburn 3124: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3125: $result = &mt
1.144 matthew 3126: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3127: '<label><input type="radio" name="login" value="fsys" '.
1.1075.2.117 raeburn 3128: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
1.605 bisitz 3129: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.1075.2.117 raeburn 3130: 'onchange="'.$jscall.'"'.$disabled.' />');
1.32 matthew 3131: return $result;
3132: }
3133:
1.586 raeburn 3134: sub get_assignable_auth {
3135: my ($dom) = @_;
3136: if ($dom eq '') {
3137: $dom = $env{'request.role.domain'};
3138: }
3139: my %can_assign = (
3140: krb4 => 1,
3141: krb5 => 1,
3142: int => 1,
3143: loc => 1,
3144: );
3145: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3146: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3147: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3148: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3149: my $context;
3150: if ($env{'request.role'} =~ /^au/) {
3151: $context = 'author';
1.1075.2.117 raeburn 3152: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3153: $context = 'domain';
3154: } elsif ($env{'request.course.id'}) {
3155: $context = 'course';
3156: }
3157: if ($context) {
3158: if (ref($authhash->{$context}) eq 'HASH') {
3159: %can_assign = %{$authhash->{$context}};
3160: }
3161: }
3162: }
3163: }
3164: my $authnum = 0;
3165: foreach my $key (keys(%can_assign)) {
3166: if ($can_assign{$key}) {
3167: $authnum ++;
3168: }
3169: }
3170: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3171: $authnum --;
3172: }
3173: return ($authnum,%can_assign);
3174: }
3175:
1.1075.2.137 raeburn 3176: sub check_passwd_rules {
3177: my ($domain,$plainpass) = @_;
3178: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3179: my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138 raeburn 3180: $min = $Apache::lonnet::passwdmin;
1.1075.2.137 raeburn 3181: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3182: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138 raeburn 3183: if ($passwdconf{'min'} > $min) {
3184: $min = $passwdconf{'min'};
3185: }
1.1075.2.137 raeburn 3186: }
3187: if ($passwdconf{'max'} =~ /^\d+$/) {
3188: $max = $passwdconf{'max'};
3189: }
3190: @chars = @{$passwdconf{'chars'}};
3191: }
3192: if (($min) && (length($plainpass) < $min)) {
3193: push(@brokerule,'min');
3194: }
3195: if (($max) && (length($plainpass) > $max)) {
3196: push(@brokerule,'max');
3197: }
3198: if (@chars) {
3199: my %rules;
3200: map { $rules{$_} = 1; } @chars;
3201: if ($rules{'uc'}) {
3202: unless ($plainpass =~ /[A-Z]/) {
3203: push(@brokerule,'uc');
3204: }
3205: }
3206: if ($rules{'lc'}) {
3207: unless ($plainpass =~ /[a-z]/) {
3208: push(@brokerule,'lc');
3209: }
3210: }
3211: if ($rules{'num'}) {
3212: unless ($plainpass =~ /\d/) {
3213: push(@brokerule,'num');
3214: }
3215: }
3216: if ($rules{'spec'}) {
3217: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3218: push(@brokerule,'spec');
3219: }
3220: }
3221: }
3222: if (@brokerule) {
3223: my %rulenames = &Apache::lonlocal::texthash(
3224: uc => 'At least one upper case letter',
3225: lc => 'At least one lower case letter',
3226: num => 'At least one number',
3227: spec => 'At least one non-alphanumeric',
3228: );
3229: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3230: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3231: $rulenames{'num'} .= ': 0123456789';
3232: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3233: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3234: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3235: $warning = &mt('Password did not satisfy the following:').'<ul>';
3236: foreach my $rule ('min','max','uc','ls','num','spec') {
3237: if (grep(/^$rule$/,@brokerule)) {
3238: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3239: }
3240: }
3241: $warning .= '</ul>';
3242: }
3243: if (wantarray) {
3244: return @brokerule;
3245: }
3246: return $warning;
3247: }
3248:
1.80 albertel 3249: ###############################################################
3250: ## Get Kerberos Defaults for Domain ##
3251: ###############################################################
3252: ##
3253: ## Returns default kerberos version and an associated argument
3254: ## as listed in file domain.tab. If not listed, provides
3255: ## appropriate default domain and kerberos version.
3256: ##
3257: #-------------------------------------------
3258:
3259: =pod
3260:
1.648 raeburn 3261: =item * &get_kerberos_defaults()
1.80 albertel 3262:
3263: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3264: version and domain. If not found, it defaults to version 4 and the
3265: domain of the server.
1.80 albertel 3266:
1.648 raeburn 3267: =over 4
3268:
1.80 albertel 3269: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3270:
1.648 raeburn 3271: =back
3272:
3273: =back
3274:
1.80 albertel 3275: =cut
3276:
3277: #-------------------------------------------
3278: sub get_kerberos_defaults {
3279: my $domain=shift;
1.641 raeburn 3280: my ($krbdef,$krbdefdom);
3281: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3282: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3283: $krbdef = $domdefaults{'auth_def'};
3284: $krbdefdom = $domdefaults{'auth_arg_def'};
3285: } else {
1.80 albertel 3286: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3287: my $krbdefdom=$1;
3288: $krbdefdom=~tr/a-z/A-Z/;
3289: $krbdef = "krb4";
3290: }
3291: return ($krbdef,$krbdefdom);
3292: }
1.112 bowersj2 3293:
1.32 matthew 3294:
1.46 matthew 3295: ###############################################################
3296: ## Thesaurus Functions ##
3297: ###############################################################
1.20 www 3298:
1.46 matthew 3299: =pod
1.20 www 3300:
1.112 bowersj2 3301: =head1 Thesaurus Functions
3302:
3303: =over 4
3304:
1.648 raeburn 3305: =item * &initialize_keywords()
1.46 matthew 3306:
3307: Initializes the package variable %Keywords if it is empty. Uses the
3308: package variable $thesaurus_db_file.
3309:
3310: =cut
3311:
3312: ###################################################
3313:
3314: sub initialize_keywords {
3315: return 1 if (scalar keys(%Keywords));
3316: # If we are here, %Keywords is empty, so fill it up
3317: # Make sure the file we need exists...
3318: if (! -e $thesaurus_db_file) {
3319: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3320: " failed because it does not exist");
3321: return 0;
3322: }
3323: # Set up the hash as a database
3324: my %thesaurus_db;
3325: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3326: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3327: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3328: $thesaurus_db_file);
3329: return 0;
3330: }
3331: # Get the average number of appearances of a word.
3332: my $avecount = $thesaurus_db{'average.count'};
3333: # Put keywords (those that appear > average) into %Keywords
3334: while (my ($word,$data)=each (%thesaurus_db)) {
3335: my ($count,undef) = split /:/,$data;
3336: $Keywords{$word}++ if ($count > $avecount);
3337: }
3338: untie %thesaurus_db;
3339: # Remove special values from %Keywords.
1.356 albertel 3340: foreach my $value ('total.count','average.count') {
3341: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3342: }
1.46 matthew 3343: return 1;
3344: }
3345:
3346: ###################################################
3347:
3348: =pod
3349:
1.648 raeburn 3350: =item * &keyword($word)
1.46 matthew 3351:
3352: Returns true if $word is a keyword. A keyword is a word that appears more
3353: than the average number of times in the thesaurus database. Calls
3354: &initialize_keywords
3355:
3356: =cut
3357:
3358: ###################################################
1.20 www 3359:
3360: sub keyword {
1.46 matthew 3361: return if (!&initialize_keywords());
3362: my $word=lc(shift());
3363: $word=~s/\W//g;
3364: return exists($Keywords{$word});
1.20 www 3365: }
1.46 matthew 3366:
3367: ###############################################################
3368:
3369: =pod
1.20 www 3370:
1.648 raeburn 3371: =item * &get_related_words()
1.46 matthew 3372:
1.160 matthew 3373: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3374: an array of words. If the keyword is not in the thesaurus, an empty array
3375: will be returned. The order of the words returned is determined by the
3376: database which holds them.
3377:
3378: Uses global $thesaurus_db_file.
3379:
1.1057 foxr 3380:
1.46 matthew 3381: =cut
3382:
3383: ###############################################################
3384: sub get_related_words {
3385: my $keyword = shift;
3386: my %thesaurus_db;
3387: if (! -e $thesaurus_db_file) {
3388: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3389: "failed because the file does not exist");
3390: return ();
3391: }
3392: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3393: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3394: return ();
3395: }
3396: my @Words=();
1.429 www 3397: my $count=0;
1.46 matthew 3398: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3399: # The first element is the number of times
3400: # the word appears. We do not need it now.
1.429 www 3401: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3402: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3403: my $threshold=$mostfrequentcount/10;
3404: foreach my $possibleword (@RelatedWords) {
3405: my ($word,$wordcount)=split(/\,/,$possibleword);
3406: if ($wordcount>$threshold) {
3407: push(@Words,$word);
3408: $count++;
3409: if ($count>10) { last; }
3410: }
1.20 www 3411: }
3412: }
1.46 matthew 3413: untie %thesaurus_db;
3414: return @Words;
1.14 harris41 3415: }
1.46 matthew 3416:
1.112 bowersj2 3417: =pod
3418:
3419: =back
3420:
3421: =cut
1.61 www 3422:
3423: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3424: =pod
3425:
1.112 bowersj2 3426: =head1 User Name Functions
3427:
3428: =over 4
3429:
1.648 raeburn 3430: =item * &plainname($uname,$udom,$first)
1.81 albertel 3431:
1.112 bowersj2 3432: Takes a users logon name and returns it as a string in
1.226 albertel 3433: "first middle last generation" form
3434: if $first is set to 'lastname' then it returns it as
3435: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3436:
3437: =cut
1.61 www 3438:
1.295 www 3439:
1.81 albertel 3440: ###############################################################
1.61 www 3441: sub plainname {
1.226 albertel 3442: my ($uname,$udom,$first)=@_;
1.537 albertel 3443: return if (!defined($uname) || !defined($udom));
1.295 www 3444: my %names=&getnames($uname,$udom);
1.226 albertel 3445: my $name=&Apache::lonnet::format_name($names{'firstname'},
3446: $names{'middlename'},
3447: $names{'lastname'},
3448: $names{'generation'},$first);
3449: $name=~s/^\s+//;
1.62 www 3450: $name=~s/\s+$//;
3451: $name=~s/\s+/ /g;
1.353 albertel 3452: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3453: return $name;
1.61 www 3454: }
1.66 www 3455:
3456: # -------------------------------------------------------------------- Nickname
1.81 albertel 3457: =pod
3458:
1.648 raeburn 3459: =item * &nickname($uname,$udom)
1.81 albertel 3460:
3461: Gets a users name and returns it as a string as
3462:
3463: ""nickname""
1.66 www 3464:
1.81 albertel 3465: if the user has a nickname or
3466:
3467: "first middle last generation"
3468:
3469: if the user does not
3470:
3471: =cut
1.66 www 3472:
3473: sub nickname {
3474: my ($uname,$udom)=@_;
1.537 albertel 3475: return if (!defined($uname) || !defined($udom));
1.295 www 3476: my %names=&getnames($uname,$udom);
1.68 albertel 3477: my $name=$names{'nickname'};
1.66 www 3478: if ($name) {
3479: $name='"'.$name.'"';
3480: } else {
3481: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3482: $names{'lastname'}.' '.$names{'generation'};
3483: $name=~s/\s+$//;
3484: $name=~s/\s+/ /g;
3485: }
3486: return $name;
3487: }
3488:
1.295 www 3489: sub getnames {
3490: my ($uname,$udom)=@_;
1.537 albertel 3491: return if (!defined($uname) || !defined($udom));
1.433 albertel 3492: if ($udom eq 'public' && $uname eq 'public') {
3493: return ('lastname' => &mt('Public'));
3494: }
1.295 www 3495: my $id=$uname.':'.$udom;
3496: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3497: if ($cached) {
3498: return %{$names};
3499: } else {
3500: my %loadnames=&Apache::lonnet::get('environment',
3501: ['firstname','middlename','lastname','generation','nickname'],
3502: $udom,$uname);
3503: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3504: return %loadnames;
3505: }
3506: }
1.61 www 3507:
1.542 raeburn 3508: # -------------------------------------------------------------------- getemails
1.648 raeburn 3509:
1.542 raeburn 3510: =pod
3511:
1.648 raeburn 3512: =item * &getemails($uname,$udom)
1.542 raeburn 3513:
3514: Gets a user's email information and returns it as a hash with keys:
3515: notification, critnotification, permanentemail
3516:
3517: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3518: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3519:
1.648 raeburn 3520:
1.542 raeburn 3521: =cut
3522:
1.648 raeburn 3523:
1.466 albertel 3524: sub getemails {
3525: my ($uname,$udom)=@_;
3526: if ($udom eq 'public' && $uname eq 'public') {
3527: return;
3528: }
1.467 www 3529: if (!$udom) { $udom=$env{'user.domain'}; }
3530: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3531: my $id=$uname.':'.$udom;
3532: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3533: if ($cached) {
3534: return %{$names};
3535: } else {
3536: my %loadnames=&Apache::lonnet::get('environment',
3537: ['notification','critnotification',
3538: 'permanentemail'],
3539: $udom,$uname);
3540: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3541: return %loadnames;
3542: }
3543: }
3544:
1.551 albertel 3545: sub flush_email_cache {
3546: my ($uname,$udom)=@_;
3547: if (!$udom) { $udom =$env{'user.domain'}; }
3548: if (!$uname) { $uname=$env{'user.name'}; }
3549: return if ($udom eq 'public' && $uname eq 'public');
3550: my $id=$uname.':'.$udom;
3551: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3552: }
3553:
1.728 raeburn 3554: # -------------------------------------------------------------------- getlangs
3555:
3556: =pod
3557:
3558: =item * &getlangs($uname,$udom)
3559:
3560: Gets a user's language preference and returns it as a hash with key:
3561: language.
3562:
3563: =cut
3564:
3565:
3566: sub getlangs {
3567: my ($uname,$udom) = @_;
3568: if (!$udom) { $udom =$env{'user.domain'}; }
3569: if (!$uname) { $uname=$env{'user.name'}; }
3570: my $id=$uname.':'.$udom;
3571: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3572: if ($cached) {
3573: return %{$langs};
3574: } else {
3575: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3576: $udom,$uname);
3577: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3578: return %loadlangs;
3579: }
3580: }
3581:
3582: sub flush_langs_cache {
3583: my ($uname,$udom)=@_;
3584: if (!$udom) { $udom =$env{'user.domain'}; }
3585: if (!$uname) { $uname=$env{'user.name'}; }
3586: return if ($udom eq 'public' && $uname eq 'public');
3587: my $id=$uname.':'.$udom;
3588: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3589: }
3590:
1.61 www 3591: # ------------------------------------------------------------------ Screenname
1.81 albertel 3592:
3593: =pod
3594:
1.648 raeburn 3595: =item * &screenname($uname,$udom)
1.81 albertel 3596:
3597: Gets a users screenname and returns it as a string
3598:
3599: =cut
1.61 www 3600:
3601: sub screenname {
3602: my ($uname,$udom)=@_;
1.258 albertel 3603: if ($uname eq $env{'user.name'} &&
3604: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3605: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3606: return $names{'screenname'};
1.62 www 3607: }
3608:
1.212 albertel 3609:
1.802 bisitz 3610: # ------------------------------------------------------------- Confirm Wrapper
3611: =pod
3612:
1.1075.2.42 raeburn 3613: =item * &confirmwrapper($message)
1.802 bisitz 3614:
3615: Wrap messages about completion of operation in box
3616:
3617: =cut
3618:
3619: sub confirmwrapper {
3620: my ($message)=@_;
3621: if ($message) {
3622: return "\n".'<div class="LC_confirm_box">'."\n"
3623: .$message."\n"
3624: .'</div>'."\n";
3625: } else {
3626: return $message;
3627: }
3628: }
3629:
1.62 www 3630: # ------------------------------------------------------------- Message Wrapper
3631:
3632: sub messagewrapper {
1.369 www 3633: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3634: return
1.441 albertel 3635: '<a href="/adm/email?compose=individual&'.
3636: 'recname='.$username.'&recdom='.$domain.
3637: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3638: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3639: }
1.802 bisitz 3640:
1.74 www 3641: # --------------------------------------------------------------- Notes Wrapper
3642:
3643: sub noteswrapper {
3644: my ($link,$un,$do)=@_;
3645: return
1.896 amueller 3646: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3647: }
1.802 bisitz 3648:
1.62 www 3649: # ------------------------------------------------------------- Aboutme Wrapper
3650:
3651: sub aboutmewrapper {
1.1070 raeburn 3652: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3653: if (!defined($username) && !defined($domain)) {
3654: return;
3655: }
1.1075.2.15 raeburn 3656: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3657: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3658: }
3659:
3660: # ------------------------------------------------------------ Syllabus Wrapper
3661:
3662: sub syllabuswrapper {
1.707 bisitz 3663: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3664: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3665: }
1.14 harris41 3666:
1.802 bisitz 3667: # -----------------------------------------------------------------------------
3668:
1.208 matthew 3669: sub track_student_link {
1.887 raeburn 3670: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3671: my $link ="/adm/trackstudent?";
1.208 matthew 3672: my $title = 'View recent activity';
3673: if (defined($sname) && $sname !~ /^\s*$/ &&
3674: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3675: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3676: $title .= ' of this student';
1.268 albertel 3677: }
1.208 matthew 3678: if (defined($target) && $target !~ /^\s*$/) {
3679: $target = qq{target="$target"};
3680: } else {
3681: $target = '';
3682: }
1.268 albertel 3683: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3684: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3685: $title = &mt($title);
3686: $linktext = &mt($linktext);
1.448 albertel 3687: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3688: &help_open_topic('View_recent_activity');
1.208 matthew 3689: }
3690:
1.781 raeburn 3691: sub slot_reservations_link {
3692: my ($linktext,$sname,$sdom,$target) = @_;
3693: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3694: my $title = 'View slot reservation history';
3695: if (defined($sname) && $sname !~ /^\s*$/ &&
3696: defined($sdom) && $sdom !~ /^\s*$/) {
3697: $link .= "&uname=$sname&udom=$sdom";
3698: $title .= ' of this student';
3699: }
3700: if (defined($target) && $target !~ /^\s*$/) {
3701: $target = qq{target="$target"};
3702: } else {
3703: $target = '';
3704: }
3705: $title = &mt($title);
3706: $linktext = &mt($linktext);
3707: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3708: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3709:
3710: }
3711:
1.508 www 3712: # ===================================================== Display a student photo
3713:
3714:
1.509 albertel 3715: sub student_image_tag {
1.508 www 3716: my ($domain,$user)=@_;
3717: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3718: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3719: return '<img src="'.$imgsrc.'" align="right" />';
3720: } else {
3721: return '';
3722: }
3723: }
3724:
1.112 bowersj2 3725: =pod
3726:
3727: =back
3728:
3729: =head1 Access .tab File Data
3730:
3731: =over 4
3732:
1.648 raeburn 3733: =item * &languageids()
1.112 bowersj2 3734:
3735: returns list of all language ids
3736:
3737: =cut
3738:
1.14 harris41 3739: sub languageids {
1.16 harris41 3740: return sort(keys(%language));
1.14 harris41 3741: }
3742:
1.112 bowersj2 3743: =pod
3744:
1.648 raeburn 3745: =item * &languagedescription()
1.112 bowersj2 3746:
3747: returns description of a specified language id
3748:
3749: =cut
3750:
1.14 harris41 3751: sub languagedescription {
1.125 www 3752: my $code=shift;
3753: return ($supported_language{$code}?'* ':'').
3754: $language{$code}.
1.126 www 3755: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3756: }
3757:
1.1048 foxr 3758: =pod
3759:
3760: =item * &plainlanguagedescription
3761:
3762: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3763: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3764:
3765: =cut
3766:
1.145 www 3767: sub plainlanguagedescription {
3768: my $code=shift;
3769: return $language{$code};
3770: }
3771:
1.1048 foxr 3772: =pod
3773:
3774: =item * &supportedlanguagecode
3775:
3776: Returns the supported language code (e.g. sptutf maps to pt) given a language
3777: code.
3778:
3779: =cut
3780:
1.145 www 3781: sub supportedlanguagecode {
3782: my $code=shift;
3783: return $supported_language{$code};
1.97 www 3784: }
3785:
1.112 bowersj2 3786: =pod
3787:
1.1048 foxr 3788: =item * &latexlanguage()
3789:
3790: Given a language key code returns the correspondnig language to use
3791: to select the correct hyphenation on LaTeX printouts. This is undef if there
3792: is no supported hyphenation for the language code.
3793:
3794: =cut
3795:
3796: sub latexlanguage {
3797: my $code = shift;
3798: return $latex_language{$code};
3799: }
3800:
3801: =pod
3802:
3803: =item * &latexhyphenation()
3804:
3805: Same as above but what's supplied is the language as it might be stored
3806: in the metadata.
3807:
3808: =cut
3809:
3810: sub latexhyphenation {
3811: my $key = shift;
3812: return $latex_language_bykey{$key};
3813: }
3814:
3815: =pod
3816:
1.648 raeburn 3817: =item * ©rightids()
1.112 bowersj2 3818:
3819: returns list of all copyrights
3820:
3821: =cut
3822:
3823: sub copyrightids {
3824: return sort(keys(%cprtag));
3825: }
3826:
3827: =pod
3828:
1.648 raeburn 3829: =item * ©rightdescription()
1.112 bowersj2 3830:
3831: returns description of a specified copyright id
3832:
3833: =cut
3834:
3835: sub copyrightdescription {
1.166 www 3836: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3837: }
1.197 matthew 3838:
3839: =pod
3840:
1.648 raeburn 3841: =item * &source_copyrightids()
1.192 taceyjo1 3842:
3843: returns list of all source copyrights
3844:
3845: =cut
3846:
3847: sub source_copyrightids {
3848: return sort(keys(%scprtag));
3849: }
3850:
3851: =pod
3852:
1.648 raeburn 3853: =item * &source_copyrightdescription()
1.192 taceyjo1 3854:
3855: returns description of a specified source copyright id
3856:
3857: =cut
3858:
3859: sub source_copyrightdescription {
3860: return &mt($scprtag{shift(@_)});
3861: }
1.112 bowersj2 3862:
3863: =pod
3864:
1.648 raeburn 3865: =item * &filecategories()
1.112 bowersj2 3866:
3867: returns list of all file categories
3868:
3869: =cut
3870:
3871: sub filecategories {
3872: return sort(keys(%category_extensions));
3873: }
3874:
3875: =pod
3876:
1.648 raeburn 3877: =item * &filecategorytypes()
1.112 bowersj2 3878:
3879: returns list of file types belonging to a given file
3880: category
3881:
3882: =cut
3883:
3884: sub filecategorytypes {
1.356 albertel 3885: my ($cat) = @_;
3886: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3887: }
3888:
3889: =pod
3890:
1.648 raeburn 3891: =item * &fileembstyle()
1.112 bowersj2 3892:
3893: returns embedding style for a specified file type
3894:
3895: =cut
3896:
3897: sub fileembstyle {
3898: return $fe{lc(shift(@_))};
1.169 www 3899: }
3900:
1.351 www 3901: sub filemimetype {
3902: return $fm{lc(shift(@_))};
3903: }
3904:
1.169 www 3905:
3906: sub filecategoryselect {
3907: my ($name,$value)=@_;
1.189 matthew 3908: return &select_form($value,$name,
1.970 raeburn 3909: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3910: }
3911:
3912: =pod
3913:
1.648 raeburn 3914: =item * &filedescription()
1.112 bowersj2 3915:
3916: returns description for a specified file type
3917:
3918: =cut
3919:
3920: sub filedescription {
1.188 matthew 3921: my $file_description = $fd{lc(shift())};
3922: $file_description =~ s:([\[\]]):~$1:g;
3923: return &mt($file_description);
1.112 bowersj2 3924: }
3925:
3926: =pod
3927:
1.648 raeburn 3928: =item * &filedescriptionex()
1.112 bowersj2 3929:
3930: returns description for a specified file type with
3931: extra formatting
3932:
3933: =cut
3934:
3935: sub filedescriptionex {
3936: my $ex=shift;
1.188 matthew 3937: my $file_description = $fd{lc($ex)};
3938: $file_description =~ s:([\[\]]):~$1:g;
3939: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3940: }
3941:
3942: # End of .tab access
3943: =pod
3944:
3945: =back
3946:
3947: =cut
3948:
3949: # ------------------------------------------------------------------ File Types
3950: sub fileextensions {
3951: return sort(keys(%fe));
3952: }
3953:
1.97 www 3954: # ----------------------------------------------------------- Display Languages
3955: # returns a hash with all desired display languages
3956: #
3957:
3958: sub display_languages {
3959: my %languages=();
1.695 raeburn 3960: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3961: $languages{$lang}=1;
1.97 www 3962: }
3963: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3964: if ($env{'form.displaylanguage'}) {
1.356 albertel 3965: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3966: $languages{$lang}=1;
1.97 www 3967: }
3968: }
3969: return %languages;
1.14 harris41 3970: }
3971:
1.582 albertel 3972: sub languages {
3973: my ($possible_langs) = @_;
1.695 raeburn 3974: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3975: if (!ref($possible_langs)) {
3976: if( wantarray ) {
3977: return @preferred_langs;
3978: } else {
3979: return $preferred_langs[0];
3980: }
3981: }
3982: my %possibilities = map { $_ => 1 } (@$possible_langs);
3983: my @preferred_possibilities;
3984: foreach my $preferred_lang (@preferred_langs) {
3985: if (exists($possibilities{$preferred_lang})) {
3986: push(@preferred_possibilities, $preferred_lang);
3987: }
3988: }
3989: if( wantarray ) {
3990: return @preferred_possibilities;
3991: }
3992: return $preferred_possibilities[0];
3993: }
3994:
1.742 raeburn 3995: sub user_lang {
3996: my ($touname,$toudom,$fromcid) = @_;
3997: my @userlangs;
3998: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3999: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4000: $env{'course.'.$fromcid.'.languages'}));
4001: } else {
4002: my %langhash = &getlangs($touname,$toudom);
4003: if ($langhash{'languages'} ne '') {
4004: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4005: } else {
4006: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4007: if ($domdefs{'lang_def'} ne '') {
4008: @userlangs = ($domdefs{'lang_def'});
4009: }
4010: }
4011: }
4012: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4013: my $user_lh = Apache::localize->get_handle(@languages);
4014: return $user_lh;
4015: }
4016:
4017:
1.112 bowersj2 4018: ###############################################################
4019: ## Student Answer Attempts ##
4020: ###############################################################
4021:
4022: =pod
4023:
4024: =head1 Alternate Problem Views
4025:
4026: =over 4
4027:
1.648 raeburn 4028: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 4029: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4030:
4031: Return string with previous attempt on problem. Arguments:
4032:
4033: =over 4
4034:
4035: =item * $symb: Problem, including path
4036:
4037: =item * $username: username of the desired student
4038:
4039: =item * $domain: domain of the desired student
1.14 harris41 4040:
1.112 bowersj2 4041: =item * $course: Course ID
1.14 harris41 4042:
1.112 bowersj2 4043: =item * $getattempt: Leave blank for all attempts, otherwise put
4044: something
1.14 harris41 4045:
1.112 bowersj2 4046: =item * $regexp: if string matches this regexp, the string will be
4047: sent to $gradesub
1.14 harris41 4048:
1.112 bowersj2 4049: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4050:
1.1075.2.86 raeburn 4051: =item * $usec: section of the desired student
4052:
4053: =item * $identifier: counter for student (multiple students one problem) or
4054: problem (one student; whole sequence).
4055:
1.112 bowersj2 4056: =back
1.14 harris41 4057:
1.112 bowersj2 4058: The output string is a table containing all desired attempts, if any.
1.16 harris41 4059:
1.112 bowersj2 4060: =cut
1.1 albertel 4061:
4062: sub get_previous_attempt {
1.1075.2.86 raeburn 4063: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4064: my $prevattempts='';
1.43 ng 4065: no strict 'refs';
1.1 albertel 4066: if ($symb) {
1.3 albertel 4067: my (%returnhash)=
4068: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4069: if ($returnhash{'version'}) {
4070: my %lasthash=();
4071: my $version;
4072: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 4073: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4074: if ($key =~ /\.rawrndseed$/) {
4075: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4076: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4077: } else {
4078: $lasthash{$key}=$returnhash{$version.':'.$key};
4079: }
1.19 harris41 4080: }
1.1 albertel 4081: }
1.596 albertel 4082: $prevattempts=&start_data_table().&start_data_table_header_row();
4083: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 4084: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4085: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4086: foreach my $key (sort(keys(%lasthash))) {
4087: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4088: if ($#parts > 0) {
1.31 albertel 4089: my $data=$parts[-1];
1.989 raeburn 4090: next if ($data eq 'foilorder');
1.31 albertel 4091: pop(@parts);
1.1010 www 4092: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4093: if ($data eq 'type') {
4094: unless ($showsurv) {
4095: my $id = join(',',@parts);
4096: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4097: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4098: $lasthidden{$ign.'.'.$id} = 1;
4099: }
1.945 raeburn 4100: }
1.1075.2.86 raeburn 4101: if ($identifier ne '') {
4102: my $id = join(',',@parts);
4103: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4104: $domain,$username,$usec,undef,$course) =~ /^no/) {
4105: $hidestatus{$ign.'.'.$id} = 1;
4106: }
4107: }
4108: } elsif ($data eq 'regrader') {
4109: if (($identifier ne '') && (@parts)) {
4110: my $id = join(',',@parts);
4111: $regraded{$ign.'.'.$id} = 1;
4112: }
1.1010 www 4113: }
1.31 albertel 4114: } else {
1.41 ng 4115: if ($#parts == 0) {
4116: $prevattempts.='<th>'.$parts[0].'</th>';
4117: } else {
4118: $prevattempts.='<th>'.$ign.'</th>';
4119: }
1.31 albertel 4120: }
1.16 harris41 4121: }
1.596 albertel 4122: $prevattempts.=&end_data_table_header_row();
1.40 ng 4123: if ($getattempt eq '') {
1.1075.2.86 raeburn 4124: my (%solved,%resets,%probstatus);
4125: if (($identifier ne '') && (keys(%regraded) > 0)) {
4126: for ($version=1;$version<=$returnhash{'version'};$version++) {
4127: foreach my $id (keys(%regraded)) {
4128: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4129: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4130: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4131: push(@{$resets{$id}},$version);
4132: }
4133: }
4134: }
4135: }
1.40 ng 4136: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 4137: my (@hidden,@unsolved);
1.945 raeburn 4138: if (%typeparts) {
4139: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 4140: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4141: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4142: push(@hidden,$id);
1.1075.2.86 raeburn 4143: } elsif ($identifier ne '') {
4144: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4145: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4146: ($hidestatus{$id})) {
4147: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
4148: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4149: push(@{$solved{$id}},$version);
4150: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4151: (ref($solved{$id}) eq 'ARRAY')) {
4152: my $skip;
4153: if (ref($resets{$id}) eq 'ARRAY') {
4154: foreach my $reset (@{$resets{$id}}) {
4155: if ($reset > $solved{$id}[-1]) {
4156: $skip=1;
4157: last;
4158: }
4159: }
4160: }
4161: unless ($skip) {
4162: my ($ign,$partslist) = split(/\./,$id,2);
4163: push(@unsolved,$partslist);
4164: }
4165: }
4166: }
1.945 raeburn 4167: }
4168: }
4169: }
4170: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 4171: '<td>'.&mt('Transaction [_1]',$version);
4172: if (@unsolved) {
4173: $prevattempts .= '<span class="LC_nobreak"><label>'.
4174: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4175: &mt('Hide').'</label></span>';
4176: }
4177: $prevattempts .= '</td>';
1.945 raeburn 4178: if (@hidden) {
4179: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4180: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4181: my $hide;
4182: foreach my $id (@hidden) {
4183: if ($key =~ /^\Q$id\E/) {
4184: $hide = 1;
4185: last;
4186: }
4187: }
4188: if ($hide) {
4189: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4190: if (($data eq 'award') || ($data eq 'awarddetail')) {
4191: my $value = &format_previous_attempt_value($key,
4192: $returnhash{$version.':'.$key});
4193: $prevattempts.='<td>'.$value.' </td>';
4194: } else {
4195: $prevattempts.='<td> </td>';
4196: }
4197: } else {
4198: if ($key =~ /\./) {
1.1075.2.91 raeburn 4199: my $value = $returnhash{$version.':'.$key};
4200: if ($key =~ /\.rndseed$/) {
4201: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4202: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4203: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4204: }
4205: }
4206: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4207: ' </td>';
1.945 raeburn 4208: } else {
4209: $prevattempts.='<td> </td>';
4210: }
4211: }
4212: }
4213: } else {
4214: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4215: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 4216: my $value = $returnhash{$version.':'.$key};
4217: if ($key =~ /\.rndseed$/) {
4218: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4219: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4220: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4221: }
4222: }
4223: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4224: ' </td>';
1.945 raeburn 4225: }
4226: }
4227: $prevattempts.=&end_data_table_row();
1.40 ng 4228: }
1.1 albertel 4229: }
1.945 raeburn 4230: my @currhidden = keys(%lasthidden);
1.596 albertel 4231: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4232: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4233: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4234: if (%typeparts) {
4235: my $hidden;
4236: foreach my $id (@currhidden) {
4237: if ($key =~ /^\Q$id\E/) {
4238: $hidden = 1;
4239: last;
4240: }
4241: }
4242: if ($hidden) {
4243: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4244: if (($data eq 'award') || ($data eq 'awarddetail')) {
4245: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4246: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4247: $value = &$gradesub($value);
4248: }
4249: $prevattempts.='<td>'.$value.' </td>';
4250: } else {
4251: $prevattempts.='<td> </td>';
4252: }
4253: } else {
4254: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4255: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4256: $value = &$gradesub($value);
4257: }
4258: $prevattempts.='<td>'.$value.' </td>';
4259: }
4260: } else {
4261: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4262: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4263: $value = &$gradesub($value);
4264: }
4265: $prevattempts.='<td>'.$value.' </td>';
4266: }
1.16 harris41 4267: }
1.596 albertel 4268: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4269: } else {
1.596 albertel 4270: $prevattempts=
4271: &start_data_table().&start_data_table_row().
4272: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4273: &end_data_table_row().&end_data_table();
1.1 albertel 4274: }
4275: } else {
1.596 albertel 4276: $prevattempts=
4277: &start_data_table().&start_data_table_row().
4278: '<td>'.&mt('No data.').'</td>'.
4279: &end_data_table_row().&end_data_table();
1.1 albertel 4280: }
1.10 albertel 4281: }
4282:
1.581 albertel 4283: sub format_previous_attempt_value {
4284: my ($key,$value) = @_;
1.1011 www 4285: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 4286: $value = &Apache::lonlocal::locallocaltime($value);
4287: } elsif (ref($value) eq 'ARRAY') {
4288: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 4289: } elsif ($key =~ /answerstring$/) {
4290: my %answers = &Apache::lonnet::str2hash($value);
4291: my @anskeys = sort(keys(%answers));
4292: if (@anskeys == 1) {
4293: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4294: if ($answer =~ m{\0}) {
4295: $answer =~ s{\0}{,}g;
1.988 raeburn 4296: }
4297: my $tag_internal_answer_name = 'INTERNAL';
4298: if ($anskeys[0] eq $tag_internal_answer_name) {
4299: $value = $answer;
4300: } else {
4301: $value = $anskeys[0].'='.$answer;
4302: }
4303: } else {
4304: foreach my $ans (@anskeys) {
4305: my $answer = $answers{$ans};
1.1001 raeburn 4306: if ($answer =~ m{\0}) {
4307: $answer =~ s{\0}{,}g;
1.988 raeburn 4308: }
4309: $value .= $ans.'='.$answer.'<br />';;
4310: }
4311: }
1.581 albertel 4312: } else {
4313: $value = &unescape($value);
4314: }
4315: return $value;
4316: }
4317:
4318:
1.107 albertel 4319: sub relative_to_absolute {
4320: my ($url,$output)=@_;
4321: my $parser=HTML::TokeParser->new(\$output);
4322: my $token;
4323: my $thisdir=$url;
4324: my @rlinks=();
4325: while ($token=$parser->get_token) {
4326: if ($token->[0] eq 'S') {
4327: if ($token->[1] eq 'a') {
4328: if ($token->[2]->{'href'}) {
4329: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4330: }
4331: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4332: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4333: } elsif ($token->[1] eq 'base') {
4334: $thisdir=$token->[2]->{'href'};
4335: }
4336: }
4337: }
4338: $thisdir=~s-/[^/]*$--;
1.356 albertel 4339: foreach my $link (@rlinks) {
1.726 raeburn 4340: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4341: ($link=~/^\//) ||
4342: ($link=~/^javascript:/i) ||
4343: ($link=~/^mailto:/i) ||
4344: ($link=~/^\#/)) {
4345: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4346: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4347: }
4348: }
4349: # -------------------------------------------------- Deal with Applet codebases
4350: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4351: return $output;
4352: }
4353:
1.112 bowersj2 4354: =pod
4355:
1.648 raeburn 4356: =item * &get_student_view()
1.112 bowersj2 4357:
4358: show a snapshot of what student was looking at
4359:
4360: =cut
4361:
1.10 albertel 4362: sub get_student_view {
1.186 albertel 4363: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4364: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4365: my (%form);
1.10 albertel 4366: my @elements=('symb','courseid','domain','username');
4367: foreach my $element (@elements) {
1.186 albertel 4368: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4369: }
1.186 albertel 4370: if (defined($moreenv)) {
4371: %form=(%form,%{$moreenv});
4372: }
1.236 albertel 4373: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4374: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4375: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4376: $userview=~s/\<body[^\>]*\>//gi;
4377: $userview=~s/\<\/body\>//gi;
4378: $userview=~s/\<html\>//gi;
4379: $userview=~s/\<\/html\>//gi;
4380: $userview=~s/\<head\>//gi;
4381: $userview=~s/\<\/head\>//gi;
4382: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4383: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4384: if (wantarray) {
4385: return ($userview,$response);
4386: } else {
4387: return $userview;
4388: }
4389: }
4390:
4391: sub get_student_view_with_retries {
4392: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4393:
4394: my $ok = 0; # True if we got a good response.
4395: my $content;
4396: my $response;
4397:
4398: # Try to get the student_view done. within the retries count:
4399:
4400: do {
4401: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4402: $ok = $response->is_success;
4403: if (!$ok) {
4404: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4405: }
4406: $retries--;
4407: } while (!$ok && ($retries > 0));
4408:
4409: if (!$ok) {
4410: $content = ''; # On error return an empty content.
4411: }
1.651 www 4412: if (wantarray) {
4413: return ($content, $response);
4414: } else {
4415: return $content;
4416: }
1.11 albertel 4417: }
4418:
1.112 bowersj2 4419: =pod
4420:
1.648 raeburn 4421: =item * &get_student_answers()
1.112 bowersj2 4422:
4423: show a snapshot of how student was answering problem
4424:
4425: =cut
4426:
1.11 albertel 4427: sub get_student_answers {
1.100 sakharuk 4428: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4429: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4430: my (%moreenv);
1.11 albertel 4431: my @elements=('symb','courseid','domain','username');
4432: foreach my $element (@elements) {
1.186 albertel 4433: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4434: }
1.186 albertel 4435: $moreenv{'grade_target'}='answer';
4436: %moreenv=(%form,%moreenv);
1.497 raeburn 4437: $feedurl = &Apache::lonnet::clutter($feedurl);
4438: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4439: return $userview;
1.1 albertel 4440: }
1.116 albertel 4441:
4442: =pod
4443:
4444: =item * &submlink()
4445:
1.242 albertel 4446: Inputs: $text $uname $udom $symb $target
1.116 albertel 4447:
4448: Returns: A link to grades.pm such as to see the SUBM view of a student
4449:
4450: =cut
4451:
4452: ###############################################
4453: sub submlink {
1.242 albertel 4454: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4455: if (!($uname && $udom)) {
4456: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4457: &Apache::lonnet::whichuser($symb);
1.116 albertel 4458: if (!$symb) { $symb=$cursymb; }
4459: }
1.254 matthew 4460: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4461: $symb=&escape($symb);
1.960 bisitz 4462: if ($target) { $target=" target=\"$target\""; }
4463: return
4464: '<a href="/adm/grades?command=submission'.
4465: '&symb='.$symb.
4466: '&student='.$uname.
4467: '&userdom='.$udom.'"'.
4468: $target.'>'.$text.'</a>';
1.242 albertel 4469: }
4470: ##############################################
4471:
4472: =pod
4473:
4474: =item * &pgrdlink()
4475:
4476: Inputs: $text $uname $udom $symb $target
4477:
4478: Returns: A link to grades.pm such as to see the PGRD view of a student
4479:
4480: =cut
4481:
4482: ###############################################
4483: sub pgrdlink {
4484: my $link=&submlink(@_);
4485: $link=~s/(&command=submission)/$1&showgrading=yes/;
4486: return $link;
4487: }
4488: ##############################################
4489:
4490: =pod
4491:
4492: =item * &pprmlink()
4493:
4494: Inputs: $text $uname $udom $symb $target
4495:
4496: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4497: student and a specific resource
1.242 albertel 4498:
4499: =cut
4500:
4501: ###############################################
4502: sub pprmlink {
4503: my ($text,$uname,$udom,$symb,$target)=@_;
4504: if (!($uname && $udom)) {
4505: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4506: &Apache::lonnet::whichuser($symb);
1.242 albertel 4507: if (!$symb) { $symb=$cursymb; }
4508: }
1.254 matthew 4509: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4510: $symb=&escape($symb);
1.242 albertel 4511: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4512: return '<a href="/adm/parmset?command=set&'.
4513: 'symb='.$symb.'&uname='.$uname.
4514: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4515: }
4516: ##############################################
1.37 matthew 4517:
1.112 bowersj2 4518: =pod
4519:
4520: =back
4521:
4522: =cut
4523:
1.37 matthew 4524: ###############################################
1.51 www 4525:
4526:
4527: sub timehash {
1.687 raeburn 4528: my ($thistime) = @_;
4529: my $timezone = &Apache::lonlocal::gettimezone();
4530: my $dt = DateTime->from_epoch(epoch => $thistime)
4531: ->set_time_zone($timezone);
4532: my $wday = $dt->day_of_week();
4533: if ($wday == 7) { $wday = 0; }
4534: return ( 'second' => $dt->second(),
4535: 'minute' => $dt->minute(),
4536: 'hour' => $dt->hour(),
4537: 'day' => $dt->day_of_month(),
4538: 'month' => $dt->month(),
4539: 'year' => $dt->year(),
4540: 'weekday' => $wday,
4541: 'dayyear' => $dt->day_of_year(),
4542: 'dlsav' => $dt->is_dst() );
1.51 www 4543: }
4544:
1.370 www 4545: sub utc_string {
4546: my ($date)=@_;
1.371 www 4547: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4548: }
4549:
1.51 www 4550: sub maketime {
4551: my %th=@_;
1.687 raeburn 4552: my ($epoch_time,$timezone,$dt);
4553: $timezone = &Apache::lonlocal::gettimezone();
4554: eval {
4555: $dt = DateTime->new( year => $th{'year'},
4556: month => $th{'month'},
4557: day => $th{'day'},
4558: hour => $th{'hour'},
4559: minute => $th{'minute'},
4560: second => $th{'second'},
4561: time_zone => $timezone,
4562: );
4563: };
4564: if (!$@) {
4565: $epoch_time = $dt->epoch;
4566: if ($epoch_time) {
4567: return $epoch_time;
4568: }
4569: }
1.51 www 4570: return POSIX::mktime(
4571: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4572: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4573: }
4574:
4575: #########################################
1.51 www 4576:
4577: sub findallcourses {
1.482 raeburn 4578: my ($roles,$uname,$udom) = @_;
1.355 albertel 4579: my %roles;
4580: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4581: my %courses;
1.51 www 4582: my $now=time;
1.482 raeburn 4583: if (!defined($uname)) {
4584: $uname = $env{'user.name'};
4585: }
4586: if (!defined($udom)) {
4587: $udom = $env{'user.domain'};
4588: }
4589: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4590: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4591: if (!%roles) {
4592: %roles = (
4593: cc => 1,
1.907 raeburn 4594: co => 1,
1.482 raeburn 4595: in => 1,
4596: ep => 1,
4597: ta => 1,
4598: cr => 1,
4599: st => 1,
4600: );
4601: }
4602: foreach my $entry (keys(%roleshash)) {
4603: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4604: if ($trole =~ /^cr/) {
4605: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4606: } else {
4607: next if (!exists($roles{$trole}));
4608: }
4609: if ($tend) {
4610: next if ($tend < $now);
4611: }
4612: if ($tstart) {
4613: next if ($tstart > $now);
4614: }
1.1058 raeburn 4615: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4616: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4617: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4618: if ($secpart eq '') {
4619: ($cnum,$role) = split(/_/,$cnumpart);
4620: $sec = 'none';
1.1058 raeburn 4621: $value .= $cnum.'/';
1.482 raeburn 4622: } else {
4623: $cnum = $cnumpart;
4624: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4625: $value .= $cnum.'/'.$sec;
4626: }
4627: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4628: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4629: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4630: }
4631: } else {
4632: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4633: }
1.482 raeburn 4634: }
4635: } else {
4636: foreach my $key (keys(%env)) {
1.483 albertel 4637: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4638: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4639: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4640: next if ($role eq 'ca' || $role eq 'aa');
4641: next if (%roles && !exists($roles{$role}));
4642: my ($starttime,$endtime)=split(/\./,$env{$key});
4643: my $active=1;
4644: if ($starttime) {
4645: if ($now<$starttime) { $active=0; }
4646: }
4647: if ($endtime) {
4648: if ($now>$endtime) { $active=0; }
4649: }
4650: if ($active) {
1.1058 raeburn 4651: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4652: if ($sec eq '') {
4653: $sec = 'none';
1.1058 raeburn 4654: } else {
4655: $value .= $sec;
4656: }
4657: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4658: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4659: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4660: }
4661: } else {
4662: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4663: }
1.474 raeburn 4664: }
4665: }
1.51 www 4666: }
4667: }
1.474 raeburn 4668: return %courses;
1.51 www 4669: }
1.37 matthew 4670:
1.54 www 4671: ###############################################
1.474 raeburn 4672:
4673: sub blockcheck {
1.1075.2.73 raeburn 4674: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4675:
1.1075.2.73 raeburn 4676: if (defined($udom) && defined($uname)) {
4677: # If uname and udom are for a course, check for blocks in the course.
4678: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4679: my ($startblock,$endblock,$triggerblock) =
4680: &get_blocks($setters,$activity,$udom,$uname,$url);
4681: return ($startblock,$endblock,$triggerblock);
4682: }
4683: } else {
1.490 raeburn 4684: $udom = $env{'user.domain'};
4685: $uname = $env{'user.name'};
4686: }
4687:
1.502 raeburn 4688: my $startblock = 0;
4689: my $endblock = 0;
1.1062 raeburn 4690: my $triggerblock = '';
1.482 raeburn 4691: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4692:
1.490 raeburn 4693: # If uname is for a user, and activity is course-specific, i.e.,
4694: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4695:
1.490 raeburn 4696: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4697: $activity eq 'groups' || $activity eq 'printout') &&
4698: ($env{'request.course.id'})) {
1.490 raeburn 4699: foreach my $key (keys(%live_courses)) {
4700: if ($key ne $env{'request.course.id'}) {
4701: delete($live_courses{$key});
4702: }
4703: }
4704: }
4705:
4706: my $otheruser = 0;
4707: my %own_courses;
4708: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4709: # Resource belongs to user other than current user.
4710: $otheruser = 1;
4711: # Gather courses for current user
4712: %own_courses =
4713: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4714: }
4715:
4716: # Gather active course roles - course coordinator, instructor,
4717: # exam proctor, ta, student, or custom role.
1.474 raeburn 4718:
4719: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4720: my ($cdom,$cnum);
4721: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4722: $cdom = $env{'course.'.$course.'.domain'};
4723: $cnum = $env{'course.'.$course.'.num'};
4724: } else {
1.490 raeburn 4725: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4726: }
4727: my $no_ownblock = 0;
4728: my $no_userblock = 0;
1.533 raeburn 4729: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4730: # Check if current user has 'evb' priv for this
4731: if (defined($own_courses{$course})) {
4732: foreach my $sec (keys(%{$own_courses{$course}})) {
4733: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4734: if ($sec ne 'none') {
4735: $checkrole .= '/'.$sec;
4736: }
4737: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4738: $no_ownblock = 1;
4739: last;
4740: }
4741: }
4742: }
4743: # if they have 'evb' priv and are currently not playing student
4744: next if (($no_ownblock) &&
4745: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4746: }
1.474 raeburn 4747: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4748: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4749: if ($sec ne 'none') {
1.482 raeburn 4750: $checkrole .= '/'.$sec;
1.474 raeburn 4751: }
1.490 raeburn 4752: if ($otheruser) {
4753: # Resource belongs to user other than current user.
4754: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4755: my (%allroles,%userroles);
4756: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4757: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4758: my ($trole,$tdom,$tnum,$tsec);
4759: if ($entry =~ /^cr/) {
4760: ($trole,$tdom,$tnum,$tsec) =
4761: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4762: } else {
4763: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4764: }
4765: my ($spec,$area,$trest);
4766: $area = '/'.$tdom.'/'.$tnum;
4767: $trest = $tnum;
4768: if ($tsec ne '') {
4769: $area .= '/'.$tsec;
4770: $trest .= '/'.$tsec;
4771: }
4772: $spec = $trole.'.'.$area;
4773: if ($trole =~ /^cr/) {
4774: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4775: $tdom,$spec,$trest,$area);
4776: } else {
4777: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4778: $tdom,$spec,$trest,$area);
4779: }
4780: }
1.1075.2.124 raeburn 4781: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 4782: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4783: if ($1) {
4784: $no_userblock = 1;
4785: last;
4786: }
1.486 raeburn 4787: }
4788: }
1.490 raeburn 4789: } else {
4790: # Resource belongs to current user
4791: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4792: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4793: $no_ownblock = 1;
4794: last;
4795: }
1.474 raeburn 4796: }
4797: }
4798: # if they have the evb priv and are currently not playing student
1.482 raeburn 4799: next if (($no_ownblock) &&
1.491 albertel 4800: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4801: next if ($no_userblock);
1.474 raeburn 4802:
1.1075.2.128 raeburn 4803: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 4804: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4805:
1.1062 raeburn 4806: my ($start,$end,$trigger) =
4807: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4808: if (($start != 0) &&
4809: (($startblock == 0) || ($startblock > $start))) {
4810: $startblock = $start;
1.1062 raeburn 4811: if ($trigger ne '') {
4812: $triggerblock = $trigger;
4813: }
1.502 raeburn 4814: }
4815: if (($end != 0) &&
4816: (($endblock == 0) || ($endblock < $end))) {
4817: $endblock = $end;
1.1062 raeburn 4818: if ($trigger ne '') {
4819: $triggerblock = $trigger;
4820: }
1.502 raeburn 4821: }
1.490 raeburn 4822: }
1.1062 raeburn 4823: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4824: }
4825:
4826: sub get_blocks {
1.1062 raeburn 4827: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4828: my $startblock = 0;
4829: my $endblock = 0;
1.1062 raeburn 4830: my $triggerblock = '';
1.490 raeburn 4831: my $course = $cdom.'_'.$cnum;
4832: $setters->{$course} = {};
4833: $setters->{$course}{'staff'} = [];
4834: $setters->{$course}{'times'} = [];
1.1062 raeburn 4835: $setters->{$course}{'triggers'} = [];
4836: my (@blockers,%triggered);
4837: my $now = time;
4838: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4839: if ($activity eq 'docs') {
4840: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4841: foreach my $block (@blockers) {
4842: if ($block =~ /^firstaccess____(.+)$/) {
4843: my $item = $1;
4844: my $type = 'map';
4845: my $timersymb = $item;
4846: if ($item eq 'course') {
4847: $type = 'course';
4848: } elsif ($item =~ /___\d+___/) {
4849: $type = 'resource';
4850: } else {
4851: $timersymb = &Apache::lonnet::symbread($item);
4852: }
4853: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4854: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4855: $triggered{$block} = {
4856: start => $start,
4857: end => $end,
4858: type => $type,
4859: };
4860: }
4861: }
4862: } else {
4863: foreach my $block (keys(%commblocks)) {
4864: if ($block =~ m/^(\d+)____(\d+)$/) {
4865: my ($start,$end) = ($1,$2);
4866: if ($start <= time && $end >= time) {
4867: if (ref($commblocks{$block}) eq 'HASH') {
4868: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4869: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4870: unless(grep(/^\Q$block\E$/,@blockers)) {
4871: push(@blockers,$block);
4872: }
4873: }
4874: }
4875: }
4876: }
4877: } elsif ($block =~ /^firstaccess____(.+)$/) {
4878: my $item = $1;
4879: my $timersymb = $item;
4880: my $type = 'map';
4881: if ($item eq 'course') {
4882: $type = 'course';
4883: } elsif ($item =~ /___\d+___/) {
4884: $type = 'resource';
4885: } else {
4886: $timersymb = &Apache::lonnet::symbread($item);
4887: }
4888: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4889: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4890: if ($start && $end) {
4891: if (($start <= time) && ($end >= time)) {
4892: unless (grep(/^\Q$block\E$/,@blockers)) {
4893: push(@blockers,$block);
4894: $triggered{$block} = {
4895: start => $start,
4896: end => $end,
4897: type => $type,
4898: };
4899: }
4900: }
1.490 raeburn 4901: }
1.1062 raeburn 4902: }
4903: }
4904: }
4905: foreach my $blocker (@blockers) {
4906: my ($staff_name,$staff_dom,$title,$blocks) =
4907: &parse_block_record($commblocks{$blocker});
4908: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4909: my ($start,$end,$triggertype);
4910: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4911: ($start,$end) = ($1,$2);
4912: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4913: $start = $triggered{$blocker}{'start'};
4914: $end = $triggered{$blocker}{'end'};
4915: $triggertype = $triggered{$blocker}{'type'};
4916: }
4917: if ($start) {
4918: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4919: if ($triggertype) {
4920: push(@{$$setters{$course}{'triggers'}},$triggertype);
4921: } else {
4922: push(@{$$setters{$course}{'triggers'}},0);
4923: }
4924: if ( ($startblock == 0) || ($startblock > $start) ) {
4925: $startblock = $start;
4926: if ($triggertype) {
4927: $triggerblock = $blocker;
1.474 raeburn 4928: }
4929: }
1.1062 raeburn 4930: if ( ($endblock == 0) || ($endblock < $end) ) {
4931: $endblock = $end;
4932: if ($triggertype) {
4933: $triggerblock = $blocker;
4934: }
4935: }
1.474 raeburn 4936: }
4937: }
1.1062 raeburn 4938: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4939: }
4940:
4941: sub parse_block_record {
4942: my ($record) = @_;
4943: my ($setuname,$setudom,$title,$blocks);
4944: if (ref($record) eq 'HASH') {
4945: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4946: $title = &unescape($record->{'event'});
4947: $blocks = $record->{'blocks'};
4948: } else {
4949: my @data = split(/:/,$record,3);
4950: if (scalar(@data) eq 2) {
4951: $title = $data[1];
4952: ($setuname,$setudom) = split(/@/,$data[0]);
4953: } else {
4954: ($setuname,$setudom,$title) = @data;
4955: }
4956: $blocks = { 'com' => 'on' };
4957: }
4958: return ($setuname,$setudom,$title,$blocks);
4959: }
4960:
1.854 kalberla 4961: sub blocking_status {
1.1075.2.73 raeburn 4962: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4963: my %setters;
1.890 droeschl 4964:
1.1061 raeburn 4965: # check for active blocking
1.1062 raeburn 4966: my ($startblock,$endblock,$triggerblock) =
1.1075.2.73 raeburn 4967: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4968: my $blocked = 0;
4969: if ($startblock && $endblock) {
4970: $blocked = 1;
4971: }
1.890 droeschl 4972:
1.1061 raeburn 4973: # caller just wants to know whether a block is active
4974: if (!wantarray) { return $blocked; }
4975:
4976: # build a link to a popup window containing the details
4977: my $querystring = "?activity=$activity";
4978: # $uname and $udom decide whose portfolio the user is trying to look at
1.1075.2.97 raeburn 4979: if (($activity eq 'port') || ($activity eq 'passwd')) {
4980: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
4981: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 4982: } elsif ($activity eq 'docs') {
4983: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4984: }
1.1061 raeburn 4985:
4986: my $output .= <<'END_MYBLOCK';
4987: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4988: var options = "width=" + w + ",height=" + h + ",";
4989: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4990: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4991: var newWin = window.open(url, wdwName, options);
4992: newWin.focus();
4993: }
1.890 droeschl 4994: END_MYBLOCK
1.854 kalberla 4995:
1.1061 raeburn 4996: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4997:
1.1061 raeburn 4998: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4999: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 5000: my $class = 'LC_comblock';
1.1062 raeburn 5001: if ($activity eq 'docs') {
5002: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 5003: $class = '';
1.1063 raeburn 5004: } elsif ($activity eq 'printout') {
5005: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 5006: } elsif ($activity eq 'passwd') {
5007: $text = &mt('Password Changing Blocked');
1.1062 raeburn 5008: }
1.1061 raeburn 5009: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 5010: <div class='$class'>
1.869 kalberla 5011: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5012: title='$text'>
5013: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5014: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5015: title='$text'>$text</a>
1.867 kalberla 5016: </div>
5017:
5018: END_BLOCK
1.474 raeburn 5019:
1.1061 raeburn 5020: return ($blocked, $output);
1.854 kalberla 5021: }
1.490 raeburn 5022:
1.60 matthew 5023: ###############################################
5024:
1.682 raeburn 5025: sub check_ip_acc {
1.1075.2.105 raeburn 5026: my ($acc,$clientip)=@_;
1.682 raeburn 5027: &Apache::lonxml::debug("acc is $acc");
5028: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5029: return 1;
5030: }
1.1075.2.141. .1(raebu 5031:20): my $allowed;
1.1075.2.111 raeburn 5032: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5033:
5034: my $name;
1.1075.2.141. .1(raebu 5035:20): my %access = (
5036:20): allowfrom => 1,
5037:20): denyfrom => 0,
5038:20): );
5039:20): my @allows;
5040:20): my @denies;
5041:20): foreach my $item (split(',',$acc)) {
5042:20): $item =~ s/^\s*//;
5043:20): $item =~ s/\s*$//;
5044:20): if ($item =~ /^\!(.+)$/) {
5045:20): push(@denies,$1);
5046:20): } else {
5047:20): push(@allows,$item);
5048:20): }
5049:20): }
5050:20): my $numdenies = scalar(@denies);
5051:20): my $numallows = scalar(@allows);
5052:20): my $count = 0;
5053:20): foreach my $pattern (@denies,@allows) {
5054:20): $count ++;
5055:20): my $acctype = 'allowfrom';
5056:20): if ($count <= $numdenies) {
5057:20): $acctype = 'denyfrom';
5058:20): }
1.682 raeburn 5059: if ($pattern =~ /\*$/) {
5060: #35.8.*
5061: $pattern=~s/\*//;
1.1075.2.141. .1(raebu 5062:20): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5063: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5064: #35.8.3.[34-56]
5065: my $low=$2;
5066: my $high=$3;
5067: $pattern=$1;
5068: if ($ip =~ /^\Q$pattern\E/) {
5069: my $last=(split(/\./,$ip))[3];
1.1075.2.141. .1(raebu 5070:20): if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5071: }
5072: } elsif ($pattern =~ /^\*/) {
5073: #*.msu.edu
5074: $pattern=~s/\*//;
5075: if (!defined($name)) {
5076: use Socket;
5077: my $netaddr=inet_aton($ip);
5078: ($name)=gethostbyaddr($netaddr,AF_INET);
5079: }
1.1075.2.141. .1(raebu 5080:20): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5081: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5082: #127.0.0.1
1.1075.2.141. .1(raebu 5083:20): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5084: } else {
5085: #some.name.com
5086: if (!defined($name)) {
5087: use Socket;
5088: my $netaddr=inet_aton($ip);
5089: ($name)=gethostbyaddr($netaddr,AF_INET);
5090: }
1.1075.2.141. .1(raebu 5091:20): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5092:20): }
5093:20): if ($allowed =~ /^(0|1)$/) { last; }
5094:20): }
5095:20): if ($allowed eq '') {
5096:20): if ($numdenies && !$numallows) {
5097:20): $allowed = 1;
5098:20): } else {
5099:20): $allowed = 0;
1.682 raeburn 5100: }
5101: }
5102: return $allowed;
5103: }
5104:
5105: ###############################################
5106:
1.60 matthew 5107: =pod
5108:
1.112 bowersj2 5109: =head1 Domain Template Functions
5110:
5111: =over 4
5112:
5113: =item * &determinedomain()
1.60 matthew 5114:
5115: Inputs: $domain (usually will be undef)
5116:
1.63 www 5117: Returns: Determines which domain should be used for designs
1.60 matthew 5118:
5119: =cut
1.54 www 5120:
1.60 matthew 5121: ###############################################
1.63 www 5122: sub determinedomain {
5123: my $domain=shift;
1.531 albertel 5124: if (! $domain) {
1.60 matthew 5125: # Determine domain if we have not been given one
1.893 raeburn 5126: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5127: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5128: if ($env{'request.role.domain'}) {
5129: $domain=$env{'request.role.domain'};
1.60 matthew 5130: }
5131: }
1.63 www 5132: return $domain;
5133: }
5134: ###############################################
1.517 raeburn 5135:
1.518 albertel 5136: sub devalidate_domconfig_cache {
5137: my ($udom)=@_;
5138: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5139: }
5140:
5141: # ---------------------- Get domain configuration for a domain
5142: sub get_domainconf {
5143: my ($udom) = @_;
5144: my $cachetime=1800;
5145: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5146: if (defined($cached)) { return %{$result}; }
5147:
5148: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5149: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5150: my (%designhash,%legacy);
1.518 albertel 5151: if (keys(%domconfig) > 0) {
5152: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5153: if (keys(%{$domconfig{'login'}})) {
5154: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5155: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 5156: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5157: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5158: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5159: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5160: if ($key eq 'loginvia') {
5161: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5162: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5163: $designhash{$udom.'.login.loginvia'} = $server;
5164: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5165: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5166: } else {
5167: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5168: }
1.948 raeburn 5169: }
1.1075.2.87 raeburn 5170: } elsif ($key eq 'headtag') {
5171: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5172: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5173: }
1.946 raeburn 5174: }
1.1075.2.87 raeburn 5175: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5176: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5177: }
1.946 raeburn 5178: }
5179: }
5180: }
5181: } else {
5182: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5183: $designhash{$udom.'.login.'.$key.'_'.$img} =
5184: $domconfig{'login'}{$key}{$img};
5185: }
1.699 raeburn 5186: }
5187: } else {
5188: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5189: }
1.632 raeburn 5190: }
5191: } else {
5192: $legacy{'login'} = 1;
1.518 albertel 5193: }
1.632 raeburn 5194: } else {
5195: $legacy{'login'} = 1;
1.518 albertel 5196: }
5197: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5198: if (keys(%{$domconfig{'rolecolors'}})) {
5199: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5200: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5201: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5202: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5203: }
1.518 albertel 5204: }
5205: }
1.632 raeburn 5206: } else {
5207: $legacy{'rolecolors'} = 1;
1.518 albertel 5208: }
1.632 raeburn 5209: } else {
5210: $legacy{'rolecolors'} = 1;
1.518 albertel 5211: }
1.948 raeburn 5212: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5213: if ($domconfig{'autoenroll'}{'co-owners'}) {
5214: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5215: }
5216: }
1.632 raeburn 5217: if (keys(%legacy) > 0) {
5218: my %legacyhash = &get_legacy_domconf($udom);
5219: foreach my $item (keys(%legacyhash)) {
5220: if ($item =~ /^\Q$udom\E\.login/) {
5221: if ($legacy{'login'}) {
5222: $designhash{$item} = $legacyhash{$item};
5223: }
5224: } else {
5225: if ($legacy{'rolecolors'}) {
5226: $designhash{$item} = $legacyhash{$item};
5227: }
1.518 albertel 5228: }
5229: }
5230: }
1.632 raeburn 5231: } else {
5232: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5233: }
5234: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5235: $cachetime);
5236: return %designhash;
5237: }
5238:
1.632 raeburn 5239: sub get_legacy_domconf {
5240: my ($udom) = @_;
5241: my %legacyhash;
5242: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5243: my $designfile = $designdir.'/'.$udom.'.tab';
5244: if (-e $designfile) {
1.1075.2.128 raeburn 5245: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 5246: while (my $line = <$fh>) {
5247: next if ($line =~ /^\#/);
5248: chomp($line);
5249: my ($key,$val)=(split(/\=/,$line));
5250: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5251: }
5252: close($fh);
5253: }
5254: }
1.1026 raeburn 5255: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5256: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5257: }
5258: return %legacyhash;
5259: }
5260:
1.63 www 5261: =pod
5262:
1.112 bowersj2 5263: =item * &domainlogo()
1.63 www 5264:
5265: Inputs: $domain (usually will be undef)
5266:
5267: Returns: A link to a domain logo, if the domain logo exists.
5268: If the domain logo does not exist, a description of the domain.
5269:
5270: =cut
1.112 bowersj2 5271:
1.63 www 5272: ###############################################
5273: sub domainlogo {
1.517 raeburn 5274: my $domain = &determinedomain(shift);
1.518 albertel 5275: my %designhash = &get_domainconf($domain);
1.517 raeburn 5276: # See if there is a logo
5277: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5278: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5279: if ($imgsrc =~ m{^/(adm|res)/}) {
5280: if ($imgsrc =~ m{^/res/}) {
5281: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5282: &Apache::lonnet::repcopy($local_name);
5283: }
5284: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5285: }
5286: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5287: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5288: return &Apache::lonnet::domain($domain,'description');
1.59 www 5289: } else {
1.60 matthew 5290: return '';
1.59 www 5291: }
5292: }
1.63 www 5293: ##############################################
5294:
5295: =pod
5296:
1.112 bowersj2 5297: =item * &designparm()
1.63 www 5298:
5299: Inputs: $which parameter; $domain (usually will be undef)
5300:
5301: Returns: value of designparamter $which
5302:
5303: =cut
1.112 bowersj2 5304:
1.397 albertel 5305:
1.400 albertel 5306: ##############################################
1.397 albertel 5307: sub designparm {
5308: my ($which,$domain)=@_;
5309: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5310: return $env{'environment.color.'.$which};
1.96 www 5311: }
1.63 www 5312: $domain=&determinedomain($domain);
1.1016 raeburn 5313: my %domdesign;
5314: unless ($domain eq 'public') {
5315: %domdesign = &get_domainconf($domain);
5316: }
1.520 raeburn 5317: my $output;
1.517 raeburn 5318: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5319: $output = $domdesign{$domain.'.'.$which};
1.63 www 5320: } else {
1.520 raeburn 5321: $output = $defaultdesign{$which};
5322: }
5323: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5324: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5325: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5326: if ($output =~ m{^/res/}) {
5327: my $local_name = &Apache::lonnet::filelocation('',$output);
5328: &Apache::lonnet::repcopy($local_name);
5329: }
1.520 raeburn 5330: $output = &lonhttpdurl($output);
5331: }
1.63 www 5332: }
1.520 raeburn 5333: return $output;
1.63 www 5334: }
1.59 www 5335:
1.822 bisitz 5336: ##############################################
5337: =pod
5338:
1.832 bisitz 5339: =item * &authorspace()
5340:
1.1028 raeburn 5341: Inputs: $url (usually will be undef).
1.832 bisitz 5342:
1.1075.2.40 raeburn 5343: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5344: directory being viewed (or for which action is being taken).
5345: If $url is provided, and begins /priv/<domain>/<uname>
5346: the path will be that portion of the $context argument.
5347: Otherwise the path will be for the author space of the current
5348: user when the current role is author, or for that of the
5349: co-author/assistant co-author space when the current role
5350: is co-author or assistant co-author.
1.832 bisitz 5351:
5352: =cut
5353:
5354: sub authorspace {
1.1028 raeburn 5355: my ($url) = @_;
5356: if ($url ne '') {
5357: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5358: return $1;
5359: }
5360: }
1.832 bisitz 5361: my $caname = '';
1.1024 www 5362: my $cadom = '';
1.1028 raeburn 5363: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5364: ($cadom,$caname) =
1.832 bisitz 5365: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5366: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5367: $caname = $env{'user.name'};
1.1024 www 5368: $cadom = $env{'user.domain'};
1.832 bisitz 5369: }
1.1028 raeburn 5370: if (($caname ne '') && ($cadom ne '')) {
5371: return "/priv/$cadom/$caname/";
5372: }
5373: return;
1.832 bisitz 5374: }
5375:
5376: ##############################################
5377: =pod
5378:
1.822 bisitz 5379: =item * &head_subbox()
5380:
5381: Inputs: $content (contains HTML code with page functions, etc.)
5382:
5383: Returns: HTML div with $content
5384: To be included in page header
5385:
5386: =cut
5387:
5388: sub head_subbox {
5389: my ($content)=@_;
5390: my $output =
1.993 raeburn 5391: '<div class="LC_head_subbox">'
1.822 bisitz 5392: .$content
5393: .'</div>'
5394: }
5395:
5396: ##############################################
5397: =pod
5398:
5399: =item * &CSTR_pageheader()
5400:
1.1026 raeburn 5401: Input: (optional) filename from which breadcrumb trail is built.
5402: In most cases no input as needed, as $env{'request.filename'}
5403: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5404:
5405: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5406: To be included on Authoring Space pages
1.822 bisitz 5407:
5408: =cut
5409:
5410: sub CSTR_pageheader {
1.1026 raeburn 5411: my ($trailfile) = @_;
5412: if ($trailfile eq '') {
5413: $trailfile = $env{'request.filename'};
5414: }
5415:
5416: # this is for resources; directories have customtitle, and crumbs
5417: # and select recent are created in lonpubdir.pm
5418:
5419: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5420: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5421: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5422: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5423: $formaction =~ s{/+}{/}g;
1.822 bisitz 5424:
5425: my $parentpath = '';
5426: my $lastitem = '';
5427: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5428: $parentpath = $1;
5429: $lastitem = $2;
5430: } else {
5431: $lastitem = $thisdisfn;
5432: }
1.921 bisitz 5433:
5434: my $output =
1.822 bisitz 5435: '<div>'
5436: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5437: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5438: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5439: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5440: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5441:
5442: if ($lastitem) {
5443: $output .=
5444: '<span class="LC_filename">'
5445: .$lastitem
5446: .'</span>';
5447: }
5448: $output .=
5449: '<br />'
1.822 bisitz 5450: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5451: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5452: .'</form>'
5453: .&Apache::lonmenu::constspaceform()
5454: .'</div>';
1.921 bisitz 5455:
5456: return $output;
1.822 bisitz 5457: }
5458:
1.60 matthew 5459: ###############################################
5460: ###############################################
5461:
5462: =pod
5463:
1.112 bowersj2 5464: =back
5465:
1.549 albertel 5466: =head1 HTML Helpers
1.112 bowersj2 5467:
5468: =over 4
5469:
5470: =item * &bodytag()
1.60 matthew 5471:
5472: Returns a uniform header for LON-CAPA web pages.
5473:
5474: Inputs:
5475:
1.112 bowersj2 5476: =over 4
5477:
5478: =item * $title, A title to be displayed on the page.
5479:
5480: =item * $function, the current role (can be undef).
5481:
5482: =item * $addentries, extra parameters for the <body> tag.
5483:
5484: =item * $bodyonly, if defined, only return the <body> tag.
5485:
5486: =item * $domain, if defined, force a given domain.
5487:
5488: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5489: text interface only)
1.60 matthew 5490:
1.814 bisitz 5491: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5492: navigational links
1.317 albertel 5493:
1.338 albertel 5494: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5495:
1.1075.2.12 raeburn 5496: =item * $no_inline_link, if true and in remote mode, don't show the
5497: 'Switch To Inline Menu' link
5498:
1.460 albertel 5499: =item * $args, optional argument valid values are
5500: no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133 raeburn 5501: use_absolute -> for external resource or syllabus, this will
5502: contain https://<hostname> if server uses
5503: https (as per hosts.tab), but request is for http
5504: hostname -> hostname, from $r->hostname().
1.460 albertel 5505:
1.1075.2.15 raeburn 5506: =item * $advtoolsref, optional argument, ref to an array containing
5507: inlineremote items to be added in "Functions" menu below
5508: breadcrumbs.
5509:
1.112 bowersj2 5510: =back
5511:
1.60 matthew 5512: Returns: A uniform header for LON-CAPA web pages.
5513: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5514: If $bodyonly is undef or zero, an html string containing a <body> tag and
5515: other decorations will be returned.
5516:
5517: =cut
5518:
1.54 www 5519: sub bodytag {
1.831 bisitz 5520: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5521: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5522:
1.954 raeburn 5523: my $public;
5524: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5525: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5526: $public = 1;
5527: }
1.460 albertel 5528: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5529: my $httphost = $args->{'use_absolute'};
1.1075.2.133 raeburn 5530: my $hostname = $args->{'hostname'};
1.339 albertel 5531:
1.183 matthew 5532: $function = &get_users_function() if (!$function);
1.339 albertel 5533: my $img = &designparm($function.'.img',$domain);
5534: my $font = &designparm($function.'.font',$domain);
5535: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5536:
1.803 bisitz 5537: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5538: 'bgcolor' => $pgbg,
1.339 albertel 5539: 'text' => $font,
5540: 'alink' => &designparm($function.'.alink',$domain),
5541: 'vlink' => &designparm($function.'.vlink',$domain),
5542: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5543: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5544:
1.63 www 5545: # role and realm
1.1075.2.68 raeburn 5546: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5547: if ($realm) {
5548: $realm = '/'.$realm;
5549: }
1.378 raeburn 5550: if ($role eq 'ca') {
1.479 albertel 5551: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5552: $realm = &plainname($rname,$rdom);
1.378 raeburn 5553: }
1.55 www 5554: # realm
1.258 albertel 5555: if ($env{'request.course.id'}) {
1.378 raeburn 5556: if ($env{'request.role'} !~ /^cr/) {
5557: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115 raeburn 5558: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121 raeburn 5559: if ($env{'request.role.desc'}) {
5560: $role = $env{'request.role.desc'};
5561: } else {
5562: $role = &mt('Helpdesk[_1]',' '.$2);
5563: }
1.1075.2.115 raeburn 5564: } else {
5565: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5566: }
1.898 raeburn 5567: if ($env{'request.course.sec'}) {
5568: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5569: }
1.359 albertel 5570: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5571: } else {
5572: $role = &Apache::lonnet::plaintext($role);
1.54 www 5573: }
1.433 albertel 5574:
1.359 albertel 5575: if (!$realm) { $realm=' '; }
1.330 albertel 5576:
1.438 albertel 5577: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5578:
1.101 www 5579: # construct main body tag
1.359 albertel 5580: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 5581: &Apache::lontexconvert::init_math_support();
1.252 albertel 5582:
1.1075.2.38 raeburn 5583: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5584:
5585: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5586: return $bodytag;
1.1075.2.38 raeburn 5587: }
1.359 albertel 5588:
1.954 raeburn 5589: if ($public) {
1.433 albertel 5590: undef($role);
5591: }
1.359 albertel 5592:
1.762 bisitz 5593: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5594: #
5595: # Extra info if you are the DC
5596: my $dc_info = '';
5597: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5598: $env{'course.'.$env{'request.course.id'}.
5599: '.domain'}.'/'})) {
5600: my $cid = $env{'request.course.id'};
1.917 raeburn 5601: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5602: $dc_info =~ s/\s+$//;
1.359 albertel 5603: }
5604:
1.1075.2.108 raeburn 5605: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903 droeschl 5606:
1.1075.2.13 raeburn 5607: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5608:
1.1075.2.38 raeburn 5609:
5610:
1.1075.2.21 raeburn 5611: my $funclist;
5612: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5613: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5614: Apache::lonmenu::serverform();
5615: my $forbodytag;
5616: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5617: $forcereg,$args->{'group'},
5618: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 5619: $advtoolsref,'','',\$forbodytag);
1.1075.2.21 raeburn 5620: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5621: $funclist = $forbodytag;
5622: }
5623: } else {
1.903 droeschl 5624:
5625: # if ($env{'request.state'} eq 'construct') {
5626: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5627: # }
5628:
1.1075.2.38 raeburn 5629: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5630: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5631:
1.1075.2.38 raeburn 5632: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5633:
1.916 droeschl 5634: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5635: if ($dc_info) {
5636: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5637: }
1.1075.2.38 raeburn 5638: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5639: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5640: return $bodytag;
5641: }
1.894 droeschl 5642:
1.927 raeburn 5643: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5644: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5645: }
1.916 droeschl 5646:
1.1075.2.38 raeburn 5647: $bodytag .= $right;
1.852 droeschl 5648:
1.917 raeburn 5649: if ($dc_info) {
5650: $dc_info = &dc_courseid_toggle($dc_info);
5651: }
5652: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5653:
1.1075.2.61 raeburn 5654: #if directed to not display the secondary menu, don't.
5655: if ($args->{'no_secondary_menu'}) {
5656: return $bodytag;
5657: }
1.903 droeschl 5658: #don't show menus for public users
1.954 raeburn 5659: if (!$public){
1.1075.2.52 raeburn 5660: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5661: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5662: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5663: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5664: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.133 raeburn 5665: $args->{'bread_crumbs'},'','',$hostname);
1.1075.2.116 raeburn 5666: } elsif ($forcereg) {
1.1075.2.22 raeburn 5667: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.116 raeburn 5668: $args->{'group'},
1.1075.2.133 raeburn 5669: $args->{'hide_buttons',
5670: $hostname});
1.1075.2.15 raeburn 5671: } else {
1.1075.2.21 raeburn 5672: my $forbodytag;
5673: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5674: $forcereg,$args->{'group'},
5675: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 5676: $advtoolsref,'',$hostname,
5677: \$forbodytag);
1.1075.2.21 raeburn 5678: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5679: $bodytag .= $forbodytag;
5680: }
1.920 raeburn 5681: }
1.903 droeschl 5682: }else{
5683: # this is to seperate menu from content when there's no secondary
5684: # menu. Especially needed for public accessible ressources.
5685: $bodytag .= '<hr style="clear:both" />';
5686: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5687: }
1.903 droeschl 5688:
1.235 raeburn 5689: return $bodytag;
1.1075.2.12 raeburn 5690: }
5691:
5692: #
5693: # Top frame rendering, Remote is up
5694: #
5695:
5696: my $imgsrc = $img;
5697: if ($img =~ /^\/adm/) {
5698: $imgsrc = &lonhttpdurl($img);
5699: }
5700: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5701:
1.1075.2.60 raeburn 5702: my $help=($no_inline_link?''
5703: :&Apache::loncommon::top_nav_help('Help'));
5704:
1.1075.2.12 raeburn 5705: # Explicit link to get inline menu
5706: my $menu= ($no_inline_link?''
5707: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5708:
5709: if ($dc_info) {
5710: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5711: }
5712:
1.1075.2.38 raeburn 5713: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5714: unless ($public) {
5715: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5716: undef,'LC_menubuttons_link');
5717: }
5718:
1.1075.2.12 raeburn 5719: unless ($env{'form.inhibitmenu'}) {
5720: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5721: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5722: <li>$help</li>
1.1075.2.12 raeburn 5723: <li>$menu</li>
5724: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5725: }
1.1075.2.13 raeburn 5726: if ($env{'request.state'} eq 'construct') {
5727: if (!$public){
5728: if ($env{'request.state'} eq 'construct') {
5729: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5730: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5731: &Apache::lonhtmlcommon::scripttag('','end').
5732: &Apache::lonmenu::innerregister($forcereg,
5733: $args->{'bread_crumbs'});
5734: }
5735: }
5736: }
1.1075.2.21 raeburn 5737: return $bodytag."\n".$funclist;
1.182 matthew 5738: }
5739:
1.917 raeburn 5740: sub dc_courseid_toggle {
5741: my ($dc_info) = @_;
1.980 raeburn 5742: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5743: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5744: &mt('(More ...)').'</a></span>'.
5745: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5746: }
5747:
1.330 albertel 5748: sub make_attr_string {
5749: my ($register,$attr_ref) = @_;
5750:
5751: if ($attr_ref && !ref($attr_ref)) {
5752: die("addentries Must be a hash ref ".
5753: join(':',caller(1))." ".
5754: join(':',caller(0))." ");
5755: }
5756:
5757: if ($register) {
1.339 albertel 5758: my ($on_load,$on_unload);
5759: foreach my $key (keys(%{$attr_ref})) {
5760: if (lc($key) eq 'onload') {
5761: $on_load.=$attr_ref->{$key}.';';
5762: delete($attr_ref->{$key});
5763:
5764: } elsif (lc($key) eq 'onunload') {
5765: $on_unload.=$attr_ref->{$key}.';';
5766: delete($attr_ref->{$key});
5767: }
5768: }
1.1075.2.12 raeburn 5769: if ($env{'environment.remote'} eq 'on') {
5770: $attr_ref->{'onload'} =
5771: &Apache::lonmenu::loadevents(). $on_load;
5772: $attr_ref->{'onunload'}=
5773: &Apache::lonmenu::unloadevents().$on_unload;
5774: } else {
5775: $attr_ref->{'onload'} = $on_load;
5776: $attr_ref->{'onunload'}= $on_unload;
5777: }
1.330 albertel 5778: }
1.339 albertel 5779:
1.330 albertel 5780: my $attr_string;
1.1075.2.56 raeburn 5781: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5782: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5783: }
5784: return $attr_string;
5785: }
5786:
5787:
1.182 matthew 5788: ###############################################
1.251 albertel 5789: ###############################################
5790:
5791: =pod
5792:
5793: =item * &endbodytag()
5794:
5795: Returns a uniform footer for LON-CAPA web pages.
5796:
1.635 raeburn 5797: Inputs: 1 - optional reference to an args hash
5798: If in the hash, key for noredirectlink has a value which evaluates to true,
5799: a 'Continue' link is not displayed if the page contains an
5800: internal redirect in the <head></head> section,
5801: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5802:
5803: =cut
5804:
5805: sub endbodytag {
1.635 raeburn 5806: my ($args) = @_;
1.1075.2.6 raeburn 5807: my $endbodytag;
5808: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5809: $endbodytag='</body>';
5810: }
1.315 albertel 5811: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5812: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5813: $endbodytag=
5814: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5815: &mt('Continue').'</a>'.
5816: $endbodytag;
5817: }
1.315 albertel 5818: }
1.251 albertel 5819: return $endbodytag;
5820: }
5821:
1.352 albertel 5822: =pod
5823:
5824: =item * &standard_css()
5825:
5826: Returns a style sheet
5827:
5828: Inputs: (all optional)
5829: domain -> force to color decorate a page for a specific
5830: domain
5831: function -> force usage of a specific rolish color scheme
5832: bgcolor -> override the default page bgcolor
5833:
5834: =cut
5835:
1.343 albertel 5836: sub standard_css {
1.345 albertel 5837: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5838: $function = &get_users_function() if (!$function);
5839: my $img = &designparm($function.'.img', $domain);
5840: my $tabbg = &designparm($function.'.tabbg', $domain);
5841: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5842: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5843: #second colour for later usage
1.345 albertel 5844: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5845: my $pgbg_or_bgcolor =
5846: $bgcolor ||
1.352 albertel 5847: &designparm($function.'.pgbg', $domain);
1.382 albertel 5848: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5849: my $alink = &designparm($function.'.alink', $domain);
5850: my $vlink = &designparm($function.'.vlink', $domain);
5851: my $link = &designparm($function.'.link', $domain);
5852:
1.602 albertel 5853: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5854: my $mono = 'monospace';
1.850 bisitz 5855: my $data_table_head = $sidebg;
5856: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5857: my $data_table_dark = '#E0E0E0';
1.470 banghart 5858: my $data_table_darker = '#CCCCCC';
1.349 albertel 5859: my $data_table_highlight = '#FFFF00';
1.352 albertel 5860: my $mail_new = '#FFBB77';
5861: my $mail_new_hover = '#DD9955';
5862: my $mail_read = '#BBBB77';
5863: my $mail_read_hover = '#999944';
5864: my $mail_replied = '#AAAA88';
5865: my $mail_replied_hover = '#888855';
5866: my $mail_other = '#99BBBB';
5867: my $mail_other_hover = '#669999';
1.391 albertel 5868: my $table_header = '#DDDDDD';
1.489 raeburn 5869: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5870: my $lg_border_color = '#C8C8C8';
1.952 onken 5871: my $button_hover = '#BF2317';
1.392 albertel 5872:
1.608 albertel 5873: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5874: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5875: : '0 3px 0 4px';
1.448 albertel 5876:
1.523 albertel 5877:
1.343 albertel 5878: return <<END;
1.947 droeschl 5879:
5880: /* needed for iframe to allow 100% height in FF */
5881: body, html {
5882: margin: 0;
5883: padding: 0 0.5%;
5884: height: 99%; /* to avoid scrollbars */
5885: }
5886:
1.795 www 5887: body {
1.911 bisitz 5888: font-family: $sans;
5889: line-height:130%;
5890: font-size:0.83em;
5891: color:$font;
1.795 www 5892: }
5893:
1.959 onken 5894: a:focus,
5895: a:focus img {
1.795 www 5896: color: red;
5897: }
1.698 harmsja 5898:
1.911 bisitz 5899: form, .inline {
5900: display: inline;
1.795 www 5901: }
1.721 harmsja 5902:
1.795 www 5903: .LC_right {
1.911 bisitz 5904: text-align:right;
1.795 www 5905: }
5906:
5907: .LC_middle {
1.911 bisitz 5908: vertical-align:middle;
1.795 www 5909: }
1.721 harmsja 5910:
1.1075.2.38 raeburn 5911: .LC_floatleft {
5912: float: left;
5913: }
5914:
5915: .LC_floatright {
5916: float: right;
5917: }
5918:
1.911 bisitz 5919: .LC_400Box {
5920: width:400px;
5921: }
1.721 harmsja 5922:
1.947 droeschl 5923: .LC_iframecontainer {
5924: width: 98%;
5925: margin: 0;
5926: position: fixed;
5927: top: 8.5em;
5928: bottom: 0;
5929: }
5930:
5931: .LC_iframecontainer iframe{
5932: border: none;
5933: width: 100%;
5934: height: 100%;
5935: }
5936:
1.778 bisitz 5937: .LC_filename {
5938: font-family: $mono;
5939: white-space:pre;
1.921 bisitz 5940: font-size: 120%;
1.778 bisitz 5941: }
5942:
5943: .LC_fileicon {
5944: border: none;
5945: height: 1.3em;
5946: vertical-align: text-bottom;
5947: margin-right: 0.3em;
5948: text-decoration:none;
5949: }
5950:
1.1008 www 5951: .LC_setting {
5952: text-decoration:underline;
5953: }
5954:
1.350 albertel 5955: .LC_error {
5956: color: red;
5957: }
1.795 www 5958:
1.1075.2.15 raeburn 5959: .LC_warning {
5960: color: darkorange;
5961: }
5962:
1.457 albertel 5963: .LC_diff_removed {
1.733 bisitz 5964: color: red;
1.394 albertel 5965: }
1.532 albertel 5966:
5967: .LC_info,
1.457 albertel 5968: .LC_success,
5969: .LC_diff_added {
1.350 albertel 5970: color: green;
5971: }
1.795 www 5972:
1.802 bisitz 5973: div.LC_confirm_box {
5974: background-color: #FAFAFA;
5975: border: 1px solid $lg_border_color;
5976: margin-right: 0;
5977: padding: 5px;
5978: }
5979:
5980: div.LC_confirm_box .LC_error img,
5981: div.LC_confirm_box .LC_success img {
5982: vertical-align: middle;
5983: }
5984:
1.1075.2.108 raeburn 5985: .LC_maxwidth {
5986: max-width: 100%;
5987: height: auto;
5988: }
5989:
5990: .LC_textsize_mobile {
5991: \@media only screen and (max-device-width: 480px) {
5992: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
5993: }
5994: }
5995:
1.440 albertel 5996: .LC_icon {
1.771 droeschl 5997: border: none;
1.790 droeschl 5998: vertical-align: middle;
1.771 droeschl 5999: }
6000:
1.543 albertel 6001: .LC_docs_spacer {
6002: width: 25px;
6003: height: 1px;
1.771 droeschl 6004: border: none;
1.543 albertel 6005: }
1.346 albertel 6006:
1.532 albertel 6007: .LC_internal_info {
1.735 bisitz 6008: color: #999999;
1.532 albertel 6009: }
6010:
1.794 www 6011: .LC_discussion {
1.1050 www 6012: background: $data_table_dark;
1.911 bisitz 6013: border: 1px solid black;
6014: margin: 2px;
1.794 www 6015: }
6016:
6017: .LC_disc_action_left {
1.1050 www 6018: background: $sidebg;
1.911 bisitz 6019: text-align: left;
1.1050 www 6020: padding: 4px;
6021: margin: 2px;
1.794 www 6022: }
6023:
6024: .LC_disc_action_right {
1.1050 www 6025: background: $sidebg;
1.911 bisitz 6026: text-align: right;
1.1050 www 6027: padding: 4px;
6028: margin: 2px;
1.794 www 6029: }
6030:
6031: .LC_disc_new_item {
1.911 bisitz 6032: background: white;
6033: border: 2px solid red;
1.1050 www 6034: margin: 4px;
6035: padding: 4px;
1.794 www 6036: }
6037:
6038: .LC_disc_old_item {
1.911 bisitz 6039: background: white;
1.1050 www 6040: margin: 4px;
6041: padding: 4px;
1.794 www 6042: }
6043:
1.458 albertel 6044: table.LC_pastsubmission {
6045: border: 1px solid black;
6046: margin: 2px;
6047: }
6048:
1.924 bisitz 6049: table#LC_menubuttons {
1.345 albertel 6050: width: 100%;
6051: background: $pgbg;
1.392 albertel 6052: border: 2px;
1.402 albertel 6053: border-collapse: separate;
1.803 bisitz 6054: padding: 0;
1.345 albertel 6055: }
1.392 albertel 6056:
1.801 tempelho 6057: table#LC_title_bar a {
6058: color: $fontmenu;
6059: }
1.836 bisitz 6060:
1.807 droeschl 6061: table#LC_title_bar {
1.819 tempelho 6062: clear: both;
1.836 bisitz 6063: display: none;
1.807 droeschl 6064: }
6065:
1.795 www 6066: table#LC_title_bar,
1.933 droeschl 6067: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6068: table#LC_title_bar.LC_with_remote {
1.359 albertel 6069: width: 100%;
1.392 albertel 6070: border-color: $pgbg;
6071: border-style: solid;
6072: border-width: $border;
1.379 albertel 6073: background: $pgbg;
1.801 tempelho 6074: color: $fontmenu;
1.392 albertel 6075: border-collapse: collapse;
1.803 bisitz 6076: padding: 0;
1.819 tempelho 6077: margin: 0;
1.359 albertel 6078: }
1.795 www 6079:
1.933 droeschl 6080: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6081: margin: 0;
6082: padding: 0;
1.933 droeschl 6083: position: relative;
6084: list-style: none;
1.913 droeschl 6085: }
1.933 droeschl 6086: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6087: display: inline;
6088: }
1.933 droeschl 6089:
6090: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6091: padding: 0;
1.933 droeschl 6092: margin: 0;
6093: float: left;
1.913 droeschl 6094: }
1.933 droeschl 6095: .LC_breadcrumb_tools_tools {
6096: padding: 0;
6097: margin: 0;
1.913 droeschl 6098: float: right;
6099: }
6100:
1.359 albertel 6101: table#LC_title_bar td {
6102: background: $tabbg;
6103: }
1.795 www 6104:
1.911 bisitz 6105: table#LC_menubuttons img {
1.803 bisitz 6106: border: none;
1.346 albertel 6107: }
1.795 www 6108:
1.842 droeschl 6109: .LC_breadcrumbs_component {
1.911 bisitz 6110: float: right;
6111: margin: 0 1em;
1.357 albertel 6112: }
1.842 droeschl 6113: .LC_breadcrumbs_component img {
1.911 bisitz 6114: vertical-align: middle;
1.777 tempelho 6115: }
1.795 www 6116:
1.1075.2.108 raeburn 6117: .LC_breadcrumbs_hoverable {
6118: background: $sidebg;
6119: }
6120:
1.383 albertel 6121: td.LC_table_cell_checkbox {
6122: text-align: center;
6123: }
1.795 www 6124:
6125: .LC_fontsize_small {
1.911 bisitz 6126: font-size: 70%;
1.705 tempelho 6127: }
6128:
1.844 bisitz 6129: #LC_breadcrumbs {
1.911 bisitz 6130: clear:both;
6131: background: $sidebg;
6132: border-bottom: 1px solid $lg_border_color;
6133: line-height: 2.5em;
1.933 droeschl 6134: overflow: hidden;
1.911 bisitz 6135: margin: 0;
6136: padding: 0;
1.995 raeburn 6137: text-align: left;
1.819 tempelho 6138: }
1.862 bisitz 6139:
1.1075.2.16 raeburn 6140: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6141: clear:both;
6142: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6143: border: 1px solid $sidebg;
1.1075.2.16 raeburn 6144: margin: 0 0 10px 0;
1.966 bisitz 6145: padding: 3px;
1.995 raeburn 6146: text-align: left;
1.822 bisitz 6147: }
6148:
1.795 www 6149: .LC_fontsize_medium {
1.911 bisitz 6150: font-size: 85%;
1.705 tempelho 6151: }
6152:
1.795 www 6153: .LC_fontsize_large {
1.911 bisitz 6154: font-size: 120%;
1.705 tempelho 6155: }
6156:
1.346 albertel 6157: .LC_menubuttons_inline_text {
6158: color: $font;
1.698 harmsja 6159: font-size: 90%;
1.701 harmsja 6160: padding-left:3px;
1.346 albertel 6161: }
6162:
1.934 droeschl 6163: .LC_menubuttons_inline_text img{
6164: vertical-align: middle;
6165: }
6166:
1.1051 www 6167: li.LC_menubuttons_inline_text img {
1.951 onken 6168: cursor:pointer;
1.1002 droeschl 6169: text-decoration: none;
1.951 onken 6170: }
6171:
1.526 www 6172: .LC_menubuttons_link {
6173: text-decoration: none;
6174: }
1.795 www 6175:
1.522 albertel 6176: .LC_menubuttons_category {
1.521 www 6177: color: $font;
1.526 www 6178: background: $pgbg;
1.521 www 6179: font-size: larger;
6180: font-weight: bold;
6181: }
6182:
1.346 albertel 6183: td.LC_menubuttons_text {
1.911 bisitz 6184: color: $font;
1.346 albertel 6185: }
1.706 harmsja 6186:
1.346 albertel 6187: .LC_current_location {
6188: background: $tabbg;
6189: }
1.795 www 6190:
1.1075.2.134 raeburn 6191: td.LC_zero_height {
6192: line-height: 0;
6193: cellpadding: 0;
6194: }
6195:
1.938 bisitz 6196: table.LC_data_table {
1.347 albertel 6197: border: 1px solid #000000;
1.402 albertel 6198: border-collapse: separate;
1.426 albertel 6199: border-spacing: 1px;
1.610 albertel 6200: background: $pgbg;
1.347 albertel 6201: }
1.795 www 6202:
1.422 albertel 6203: .LC_data_table_dense {
6204: font-size: small;
6205: }
1.795 www 6206:
1.507 raeburn 6207: table.LC_nested_outer {
6208: border: 1px solid #000000;
1.589 raeburn 6209: border-collapse: collapse;
1.803 bisitz 6210: border-spacing: 0;
1.507 raeburn 6211: width: 100%;
6212: }
1.795 www 6213:
1.879 raeburn 6214: table.LC_innerpickbox,
1.507 raeburn 6215: table.LC_nested {
1.803 bisitz 6216: border: none;
1.589 raeburn 6217: border-collapse: collapse;
1.803 bisitz 6218: border-spacing: 0;
1.507 raeburn 6219: width: 100%;
6220: }
1.795 www 6221:
1.911 bisitz 6222: table.LC_data_table tr th,
6223: table.LC_calendar tr th,
1.879 raeburn 6224: table.LC_prior_tries tr th,
6225: table.LC_innerpickbox tr th {
1.349 albertel 6226: font-weight: bold;
6227: background-color: $data_table_head;
1.801 tempelho 6228: color:$fontmenu;
1.701 harmsja 6229: font-size:90%;
1.347 albertel 6230: }
1.795 www 6231:
1.879 raeburn 6232: table.LC_innerpickbox tr th,
6233: table.LC_innerpickbox tr td {
6234: vertical-align: top;
6235: }
6236:
1.711 raeburn 6237: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6238: background-color: #CCCCCC;
1.711 raeburn 6239: font-weight: bold;
6240: text-align: left;
6241: }
1.795 www 6242:
1.912 bisitz 6243: table.LC_data_table tr.LC_odd_row > td {
6244: background-color: $data_table_light;
6245: padding: 2px;
6246: vertical-align: top;
6247: }
6248:
1.809 bisitz 6249: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6250: background-color: $data_table_light;
1.912 bisitz 6251: vertical-align: top;
6252: }
6253:
6254: table.LC_data_table tr.LC_even_row > td {
6255: background-color: $data_table_dark;
1.425 albertel 6256: padding: 2px;
1.900 bisitz 6257: vertical-align: top;
1.347 albertel 6258: }
1.795 www 6259:
1.809 bisitz 6260: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6261: background-color: $data_table_dark;
1.900 bisitz 6262: vertical-align: top;
1.347 albertel 6263: }
1.795 www 6264:
1.425 albertel 6265: table.LC_data_table tr.LC_data_table_highlight td {
6266: background-color: $data_table_darker;
6267: }
1.795 www 6268:
1.639 raeburn 6269: table.LC_data_table tr td.LC_leftcol_header {
6270: background-color: $data_table_head;
6271: font-weight: bold;
6272: }
1.795 www 6273:
1.451 albertel 6274: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6275: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6276: font-weight: bold;
6277: font-style: italic;
6278: text-align: center;
6279: padding: 8px;
1.347 albertel 6280: }
1.795 www 6281:
1.1075.2.30 raeburn 6282: table.LC_data_table tr.LC_empty_row td,
6283: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6284: background-color: $sidebg;
6285: }
6286:
6287: table.LC_nested tr.LC_empty_row td {
6288: background-color: #FFFFFF;
6289: }
6290:
1.890 droeschl 6291: table.LC_caption {
6292: }
6293:
1.507 raeburn 6294: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6295: padding: 4ex
6296: }
1.795 www 6297:
1.507 raeburn 6298: table.LC_nested_outer tr th {
6299: font-weight: bold;
1.801 tempelho 6300: color:$fontmenu;
1.507 raeburn 6301: background-color: $data_table_head;
1.701 harmsja 6302: font-size: small;
1.507 raeburn 6303: border-bottom: 1px solid #000000;
6304: }
1.795 www 6305:
1.507 raeburn 6306: table.LC_nested_outer tr td.LC_subheader {
6307: background-color: $data_table_head;
6308: font-weight: bold;
6309: font-size: small;
6310: border-bottom: 1px solid #000000;
6311: text-align: right;
1.451 albertel 6312: }
1.795 www 6313:
1.507 raeburn 6314: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6315: background-color: #CCCCCC;
1.451 albertel 6316: font-weight: bold;
6317: font-size: small;
1.507 raeburn 6318: text-align: center;
6319: }
1.795 www 6320:
1.589 raeburn 6321: table.LC_nested tr.LC_info_row td.LC_left_item,
6322: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6323: text-align: left;
1.451 albertel 6324: }
1.795 www 6325:
1.507 raeburn 6326: table.LC_nested td {
1.735 bisitz 6327: background-color: #FFFFFF;
1.451 albertel 6328: font-size: small;
1.507 raeburn 6329: }
1.795 www 6330:
1.507 raeburn 6331: table.LC_nested_outer tr th.LC_right_item,
6332: table.LC_nested tr.LC_info_row td.LC_right_item,
6333: table.LC_nested tr.LC_odd_row td.LC_right_item,
6334: table.LC_nested tr td.LC_right_item {
1.451 albertel 6335: text-align: right;
6336: }
6337:
1.507 raeburn 6338: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6339: background-color: #EEEEEE;
1.451 albertel 6340: }
6341:
1.473 raeburn 6342: table.LC_createuser {
6343: }
6344:
6345: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6346: font-size: small;
1.473 raeburn 6347: }
6348:
6349: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6350: background-color: #CCCCCC;
1.473 raeburn 6351: font-weight: bold;
6352: text-align: center;
6353: }
6354:
1.349 albertel 6355: table.LC_calendar {
6356: border: 1px solid #000000;
6357: border-collapse: collapse;
1.917 raeburn 6358: width: 98%;
1.349 albertel 6359: }
1.795 www 6360:
1.349 albertel 6361: table.LC_calendar_pickdate {
6362: font-size: xx-small;
6363: }
1.795 www 6364:
1.349 albertel 6365: table.LC_calendar tr td {
6366: border: 1px solid #000000;
6367: vertical-align: top;
1.917 raeburn 6368: width: 14%;
1.349 albertel 6369: }
1.795 www 6370:
1.349 albertel 6371: table.LC_calendar tr td.LC_calendar_day_empty {
6372: background-color: $data_table_dark;
6373: }
1.795 www 6374:
1.779 bisitz 6375: table.LC_calendar tr td.LC_calendar_day_current {
6376: background-color: $data_table_highlight;
1.777 tempelho 6377: }
1.795 www 6378:
1.938 bisitz 6379: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6380: background-color: $mail_new;
6381: }
1.795 www 6382:
1.938 bisitz 6383: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6384: background-color: $mail_new_hover;
6385: }
1.795 www 6386:
1.938 bisitz 6387: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6388: background-color: $mail_read;
6389: }
1.795 www 6390:
1.938 bisitz 6391: /*
6392: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6393: background-color: $mail_read_hover;
6394: }
1.938 bisitz 6395: */
1.795 www 6396:
1.938 bisitz 6397: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6398: background-color: $mail_replied;
6399: }
1.795 www 6400:
1.938 bisitz 6401: /*
6402: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6403: background-color: $mail_replied_hover;
6404: }
1.938 bisitz 6405: */
1.795 www 6406:
1.938 bisitz 6407: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6408: background-color: $mail_other;
6409: }
1.795 www 6410:
1.938 bisitz 6411: /*
6412: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6413: background-color: $mail_other_hover;
6414: }
1.938 bisitz 6415: */
1.494 raeburn 6416:
1.777 tempelho 6417: table.LC_data_table tr > td.LC_browser_file,
6418: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6419: background: #AAEE77;
1.389 albertel 6420: }
1.795 www 6421:
1.777 tempelho 6422: table.LC_data_table tr > td.LC_browser_file_locked,
6423: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6424: background: #FFAA99;
1.387 albertel 6425: }
1.795 www 6426:
1.777 tempelho 6427: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6428: background: #888888;
1.779 bisitz 6429: }
1.795 www 6430:
1.777 tempelho 6431: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6432: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6433: background: #F8F866;
1.777 tempelho 6434: }
1.795 www 6435:
1.696 bisitz 6436: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6437: background: #E0E8FF;
1.387 albertel 6438: }
1.696 bisitz 6439:
1.707 bisitz 6440: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6441: /* background: #77FF77; */
1.707 bisitz 6442: }
1.795 www 6443:
1.707 bisitz 6444: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6445: border-right: 8px solid #FFFF77;
1.707 bisitz 6446: }
1.795 www 6447:
1.707 bisitz 6448: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6449: border-right: 8px solid #FFAA77;
1.707 bisitz 6450: }
1.795 www 6451:
1.707 bisitz 6452: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6453: border-right: 8px solid #FF7777;
1.707 bisitz 6454: }
1.795 www 6455:
1.707 bisitz 6456: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6457: border-right: 8px solid #AAFF77;
1.707 bisitz 6458: }
1.795 www 6459:
1.707 bisitz 6460: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6461: border-right: 8px solid #11CC55;
1.707 bisitz 6462: }
6463:
1.388 albertel 6464: span.LC_current_location {
1.701 harmsja 6465: font-size:larger;
1.388 albertel 6466: background: $pgbg;
6467: }
1.387 albertel 6468:
1.1029 www 6469: span.LC_current_nav_location {
6470: font-weight:bold;
6471: background: $sidebg;
6472: }
6473:
1.395 albertel 6474: span.LC_parm_menu_item {
6475: font-size: larger;
6476: }
1.795 www 6477:
1.395 albertel 6478: span.LC_parm_scope_all {
6479: color: red;
6480: }
1.795 www 6481:
1.395 albertel 6482: span.LC_parm_scope_folder {
6483: color: green;
6484: }
1.795 www 6485:
1.395 albertel 6486: span.LC_parm_scope_resource {
6487: color: orange;
6488: }
1.795 www 6489:
1.395 albertel 6490: span.LC_parm_part {
6491: color: blue;
6492: }
1.795 www 6493:
1.911 bisitz 6494: span.LC_parm_folder,
6495: span.LC_parm_symb {
1.395 albertel 6496: font-size: x-small;
6497: font-family: $mono;
6498: color: #AAAAAA;
6499: }
6500:
1.977 bisitz 6501: ul.LC_parm_parmlist li {
6502: display: inline-block;
6503: padding: 0.3em 0.8em;
6504: vertical-align: top;
6505: width: 150px;
6506: border-top:1px solid $lg_border_color;
6507: }
6508:
1.795 www 6509: td.LC_parm_overview_level_menu,
6510: td.LC_parm_overview_map_menu,
6511: td.LC_parm_overview_parm_selectors,
6512: td.LC_parm_overview_restrictions {
1.396 albertel 6513: border: 1px solid black;
6514: border-collapse: collapse;
6515: }
1.795 www 6516:
1.396 albertel 6517: table.LC_parm_overview_restrictions td {
6518: border-width: 1px 4px 1px 4px;
6519: border-style: solid;
6520: border-color: $pgbg;
6521: text-align: center;
6522: }
1.795 www 6523:
1.396 albertel 6524: table.LC_parm_overview_restrictions th {
6525: background: $tabbg;
6526: border-width: 1px 4px 1px 4px;
6527: border-style: solid;
6528: border-color: $pgbg;
6529: }
1.795 www 6530:
1.398 albertel 6531: table#LC_helpmenu {
1.803 bisitz 6532: border: none;
1.398 albertel 6533: height: 55px;
1.803 bisitz 6534: border-spacing: 0;
1.398 albertel 6535: }
6536:
6537: table#LC_helpmenu fieldset legend {
6538: font-size: larger;
6539: }
1.795 www 6540:
1.397 albertel 6541: table#LC_helpmenu_links {
6542: width: 100%;
6543: border: 1px solid black;
6544: background: $pgbg;
1.803 bisitz 6545: padding: 0;
1.397 albertel 6546: border-spacing: 1px;
6547: }
1.795 www 6548:
1.397 albertel 6549: table#LC_helpmenu_links tr td {
6550: padding: 1px;
6551: background: $tabbg;
1.399 albertel 6552: text-align: center;
6553: font-weight: bold;
1.397 albertel 6554: }
1.396 albertel 6555:
1.795 www 6556: table#LC_helpmenu_links a:link,
6557: table#LC_helpmenu_links a:visited,
1.397 albertel 6558: table#LC_helpmenu_links a:active {
6559: text-decoration: none;
6560: color: $font;
6561: }
1.795 www 6562:
1.397 albertel 6563: table#LC_helpmenu_links a:hover {
6564: text-decoration: underline;
6565: color: $vlink;
6566: }
1.396 albertel 6567:
1.417 albertel 6568: .LC_chrt_popup_exists {
6569: border: 1px solid #339933;
6570: margin: -1px;
6571: }
1.795 www 6572:
1.417 albertel 6573: .LC_chrt_popup_up {
6574: border: 1px solid yellow;
6575: margin: -1px;
6576: }
1.795 www 6577:
1.417 albertel 6578: .LC_chrt_popup {
6579: border: 1px solid #8888FF;
6580: background: #CCCCFF;
6581: }
1.795 www 6582:
1.421 albertel 6583: table.LC_pick_box {
6584: border-collapse: separate;
6585: background: white;
6586: border: 1px solid black;
6587: border-spacing: 1px;
6588: }
1.795 www 6589:
1.421 albertel 6590: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6591: background: $sidebg;
1.421 albertel 6592: font-weight: bold;
1.900 bisitz 6593: text-align: left;
1.740 bisitz 6594: vertical-align: top;
1.421 albertel 6595: width: 184px;
6596: padding: 8px;
6597: }
1.795 www 6598:
1.579 raeburn 6599: table.LC_pick_box td.LC_pick_box_value {
6600: text-align: left;
6601: padding: 8px;
6602: }
1.795 www 6603:
1.579 raeburn 6604: table.LC_pick_box td.LC_pick_box_select {
6605: text-align: left;
6606: padding: 8px;
6607: }
1.795 www 6608:
1.424 albertel 6609: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6610: padding: 0;
1.421 albertel 6611: height: 1px;
6612: background: black;
6613: }
1.795 www 6614:
1.421 albertel 6615: table.LC_pick_box td.LC_pick_box_submit {
6616: text-align: right;
6617: }
1.795 www 6618:
1.579 raeburn 6619: table.LC_pick_box td.LC_evenrow_value {
6620: text-align: left;
6621: padding: 8px;
6622: background-color: $data_table_light;
6623: }
1.795 www 6624:
1.579 raeburn 6625: table.LC_pick_box td.LC_oddrow_value {
6626: text-align: left;
6627: padding: 8px;
6628: background-color: $data_table_light;
6629: }
1.795 www 6630:
1.579 raeburn 6631: span.LC_helpform_receipt_cat {
6632: font-weight: bold;
6633: }
1.795 www 6634:
1.424 albertel 6635: table.LC_group_priv_box {
6636: background: white;
6637: border: 1px solid black;
6638: border-spacing: 1px;
6639: }
1.795 www 6640:
1.424 albertel 6641: table.LC_group_priv_box td.LC_pick_box_title {
6642: background: $tabbg;
6643: font-weight: bold;
6644: text-align: right;
6645: width: 184px;
6646: }
1.795 www 6647:
1.424 albertel 6648: table.LC_group_priv_box td.LC_groups_fixed {
6649: background: $data_table_light;
6650: text-align: center;
6651: }
1.795 www 6652:
1.424 albertel 6653: table.LC_group_priv_box td.LC_groups_optional {
6654: background: $data_table_dark;
6655: text-align: center;
6656: }
1.795 www 6657:
1.424 albertel 6658: table.LC_group_priv_box td.LC_groups_functionality {
6659: background: $data_table_darker;
6660: text-align: center;
6661: font-weight: bold;
6662: }
1.795 www 6663:
1.424 albertel 6664: table.LC_group_priv td {
6665: text-align: left;
1.803 bisitz 6666: padding: 0;
1.424 albertel 6667: }
6668:
6669: .LC_navbuttons {
6670: margin: 2ex 0ex 2ex 0ex;
6671: }
1.795 www 6672:
1.423 albertel 6673: .LC_topic_bar {
6674: font-weight: bold;
6675: background: $tabbg;
1.918 wenzelju 6676: margin: 1em 0em 1em 2em;
1.805 bisitz 6677: padding: 3px;
1.918 wenzelju 6678: font-size: 1.2em;
1.423 albertel 6679: }
1.795 www 6680:
1.423 albertel 6681: .LC_topic_bar span {
1.918 wenzelju 6682: left: 0.5em;
6683: position: absolute;
1.423 albertel 6684: vertical-align: middle;
1.918 wenzelju 6685: font-size: 1.2em;
1.423 albertel 6686: }
1.795 www 6687:
1.423 albertel 6688: table.LC_course_group_status {
6689: margin: 20px;
6690: }
1.795 www 6691:
1.423 albertel 6692: table.LC_status_selector td {
6693: vertical-align: top;
6694: text-align: center;
1.424 albertel 6695: padding: 4px;
6696: }
1.795 www 6697:
1.599 albertel 6698: div.LC_feedback_link {
1.616 albertel 6699: clear: both;
1.829 kalberla 6700: background: $sidebg;
1.779 bisitz 6701: width: 100%;
1.829 kalberla 6702: padding-bottom: 10px;
6703: border: 1px $tabbg solid;
1.833 kalberla 6704: height: 22px;
6705: line-height: 22px;
6706: padding-top: 5px;
6707: }
6708:
6709: div.LC_feedback_link img {
6710: height: 22px;
1.867 kalberla 6711: vertical-align:middle;
1.829 kalberla 6712: }
6713:
1.911 bisitz 6714: div.LC_feedback_link a {
1.829 kalberla 6715: text-decoration: none;
1.489 raeburn 6716: }
1.795 www 6717:
1.867 kalberla 6718: div.LC_comblock {
1.911 bisitz 6719: display:inline;
1.867 kalberla 6720: color:$font;
6721: font-size:90%;
6722: }
6723:
6724: div.LC_feedback_link div.LC_comblock {
6725: padding-left:5px;
6726: }
6727:
6728: div.LC_feedback_link div.LC_comblock a {
6729: color:$font;
6730: }
6731:
1.489 raeburn 6732: span.LC_feedback_link {
1.858 bisitz 6733: /* background: $feedback_link_bg; */
1.599 albertel 6734: font-size: larger;
6735: }
1.795 www 6736:
1.599 albertel 6737: span.LC_message_link {
1.858 bisitz 6738: /* background: $feedback_link_bg; */
1.599 albertel 6739: font-size: larger;
6740: position: absolute;
6741: right: 1em;
1.489 raeburn 6742: }
1.421 albertel 6743:
1.515 albertel 6744: table.LC_prior_tries {
1.524 albertel 6745: border: 1px solid #000000;
6746: border-collapse: separate;
6747: border-spacing: 1px;
1.515 albertel 6748: }
1.523 albertel 6749:
1.515 albertel 6750: table.LC_prior_tries td {
1.524 albertel 6751: padding: 2px;
1.515 albertel 6752: }
1.523 albertel 6753:
6754: .LC_answer_correct {
1.795 www 6755: background: lightgreen;
6756: color: darkgreen;
6757: padding: 6px;
1.523 albertel 6758: }
1.795 www 6759:
1.523 albertel 6760: .LC_answer_charged_try {
1.797 www 6761: background: #FFAAAA;
1.795 www 6762: color: darkred;
6763: padding: 6px;
1.523 albertel 6764: }
1.795 www 6765:
1.779 bisitz 6766: .LC_answer_not_charged_try,
1.523 albertel 6767: .LC_answer_no_grade,
6768: .LC_answer_late {
1.795 www 6769: background: lightyellow;
1.523 albertel 6770: color: black;
1.795 www 6771: padding: 6px;
1.523 albertel 6772: }
1.795 www 6773:
1.523 albertel 6774: .LC_answer_previous {
1.795 www 6775: background: lightblue;
6776: color: darkblue;
6777: padding: 6px;
1.523 albertel 6778: }
1.795 www 6779:
1.779 bisitz 6780: .LC_answer_no_message {
1.777 tempelho 6781: background: #FFFFFF;
6782: color: black;
1.795 www 6783: padding: 6px;
1.779 bisitz 6784: }
1.795 www 6785:
1.1075.2.140 raeburn 6786: .LC_answer_unknown,
6787: .LC_answer_warning {
1.779 bisitz 6788: background: orange;
6789: color: black;
1.795 www 6790: padding: 6px;
1.777 tempelho 6791: }
1.795 www 6792:
1.529 albertel 6793: span.LC_prior_numerical,
6794: span.LC_prior_string,
6795: span.LC_prior_custom,
6796: span.LC_prior_reaction,
6797: span.LC_prior_math {
1.925 bisitz 6798: font-family: $mono;
1.523 albertel 6799: white-space: pre;
6800: }
6801:
1.525 albertel 6802: span.LC_prior_string {
1.925 bisitz 6803: font-family: $mono;
1.525 albertel 6804: white-space: pre;
6805: }
6806:
1.523 albertel 6807: table.LC_prior_option {
6808: width: 100%;
6809: border-collapse: collapse;
6810: }
1.795 www 6811:
1.911 bisitz 6812: table.LC_prior_rank,
1.795 www 6813: table.LC_prior_match {
1.528 albertel 6814: border-collapse: collapse;
6815: }
1.795 www 6816:
1.528 albertel 6817: table.LC_prior_option tr td,
6818: table.LC_prior_rank tr td,
6819: table.LC_prior_match tr td {
1.524 albertel 6820: border: 1px solid #000000;
1.515 albertel 6821: }
6822:
1.855 bisitz 6823: .LC_nobreak {
1.544 albertel 6824: white-space: nowrap;
1.519 raeburn 6825: }
6826:
1.576 raeburn 6827: span.LC_cusr_emph {
6828: font-style: italic;
6829: }
6830:
1.633 raeburn 6831: span.LC_cusr_subheading {
6832: font-weight: normal;
6833: font-size: 85%;
6834: }
6835:
1.861 bisitz 6836: div.LC_docs_entry_move {
1.859 bisitz 6837: border: 1px solid #BBBBBB;
1.545 albertel 6838: background: #DDDDDD;
1.861 bisitz 6839: width: 22px;
1.859 bisitz 6840: padding: 1px;
6841: margin: 0;
1.545 albertel 6842: }
6843:
1.861 bisitz 6844: table.LC_data_table tr > td.LC_docs_entry_commands,
6845: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6846: font-size: x-small;
6847: }
1.795 www 6848:
1.861 bisitz 6849: .LC_docs_entry_parameter {
6850: white-space: nowrap;
6851: }
6852:
1.544 albertel 6853: .LC_docs_copy {
1.545 albertel 6854: color: #000099;
1.544 albertel 6855: }
1.795 www 6856:
1.544 albertel 6857: .LC_docs_cut {
1.545 albertel 6858: color: #550044;
1.544 albertel 6859: }
1.795 www 6860:
1.544 albertel 6861: .LC_docs_rename {
1.545 albertel 6862: color: #009900;
1.544 albertel 6863: }
1.795 www 6864:
1.544 albertel 6865: .LC_docs_remove {
1.545 albertel 6866: color: #990000;
6867: }
6868:
1.1075.2.134 raeburn 6869: .LC_domprefs_email,
1.547 albertel 6870: .LC_docs_reinit_warn,
6871: .LC_docs_ext_edit {
6872: font-size: x-small;
6873: }
6874:
1.545 albertel 6875: table.LC_docs_adddocs td,
6876: table.LC_docs_adddocs th {
6877: border: 1px solid #BBBBBB;
6878: padding: 4px;
6879: background: #DDDDDD;
1.543 albertel 6880: }
6881:
1.584 albertel 6882: table.LC_sty_begin {
6883: background: #BBFFBB;
6884: }
1.795 www 6885:
1.584 albertel 6886: table.LC_sty_end {
6887: background: #FFBBBB;
6888: }
6889:
1.589 raeburn 6890: table.LC_double_column {
1.803 bisitz 6891: border-width: 0;
1.589 raeburn 6892: border-collapse: collapse;
6893: width: 100%;
6894: padding: 2px;
6895: }
6896:
6897: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6898: top: 2px;
1.589 raeburn 6899: left: 2px;
6900: width: 47%;
6901: vertical-align: top;
6902: }
6903:
6904: table.LC_double_column tr td.LC_right_col {
6905: top: 2px;
1.779 bisitz 6906: right: 2px;
1.589 raeburn 6907: width: 47%;
6908: vertical-align: top;
6909: }
6910:
1.591 raeburn 6911: div.LC_left_float {
6912: float: left;
6913: padding-right: 5%;
1.597 albertel 6914: padding-bottom: 4px;
1.591 raeburn 6915: }
6916:
6917: div.LC_clear_float_header {
1.597 albertel 6918: padding-bottom: 2px;
1.591 raeburn 6919: }
6920:
6921: div.LC_clear_float_footer {
1.597 albertel 6922: padding-top: 10px;
1.591 raeburn 6923: clear: both;
6924: }
6925:
1.597 albertel 6926: div.LC_grade_show_user {
1.941 bisitz 6927: /* border-left: 5px solid $sidebg; */
6928: border-top: 5px solid #000000;
6929: margin: 50px 0 0 0;
1.936 bisitz 6930: padding: 15px 0 5px 10px;
1.597 albertel 6931: }
1.795 www 6932:
1.936 bisitz 6933: div.LC_grade_show_user_odd_row {
1.941 bisitz 6934: /* border-left: 5px solid #000000; */
6935: }
6936:
6937: div.LC_grade_show_user div.LC_Box {
6938: margin-right: 50px;
1.597 albertel 6939: }
6940:
6941: div.LC_grade_submissions,
6942: div.LC_grade_message_center,
1.936 bisitz 6943: div.LC_grade_info_links {
1.597 albertel 6944: margin: 5px;
6945: width: 99%;
6946: background: #FFFFFF;
6947: }
1.795 www 6948:
1.597 albertel 6949: div.LC_grade_submissions_header,
1.936 bisitz 6950: div.LC_grade_message_center_header {
1.705 tempelho 6951: font-weight: bold;
6952: font-size: large;
1.597 albertel 6953: }
1.795 www 6954:
1.597 albertel 6955: div.LC_grade_submissions_body,
1.936 bisitz 6956: div.LC_grade_message_center_body {
1.597 albertel 6957: border: 1px solid black;
6958: width: 99%;
6959: background: #FFFFFF;
6960: }
1.795 www 6961:
1.613 albertel 6962: table.LC_scantron_action {
6963: width: 100%;
6964: }
1.795 www 6965:
1.613 albertel 6966: table.LC_scantron_action tr th {
1.698 harmsja 6967: font-weight:bold;
6968: font-style:normal;
1.613 albertel 6969: }
1.795 www 6970:
1.779 bisitz 6971: .LC_edit_problem_header,
1.614 albertel 6972: div.LC_edit_problem_footer {
1.705 tempelho 6973: font-weight: normal;
6974: font-size: medium;
1.602 albertel 6975: margin: 2px;
1.1060 bisitz 6976: background-color: $sidebg;
1.600 albertel 6977: }
1.795 www 6978:
1.600 albertel 6979: div.LC_edit_problem_header,
1.602 albertel 6980: div.LC_edit_problem_header div,
1.614 albertel 6981: div.LC_edit_problem_footer,
6982: div.LC_edit_problem_footer div,
1.602 albertel 6983: div.LC_edit_problem_editxml_header,
6984: div.LC_edit_problem_editxml_header div {
1.1075.2.112 raeburn 6985: z-index: 100;
1.600 albertel 6986: }
1.795 www 6987:
1.600 albertel 6988: div.LC_edit_problem_header_title {
1.705 tempelho 6989: font-weight: bold;
6990: font-size: larger;
1.602 albertel 6991: background: $tabbg;
6992: padding: 3px;
1.1060 bisitz 6993: margin: 0 0 5px 0;
1.602 albertel 6994: }
1.795 www 6995:
1.602 albertel 6996: table.LC_edit_problem_header_title {
6997: width: 100%;
1.600 albertel 6998: background: $tabbg;
1.602 albertel 6999: }
7000:
1.1075.2.112 raeburn 7001: div.LC_edit_actionbar {
7002: background-color: $sidebg;
7003: margin: 0;
7004: padding: 0;
7005: line-height: 200%;
1.602 albertel 7006: }
1.795 www 7007:
1.1075.2.112 raeburn 7008: div.LC_edit_actionbar div{
7009: padding: 0;
7010: margin: 0;
7011: display: inline-block;
1.600 albertel 7012: }
1.795 www 7013:
1.1075.2.34 raeburn 7014: .LC_edit_opt {
7015: padding-left: 1em;
7016: white-space: nowrap;
7017: }
7018:
1.1075.2.57 raeburn 7019: .LC_edit_problem_latexhelper{
7020: text-align: right;
7021: }
7022:
7023: #LC_edit_problem_colorful div{
7024: margin-left: 40px;
7025: }
7026:
1.1075.2.112 raeburn 7027: #LC_edit_problem_codemirror div{
7028: margin-left: 0px;
7029: }
7030:
1.911 bisitz 7031: img.stift {
1.803 bisitz 7032: border-width: 0;
7033: vertical-align: middle;
1.677 riegler 7034: }
1.680 riegler 7035:
1.923 bisitz 7036: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7037: vertical-align: top;
1.777 tempelho 7038: }
1.795 www 7039:
1.716 raeburn 7040: div.LC_createcourse {
1.911 bisitz 7041: margin: 10px 10px 10px 10px;
1.716 raeburn 7042: }
7043:
1.917 raeburn 7044: .LC_dccid {
1.1075.2.38 raeburn 7045: float: right;
1.917 raeburn 7046: margin: 0.2em 0 0 0;
7047: padding: 0;
7048: font-size: 90%;
7049: display:none;
7050: }
7051:
1.897 wenzelju 7052: ol.LC_primary_menu a:hover,
1.721 harmsja 7053: ol#LC_MenuBreadcrumbs a:hover,
7054: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7055: ul#LC_secondary_menu a:hover,
1.721 harmsja 7056: .LC_FormSectionClearButton input:hover
1.795 www 7057: ul.LC_TabContent li:hover a {
1.952 onken 7058: color:$button_hover;
1.911 bisitz 7059: text-decoration:none;
1.693 droeschl 7060: }
7061:
1.779 bisitz 7062: h1 {
1.911 bisitz 7063: padding: 0;
7064: line-height:130%;
1.693 droeschl 7065: }
1.698 harmsja 7066:
1.911 bisitz 7067: h2,
7068: h3,
7069: h4,
7070: h5,
7071: h6 {
7072: margin: 5px 0 5px 0;
7073: padding: 0;
7074: line-height:130%;
1.693 droeschl 7075: }
1.795 www 7076:
7077: .LC_hcell {
1.911 bisitz 7078: padding:3px 15px 3px 15px;
7079: margin: 0;
7080: background-color:$tabbg;
7081: color:$fontmenu;
7082: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7083: }
1.795 www 7084:
1.840 bisitz 7085: .LC_Box > .LC_hcell {
1.911 bisitz 7086: margin: 0 -10px 10px -10px;
1.835 bisitz 7087: }
7088:
1.721 harmsja 7089: .LC_noBorder {
1.911 bisitz 7090: border: 0;
1.698 harmsja 7091: }
1.693 droeschl 7092:
1.721 harmsja 7093: .LC_FormSectionClearButton input {
1.911 bisitz 7094: background-color:transparent;
7095: border: none;
7096: cursor:pointer;
7097: text-decoration:underline;
1.693 droeschl 7098: }
1.763 bisitz 7099:
7100: .LC_help_open_topic {
1.911 bisitz 7101: color: #FFFFFF;
7102: background-color: #EEEEFF;
7103: margin: 1px;
7104: padding: 4px;
7105: border: 1px solid #000033;
7106: white-space: nowrap;
7107: /* vertical-align: middle; */
1.759 neumanie 7108: }
1.693 droeschl 7109:
1.911 bisitz 7110: dl,
7111: ul,
7112: div,
7113: fieldset {
7114: margin: 10px 10px 10px 0;
7115: /* overflow: hidden; */
1.693 droeschl 7116: }
1.795 www 7117:
1.1075.2.90 raeburn 7118: article.geogebraweb div {
7119: margin: 0;
7120: }
7121:
1.838 bisitz 7122: fieldset > legend {
1.911 bisitz 7123: font-weight: bold;
7124: padding: 0 5px 0 5px;
1.838 bisitz 7125: }
7126:
1.813 bisitz 7127: #LC_nav_bar {
1.911 bisitz 7128: float: left;
1.995 raeburn 7129: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7130: margin: 0 0 2px 0;
1.807 droeschl 7131: }
7132:
1.916 droeschl 7133: #LC_realm {
7134: margin: 0.2em 0 0 0;
7135: padding: 0;
7136: font-weight: bold;
7137: text-align: center;
1.995 raeburn 7138: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7139: }
7140:
1.911 bisitz 7141: #LC_nav_bar em {
7142: font-weight: bold;
7143: font-style: normal;
1.807 droeschl 7144: }
7145:
1.897 wenzelju 7146: ol.LC_primary_menu {
1.934 droeschl 7147: margin: 0;
1.1075.2.2 raeburn 7148: padding: 0;
1.807 droeschl 7149: }
7150:
1.852 droeschl 7151: ol#LC_PathBreadcrumbs {
1.911 bisitz 7152: margin: 0;
1.693 droeschl 7153: }
7154:
1.897 wenzelju 7155: ol.LC_primary_menu li {
1.1075.2.2 raeburn 7156: color: RGB(80, 80, 80);
7157: vertical-align: middle;
7158: text-align: left;
7159: list-style: none;
1.1075.2.112 raeburn 7160: position: relative;
1.1075.2.2 raeburn 7161: float: left;
1.1075.2.112 raeburn 7162: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7163: line-height: 1.5em;
1.1075.2.2 raeburn 7164: }
7165:
1.1075.2.113 raeburn 7166: ol.LC_primary_menu li a,
1.1075.2.112 raeburn 7167: ol.LC_primary_menu li p {
1.1075.2.2 raeburn 7168: display: block;
7169: margin: 0;
7170: padding: 0 5px 0 10px;
7171: text-decoration: none;
7172: }
7173:
1.1075.2.112 raeburn 7174: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7175: display: inline-block;
7176: width: 95%;
7177: text-align: left;
7178: }
7179:
7180: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7181: display: inline-block;
7182: width: 5%;
7183: float: right;
7184: text-align: right;
7185: font-size: 70%;
7186: }
7187:
7188: ol.LC_primary_menu ul {
1.1075.2.2 raeburn 7189: display: none;
1.1075.2.112 raeburn 7190: width: 15em;
1.1075.2.2 raeburn 7191: background-color: $data_table_light;
1.1075.2.112 raeburn 7192: position: absolute;
7193: top: 100%;
7194: }
7195:
7196: ol.LC_primary_menu ul ul {
7197: left: 100%;
7198: top: 0;
1.1075.2.2 raeburn 7199: }
7200:
1.1075.2.112 raeburn 7201: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2 raeburn 7202: display: block;
7203: position: absolute;
7204: margin: 0;
7205: padding: 0;
1.1075.2.5 raeburn 7206: z-index: 2;
1.1075.2.2 raeburn 7207: }
7208:
7209: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112 raeburn 7210: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2 raeburn 7211: font-size: 90%;
1.911 bisitz 7212: vertical-align: top;
1.1075.2.2 raeburn 7213: float: none;
1.1075.2.5 raeburn 7214: border-left: 1px solid black;
7215: border-right: 1px solid black;
1.1075.2.112 raeburn 7216: /* A dark bottom border to visualize different menu options;
7217: overwritten in the create_submenu routine for the last border-bottom of the menu */
7218: border-bottom: 1px solid $data_table_dark;
1.1075.2.2 raeburn 7219: }
7220:
1.1075.2.112 raeburn 7221: ol.LC_primary_menu li li p:hover {
7222: color:$button_hover;
7223: text-decoration:none;
7224: background-color:$data_table_dark;
1.1075.2.2 raeburn 7225: }
7226:
7227: ol.LC_primary_menu li li a:hover {
7228: color:$button_hover;
7229: background-color:$data_table_dark;
1.693 droeschl 7230: }
7231:
1.1075.2.112 raeburn 7232: /* Font-size equal to the size of the predecessors*/
7233: ol.LC_primary_menu li:hover li li {
7234: font-size: 100%;
7235: }
7236:
1.897 wenzelju 7237: ol.LC_primary_menu li img {
1.911 bisitz 7238: vertical-align: bottom;
1.934 droeschl 7239: height: 1.1em;
1.1075.2.3 raeburn 7240: margin: 0.2em 0 0 0;
1.693 droeschl 7241: }
7242:
1.897 wenzelju 7243: ol.LC_primary_menu a {
1.911 bisitz 7244: color: RGB(80, 80, 80);
7245: text-decoration: none;
1.693 droeschl 7246: }
1.795 www 7247:
1.949 droeschl 7248: ol.LC_primary_menu a.LC_new_message {
7249: font-weight:bold;
7250: color: darkred;
7251: }
7252:
1.975 raeburn 7253: ol.LC_docs_parameters {
7254: margin-left: 0;
7255: padding: 0;
7256: list-style: none;
7257: }
7258:
7259: ol.LC_docs_parameters li {
7260: margin: 0;
7261: padding-right: 20px;
7262: display: inline;
7263: }
7264:
1.976 raeburn 7265: ol.LC_docs_parameters li:before {
7266: content: "\\002022 \\0020";
7267: }
7268:
7269: li.LC_docs_parameters_title {
7270: font-weight: bold;
7271: }
7272:
7273: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7274: content: "";
7275: }
7276:
1.897 wenzelju 7277: ul#LC_secondary_menu {
1.1075.2.23 raeburn 7278: clear: right;
1.911 bisitz 7279: color: $fontmenu;
7280: background: $tabbg;
7281: list-style: none;
7282: padding: 0;
7283: margin: 0;
7284: width: 100%;
1.995 raeburn 7285: text-align: left;
1.1075.2.4 raeburn 7286: float: left;
1.808 droeschl 7287: }
7288:
1.897 wenzelju 7289: ul#LC_secondary_menu li {
1.911 bisitz 7290: font-weight: bold;
7291: line-height: 1.8em;
7292: border-right: 1px solid black;
1.1075.2.4 raeburn 7293: float: left;
7294: }
7295:
7296: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7297: background-color: $data_table_light;
7298: }
7299:
7300: ul#LC_secondary_menu li a {
7301: padding: 0 0.8em;
7302: }
7303:
7304: ul#LC_secondary_menu li ul {
7305: display: none;
7306: }
7307:
7308: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7309: display: block;
7310: position: absolute;
7311: margin: 0;
7312: padding: 0;
7313: list-style:none;
7314: float: none;
7315: background-color: $data_table_light;
1.1075.2.5 raeburn 7316: z-index: 2;
1.1075.2.10 raeburn 7317: margin-left: -1px;
1.1075.2.4 raeburn 7318: }
7319:
7320: ul#LC_secondary_menu li ul li {
7321: font-size: 90%;
7322: vertical-align: top;
7323: border-left: 1px solid black;
7324: border-right: 1px solid black;
1.1075.2.33 raeburn 7325: background-color: $data_table_light;
1.1075.2.4 raeburn 7326: list-style:none;
7327: float: none;
7328: }
7329:
7330: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7331: background-color: $data_table_dark;
1.807 droeschl 7332: }
7333:
1.847 tempelho 7334: ul.LC_TabContent {
1.911 bisitz 7335: display:block;
7336: background: $sidebg;
7337: border-bottom: solid 1px $lg_border_color;
7338: list-style:none;
1.1020 raeburn 7339: margin: -1px -10px 0 -10px;
1.911 bisitz 7340: padding: 0;
1.693 droeschl 7341: }
7342:
1.795 www 7343: ul.LC_TabContent li,
7344: ul.LC_TabContentBigger li {
1.911 bisitz 7345: float:left;
1.741 harmsja 7346: }
1.795 www 7347:
1.897 wenzelju 7348: ul#LC_secondary_menu li a {
1.911 bisitz 7349: color: $fontmenu;
7350: text-decoration: none;
1.693 droeschl 7351: }
1.795 www 7352:
1.721 harmsja 7353: ul.LC_TabContent {
1.952 onken 7354: min-height:20px;
1.721 harmsja 7355: }
1.795 www 7356:
7357: ul.LC_TabContent li {
1.911 bisitz 7358: vertical-align:middle;
1.959 onken 7359: padding: 0 16px 0 10px;
1.911 bisitz 7360: background-color:$tabbg;
7361: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7362: border-left: solid 1px $font;
1.721 harmsja 7363: }
1.795 www 7364:
1.847 tempelho 7365: ul.LC_TabContent .right {
1.911 bisitz 7366: float:right;
1.847 tempelho 7367: }
7368:
1.911 bisitz 7369: ul.LC_TabContent li a,
7370: ul.LC_TabContent li {
7371: color:rgb(47,47,47);
7372: text-decoration:none;
7373: font-size:95%;
7374: font-weight:bold;
1.952 onken 7375: min-height:20px;
7376: }
7377:
1.959 onken 7378: ul.LC_TabContent li a:hover,
7379: ul.LC_TabContent li a:focus {
1.952 onken 7380: color: $button_hover;
1.959 onken 7381: background:none;
7382: outline:none;
1.952 onken 7383: }
7384:
7385: ul.LC_TabContent li:hover {
7386: color: $button_hover;
7387: cursor:pointer;
1.721 harmsja 7388: }
1.795 www 7389:
1.911 bisitz 7390: ul.LC_TabContent li.active {
1.952 onken 7391: color: $font;
1.911 bisitz 7392: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7393: border-bottom:solid 1px #FFFFFF;
7394: cursor: default;
1.744 ehlerst 7395: }
1.795 www 7396:
1.959 onken 7397: ul.LC_TabContent li.active a {
7398: color:$font;
7399: background:#FFFFFF;
7400: outline: none;
7401: }
1.1047 raeburn 7402:
7403: ul.LC_TabContent li.goback {
7404: float: left;
7405: border-left: none;
7406: }
7407:
1.870 tempelho 7408: #maincoursedoc {
1.911 bisitz 7409: clear:both;
1.870 tempelho 7410: }
7411:
7412: ul.LC_TabContentBigger {
1.911 bisitz 7413: display:block;
7414: list-style:none;
7415: padding: 0;
1.870 tempelho 7416: }
7417:
1.795 www 7418: ul.LC_TabContentBigger li {
1.911 bisitz 7419: vertical-align:bottom;
7420: height: 30px;
7421: font-size:110%;
7422: font-weight:bold;
7423: color: #737373;
1.841 tempelho 7424: }
7425:
1.957 onken 7426: ul.LC_TabContentBigger li.active {
7427: position: relative;
7428: top: 1px;
7429: }
7430:
1.870 tempelho 7431: ul.LC_TabContentBigger li a {
1.911 bisitz 7432: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7433: height: 30px;
7434: line-height: 30px;
7435: text-align: center;
7436: display: block;
7437: text-decoration: none;
1.958 onken 7438: outline: none;
1.741 harmsja 7439: }
1.795 www 7440:
1.870 tempelho 7441: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7442: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7443: color:$font;
1.744 ehlerst 7444: }
1.795 www 7445:
1.870 tempelho 7446: ul.LC_TabContentBigger li b {
1.911 bisitz 7447: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7448: display: block;
7449: float: left;
7450: padding: 0 30px;
1.957 onken 7451: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7452: }
7453:
1.956 onken 7454: ul.LC_TabContentBigger li:hover b {
7455: color:$button_hover;
7456: }
7457:
1.870 tempelho 7458: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7459: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7460: color:$font;
1.957 onken 7461: border: 0;
1.741 harmsja 7462: }
1.693 droeschl 7463:
1.870 tempelho 7464:
1.862 bisitz 7465: ul.LC_CourseBreadcrumbs {
7466: background: $sidebg;
1.1020 raeburn 7467: height: 2em;
1.862 bisitz 7468: padding-left: 10px;
1.1020 raeburn 7469: margin: 0;
1.862 bisitz 7470: list-style-position: inside;
7471: }
7472:
1.911 bisitz 7473: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7474: ol#LC_PathBreadcrumbs {
1.911 bisitz 7475: padding-left: 10px;
7476: margin: 0;
1.933 droeschl 7477: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7478: }
7479:
1.911 bisitz 7480: ol#LC_MenuBreadcrumbs li,
7481: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7482: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7483: display: inline;
1.933 droeschl 7484: white-space: normal;
1.693 droeschl 7485: }
7486:
1.823 bisitz 7487: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7488: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7489: text-decoration: none;
7490: font-size:90%;
1.693 droeschl 7491: }
1.795 www 7492:
1.969 droeschl 7493: ol#LC_MenuBreadcrumbs h1 {
7494: display: inline;
7495: font-size: 90%;
7496: line-height: 2.5em;
7497: margin: 0;
7498: padding: 0;
7499: }
7500:
1.795 www 7501: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7502: text-decoration:none;
7503: font-size:100%;
7504: font-weight:bold;
1.693 droeschl 7505: }
1.795 www 7506:
1.840 bisitz 7507: .LC_Box {
1.911 bisitz 7508: border: solid 1px $lg_border_color;
7509: padding: 0 10px 10px 10px;
1.746 neumanie 7510: }
1.795 www 7511:
1.1020 raeburn 7512: .LC_DocsBox {
7513: border: solid 1px $lg_border_color;
7514: padding: 0 0 10px 10px;
7515: }
7516:
1.795 www 7517: .LC_AboutMe_Image {
1.911 bisitz 7518: float:left;
7519: margin-right:10px;
1.747 neumanie 7520: }
1.795 www 7521:
7522: .LC_Clear_AboutMe_Image {
1.911 bisitz 7523: clear:left;
1.747 neumanie 7524: }
1.795 www 7525:
1.721 harmsja 7526: dl.LC_ListStyleClean dt {
1.911 bisitz 7527: padding-right: 5px;
7528: display: table-header-group;
1.693 droeschl 7529: }
7530:
1.721 harmsja 7531: dl.LC_ListStyleClean dd {
1.911 bisitz 7532: display: table-row;
1.693 droeschl 7533: }
7534:
1.721 harmsja 7535: .LC_ListStyleClean,
7536: .LC_ListStyleSimple,
7537: .LC_ListStyleNormal,
1.795 www 7538: .LC_ListStyleSpecial {
1.911 bisitz 7539: /* display:block; */
7540: list-style-position: inside;
7541: list-style-type: none;
7542: overflow: hidden;
7543: padding: 0;
1.693 droeschl 7544: }
7545:
1.721 harmsja 7546: .LC_ListStyleSimple li,
7547: .LC_ListStyleSimple dd,
7548: .LC_ListStyleNormal li,
7549: .LC_ListStyleNormal dd,
7550: .LC_ListStyleSpecial li,
1.795 www 7551: .LC_ListStyleSpecial dd {
1.911 bisitz 7552: margin: 0;
7553: padding: 5px 5px 5px 10px;
7554: clear: both;
1.693 droeschl 7555: }
7556:
1.721 harmsja 7557: .LC_ListStyleClean li,
7558: .LC_ListStyleClean dd {
1.911 bisitz 7559: padding-top: 0;
7560: padding-bottom: 0;
1.693 droeschl 7561: }
7562:
1.721 harmsja 7563: .LC_ListStyleSimple dd,
1.795 www 7564: .LC_ListStyleSimple li {
1.911 bisitz 7565: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7566: }
7567:
1.721 harmsja 7568: .LC_ListStyleSpecial li,
7569: .LC_ListStyleSpecial dd {
1.911 bisitz 7570: list-style-type: none;
7571: background-color: RGB(220, 220, 220);
7572: margin-bottom: 4px;
1.693 droeschl 7573: }
7574:
1.721 harmsja 7575: table.LC_SimpleTable {
1.911 bisitz 7576: margin:5px;
7577: border:solid 1px $lg_border_color;
1.795 www 7578: }
1.693 droeschl 7579:
1.721 harmsja 7580: table.LC_SimpleTable tr {
1.911 bisitz 7581: padding: 0;
7582: border:solid 1px $lg_border_color;
1.693 droeschl 7583: }
1.795 www 7584:
7585: table.LC_SimpleTable thead {
1.911 bisitz 7586: background:rgb(220,220,220);
1.693 droeschl 7587: }
7588:
1.721 harmsja 7589: div.LC_columnSection {
1.911 bisitz 7590: display: block;
7591: clear: both;
7592: overflow: hidden;
7593: margin: 0;
1.693 droeschl 7594: }
7595:
1.721 harmsja 7596: div.LC_columnSection>* {
1.911 bisitz 7597: float: left;
7598: margin: 10px 20px 10px 0;
7599: overflow:hidden;
1.693 droeschl 7600: }
1.721 harmsja 7601:
1.795 www 7602: table em {
1.911 bisitz 7603: font-weight: bold;
7604: font-style: normal;
1.748 schulted 7605: }
1.795 www 7606:
1.779 bisitz 7607: table.LC_tableBrowseRes,
1.795 www 7608: table.LC_tableOfContent {
1.911 bisitz 7609: border:none;
7610: border-spacing: 1px;
7611: padding: 3px;
7612: background-color: #FFFFFF;
7613: font-size: 90%;
1.753 droeschl 7614: }
1.789 droeschl 7615:
1.911 bisitz 7616: table.LC_tableOfContent {
7617: border-collapse: collapse;
1.789 droeschl 7618: }
7619:
1.771 droeschl 7620: table.LC_tableBrowseRes a,
1.768 schulted 7621: table.LC_tableOfContent a {
1.911 bisitz 7622: background-color: transparent;
7623: text-decoration: none;
1.753 droeschl 7624: }
7625:
1.795 www 7626: table.LC_tableOfContent img {
1.911 bisitz 7627: border: none;
7628: height: 1.3em;
7629: vertical-align: text-bottom;
7630: margin-right: 0.3em;
1.753 droeschl 7631: }
1.757 schulted 7632:
1.795 www 7633: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7634: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7635: }
7636:
1.795 www 7637: a#LC_content_toolbar_everything {
1.911 bisitz 7638: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7639: }
7640:
1.795 www 7641: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7642: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7643: }
7644:
1.795 www 7645: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7646: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7647: }
7648:
1.795 www 7649: a#LC_content_toolbar_changefolder {
1.911 bisitz 7650: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7651: }
7652:
1.795 www 7653: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7654: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7655: }
7656:
1.1043 raeburn 7657: a#LC_content_toolbar_edittoplevel {
7658: background-image:url(/res/adm/pages/edittoplevel.gif);
7659: }
7660:
1.795 www 7661: ul#LC_toolbar li a:hover {
1.911 bisitz 7662: background-position: bottom center;
1.757 schulted 7663: }
7664:
1.795 www 7665: ul#LC_toolbar {
1.911 bisitz 7666: padding: 0;
7667: margin: 2px;
7668: list-style:none;
7669: position:relative;
7670: background-color:white;
1.1075.2.9 raeburn 7671: overflow: auto;
1.757 schulted 7672: }
7673:
1.795 www 7674: ul#LC_toolbar li {
1.911 bisitz 7675: border:1px solid white;
7676: padding: 0;
7677: margin: 0;
7678: float: left;
7679: display:inline;
7680: vertical-align:middle;
1.1075.2.9 raeburn 7681: white-space: nowrap;
1.911 bisitz 7682: }
1.757 schulted 7683:
1.783 amueller 7684:
1.795 www 7685: a.LC_toolbarItem {
1.911 bisitz 7686: display:block;
7687: padding: 0;
7688: margin: 0;
7689: height: 32px;
7690: width: 32px;
7691: color:white;
7692: border: none;
7693: background-repeat:no-repeat;
7694: background-color:transparent;
1.757 schulted 7695: }
7696:
1.915 droeschl 7697: ul.LC_funclist {
7698: margin: 0;
7699: padding: 0.5em 1em 0.5em 0;
7700: }
7701:
1.933 droeschl 7702: ul.LC_funclist > li:first-child {
7703: font-weight:bold;
7704: margin-left:0.8em;
7705: }
7706:
1.915 droeschl 7707: ul.LC_funclist + ul.LC_funclist {
7708: /*
7709: left border as a seperator if we have more than
7710: one list
7711: */
7712: border-left: 1px solid $sidebg;
7713: /*
7714: this hides the left border behind the border of the
7715: outer box if element is wrapped to the next 'line'
7716: */
7717: margin-left: -1px;
7718: }
7719:
1.843 bisitz 7720: ul.LC_funclist li {
1.915 droeschl 7721: display: inline;
1.782 bisitz 7722: white-space: nowrap;
1.915 droeschl 7723: margin: 0 0 0 25px;
7724: line-height: 150%;
1.782 bisitz 7725: }
7726:
1.974 wenzelju 7727: .LC_hidden {
7728: display: none;
7729: }
7730:
1.1030 www 7731: .LCmodal-overlay {
7732: position:fixed;
7733: top:0;
7734: right:0;
7735: bottom:0;
7736: left:0;
7737: height:100%;
7738: width:100%;
7739: margin:0;
7740: padding:0;
7741: background:#999;
7742: opacity:.75;
7743: filter: alpha(opacity=75);
7744: -moz-opacity: 0.75;
7745: z-index:101;
7746: }
7747:
7748: * html .LCmodal-overlay {
7749: position: absolute;
7750: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7751: }
7752:
7753: .LCmodal-window {
7754: position:fixed;
7755: top:50%;
7756: left:50%;
7757: margin:0;
7758: padding:0;
7759: z-index:102;
7760: }
7761:
7762: * html .LCmodal-window {
7763: position:absolute;
7764: }
7765:
7766: .LCclose-window {
7767: position:absolute;
7768: width:32px;
7769: height:32px;
7770: right:8px;
7771: top:8px;
7772: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7773: text-indent:-99999px;
7774: overflow:hidden;
7775: cursor:pointer;
7776: }
7777:
1.1075.2.141 raeburn 7778: pre.LC_wordwrap {
7779: white-space: pre-wrap;
7780: white-space: -moz-pre-wrap;
7781: white-space: -pre-wrap;
7782: white-space: -o-pre-wrap;
7783: word-wrap: break-word;
7784: }
7785:
1.1075.2.17 raeburn 7786: /*
7787: styles used by TTH when "Default set of options to pass to tth/m
7788: when converting TeX" in course settings has been set
7789:
7790: option passed: -t
7791:
7792: */
7793:
7794: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7795: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7796: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7797: td div.norm {line-height:normal;}
7798:
7799: /*
7800: option passed -y3
7801: */
7802:
7803: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7804: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7805: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7806:
1.1075.2.121 raeburn 7807: #LC_minitab_header {
7808: float:left;
7809: width:100%;
7810: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
7811: font-size:93%;
7812: line-height:normal;
7813: margin: 0.5em 0 0.5em 0;
7814: }
7815: #LC_minitab_header ul {
7816: margin:0;
7817: padding:10px 10px 0;
7818: list-style:none;
7819: }
7820: #LC_minitab_header li {
7821: float:left;
7822: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
7823: margin:0;
7824: padding:0 0 0 9px;
7825: }
7826: #LC_minitab_header a {
7827: display:block;
7828: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
7829: padding:5px 15px 4px 6px;
7830: }
7831: #LC_minitab_header #LC_current_minitab {
7832: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
7833: }
7834: #LC_minitab_header #LC_current_minitab a {
7835: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
7836: padding-bottom:5px;
7837: }
7838:
7839:
1.343 albertel 7840: END
7841: }
7842:
1.306 albertel 7843: =pod
7844:
7845: =item * &headtag()
7846:
7847: Returns a uniform footer for LON-CAPA web pages.
7848:
1.307 albertel 7849: Inputs: $title - optional title for the head
7850: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7851: $args - optional arguments
1.319 albertel 7852: force_register - if is true call registerurl so the remote is
7853: informed
1.415 albertel 7854: redirect -> array ref of
7855: 1- seconds before redirect occurs
7856: 2- url to redirect to
7857: 3- whether the side effect should occur
1.315 albertel 7858: (side effect of setting
7859: $env{'internal.head.redirect'} to the url
7860: redirected too)
1.352 albertel 7861: domain -> force to color decorate a page for a specific
7862: domain
7863: function -> force usage of a specific rolish color scheme
7864: bgcolor -> override the default page bgcolor
1.460 albertel 7865: no_auto_mt_title
7866: -> prevent &mt()ing the title arg
1.464 albertel 7867:
1.306 albertel 7868: =cut
7869:
7870: sub headtag {
1.313 albertel 7871: my ($title,$head_extra,$args) = @_;
1.306 albertel 7872:
1.363 albertel 7873: my $function = $args->{'function'} || &get_users_function();
7874: my $domain = $args->{'domain'} || &determinedomain();
7875: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7876: my $httphost = $args->{'use_absolute'};
1.418 albertel 7877: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7878: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7879: #time(),
1.418 albertel 7880: $env{'environment.color.timestamp'},
1.363 albertel 7881: $function,$domain,$bgcolor);
7882:
1.369 www 7883: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7884:
1.308 albertel 7885: my $result =
7886: '<head>'.
1.1075.2.56 raeburn 7887: &font_settings($args);
1.319 albertel 7888:
1.1075.2.72 raeburn 7889: my $inhibitprint;
7890: if ($args->{'print_suppress'}) {
7891: $inhibitprint = &print_suppression();
7892: }
1.1064 raeburn 7893:
1.461 albertel 7894: if (!$args->{'frameset'}) {
7895: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7896: }
1.1075.2.12 raeburn 7897: if ($args->{'force_register'}) {
7898: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7899: }
1.436 albertel 7900: if (!$args->{'no_nav_bar'}
7901: && !$args->{'only_body'}
7902: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7903: $result .= &help_menu_js($httphost);
1.1032 www 7904: $result.=&modal_window();
1.1038 www 7905: $result.=&togglebox_script();
1.1034 www 7906: $result.=&wishlist_window();
1.1041 www 7907: $result.=&LCprogressbarUpdate_script();
1.1034 www 7908: } else {
7909: if ($args->{'add_modal'}) {
7910: $result.=&modal_window();
7911: }
7912: if ($args->{'add_wishlist'}) {
7913: $result.=&wishlist_window();
7914: }
1.1038 www 7915: if ($args->{'add_togglebox'}) {
7916: $result.=&togglebox_script();
7917: }
1.1041 www 7918: if ($args->{'add_progressbar'}) {
7919: $result.=&LCprogressbarUpdate_script();
7920: }
1.436 albertel 7921: }
1.314 albertel 7922: if (ref($args->{'redirect'})) {
1.414 albertel 7923: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7924: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7925: if (!$inhibit_continue) {
7926: $env{'internal.head.redirect'} = $url;
7927: }
1.313 albertel 7928: $result.=<<ADDMETA
7929: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7930: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7931: ADDMETA
1.1075.2.89 raeburn 7932: } else {
7933: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7934: my $requrl = $env{'request.uri'};
7935: if ($requrl eq '') {
7936: $requrl = $ENV{'REQUEST_URI'};
7937: $requrl =~ s/\?.+$//;
7938: }
7939: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7940: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7941: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7942: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7943: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7944: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7945: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7946: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7947: if ($domdefs{'offloadnow'}{$lonhost}) {
7948: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7949: if (($newserver) && ($newserver ne $lonhost)) {
7950: my $numsec = 5;
7951: my $timeout = $numsec * 1000;
7952: my ($newurl,$locknum,%locks,$msg);
7953: if ($env{'request.role.adv'}) {
7954: ($locknum,%locks) = &Apache::lonnet::get_locks();
7955: }
7956: my $disable_submit = 0;
7957: if ($requrl =~ /$LONCAPA::assess_re/) {
7958: $disable_submit = 1;
7959: }
7960: if ($locknum) {
7961: my @lockinfo = sort(values(%locks));
7962: $msg = &mt('Once the following tasks are complete: ')."\\n".
7963: join(", ",sort(values(%locks)))."\\n".
7964: &mt('your session will be transferred to a different server, after you click "Roles".');
7965: } else {
7966: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7967: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7968: }
7969: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7970: $newurl = '/adm/switchserver?otherserver='.$newserver;
7971: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7972: $newurl .= '&role='.$env{'request.role'};
7973: }
7974: if ($env{'request.symb'}) {
7975: $newurl .= '&symb='.$env{'request.symb'};
7976: } else {
7977: $newurl .= '&origurl='.$requrl;
7978: }
7979: }
1.1075.2.98 raeburn 7980: &js_escape(\$msg);
1.1075.2.89 raeburn 7981: $result.=<<OFFLOAD
7982: <meta http-equiv="pragma" content="no-cache" />
7983: <script type="text/javascript">
1.1075.2.92 raeburn 7984: // <![CDATA[
1.1075.2.89 raeburn 7985: function LC_Offload_Now() {
7986: var dest = "$newurl";
7987: if (dest != '') {
7988: window.location.href="$newurl";
7989: }
7990: }
1.1075.2.92 raeburn 7991: \$(document).ready(function () {
7992: window.alert('$msg');
7993: if ($disable_submit) {
1.1075.2.89 raeburn 7994: \$(".LC_hwk_submit").prop("disabled", true);
7995: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 7996: }
7997: setTimeout('LC_Offload_Now()', $timeout);
7998: });
7999: // ]]>
1.1075.2.89 raeburn 8000: </script>
8001: OFFLOAD
8002: }
8003: }
8004: }
8005: }
8006: }
8007: }
1.313 albertel 8008: }
1.306 albertel 8009: if (!defined($title)) {
8010: $title = 'The LearningOnline Network with CAPA';
8011: }
1.460 albertel 8012: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8013: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 8014: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8015: if (!$args->{'frameset'}) {
8016: $result .= ' /';
8017: }
8018: $result .= '>'
1.1064 raeburn 8019: .$inhibitprint
1.414 albertel 8020: .$head_extra;
1.1075.2.108 raeburn 8021: my $clientmobile;
8022: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8023: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8024: } else {
8025: $clientmobile = $env{'browser.mobile'};
8026: }
8027: if ($clientmobile) {
1.1075.2.42 raeburn 8028: $result .= '
8029: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8030: <meta name="apple-mobile-web-app-capable" content="yes" />';
8031: }
1.1075.2.126 raeburn 8032: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8033: return $result.'</head>';
1.306 albertel 8034: }
8035:
8036: =pod
8037:
1.340 albertel 8038: =item * &font_settings()
8039:
8040: Returns neccessary <meta> to set the proper encoding
8041:
1.1075.2.56 raeburn 8042: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8043:
8044: =cut
8045:
8046: sub font_settings {
1.1075.2.56 raeburn 8047: my ($args) = @_;
1.340 albertel 8048: my $headerstring='';
1.1075.2.56 raeburn 8049: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8050: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 8051: $headerstring.=
1.1075.2.61 raeburn 8052: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8053: if (!$args->{'frameset'}) {
8054: $headerstring.= ' /';
8055: }
8056: $headerstring .= '>'."\n";
1.340 albertel 8057: }
8058: return $headerstring;
8059: }
8060:
1.341 albertel 8061: =pod
8062:
1.1064 raeburn 8063: =item * &print_suppression()
8064:
8065: In course context returns css which causes the body to be blank when media="print",
8066: if printout generation is unavailable for the current resource.
8067:
8068: This could be because:
8069:
8070: (a) printstartdate is in the future
8071:
8072: (b) printenddate is in the past
8073:
8074: (c) there is an active exam block with "printout"
8075: functionality blocked
8076:
8077: Users with pav, pfo or evb privileges are exempt.
8078:
8079: Inputs: none
8080:
8081: =cut
8082:
8083:
8084: sub print_suppression {
8085: my $noprint;
8086: if ($env{'request.course.id'}) {
8087: my $scope = $env{'request.course.id'};
8088: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8089: (&Apache::lonnet::allowed('pfo',$scope))) {
8090: return;
8091: }
8092: if ($env{'request.course.sec'} ne '') {
8093: $scope .= "/$env{'request.course.sec'}";
8094: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8095: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8096: return;
1.1064 raeburn 8097: }
8098: }
8099: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8100: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73 raeburn 8101: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8102: if ($blocked) {
8103: my $checkrole = "cm./$cdom/$cnum";
8104: if ($env{'request.course.sec'} ne '') {
8105: $checkrole .= "/$env{'request.course.sec'}";
8106: }
8107: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8108: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8109: $noprint = 1;
8110: }
8111: }
8112: unless ($noprint) {
8113: my $symb = &Apache::lonnet::symbread();
8114: if ($symb ne '') {
8115: my $navmap = Apache::lonnavmaps::navmap->new();
8116: if (ref($navmap)) {
8117: my $res = $navmap->getBySymb($symb);
8118: if (ref($res)) {
8119: if (!$res->resprintable()) {
8120: $noprint = 1;
8121: }
8122: }
8123: }
8124: }
8125: }
8126: if ($noprint) {
8127: return <<"ENDSTYLE";
8128: <style type="text/css" media="print">
8129: body { display:none }
8130: </style>
8131: ENDSTYLE
8132: }
8133: }
8134: return;
8135: }
8136:
8137: =pod
8138:
1.341 albertel 8139: =item * &xml_begin()
8140:
8141: Returns the needed doctype and <html>
8142:
8143: Inputs: none
8144:
8145: =cut
8146:
8147: sub xml_begin {
1.1075.2.61 raeburn 8148: my ($is_frameset) = @_;
1.341 albertel 8149: my $output='';
8150:
8151: if ($env{'browser.mathml'}) {
8152: $output='<?xml version="1.0"?>'
8153: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8154: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8155:
8156: # .'<!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">] >'
8157: .'<!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">'
8158: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8159: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 8160: } elsif ($is_frameset) {
8161: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8162: '<html>'."\n";
1.341 albertel 8163: } else {
1.1075.2.61 raeburn 8164: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8165: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8166: }
8167: return $output;
8168: }
1.340 albertel 8169:
8170: =pod
8171:
1.306 albertel 8172: =item * &start_page()
8173:
8174: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8175:
1.648 raeburn 8176: Inputs:
8177:
8178: =over 4
8179:
8180: $title - optional title for the page
8181:
8182: $head_extra - optional extra HTML to incude inside the <head>
8183:
8184: $args - additional optional args supported are:
8185:
8186: =over 8
8187:
8188: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8189: arg on
1.814 bisitz 8190: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8191: add_entries -> additional attributes to add to the <body>
8192: domain -> force to color decorate a page for a
1.317 albertel 8193: specific domain
1.648 raeburn 8194: function -> force usage of a specific rolish color
1.317 albertel 8195: scheme
1.648 raeburn 8196: redirect -> see &headtag()
8197: bgcolor -> override the default page bg color
8198: js_ready -> return a string ready for being used in
1.317 albertel 8199: a javascript writeln
1.648 raeburn 8200: html_encode -> return a string ready for being used in
1.320 albertel 8201: a html attribute
1.648 raeburn 8202: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8203: $forcereg arg
1.648 raeburn 8204: frameset -> if true will start with a <frameset>
1.330 albertel 8205: rather than <body>
1.648 raeburn 8206: skip_phases -> hash ref of
1.338 albertel 8207: head -> skip the <html><head> generation
8208: body -> skip all <body> generation
1.1075.2.12 raeburn 8209: no_inline_link -> if true and in remote mode, don't show the
8210: 'Switch To Inline Menu' link
1.648 raeburn 8211: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8212: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8213: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.123 raeburn 8214: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8215: to lonhtmlcommon::breadcrumbs
1.1075.2.15 raeburn 8216: group -> includes the current group, if page is for a
8217: specific group
1.1075.2.133 raeburn 8218: use_absolute -> for request for external resource or syllabus, this
8219: will contain https://<hostname> if server uses
8220: https (as per hosts.tab), but request is for http
8221: hostname -> hostname, originally from $r->hostname(), (optional).
1.361 albertel 8222:
1.648 raeburn 8223: =back
1.460 albertel 8224:
1.648 raeburn 8225: =back
1.562 albertel 8226:
1.306 albertel 8227: =cut
8228:
8229: sub start_page {
1.309 albertel 8230: my ($title,$head_extra,$args) = @_;
1.318 albertel 8231: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8232:
1.315 albertel 8233: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 8234: my ($result,@advtools);
1.964 droeschl 8235:
1.338 albertel 8236: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 8237: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8238: }
8239:
8240: if (! exists($args->{'skip_phases'}{'body'}) ) {
8241: if ($args->{'frameset'}) {
8242: my $attr_string = &make_attr_string($args->{'force_register'},
8243: $args->{'add_entries'});
8244: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8245: } else {
8246: $result .=
8247: &bodytag($title,
8248: $args->{'function'}, $args->{'add_entries'},
8249: $args->{'only_body'}, $args->{'domain'},
8250: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 8251: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 8252: $args, \@advtools);
1.831 bisitz 8253: }
1.330 albertel 8254: }
1.338 albertel 8255:
1.315 albertel 8256: if ($args->{'js_ready'}) {
1.713 kaisler 8257: $result = &js_ready($result);
1.315 albertel 8258: }
1.320 albertel 8259: if ($args->{'html_encode'}) {
1.713 kaisler 8260: $result = &html_encode($result);
8261: }
8262:
1.813 bisitz 8263: # Preparation for new and consistent functionlist at top of screen
8264: # if ($args->{'functionlist'}) {
8265: # $result .= &build_functionlist();
8266: #}
8267:
1.964 droeschl 8268: # Don't add anything more if only_body wanted or in const space
8269: return $result if $args->{'only_body'}
8270: || $env{'request.state'} eq 'construct';
1.813 bisitz 8271:
8272: #Breadcrumbs
1.758 kaisler 8273: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8274: &Apache::lonhtmlcommon::clear_breadcrumbs();
8275: #if any br links exists, add them to the breadcrumbs
8276: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8277: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8278: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8279: }
8280: }
1.1075.2.19 raeburn 8281: # if @advtools array contains items add then to the breadcrumbs
8282: if (@advtools > 0) {
8283: &Apache::lonmenu::advtools_crumbs(@advtools);
8284: }
1.1075.2.123 raeburn 8285: my $menulink;
8286: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8287: if (exists($args->{'bread_crumbs_nomenu'})) {
8288: $menulink = 0;
8289: } else {
8290: undef($menulink);
8291: }
1.758 kaisler 8292: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8293: if(exists($args->{'bread_crumbs_component'})){
1.1075.2.123 raeburn 8294: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.758 kaisler 8295: }else{
1.1075.2.123 raeburn 8296: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8297: }
1.1075.2.24 raeburn 8298: } elsif (($env{'environment.remote'} eq 'on') &&
8299: ($env{'form.inhibitmenu'} ne 'yes') &&
8300: ($env{'request.noversionuri'} =~ m{^/res/}) &&
8301: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 8302: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 8303: }
1.315 albertel 8304: return $result;
1.306 albertel 8305: }
8306:
8307: sub end_page {
1.315 albertel 8308: my ($args) = @_;
8309: $env{'internal.end_page'}++;
1.330 albertel 8310: my $result;
1.335 albertel 8311: if ($args->{'discussion'}) {
8312: my ($target,$parser);
8313: if (ref($args->{'discussion'})) {
8314: ($target,$parser) =($args->{'discussion'}{'target'},
8315: $args->{'discussion'}{'parser'});
8316: }
8317: $result .= &Apache::lonxml::xmlend($target,$parser);
8318: }
1.330 albertel 8319: if ($args->{'frameset'}) {
8320: $result .= '</frameset>';
8321: } else {
1.635 raeburn 8322: $result .= &endbodytag($args);
1.330 albertel 8323: }
1.1075.2.6 raeburn 8324: unless ($args->{'notbody'}) {
8325: $result .= "\n</html>";
8326: }
1.330 albertel 8327:
1.315 albertel 8328: if ($args->{'js_ready'}) {
1.317 albertel 8329: $result = &js_ready($result);
1.315 albertel 8330: }
1.335 albertel 8331:
1.320 albertel 8332: if ($args->{'html_encode'}) {
8333: $result = &html_encode($result);
8334: }
1.335 albertel 8335:
1.315 albertel 8336: return $result;
8337: }
8338:
1.1034 www 8339: sub wishlist_window {
8340: return(<<'ENDWISHLIST');
1.1046 raeburn 8341: <script type="text/javascript">
1.1034 www 8342: // <![CDATA[
8343: // <!-- BEGIN LON-CAPA Internal
8344: function set_wishlistlink(title, path) {
8345: if (!title) {
8346: title = document.title;
8347: title = title.replace(/^LON-CAPA /,'');
8348: }
1.1075.2.65 raeburn 8349: title = encodeURIComponent(title);
1.1075.2.83 raeburn 8350: title = title.replace("'","\\\'");
1.1034 www 8351: if (!path) {
8352: path = location.pathname;
8353: }
1.1075.2.65 raeburn 8354: path = encodeURIComponent(path);
1.1075.2.83 raeburn 8355: path = path.replace("'","\\\'");
1.1034 www 8356: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8357: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8358: }
8359: // END LON-CAPA Internal -->
8360: // ]]>
8361: </script>
8362: ENDWISHLIST
8363: }
8364:
1.1030 www 8365: sub modal_window {
8366: return(<<'ENDMODAL');
1.1046 raeburn 8367: <script type="text/javascript">
1.1030 www 8368: // <![CDATA[
8369: // <!-- BEGIN LON-CAPA Internal
8370: var modalWindow = {
8371: parent:"body",
8372: windowId:null,
8373: content:null,
8374: width:null,
8375: height:null,
8376: close:function()
8377: {
8378: $(".LCmodal-window").remove();
8379: $(".LCmodal-overlay").remove();
8380: },
8381: open:function()
8382: {
8383: var modal = "";
8384: modal += "<div class=\"LCmodal-overlay\"></div>";
8385: 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;\">";
8386: modal += this.content;
8387: modal += "</div>";
8388:
8389: $(this.parent).append(modal);
8390:
8391: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8392: $(".LCclose-window").click(function(){modalWindow.close();});
8393: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8394: }
8395: };
1.1075.2.42 raeburn 8396: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8397: {
1.1075.2.119 raeburn 8398: source = source.replace(/'/g,"'");
1.1030 www 8399: modalWindow.windowId = "myModal";
8400: modalWindow.width = width;
8401: modalWindow.height = height;
1.1075.2.80 raeburn 8402: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8403: modalWindow.open();
1.1075.2.87 raeburn 8404: };
1.1030 www 8405: // END LON-CAPA Internal -->
8406: // ]]>
8407: </script>
8408: ENDMODAL
8409: }
8410:
8411: sub modal_link {
1.1075.2.42 raeburn 8412: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8413: unless ($width) { $width=480; }
8414: unless ($height) { $height=400; }
1.1031 www 8415: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 8416: unless ($transparency) { $transparency='true'; }
8417:
1.1074 raeburn 8418: my $target_attr;
8419: if (defined($target)) {
8420: $target_attr = 'target="'.$target.'"';
8421: }
8422: return <<"ENDLINK";
1.1075.2.42 raeburn 8423: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8424: $linktext</a>
8425: ENDLINK
1.1030 www 8426: }
8427:
1.1032 www 8428: sub modal_adhoc_script {
8429: my ($funcname,$width,$height,$content)=@_;
8430: return (<<ENDADHOC);
1.1046 raeburn 8431: <script type="text/javascript">
1.1032 www 8432: // <![CDATA[
8433: var $funcname = function()
8434: {
8435: modalWindow.windowId = "myModal";
8436: modalWindow.width = $width;
8437: modalWindow.height = $height;
8438: modalWindow.content = '$content';
8439: modalWindow.open();
8440: };
8441: // ]]>
8442: </script>
8443: ENDADHOC
8444: }
8445:
1.1041 www 8446: sub modal_adhoc_inner {
8447: my ($funcname,$width,$height,$content)=@_;
8448: my $innerwidth=$width-20;
8449: $content=&js_ready(
1.1042 www 8450: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 8451: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8452: $content.
1.1041 www 8453: &end_scrollbox().
1.1075.2.42 raeburn 8454: &end_page()
1.1041 www 8455: );
8456: return &modal_adhoc_script($funcname,$width,$height,$content);
8457: }
8458:
8459: sub modal_adhoc_window {
8460: my ($funcname,$width,$height,$content,$linktext)=@_;
8461: return &modal_adhoc_inner($funcname,$width,$height,$content).
8462: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8463: }
8464:
8465: sub modal_adhoc_launch {
8466: my ($funcname,$width,$height,$content)=@_;
8467: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8468: <script type="text/javascript">
8469: // <![CDATA[
8470: $funcname();
8471: // ]]>
8472: </script>
8473: ENDLAUNCH
8474: }
8475:
8476: sub modal_adhoc_close {
8477: return (<<ENDCLOSE);
8478: <script type="text/javascript">
8479: // <![CDATA[
8480: modalWindow.close();
8481: // ]]>
8482: </script>
8483: ENDCLOSE
8484: }
8485:
1.1038 www 8486: sub togglebox_script {
8487: return(<<ENDTOGGLE);
8488: <script type="text/javascript">
8489: // <![CDATA[
8490: function LCtoggleDisplay(id,hidetext,showtext) {
8491: link = document.getElementById(id + "link").childNodes[0];
8492: with (document.getElementById(id).style) {
8493: if (display == "none" ) {
8494: display = "inline";
8495: link.nodeValue = hidetext;
8496: } else {
8497: display = "none";
8498: link.nodeValue = showtext;
8499: }
8500: }
8501: }
8502: // ]]>
8503: </script>
8504: ENDTOGGLE
8505: }
8506:
1.1039 www 8507: sub start_togglebox {
8508: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8509: unless ($heading) { $heading=''; } else { $heading.=' '; }
8510: unless ($showtext) { $showtext=&mt('show'); }
8511: unless ($hidetext) { $hidetext=&mt('hide'); }
8512: unless ($headerbg) { $headerbg='#FFFFFF'; }
8513: return &start_data_table().
8514: &start_data_table_header_row().
8515: '<td bgcolor="'.$headerbg.'">'.$heading.
8516: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8517: $showtext.'\')">'.$showtext.'</a>]</td>'.
8518: &end_data_table_header_row().
8519: '<tr id="'.$id.'" style="display:none""><td>';
8520: }
8521:
8522: sub end_togglebox {
8523: return '</td></tr>'.&end_data_table();
8524: }
8525:
1.1041 www 8526: sub LCprogressbar_script {
1.1075.2.130 raeburn 8527: my ($id,$number_to_do)=@_;
8528: if ($number_to_do) {
8529: return(<<ENDPROGRESS);
1.1041 www 8530: <script type="text/javascript">
8531: // <![CDATA[
1.1045 www 8532: \$('#progressbar$id').progressbar({
1.1041 www 8533: value: 0,
8534: change: function(event, ui) {
8535: var newVal = \$(this).progressbar('option', 'value');
8536: \$('.pblabel', this).text(LCprogressTxt);
8537: }
8538: });
8539: // ]]>
8540: </script>
8541: ENDPROGRESS
1.1075.2.130 raeburn 8542: } else {
8543: return(<<ENDPROGRESS);
8544: <script type="text/javascript">
8545: // <![CDATA[
8546: \$('#progressbar$id').progressbar({
8547: value: false,
8548: create: function(event, ui) {
8549: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
8550: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
8551: }
8552: });
8553: // ]]>
8554: </script>
8555: ENDPROGRESS
8556: }
1.1041 www 8557: }
8558:
8559: sub LCprogressbarUpdate_script {
8560: return(<<ENDPROGRESSUPDATE);
8561: <style type="text/css">
8562: .ui-progressbar { position:relative; }
1.1075.2.130 raeburn 8563: .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 8564: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8565: </style>
8566: <script type="text/javascript">
8567: // <![CDATA[
1.1045 www 8568: var LCprogressTxt='---';
8569:
1.1075.2.130 raeburn 8570: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 8571: LCprogressTxt=progresstext;
1.1075.2.130 raeburn 8572: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
8573: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
8574: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
8575: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
8576: } else {
8577: \$('#progressbar'+id).progressbar('value',percent);
8578: }
1.1041 www 8579: }
8580: // ]]>
8581: </script>
8582: ENDPROGRESSUPDATE
8583: }
8584:
1.1042 www 8585: my $LClastpercent;
1.1045 www 8586: my $LCidcnt;
8587: my $LCcurrentid;
1.1042 www 8588:
1.1041 www 8589: sub LCprogressbar {
1.1075.2.130 raeburn 8590: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 8591: $LClastpercent=0;
1.1045 www 8592: $LCidcnt++;
8593: $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130 raeburn 8594: my ($starting,$content);
8595: if ($number_to_do) {
8596: $starting=&mt('Starting');
8597: $content=(<<ENDPROGBAR);
8598: $preamble
1.1045 www 8599: <div id="progressbar$LCcurrentid">
1.1041 www 8600: <span class="pblabel">$starting</span>
8601: </div>
8602: ENDPROGBAR
1.1075.2.130 raeburn 8603: } else {
8604: $starting=&mt('Loading...');
8605: $LClastpercent='false';
8606: $content=(<<ENDPROGBAR);
8607: $preamble
8608: <div id="progressbar$LCcurrentid">
8609: <div class="progress-label">$starting</div>
8610: </div>
8611: ENDPROGBAR
8612: }
8613: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 8614: }
8615:
8616: sub LCprogressbarUpdate {
1.1075.2.130 raeburn 8617: my ($r,$val,$text,$number_to_do)=@_;
8618: if ($number_to_do) {
8619: unless ($val) {
8620: if ($LClastpercent) {
8621: $val=$LClastpercent;
8622: } else {
8623: $val=0;
8624: }
8625: }
8626: if ($val<0) { $val=0; }
8627: if ($val>100) { $val=0; }
8628: $LClastpercent=$val;
8629: unless ($text) { $text=$val.'%'; }
8630: } else {
8631: $val = 'false';
1.1042 www 8632: }
1.1041 www 8633: $text=&js_ready($text);
1.1044 www 8634: &r_print($r,<<ENDUPDATE);
1.1041 www 8635: <script type="text/javascript">
8636: // <![CDATA[
1.1075.2.130 raeburn 8637: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 8638: // ]]>
8639: </script>
8640: ENDUPDATE
1.1035 www 8641: }
8642:
1.1042 www 8643: sub LCprogressbarClose {
8644: my ($r)=@_;
8645: $LClastpercent=0;
1.1044 www 8646: &r_print($r,<<ENDCLOSE);
1.1042 www 8647: <script type="text/javascript">
8648: // <![CDATA[
1.1045 www 8649: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8650: // ]]>
8651: </script>
8652: ENDCLOSE
1.1044 www 8653: }
8654:
8655: sub r_print {
8656: my ($r,$to_print)=@_;
8657: if ($r) {
8658: $r->print($to_print);
8659: $r->rflush();
8660: } else {
8661: print($to_print);
8662: }
1.1042 www 8663: }
8664:
1.320 albertel 8665: sub html_encode {
8666: my ($result) = @_;
8667:
1.322 albertel 8668: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8669:
8670: return $result;
8671: }
1.1044 www 8672:
1.317 albertel 8673: sub js_ready {
8674: my ($result) = @_;
8675:
1.323 albertel 8676: $result =~ s/[\n\r]/ /xmsg;
8677: $result =~ s/\\/\\\\/xmsg;
8678: $result =~ s/'/\\'/xmsg;
1.372 albertel 8679: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8680:
8681: return $result;
8682: }
8683:
1.315 albertel 8684: sub validate_page {
8685: if ( exists($env{'internal.start_page'})
1.316 albertel 8686: && $env{'internal.start_page'} > 1) {
8687: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8688: $env{'internal.start_page'}.' '.
1.316 albertel 8689: $ENV{'request.filename'});
1.315 albertel 8690: }
8691: if ( exists($env{'internal.end_page'})
1.316 albertel 8692: && $env{'internal.end_page'} > 1) {
8693: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8694: $env{'internal.end_page'}.' '.
1.316 albertel 8695: $env{'request.filename'});
1.315 albertel 8696: }
8697: if ( exists($env{'internal.start_page'})
8698: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8699: &Apache::lonnet::logthis('start_page called without end_page '.
8700: $env{'request.filename'});
1.315 albertel 8701: }
8702: if ( ! exists($env{'internal.start_page'})
8703: && exists($env{'internal.end_page'})) {
1.316 albertel 8704: &Apache::lonnet::logthis('end_page called without start_page'.
8705: $env{'request.filename'});
1.315 albertel 8706: }
1.306 albertel 8707: }
1.315 albertel 8708:
1.996 www 8709:
8710: sub start_scrollbox {
1.1075.2.56 raeburn 8711: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8712: unless ($outerwidth) { $outerwidth='520px'; }
8713: unless ($width) { $width='500px'; }
8714: unless ($height) { $height='200px'; }
1.1075 raeburn 8715: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8716: if ($id ne '') {
1.1075.2.42 raeburn 8717: $table_id = ' id="table_'.$id.'"';
8718: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8719: }
1.1075 raeburn 8720: if ($bgcolor ne '') {
8721: $tdcol = "background-color: $bgcolor;";
8722: }
1.1075.2.42 raeburn 8723: my $nicescroll_js;
8724: if ($env{'browser.mobile'}) {
8725: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8726: }
1.1075 raeburn 8727: return <<"END";
1.1075.2.42 raeburn 8728: $nicescroll_js
8729:
8730: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8731: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8732: END
1.996 www 8733: }
8734:
8735: sub end_scrollbox {
1.1036 www 8736: return '</div></td></tr></table>';
1.996 www 8737: }
8738:
1.1075.2.42 raeburn 8739: sub nicescroll_javascript {
8740: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8741: my %options;
8742: if (ref($cursor) eq 'HASH') {
8743: %options = %{$cursor};
8744: }
8745: unless ($options{'railalign'} =~ /^left|right$/) {
8746: $options{'railalign'} = 'left';
8747: }
8748: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8749: my $function = &get_users_function();
8750: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8751: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8752: $options{'cursorcolor'} = '#00F';
8753: }
8754: }
8755: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8756: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8757: $options{'cursoropacity'}='1.0';
8758: }
8759: } else {
8760: $options{'cursoropacity'}='1.0';
8761: }
8762: if ($options{'cursorfixedheight'} eq 'none') {
8763: delete($options{'cursorfixedheight'});
8764: } else {
8765: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8766: }
8767: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8768: delete($options{'railoffset'});
8769: }
8770: my @niceoptions;
8771: while (my($key,$value) = each(%options)) {
8772: if ($value =~ /^\{.+\}$/) {
8773: push(@niceoptions,$key.':'.$value);
8774: } else {
8775: push(@niceoptions,$key.':"'.$value.'"');
8776: }
8777: }
8778: my $nicescroll_js = '
8779: $(document).ready(
8780: function() {
8781: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8782: }
8783: );
8784: ';
8785: if ($framecheck) {
8786: $nicescroll_js .= '
8787: function expand_div(caller) {
8788: if (top === self) {
8789: document.getElementById("'.$id.'").style.width = "auto";
8790: document.getElementById("'.$id.'").style.height = "auto";
8791: } else {
8792: try {
8793: if (parent.frames) {
8794: if (parent.frames.length > 1) {
8795: var framesrc = parent.frames[1].location.href;
8796: var currsrc = framesrc.replace(/\#.*$/,"");
8797: if ((caller == "search") || (currsrc == "'.$location.'")) {
8798: document.getElementById("'.$id.'").style.width = "auto";
8799: document.getElementById("'.$id.'").style.height = "auto";
8800: }
8801: }
8802: }
8803: } catch (e) {
8804: return;
8805: }
8806: }
8807: return;
8808: }
8809: ';
8810: }
8811: if ($needjsready) {
8812: $nicescroll_js = '
8813: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8814: } else {
8815: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8816: }
8817: return $nicescroll_js;
8818: }
8819:
1.318 albertel 8820: sub simple_error_page {
1.1075.2.49 raeburn 8821: my ($r,$title,$msg,$args) = @_;
8822: if (ref($args) eq 'HASH') {
8823: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8824: } else {
8825: $msg = &mt($msg);
8826: }
8827:
1.318 albertel 8828: my $page =
8829: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8830: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8831: &Apache::loncommon::end_page();
8832: if (ref($r)) {
8833: $r->print($page);
1.327 albertel 8834: return;
1.318 albertel 8835: }
8836: return $page;
8837: }
1.347 albertel 8838:
8839: {
1.610 albertel 8840: my @row_count;
1.961 onken 8841:
8842: sub start_data_table_count {
8843: unshift(@row_count, 0);
8844: return;
8845: }
8846:
8847: sub end_data_table_count {
8848: shift(@row_count);
8849: return;
8850: }
8851:
1.347 albertel 8852: sub start_data_table {
1.1018 raeburn 8853: my ($add_class,$id) = @_;
1.422 albertel 8854: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8855: my $table_id;
8856: if (defined($id)) {
8857: $table_id = ' id="'.$id.'"';
8858: }
1.961 onken 8859: &start_data_table_count();
1.1018 raeburn 8860: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8861: }
8862:
8863: sub end_data_table {
1.961 onken 8864: &end_data_table_count();
1.389 albertel 8865: return '</table>'."\n";;
1.347 albertel 8866: }
8867:
8868: sub start_data_table_row {
1.974 wenzelju 8869: my ($add_class, $id) = @_;
1.610 albertel 8870: $row_count[0]++;
8871: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8872: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8873: $id = (' id="'.$id.'"') unless ($id eq '');
8874: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8875: }
1.471 banghart 8876:
8877: sub continue_data_table_row {
1.974 wenzelju 8878: my ($add_class, $id) = @_;
1.610 albertel 8879: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8880: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8881: $id = (' id="'.$id.'"') unless ($id eq '');
8882: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8883: }
1.347 albertel 8884:
8885: sub end_data_table_row {
1.389 albertel 8886: return '</tr>'."\n";;
1.347 albertel 8887: }
1.367 www 8888:
1.421 albertel 8889: sub start_data_table_empty_row {
1.707 bisitz 8890: # $row_count[0]++;
1.421 albertel 8891: return '<tr class="LC_empty_row" >'."\n";;
8892: }
8893:
8894: sub end_data_table_empty_row {
8895: return '</tr>'."\n";;
8896: }
8897:
1.367 www 8898: sub start_data_table_header_row {
1.389 albertel 8899: return '<tr class="LC_header_row">'."\n";;
1.367 www 8900: }
8901:
8902: sub end_data_table_header_row {
1.389 albertel 8903: return '</tr>'."\n";;
1.367 www 8904: }
1.890 droeschl 8905:
8906: sub data_table_caption {
8907: my $caption = shift;
8908: return "<caption class=\"LC_caption\">$caption</caption>";
8909: }
1.347 albertel 8910: }
8911:
1.548 albertel 8912: =pod
8913:
8914: =item * &inhibit_menu_check($arg)
8915:
8916: Checks for a inhibitmenu state and generates output to preserve it
8917:
8918: Inputs: $arg - can be any of
8919: - undef - in which case the return value is a string
8920: to add into arguments list of a uri
8921: - 'input' - in which case the return value is a HTML
8922: <form> <input> field of type hidden to
8923: preserve the value
8924: - a url - in which case the return value is the url with
8925: the neccesary cgi args added to preserve the
8926: inhibitmenu state
8927: - a ref to a url - no return value, but the string is
8928: updated to include the neccessary cgi
8929: args to preserve the inhibitmenu state
8930:
8931: =cut
8932:
8933: sub inhibit_menu_check {
8934: my ($arg) = @_;
8935: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8936: if ($arg eq 'input') {
8937: if ($env{'form.inhibitmenu'}) {
8938: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8939: } else {
8940: return
8941: }
8942: }
8943: if ($env{'form.inhibitmenu'}) {
8944: if (ref($arg)) {
8945: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8946: } elsif ($arg eq '') {
8947: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8948: } else {
8949: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8950: }
8951: }
8952: if (!ref($arg)) {
8953: return $arg;
8954: }
8955: }
8956:
1.251 albertel 8957: ###############################################
1.182 matthew 8958:
8959: =pod
8960:
1.549 albertel 8961: =back
8962:
8963: =head1 User Information Routines
8964:
8965: =over 4
8966:
1.405 albertel 8967: =item * &get_users_function()
1.182 matthew 8968:
8969: Used by &bodytag to determine the current users primary role.
8970: Returns either 'student','coordinator','admin', or 'author'.
8971:
8972: =cut
8973:
8974: ###############################################
8975: sub get_users_function {
1.815 tempelho 8976: my $function = 'norole';
1.818 tempelho 8977: if ($env{'request.role'}=~/^(st)/) {
8978: $function='student';
8979: }
1.907 raeburn 8980: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8981: $function='coordinator';
8982: }
1.258 albertel 8983: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8984: $function='admin';
8985: }
1.826 bisitz 8986: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8987: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8988: $function='author';
8989: }
8990: return $function;
1.54 www 8991: }
1.99 www 8992:
8993: ###############################################
8994:
1.233 raeburn 8995: =pod
8996:
1.821 raeburn 8997: =item * &show_course()
8998:
8999: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9000: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9001:
9002: Inputs:
9003: None
9004:
9005: Outputs:
9006: Scalar: 1 if 'Course' to be used, 0 otherwise.
9007:
9008: =cut
9009:
9010: ###############################################
9011: sub show_course {
9012: my $course = !$env{'user.adv'};
9013: if (!$env{'user.adv'}) {
9014: foreach my $env (keys(%env)) {
9015: next if ($env !~ m/^user\.priv\./);
9016: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9017: $course = 0;
9018: last;
9019: }
9020: }
9021: }
9022: return $course;
9023: }
9024:
9025: ###############################################
9026:
9027: =pod
9028:
1.542 raeburn 9029: =item * &check_user_status()
1.274 raeburn 9030:
9031: Determines current status of supplied role for a
9032: specific user. Roles can be active, previous or future.
9033:
9034: Inputs:
9035: user's domain, user's username, course's domain,
1.375 raeburn 9036: course's number, optional section ID.
1.274 raeburn 9037:
9038: Outputs:
9039: role status: active, previous or future.
9040:
9041: =cut
9042:
9043: sub check_user_status {
1.412 raeburn 9044: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9045: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 9046: my @uroles = keys(%userinfo);
1.274 raeburn 9047: my $srchstr;
9048: my $active_chk = 'none';
1.412 raeburn 9049: my $now = time;
1.274 raeburn 9050: if (@uroles > 0) {
1.908 raeburn 9051: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9052: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9053: } else {
1.412 raeburn 9054: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9055: }
9056: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9057: my $role_end = 0;
9058: my $role_start = 0;
9059: $active_chk = 'active';
1.412 raeburn 9060: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9061: $role_end = $1;
9062: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9063: $role_start = $1;
1.274 raeburn 9064: }
9065: }
9066: if ($role_start > 0) {
1.412 raeburn 9067: if ($now < $role_start) {
1.274 raeburn 9068: $active_chk = 'future';
9069: }
9070: }
9071: if ($role_end > 0) {
1.412 raeburn 9072: if ($now > $role_end) {
1.274 raeburn 9073: $active_chk = 'previous';
9074: }
9075: }
9076: }
9077: }
9078: return $active_chk;
9079: }
9080:
9081: ###############################################
9082:
9083: =pod
9084:
1.405 albertel 9085: =item * &get_sections()
1.233 raeburn 9086:
9087: Determines all the sections for a course including
9088: sections with students and sections containing other roles.
1.419 raeburn 9089: Incoming parameters:
9090:
9091: 1. domain
9092: 2. course number
9093: 3. reference to array containing roles for which sections should
9094: be gathered (optional).
9095: 4. reference to array containing status types for which sections
9096: should be gathered (optional).
9097:
9098: If the third argument is undefined, sections are gathered for any role.
9099: If the fourth argument is undefined, sections are gathered for any status.
9100: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9101:
1.374 raeburn 9102: Returns section hash (keys are section IDs, values are
9103: number of users in each section), subject to the
1.419 raeburn 9104: optional roles filter, optional status filter
1.233 raeburn 9105:
9106: =cut
9107:
9108: ###############################################
9109: sub get_sections {
1.419 raeburn 9110: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9111: if (!defined($cdom) || !defined($cnum)) {
9112: my $cid = $env{'request.course.id'};
9113:
9114: return if (!defined($cid));
9115:
9116: $cdom = $env{'course.'.$cid.'.domain'};
9117: $cnum = $env{'course.'.$cid.'.num'};
9118: }
9119:
9120: my %sectioncount;
1.419 raeburn 9121: my $now = time;
1.240 albertel 9122:
1.1075.2.33 raeburn 9123: my $check_students = 1;
9124: my $only_students = 0;
9125: if (ref($possible_roles) eq 'ARRAY') {
9126: if (grep(/^st$/,@{$possible_roles})) {
9127: if (@{$possible_roles} == 1) {
9128: $only_students = 1;
9129: }
9130: } else {
9131: $check_students = 0;
9132: }
9133: }
9134:
9135: if ($check_students) {
1.276 albertel 9136: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9137: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9138: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9139: my $start_index = &Apache::loncoursedata::CL_START();
9140: my $end_index = &Apache::loncoursedata::CL_END();
9141: my $status;
1.366 albertel 9142: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9143: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9144: $data->[$status_index],
9145: $data->[$start_index],
9146: $data->[$end_index]);
9147: if ($stu_status eq 'Active') {
9148: $status = 'active';
9149: } elsif ($end < $now) {
9150: $status = 'previous';
9151: } elsif ($start > $now) {
9152: $status = 'future';
9153: }
9154: if ($section ne '-1' && $section !~ /^\s*$/) {
9155: if ((!defined($possible_status)) || (($status ne '') &&
9156: (grep/^\Q$status\E$/,@{$possible_status}))) {
9157: $sectioncount{$section}++;
9158: }
1.240 albertel 9159: }
9160: }
9161: }
1.1075.2.33 raeburn 9162: if ($only_students) {
9163: return %sectioncount;
9164: }
1.240 albertel 9165: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9166: foreach my $user (sort(keys(%courseroles))) {
9167: if ($user !~ /^(\w{2})/) { next; }
9168: my ($role) = ($user =~ /^(\w{2})/);
9169: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9170: my ($section,$status);
1.240 albertel 9171: if ($role eq 'cr' &&
9172: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9173: $section=$1;
9174: }
9175: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9176: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9177: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9178: if ($end == -1 && $start == -1) {
9179: next; #deleted role
9180: }
9181: if (!defined($possible_status)) {
9182: $sectioncount{$section}++;
9183: } else {
9184: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9185: $status = 'active';
9186: } elsif ($end < $now) {
9187: $status = 'future';
9188: } elsif ($start > $now) {
9189: $status = 'previous';
9190: }
9191: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9192: $sectioncount{$section}++;
9193: }
9194: }
1.233 raeburn 9195: }
1.366 albertel 9196: return %sectioncount;
1.233 raeburn 9197: }
9198:
1.274 raeburn 9199: ###############################################
1.294 raeburn 9200:
9201: =pod
1.405 albertel 9202:
9203: =item * &get_course_users()
9204:
1.275 raeburn 9205: Retrieves usernames:domains for users in the specified course
9206: with specific role(s), and access status.
9207:
9208: Incoming parameters:
1.277 albertel 9209: 1. course domain
9210: 2. course number
9211: 3. access status: users must have - either active,
1.275 raeburn 9212: previous, future, or all.
1.277 albertel 9213: 4. reference to array of permissible roles
1.288 raeburn 9214: 5. reference to array of section restrictions (optional)
9215: 6. reference to results object (hash of hashes).
9216: 7. reference to optional userdata hash
1.609 raeburn 9217: 8. reference to optional statushash
1.630 raeburn 9218: 9. flag if privileged users (except those set to unhide in
9219: course settings) should be excluded
1.609 raeburn 9220: Keys of top level results hash are roles.
1.275 raeburn 9221: Keys of inner hashes are username:domain, with
9222: values set to access type.
1.288 raeburn 9223: Optional userdata hash returns an array with arguments in the
9224: same order as loncoursedata::get_classlist() for student data.
9225:
1.609 raeburn 9226: Optional statushash returns
9227:
1.288 raeburn 9228: Entries for end, start, section and status are blank because
9229: of the possibility of multiple values for non-student roles.
9230:
1.275 raeburn 9231: =cut
1.405 albertel 9232:
1.275 raeburn 9233: ###############################################
1.405 albertel 9234:
1.275 raeburn 9235: sub get_course_users {
1.630 raeburn 9236: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9237: my %idx = ();
1.419 raeburn 9238: my %seclists;
1.288 raeburn 9239:
9240: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9241: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9242: $idx{end} = &Apache::loncoursedata::CL_END();
9243: $idx{start} = &Apache::loncoursedata::CL_START();
9244: $idx{id} = &Apache::loncoursedata::CL_ID();
9245: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9246: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9247: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9248:
1.290 albertel 9249: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9250: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9251: my $now = time;
1.277 albertel 9252: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9253: my $match = 0;
1.412 raeburn 9254: my $secmatch = 0;
1.419 raeburn 9255: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9256: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9257: if ($section eq '') {
9258: $section = 'none';
9259: }
1.291 albertel 9260: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9261: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9262: $secmatch = 1;
9263: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9264: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9265: $secmatch = 1;
9266: }
9267: } else {
1.419 raeburn 9268: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9269: $secmatch = 1;
9270: }
1.290 albertel 9271: }
1.412 raeburn 9272: if (!$secmatch) {
9273: next;
9274: }
1.419 raeburn 9275: }
1.275 raeburn 9276: if (defined($$types{'active'})) {
1.288 raeburn 9277: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9278: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9279: $match = 1;
1.275 raeburn 9280: }
9281: }
9282: if (defined($$types{'previous'})) {
1.609 raeburn 9283: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9284: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9285: $match = 1;
1.275 raeburn 9286: }
9287: }
9288: if (defined($$types{'future'})) {
1.609 raeburn 9289: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9290: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9291: $match = 1;
1.275 raeburn 9292: }
9293: }
1.609 raeburn 9294: if ($match) {
9295: push(@{$seclists{$student}},$section);
9296: if (ref($userdata) eq 'HASH') {
9297: $$userdata{$student} = $$classlist{$student};
9298: }
9299: if (ref($statushash) eq 'HASH') {
9300: $statushash->{$student}{'st'}{$section} = $status;
9301: }
1.288 raeburn 9302: }
1.275 raeburn 9303: }
9304: }
1.412 raeburn 9305: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9306: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9307: my $now = time;
1.609 raeburn 9308: my %displaystatus = ( previous => 'Expired',
9309: active => 'Active',
9310: future => 'Future',
9311: );
1.1075.2.36 raeburn 9312: my (%nothide,@possdoms);
1.630 raeburn 9313: if ($hidepriv) {
9314: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9315: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9316: if ($user !~ /:/) {
9317: $nothide{join(':',split(/[\@]/,$user))}=1;
9318: } else {
9319: $nothide{$user} = 1;
9320: }
9321: }
1.1075.2.36 raeburn 9322: my @possdoms = ($cdom);
9323: if ($coursehash{'checkforpriv'}) {
9324: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9325: }
1.630 raeburn 9326: }
1.439 raeburn 9327: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9328: my $match = 0;
1.412 raeburn 9329: my $secmatch = 0;
1.439 raeburn 9330: my $status;
1.412 raeburn 9331: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9332: $user =~ s/:$//;
1.439 raeburn 9333: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9334: if ($end == -1 || $start == -1) {
9335: next;
9336: }
9337: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9338: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9339: my ($uname,$udom) = split(/:/,$user);
9340: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9341: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9342: $secmatch = 1;
9343: } elsif ($usec eq '') {
1.420 albertel 9344: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9345: $secmatch = 1;
9346: }
9347: } else {
9348: if (grep(/^\Q$usec\E$/,@{$sections})) {
9349: $secmatch = 1;
9350: }
9351: }
9352: if (!$secmatch) {
9353: next;
9354: }
1.288 raeburn 9355: }
1.419 raeburn 9356: if ($usec eq '') {
9357: $usec = 'none';
9358: }
1.275 raeburn 9359: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9360: if ($hidepriv) {
1.1075.2.36 raeburn 9361: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9362: (!$nothide{$uname.':'.$udom})) {
9363: next;
9364: }
9365: }
1.503 raeburn 9366: if ($end > 0 && $end < $now) {
1.439 raeburn 9367: $status = 'previous';
9368: } elsif ($start > $now) {
9369: $status = 'future';
9370: } else {
9371: $status = 'active';
9372: }
1.277 albertel 9373: foreach my $type (keys(%{$types})) {
1.275 raeburn 9374: if ($status eq $type) {
1.420 albertel 9375: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9376: push(@{$$users{$role}{$user}},$type);
9377: }
1.288 raeburn 9378: $match = 1;
9379: }
9380: }
1.419 raeburn 9381: if (($match) && (ref($userdata) eq 'HASH')) {
9382: if (!exists($$userdata{$uname.':'.$udom})) {
9383: &get_user_info($udom,$uname,\%idx,$userdata);
9384: }
1.420 albertel 9385: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9386: push(@{$seclists{$uname.':'.$udom}},$usec);
9387: }
1.609 raeburn 9388: if (ref($statushash) eq 'HASH') {
9389: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9390: }
1.275 raeburn 9391: }
9392: }
9393: }
9394: }
1.290 albertel 9395: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9396: if ((defined($cdom)) && (defined($cnum))) {
9397: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9398: if ( defined($csettings{'internal.courseowner'}) ) {
9399: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9400: next if ($owner eq '');
9401: my ($ownername,$ownerdom);
9402: if ($owner =~ /^([^:]+):([^:]+)$/) {
9403: $ownername = $1;
9404: $ownerdom = $2;
9405: } else {
9406: $ownername = $owner;
9407: $ownerdom = $cdom;
9408: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9409: }
9410: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9411: if (defined($userdata) &&
1.609 raeburn 9412: !exists($$userdata{$owner})) {
9413: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9414: if (!grep(/^none$/,@{$seclists{$owner}})) {
9415: push(@{$seclists{$owner}},'none');
9416: }
9417: if (ref($statushash) eq 'HASH') {
9418: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9419: }
1.290 albertel 9420: }
1.279 raeburn 9421: }
9422: }
9423: }
1.419 raeburn 9424: foreach my $user (keys(%seclists)) {
9425: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9426: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9427: }
1.275 raeburn 9428: }
9429: return;
9430: }
9431:
1.288 raeburn 9432: sub get_user_info {
9433: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9434: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9435: &plainname($uname,$udom,'lastname');
1.291 albertel 9436: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9437: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9438: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9439: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9440: return;
9441: }
1.275 raeburn 9442:
1.472 raeburn 9443: ###############################################
9444:
9445: =pod
9446:
9447: =item * &get_user_quota()
9448:
1.1075.2.41 raeburn 9449: Retrieves quota assigned for storage of user files.
9450: Default is to report quota for portfolio files.
1.472 raeburn 9451:
9452: Incoming parameters:
9453: 1. user's username
9454: 2. user's domain
1.1075.2.41 raeburn 9455: 3. quota name - portfolio, author, or course
9456: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 9457: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 9458: course
1.472 raeburn 9459:
9460: Returns:
1.1075.2.58 raeburn 9461: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9462: 2. (Optional) Type of setting: custom or default
9463: (individually assigned or default for user's
9464: institutional status).
9465: 3. (Optional) - User's institutional status (e.g., faculty, staff
9466: or student - types as defined in localenroll::inst_usertypes
9467: for user's domain, which determines default quota for user.
9468: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9469:
9470: If a value has been stored in the user's environment,
1.536 raeburn 9471: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 9472: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9473:
9474: =cut
9475:
9476: ###############################################
9477:
9478:
9479: sub get_user_quota {
1.1075.2.42 raeburn 9480: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9481: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9482: if (!defined($udom)) {
9483: $udom = $env{'user.domain'};
9484: }
9485: if (!defined($uname)) {
9486: $uname = $env{'user.name'};
9487: }
9488: if (($udom eq '' || $uname eq '') ||
9489: ($udom eq 'public') && ($uname eq 'public')) {
9490: $quota = 0;
1.536 raeburn 9491: $quotatype = 'default';
9492: $defquota = 0;
1.472 raeburn 9493: } else {
1.536 raeburn 9494: my $inststatus;
1.1075.2.41 raeburn 9495: if ($quotaname eq 'course') {
9496: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9497: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9498: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9499: } else {
9500: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9501: $quota = $cenv{'internal.uploadquota'};
9502: }
1.536 raeburn 9503: } else {
1.1075.2.41 raeburn 9504: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9505: if ($quotaname eq 'author') {
9506: $quota = $env{'environment.authorquota'};
9507: } else {
9508: $quota = $env{'environment.portfolioquota'};
9509: }
9510: $inststatus = $env{'environment.inststatus'};
9511: } else {
9512: my %userenv =
9513: &Apache::lonnet::get('environment',['portfolioquota',
9514: 'authorquota','inststatus'],$udom,$uname);
9515: my ($tmp) = keys(%userenv);
9516: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9517: if ($quotaname eq 'author') {
9518: $quota = $userenv{'authorquota'};
9519: } else {
9520: $quota = $userenv{'portfolioquota'};
9521: }
9522: $inststatus = $userenv{'inststatus'};
9523: } else {
9524: undef(%userenv);
9525: }
9526: }
9527: }
9528: if ($quota eq '' || wantarray) {
9529: if ($quotaname eq 'course') {
9530: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 9531: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
9532: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 9533: $defquota = $domdefs{$crstype.'quota'};
9534: }
9535: if ($defquota eq '') {
9536: $defquota = 500;
9537: }
1.1075.2.41 raeburn 9538: } else {
9539: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9540: }
9541: if ($quota eq '') {
9542: $quota = $defquota;
9543: $quotatype = 'default';
9544: } else {
9545: $quotatype = 'custom';
9546: }
1.472 raeburn 9547: }
9548: }
1.536 raeburn 9549: if (wantarray) {
9550: return ($quota,$quotatype,$settingstatus,$defquota);
9551: } else {
9552: return $quota;
9553: }
1.472 raeburn 9554: }
9555:
9556: ###############################################
9557:
9558: =pod
9559:
9560: =item * &default_quota()
9561:
1.536 raeburn 9562: Retrieves default quota assigned for storage of user portfolio files,
9563: given an (optional) user's institutional status.
1.472 raeburn 9564:
9565: Incoming parameters:
1.1075.2.42 raeburn 9566:
1.472 raeburn 9567: 1. domain
1.536 raeburn 9568: 2. (Optional) institutional status(es). This is a : separated list of
9569: status types (e.g., faculty, staff, student etc.)
9570: which apply to the user for whom the default is being retrieved.
9571: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 9572: default quota will be returned.
9573: 3. quota name - portfolio, author, or course
9574: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9575:
9576: Returns:
1.1075.2.42 raeburn 9577:
1.1075.2.58 raeburn 9578: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9579: 2. (Optional) institutional type which determined the value of the
9580: default quota.
1.472 raeburn 9581:
9582: If a value has been stored in the domain's configuration db,
9583: it will return that, otherwise it returns 20 (for backwards
9584: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9585: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9586:
1.536 raeburn 9587: If the user's status includes multiple types (e.g., staff and student),
9588: the largest default quota which applies to the user determines the
9589: default quota returned.
9590:
1.472 raeburn 9591: =cut
9592:
9593: ###############################################
9594:
9595:
9596: sub default_quota {
1.1075.2.41 raeburn 9597: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9598: my ($defquota,$settingstatus);
9599: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9600: ['quotas'],$udom);
1.1075.2.41 raeburn 9601: my $key = 'defaultquota';
9602: if ($quotaname eq 'author') {
9603: $key = 'authorquota';
9604: }
1.622 raeburn 9605: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9606: if ($inststatus ne '') {
1.765 raeburn 9607: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9608: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9609: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9610: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9611: if ($defquota eq '') {
1.1075.2.41 raeburn 9612: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9613: $settingstatus = $item;
1.1075.2.41 raeburn 9614: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9615: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9616: $settingstatus = $item;
9617: }
9618: }
1.1075.2.41 raeburn 9619: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9620: if ($quotahash{'quotas'}{$item} ne '') {
9621: if ($defquota eq '') {
9622: $defquota = $quotahash{'quotas'}{$item};
9623: $settingstatus = $item;
9624: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9625: $defquota = $quotahash{'quotas'}{$item};
9626: $settingstatus = $item;
9627: }
1.536 raeburn 9628: }
9629: }
9630: }
9631: }
9632: if ($defquota eq '') {
1.1075.2.41 raeburn 9633: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9634: $defquota = $quotahash{'quotas'}{$key}{'default'};
9635: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9636: $defquota = $quotahash{'quotas'}{'default'};
9637: }
1.536 raeburn 9638: $settingstatus = 'default';
1.1075.2.42 raeburn 9639: if ($defquota eq '') {
9640: if ($quotaname eq 'author') {
9641: $defquota = 500;
9642: }
9643: }
1.536 raeburn 9644: }
9645: } else {
9646: $settingstatus = 'default';
1.1075.2.41 raeburn 9647: if ($quotaname eq 'author') {
9648: $defquota = 500;
9649: } else {
9650: $defquota = 20;
9651: }
1.536 raeburn 9652: }
9653: if (wantarray) {
9654: return ($defquota,$settingstatus);
1.472 raeburn 9655: } else {
1.536 raeburn 9656: return $defquota;
1.472 raeburn 9657: }
9658: }
9659:
1.1075.2.41 raeburn 9660: ###############################################
9661:
9662: =pod
9663:
1.1075.2.42 raeburn 9664: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 9665:
9666: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 9667: of existing file within authoring space will cause quota for the authoring
9668: space to be exceeded.
9669:
9670: Same, if upload of a file directly to a course/community via Course Editor
9671: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 9672:
1.1075.2.61 raeburn 9673: Inputs: 7
1.1075.2.42 raeburn 9674: 1. username or coursenum
1.1075.2.41 raeburn 9675: 2. domain
1.1075.2.42 raeburn 9676: 3. context ('author' or 'course')
1.1075.2.41 raeburn 9677: 4. filename of file for which action is being requested
9678: 5. filesize (kB) of file
9679: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 9680: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 9681:
9682: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
9683: otherwise return null.
9684:
1.1075.2.42 raeburn 9685: =back
9686:
1.1075.2.41 raeburn 9687: =cut
9688:
1.1075.2.42 raeburn 9689: sub excess_filesize_warning {
1.1075.2.59 raeburn 9690: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 9691: my $current_disk_usage = 0;
1.1075.2.59 raeburn 9692: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 9693: if ($context eq 'author') {
9694: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9695: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9696: } else {
9697: foreach my $subdir ('docs','supplemental') {
9698: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9699: }
9700: }
1.1075.2.41 raeburn 9701: $disk_quota = int($disk_quota * 1000);
9702: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 9703: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 9704: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 9705: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9706: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 9707: $disk_quota,$current_disk_usage).
9708: '</p>';
9709: }
9710: return;
9711: }
9712:
9713: ###############################################
9714:
9715:
1.384 raeburn 9716: sub get_secgrprole_info {
9717: my ($cdom,$cnum,$needroles,$type) = @_;
9718: my %sections_count = &get_sections($cdom,$cnum);
9719: my @sections = (sort {$a <=> $b} keys(%sections_count));
9720: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9721: my @groups = sort(keys(%curr_groups));
9722: my $allroles = [];
9723: my $rolehash;
9724: my $accesshash = {
9725: active => 'Currently has access',
9726: future => 'Will have future access',
9727: previous => 'Previously had access',
9728: };
9729: if ($needroles) {
9730: $rolehash = {'all' => 'all'};
1.385 albertel 9731: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9732: if (&Apache::lonnet::error(%user_roles)) {
9733: undef(%user_roles);
9734: }
9735: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9736: my ($role)=split(/\:/,$item,2);
9737: if ($role eq 'cr') { next; }
9738: if ($role =~ /^cr/) {
9739: $$rolehash{$role} = (split('/',$role))[3];
9740: } else {
9741: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9742: }
9743: }
9744: foreach my $key (sort(keys(%{$rolehash}))) {
9745: push(@{$allroles},$key);
9746: }
9747: push (@{$allroles},'st');
9748: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9749: }
9750: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9751: }
9752:
1.555 raeburn 9753: sub user_picker {
1.1075.2.127 raeburn 9754: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 9755: my $currdom = $dom;
1.1075.2.114 raeburn 9756: my @alldoms = &Apache::lonnet::all_domains();
9757: if (@alldoms == 1) {
9758: my %domsrch = &Apache::lonnet::get_dom('configuration',
9759: ['directorysrch'],$alldoms[0]);
9760: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
9761: my $showdom = $domdesc;
9762: if ($showdom eq '') {
9763: $showdom = $dom;
9764: }
9765: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
9766: if ((!$domsrch{'directorysrch'}{'available'}) &&
9767: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
9768: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
9769: }
9770: }
9771: }
1.555 raeburn 9772: my %curr_selected = (
9773: srchin => 'dom',
1.580 raeburn 9774: srchby => 'lastname',
1.555 raeburn 9775: );
9776: my $srchterm;
1.625 raeburn 9777: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9778: if ($srch->{'srchby'} ne '') {
9779: $curr_selected{'srchby'} = $srch->{'srchby'};
9780: }
9781: if ($srch->{'srchin'} ne '') {
9782: $curr_selected{'srchin'} = $srch->{'srchin'};
9783: }
9784: if ($srch->{'srchtype'} ne '') {
9785: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9786: }
9787: if ($srch->{'srchdomain'} ne '') {
9788: $currdom = $srch->{'srchdomain'};
9789: }
9790: $srchterm = $srch->{'srchterm'};
9791: }
1.1075.2.98 raeburn 9792: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 9793: 'usr' => 'Search criteria',
1.563 raeburn 9794: 'doma' => 'Domain/institution to search',
1.558 albertel 9795: 'uname' => 'username',
9796: 'lastname' => 'last name',
1.555 raeburn 9797: 'lastfirst' => 'last name, first name',
1.558 albertel 9798: 'crs' => 'in this course',
1.576 raeburn 9799: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9800: 'alc' => 'all LON-CAPA',
1.573 raeburn 9801: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9802: 'exact' => 'is',
9803: 'contains' => 'contains',
1.569 raeburn 9804: 'begins' => 'begins with',
1.1075.2.98 raeburn 9805: );
9806: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 9807: 'youm' => "You must include some text to search for.",
9808: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9809: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9810: 'yomc' => "You must choose a domain when using an institutional directory search.",
9811: 'ymcd' => "You must choose a domain when using a domain search.",
9812: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9813: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9814: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9815: );
1.1075.2.98 raeburn 9816: &html_escape(\%html_lt);
9817: &js_escape(\%js_lt);
1.1075.2.115 raeburn 9818: my $domform;
1.1075.2.126 raeburn 9819: my $allow_blank = 1;
1.1075.2.115 raeburn 9820: if ($fixeddom) {
1.1075.2.126 raeburn 9821: $allow_blank = 0;
9822: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115 raeburn 9823: } else {
1.1075.2.126 raeburn 9824: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115 raeburn 9825: }
1.563 raeburn 9826: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9827:
9828: my @srchins = ('crs','dom','alc','instd');
9829:
9830: foreach my $option (@srchins) {
9831: # FIXME 'alc' option unavailable until
9832: # loncreateuser::print_user_query_page()
9833: # has been completed.
9834: next if ($option eq 'alc');
1.880 raeburn 9835: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9836: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127 raeburn 9837: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 9838: if ($curr_selected{'srchin'} eq $option) {
9839: $srchinsel .= '
1.1075.2.98 raeburn 9840: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 9841: } else {
9842: $srchinsel .= '
1.1075.2.98 raeburn 9843: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 9844: }
1.555 raeburn 9845: }
1.563 raeburn 9846: $srchinsel .= "\n </select>\n";
1.555 raeburn 9847:
9848: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9849: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9850: if ($curr_selected{'srchby'} eq $option) {
9851: $srchbysel .= '
1.1075.2.98 raeburn 9852: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9853: } else {
9854: $srchbysel .= '
1.1075.2.98 raeburn 9855: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9856: }
9857: }
9858: $srchbysel .= "\n </select>\n";
9859:
9860: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9861: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9862: if ($curr_selected{'srchtype'} eq $option) {
9863: $srchtypesel .= '
1.1075.2.98 raeburn 9864: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9865: } else {
9866: $srchtypesel .= '
1.1075.2.98 raeburn 9867: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9868: }
9869: }
9870: $srchtypesel .= "\n </select>\n";
9871:
1.558 albertel 9872: my ($newuserscript,$new_user_create);
1.994 raeburn 9873: my $context_dom = $env{'request.role.domain'};
9874: if ($context eq 'requestcrs') {
9875: if ($env{'form.coursedom'} ne '') {
9876: $context_dom = $env{'form.coursedom'};
9877: }
9878: }
1.556 raeburn 9879: if ($forcenewuser) {
1.576 raeburn 9880: if (ref($srch) eq 'HASH') {
1.994 raeburn 9881: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9882: if ($cancreate) {
9883: $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>';
9884: } else {
1.799 bisitz 9885: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9886: my %usertypetext = (
9887: official => 'institutional',
9888: unofficial => 'non-institutional',
9889: );
1.799 bisitz 9890: $new_user_create = '<p class="LC_warning">'
9891: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9892: .' '
9893: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9894: ,'<a href="'.$helplink.'">','</a>')
9895: .'</p><br />';
1.627 raeburn 9896: }
1.576 raeburn 9897: }
9898: }
9899:
1.556 raeburn 9900: $newuserscript = <<"ENDSCRIPT";
9901:
1.570 raeburn 9902: function setSearch(createnew,callingForm) {
1.556 raeburn 9903: if (createnew == 1) {
1.570 raeburn 9904: for (var i=0; i<callingForm.srchby.length; i++) {
9905: if (callingForm.srchby.options[i].value == 'uname') {
9906: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9907: }
9908: }
1.570 raeburn 9909: for (var i=0; i<callingForm.srchin.length; i++) {
9910: if ( callingForm.srchin.options[i].value == 'dom') {
9911: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9912: }
9913: }
1.570 raeburn 9914: for (var i=0; i<callingForm.srchtype.length; i++) {
9915: if (callingForm.srchtype.options[i].value == 'exact') {
9916: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9917: }
9918: }
1.570 raeburn 9919: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9920: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9921: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9922: }
9923: }
9924: }
9925: }
9926: ENDSCRIPT
1.558 albertel 9927:
1.556 raeburn 9928: }
9929:
1.555 raeburn 9930: my $output = <<"END_BLOCK";
1.556 raeburn 9931: <script type="text/javascript">
1.824 bisitz 9932: // <![CDATA[
1.570 raeburn 9933: function validateEntry(callingForm) {
1.558 albertel 9934:
1.556 raeburn 9935: var checkok = 1;
1.558 albertel 9936: var srchin;
1.570 raeburn 9937: for (var i=0; i<callingForm.srchin.length; i++) {
9938: if ( callingForm.srchin[i].checked ) {
9939: srchin = callingForm.srchin[i].value;
1.558 albertel 9940: }
9941: }
9942:
1.570 raeburn 9943: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9944: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9945: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9946: var srchterm = callingForm.srchterm.value;
9947: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9948: var msg = "";
9949:
9950: if (srchterm == "") {
9951: checkok = 0;
1.1075.2.98 raeburn 9952: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 9953: }
9954:
1.569 raeburn 9955: if (srchtype== 'begins') {
9956: if (srchterm.length < 2) {
9957: checkok = 0;
1.1075.2.98 raeburn 9958: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 9959: }
9960: }
9961:
1.556 raeburn 9962: if (srchtype== 'contains') {
9963: if (srchterm.length < 3) {
9964: checkok = 0;
1.1075.2.98 raeburn 9965: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 9966: }
9967: }
9968: if (srchin == 'instd') {
9969: if (srchdomain == '') {
9970: checkok = 0;
1.1075.2.98 raeburn 9971: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 9972: }
9973: }
9974: if (srchin == 'dom') {
9975: if (srchdomain == '') {
9976: checkok = 0;
1.1075.2.98 raeburn 9977: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 9978: }
9979: }
9980: if (srchby == 'lastfirst') {
9981: if (srchterm.indexOf(",") == -1) {
9982: checkok = 0;
1.1075.2.98 raeburn 9983: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 9984: }
9985: if (srchterm.indexOf(",") == srchterm.length -1) {
9986: checkok = 0;
1.1075.2.98 raeburn 9987: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 9988: }
9989: }
9990: if (checkok == 0) {
1.1075.2.98 raeburn 9991: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 9992: return;
9993: }
9994: if (checkok == 1) {
1.570 raeburn 9995: callingForm.submit();
1.556 raeburn 9996: }
9997: }
9998:
9999: $newuserscript
10000:
1.824 bisitz 10001: // ]]>
1.556 raeburn 10002: </script>
1.558 albertel 10003:
10004: $new_user_create
10005:
1.555 raeburn 10006: END_BLOCK
1.558 albertel 10007:
1.876 raeburn 10008: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 10009: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10010: $domform.
10011: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 10012: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10013: $srchbysel.
10014: $srchtypesel.
10015: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10016: $srchinsel.
10017: &Apache::lonhtmlcommon::row_closure(1).
10018: &Apache::lonhtmlcommon::end_pick_box().
10019: '<br />';
1.1075.2.114 raeburn 10020: return ($output,1);
1.555 raeburn 10021: }
10022:
1.612 raeburn 10023: sub user_rule_check {
1.615 raeburn 10024: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 10025: my ($response,%inst_response);
1.612 raeburn 10026: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 10027: if (keys(%{$usershash}) > 1) {
10028: my (%by_username,%by_id,%userdoms);
10029: my $checkid;
1.612 raeburn 10030: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 10031: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10032: $checkid = 1;
10033: }
10034: }
10035: foreach my $user (keys(%{$usershash})) {
10036: my ($uname,$udom) = split(/:/,$user);
10037: if ($checkid) {
10038: if (ref($usershash->{$user}) eq 'HASH') {
10039: if ($usershash->{$user}->{'id'} ne '') {
10040: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
10041: $userdoms{$udom} = 1;
10042: if (ref($inst_results) eq 'HASH') {
10043: $inst_results->{$uname.':'.$udom} = {};
10044: }
10045: }
10046: }
10047: } else {
10048: $by_username{$udom}{$uname} = 1;
10049: $userdoms{$udom} = 1;
10050: if (ref($inst_results) eq 'HASH') {
10051: $inst_results->{$uname.':'.$udom} = {};
10052: }
10053: }
10054: }
10055: foreach my $udom (keys(%userdoms)) {
10056: if (!$got_rules->{$udom}) {
10057: my %domconfig = &Apache::lonnet::get_dom('configuration',
10058: ['usercreation'],$udom);
10059: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10060: foreach my $item ('username','id') {
10061: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10062: $$curr_rules{$udom}{$item} =
10063: $domconfig{'usercreation'}{$item.'_rule'};
10064: }
10065: }
10066: }
10067: $got_rules->{$udom} = 1;
10068: }
10069: }
10070: if ($checkid) {
10071: foreach my $udom (keys(%by_id)) {
10072: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10073: if ($outcome eq 'ok') {
10074: foreach my $id (keys(%{$by_id{$udom}})) {
10075: my $uname = $by_id{$udom}{$id};
10076: $inst_response{$uname.':'.$udom} = $outcome;
10077: }
10078: if (ref($results) eq 'HASH') {
10079: foreach my $uname (keys(%{$results})) {
10080: if (exists($inst_response{$uname.':'.$udom})) {
10081: $inst_response{$uname.':'.$udom} = $outcome;
10082: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10083: }
10084: }
10085: }
10086: }
1.612 raeburn 10087: }
1.615 raeburn 10088: } else {
1.1075.2.99 raeburn 10089: foreach my $udom (keys(%by_username)) {
10090: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10091: if ($outcome eq 'ok') {
10092: foreach my $uname (keys(%{$by_username{$udom}})) {
10093: $inst_response{$uname.':'.$udom} = $outcome;
10094: }
10095: if (ref($results) eq 'HASH') {
10096: foreach my $uname (keys(%{$results})) {
10097: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10098: }
10099: }
10100: }
10101: }
1.612 raeburn 10102: }
1.1075.2.99 raeburn 10103: } elsif (keys(%{$usershash}) == 1) {
10104: my $user = (keys(%{$usershash}))[0];
10105: my ($uname,$udom) = split(/:/,$user);
10106: if (($udom ne '') && ($uname ne '')) {
10107: if (ref($usershash->{$user}) eq 'HASH') {
10108: if (ref($checks) eq 'HASH') {
10109: if (defined($checks->{'username'})) {
10110: ($inst_response{$user},%{$inst_results->{$user}}) =
10111: &Apache::lonnet::get_instuser($udom,$uname);
10112: } elsif (defined($checks->{'id'})) {
10113: if ($usershash->{$user}->{'id'} ne '') {
10114: ($inst_response{$user},%{$inst_results->{$user}}) =
10115: &Apache::lonnet::get_instuser($udom,undef,
10116: $usershash->{$user}->{'id'});
10117: } else {
10118: ($inst_response{$user},%{$inst_results->{$user}}) =
10119: &Apache::lonnet::get_instuser($udom,$uname);
10120: }
10121: }
10122: } else {
10123: ($inst_response{$user},%{$inst_results->{$user}}) =
10124: &Apache::lonnet::get_instuser($udom,$uname);
10125: return;
10126: }
10127: if (!$got_rules->{$udom}) {
10128: my %domconfig = &Apache::lonnet::get_dom('configuration',
10129: ['usercreation'],$udom);
10130: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10131: foreach my $item ('username','id') {
10132: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10133: $$curr_rules{$udom}{$item} =
10134: $domconfig{'usercreation'}{$item.'_rule'};
10135: }
10136: }
1.585 raeburn 10137: }
1.1075.2.99 raeburn 10138: $got_rules->{$udom} = 1;
1.585 raeburn 10139: }
10140: }
1.1075.2.99 raeburn 10141: } else {
10142: return;
10143: }
10144: } else {
10145: return;
10146: }
10147: foreach my $user (keys(%{$usershash})) {
10148: my ($uname,$udom) = split(/:/,$user);
10149: next if (($udom eq '') || ($uname eq ''));
10150: my $id;
10151: if (ref($inst_results) eq 'HASH') {
10152: if (ref($inst_results->{$user}) eq 'HASH') {
10153: $id = $inst_results->{$user}->{'id'};
10154: }
10155: }
10156: if ($id eq '') {
10157: if (ref($usershash->{$user})) {
10158: $id = $usershash->{$user}->{'id'};
10159: }
1.585 raeburn 10160: }
1.612 raeburn 10161: foreach my $item (keys(%{$checks})) {
10162: if (ref($$curr_rules{$udom}) eq 'HASH') {
10163: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10164: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 10165: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10166: $$curr_rules{$udom}{$item});
1.612 raeburn 10167: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10168: if ($rule_check{$rule}) {
10169: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 10170: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10171: if (ref($inst_results) eq 'HASH') {
10172: if (ref($inst_results->{$user}) eq 'HASH') {
10173: if (keys(%{$inst_results->{$user}}) == 0) {
10174: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 10175: } elsif ($item eq 'id') {
10176: if ($inst_results->{$user}->{'id'} eq '') {
10177: $$alerts{$item}{$udom}{$uname} = 1;
10178: }
1.615 raeburn 10179: }
1.612 raeburn 10180: }
10181: }
1.615 raeburn 10182: }
10183: last;
1.585 raeburn 10184: }
10185: }
10186: }
10187: }
10188: }
10189: }
10190: }
10191: }
1.612 raeburn 10192: return;
10193: }
10194:
10195: sub user_rule_formats {
10196: my ($domain,$domdesc,$curr_rules,$check) = @_;
10197: my %text = (
10198: 'username' => 'Usernames',
10199: 'id' => 'IDs',
10200: );
10201: my $output;
10202: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10203: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10204: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 10205: $output = '<br />'.
10206: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10207: '<span class="LC_cusr_emph">','</span>',$domdesc).
10208: ' <ul>';
1.612 raeburn 10209: foreach my $rule (@{$ruleorder}) {
10210: if (ref($curr_rules) eq 'ARRAY') {
10211: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10212: if (ref($rules->{$rule}) eq 'HASH') {
10213: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10214: $rules->{$rule}{'desc'}.'</li>';
10215: }
10216: }
10217: }
10218: }
10219: $output .= '</ul>';
10220: }
10221: }
10222: return $output;
10223: }
10224:
10225: sub instrule_disallow_msg {
1.615 raeburn 10226: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10227: my $response;
10228: my %text = (
10229: item => 'username',
10230: items => 'usernames',
10231: match => 'matches',
10232: do => 'does',
10233: action => 'a username',
10234: one => 'one',
10235: );
10236: if ($count > 1) {
10237: $text{'item'} = 'usernames';
10238: $text{'match'} ='match';
10239: $text{'do'} = 'do';
10240: $text{'action'} = 'usernames',
10241: $text{'one'} = 'ones';
10242: }
10243: if ($checkitem eq 'id') {
10244: $text{'items'} = 'IDs';
10245: $text{'item'} = 'ID';
10246: $text{'action'} = 'an ID';
1.615 raeburn 10247: if ($count > 1) {
10248: $text{'item'} = 'IDs';
10249: $text{'action'} = 'IDs';
10250: }
1.612 raeburn 10251: }
1.674 bisitz 10252: $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 10253: if ($mode eq 'upload') {
10254: if ($checkitem eq 'username') {
10255: $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'}.");
10256: } elsif ($checkitem eq 'id') {
1.674 bisitz 10257: $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 10258: }
1.669 raeburn 10259: } elsif ($mode eq 'selfcreate') {
10260: if ($checkitem eq 'id') {
10261: $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.");
10262: }
1.615 raeburn 10263: } else {
10264: if ($checkitem eq 'username') {
10265: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10266: } elsif ($checkitem eq 'id') {
10267: $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.");
10268: }
1.612 raeburn 10269: }
10270: return $response;
1.585 raeburn 10271: }
10272:
1.624 raeburn 10273: sub personal_data_fieldtitles {
10274: my %fieldtitles = &Apache::lonlocal::texthash (
10275: id => 'Student/Employee ID',
10276: permanentemail => 'E-mail address',
10277: lastname => 'Last Name',
10278: firstname => 'First Name',
10279: middlename => 'Middle Name',
10280: generation => 'Generation',
10281: gen => 'Generation',
1.765 raeburn 10282: inststatus => 'Affiliation',
1.624 raeburn 10283: );
10284: return %fieldtitles;
10285: }
10286:
1.642 raeburn 10287: sub sorted_inst_types {
10288: my ($dom) = @_;
1.1075.2.70 raeburn 10289: my ($usertypes,$order);
10290: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10291: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10292: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10293: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10294: } else {
10295: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10296: }
1.642 raeburn 10297: my $othertitle = &mt('All users');
10298: if ($env{'request.course.id'}) {
1.668 raeburn 10299: $othertitle = &mt('Any users');
1.642 raeburn 10300: }
10301: my @types;
10302: if (ref($order) eq 'ARRAY') {
10303: @types = @{$order};
10304: }
10305: if (@types == 0) {
10306: if (ref($usertypes) eq 'HASH') {
10307: @types = sort(keys(%{$usertypes}));
10308: }
10309: }
10310: if (keys(%{$usertypes}) > 0) {
10311: $othertitle = &mt('Other users');
10312: }
10313: return ($othertitle,$usertypes,\@types);
10314: }
10315:
1.645 raeburn 10316: sub get_institutional_codes {
10317: my ($settings,$allcourses,$LC_code) = @_;
10318: # Get complete list of course sections to update
10319: my @currsections = ();
10320: my @currxlists = ();
10321: my $coursecode = $$settings{'internal.coursecode'};
10322:
10323: if ($$settings{'internal.sectionnums'} ne '') {
10324: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10325: }
10326:
10327: if ($$settings{'internal.crosslistings'} ne '') {
10328: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10329: }
10330:
10331: if (@currxlists > 0) {
10332: foreach (@currxlists) {
10333: if (m/^([^:]+):(\w*)$/) {
10334: unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119 raeburn 10335: push(@{$allcourses},$1);
1.645 raeburn 10336: $$LC_code{$1} = $2;
10337: }
10338: }
10339: }
10340: }
10341:
10342: if (@currsections > 0) {
10343: foreach (@currsections) {
10344: if (m/^(\w+):(\w*)$/) {
10345: my $sec = $coursecode.$1;
10346: my $lc_sec = $2;
10347: unless (grep/^$sec$/,@{$allcourses}) {
1.1075.2.119 raeburn 10348: push(@{$allcourses},$sec);
1.645 raeburn 10349: $$LC_code{$sec} = $lc_sec;
10350: }
10351: }
10352: }
10353: }
10354: return;
10355: }
10356:
1.971 raeburn 10357: sub get_standard_codeitems {
10358: return ('Year','Semester','Department','Number','Section');
10359: }
10360:
1.112 bowersj2 10361: =pod
10362:
1.780 raeburn 10363: =head1 Slot Helpers
10364:
10365: =over 4
10366:
10367: =item * sorted_slots()
10368:
1.1040 raeburn 10369: Sorts an array of slot names in order of an optional sort key,
10370: default sort is by slot start time (earliest first).
1.780 raeburn 10371:
10372: Inputs:
10373:
10374: =over 4
10375:
10376: slotsarr - Reference to array of unsorted slot names.
10377:
10378: slots - Reference to hash of hash, where outer hash keys are slot names.
10379:
1.1040 raeburn 10380: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10381:
1.549 albertel 10382: =back
10383:
1.780 raeburn 10384: Returns:
10385:
10386: =over 4
10387:
1.1040 raeburn 10388: sorted - An array of slot names sorted by a specified sort key
10389: (default sort key is start time of the slot).
1.780 raeburn 10390:
10391: =back
10392:
10393: =cut
10394:
10395:
10396: sub sorted_slots {
1.1040 raeburn 10397: my ($slotsarr,$slots,$sortkey) = @_;
10398: if ($sortkey eq '') {
10399: $sortkey = 'starttime';
10400: }
1.780 raeburn 10401: my @sorted;
10402: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10403: @sorted =
10404: sort {
10405: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10406: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10407: }
10408: if (ref($slots->{$a})) { return -1;}
10409: if (ref($slots->{$b})) { return 1;}
10410: return 0;
10411: } @{$slotsarr};
10412: }
10413: return @sorted;
10414: }
10415:
1.1040 raeburn 10416: =pod
10417:
10418: =item * get_future_slots()
10419:
10420: Inputs:
10421:
10422: =over 4
10423:
10424: cnum - course number
10425:
10426: cdom - course domain
10427:
10428: now - current UNIX time
10429:
10430: symb - optional symb
10431:
10432: =back
10433:
10434: Returns:
10435:
10436: =over 4
10437:
10438: sorted_reservable - ref to array of student_schedulable slots currently
10439: reservable, ordered by end date of reservation period.
10440:
10441: reservable_now - ref to hash of student_schedulable slots currently
10442: reservable.
10443:
10444: Keys in inner hash are:
10445: (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104 raeburn 10446: (b) endreserve: end date of reservation period.
10447: (c) uniqueperiod: start,end dates when slot is to be uniquely
10448: selected.
1.1040 raeburn 10449:
10450: sorted_future - ref to array of student_schedulable slots reservable in
10451: the future, ordered by start date of reservation period.
10452:
10453: future_reservable - ref to hash of student_schedulable slots reservable
10454: in the future.
10455:
10456: Keys in inner hash are:
10457: (a) symb: either blank or symb to which slot use is restricted.
10458: (b) startreserve: start date of reservation period.
1.1075.2.104 raeburn 10459: (c) uniqueperiod: start,end dates when slot is to be uniquely
10460: selected.
1.1040 raeburn 10461:
10462: =back
10463:
10464: =cut
10465:
10466: sub get_future_slots {
10467: my ($cnum,$cdom,$now,$symb) = @_;
10468: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10469: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10470: foreach my $slot (keys(%slots)) {
10471: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10472: if ($symb) {
10473: next if (($slots{$slot}->{'symb'} ne '') &&
10474: ($slots{$slot}->{'symb'} ne $symb));
10475: }
10476: if (($slots{$slot}->{'starttime'} > $now) &&
10477: ($slots{$slot}->{'endtime'} > $now)) {
10478: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10479: my $userallowed = 0;
10480: if ($slots{$slot}->{'allowedsections'}) {
10481: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10482: if (!defined($env{'request.role.sec'})
10483: && grep(/^No section assigned$/,@allowed_sec)) {
10484: $userallowed=1;
10485: } else {
10486: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10487: $userallowed=1;
10488: }
10489: }
10490: unless ($userallowed) {
10491: if (defined($env{'request.course.groups'})) {
10492: my @groups = split(/:/,$env{'request.course.groups'});
10493: foreach my $group (@groups) {
10494: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10495: $userallowed=1;
10496: last;
10497: }
10498: }
10499: }
10500: }
10501: }
10502: if ($slots{$slot}->{'allowedusers'}) {
10503: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10504: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10505: if (grep(/^\Q$user\E$/,@allowed_users)) {
10506: $userallowed = 1;
10507: }
10508: }
10509: next unless($userallowed);
10510: }
10511: my $startreserve = $slots{$slot}->{'startreserve'};
10512: my $endreserve = $slots{$slot}->{'endreserve'};
10513: my $symb = $slots{$slot}->{'symb'};
1.1075.2.104 raeburn 10514: my $uniqueperiod;
10515: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10516: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10517: }
1.1040 raeburn 10518: if (($startreserve < $now) &&
10519: (!$endreserve || $endreserve > $now)) {
10520: my $lastres = $endreserve;
10521: if (!$lastres) {
10522: $lastres = $slots{$slot}->{'starttime'};
10523: }
10524: $reservable_now{$slot} = {
10525: symb => $symb,
1.1075.2.104 raeburn 10526: endreserve => $lastres,
10527: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10528: };
10529: } elsif (($startreserve > $now) &&
10530: (!$endreserve || $endreserve > $startreserve)) {
10531: $future_reservable{$slot} = {
10532: symb => $symb,
1.1075.2.104 raeburn 10533: startreserve => $startreserve,
10534: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10535: };
10536: }
10537: }
10538: }
10539: my @unsorted_reservable = keys(%reservable_now);
10540: if (@unsorted_reservable > 0) {
10541: @sorted_reservable =
10542: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10543: }
10544: my @unsorted_future = keys(%future_reservable);
10545: if (@unsorted_future > 0) {
10546: @sorted_future =
10547: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10548: }
10549: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10550: }
1.780 raeburn 10551:
10552: =pod
10553:
1.1057 foxr 10554: =back
10555:
1.549 albertel 10556: =head1 HTTP Helpers
10557:
10558: =over 4
10559:
1.648 raeburn 10560: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10561:
1.258 albertel 10562: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10563: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10564: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10565:
10566: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10567: $possible_names is an ref to an array of form element names. As an example:
10568: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10569: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10570:
10571: =cut
1.1 albertel 10572:
1.6 albertel 10573: sub get_unprocessed_cgi {
1.25 albertel 10574: my ($query,$possible_names)= @_;
1.26 matthew 10575: # $Apache::lonxml::debug=1;
1.356 albertel 10576: foreach my $pair (split(/&/,$query)) {
10577: my ($name, $value) = split(/=/,$pair);
1.369 www 10578: $name = &unescape($name);
1.25 albertel 10579: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10580: $value =~ tr/+/ /;
10581: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10582: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10583: }
1.16 harris41 10584: }
1.6 albertel 10585: }
10586:
1.112 bowersj2 10587: =pod
10588:
1.648 raeburn 10589: =item * &cacheheader()
1.112 bowersj2 10590:
10591: returns cache-controlling header code
10592:
10593: =cut
10594:
1.7 albertel 10595: sub cacheheader {
1.258 albertel 10596: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10597: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10598: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10599: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10600: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10601: return $output;
1.7 albertel 10602: }
10603:
1.112 bowersj2 10604: =pod
10605:
1.648 raeburn 10606: =item * &no_cache($r)
1.112 bowersj2 10607:
10608: specifies header code to not have cache
10609:
10610: =cut
10611:
1.9 albertel 10612: sub no_cache {
1.216 albertel 10613: my ($r) = @_;
10614: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10615: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10616: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10617: $r->no_cache(1);
10618: $r->header_out("Expires" => $date);
10619: $r->header_out("Pragma" => "no-cache");
1.123 www 10620: }
10621:
10622: sub content_type {
1.181 albertel 10623: my ($r,$type,$charset) = @_;
1.299 foxr 10624: if ($r) {
10625: # Note that printout.pl calls this with undef for $r.
10626: &no_cache($r);
10627: }
1.258 albertel 10628: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10629: unless ($charset) {
10630: $charset=&Apache::lonlocal::current_encoding;
10631: }
10632: if ($charset) { $type.='; charset='.$charset; }
10633: if ($r) {
10634: $r->content_type($type);
10635: } else {
10636: print("Content-type: $type\n\n");
10637: }
1.9 albertel 10638: }
1.25 albertel 10639:
1.112 bowersj2 10640: =pod
10641:
1.648 raeburn 10642: =item * &add_to_env($name,$value)
1.112 bowersj2 10643:
1.258 albertel 10644: adds $name to the %env hash with value
1.112 bowersj2 10645: $value, if $name already exists, the entry is converted to an array
10646: reference and $value is added to the array.
10647:
10648: =cut
10649:
1.25 albertel 10650: sub add_to_env {
10651: my ($name,$value)=@_;
1.258 albertel 10652: if (defined($env{$name})) {
10653: if (ref($env{$name})) {
1.25 albertel 10654: #already have multiple values
1.258 albertel 10655: push(@{ $env{$name} },$value);
1.25 albertel 10656: } else {
10657: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10658: my $first=$env{$name};
10659: undef($env{$name});
10660: push(@{ $env{$name} },$first,$value);
1.25 albertel 10661: }
10662: } else {
1.258 albertel 10663: $env{$name}=$value;
1.25 albertel 10664: }
1.31 albertel 10665: }
1.149 albertel 10666:
10667: =pod
10668:
1.648 raeburn 10669: =item * &get_env_multiple($name)
1.149 albertel 10670:
1.258 albertel 10671: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10672: values may be defined and end up as an array ref.
10673:
10674: returns an array of values
10675:
10676: =cut
10677:
10678: sub get_env_multiple {
10679: my ($name) = @_;
10680: my @values;
1.258 albertel 10681: if (defined($env{$name})) {
1.149 albertel 10682: # exists is it an array
1.258 albertel 10683: if (ref($env{$name})) {
10684: @values=@{ $env{$name} };
1.149 albertel 10685: } else {
1.258 albertel 10686: $values[0]=$env{$name};
1.149 albertel 10687: }
10688: }
10689: return(@values);
10690: }
10691:
1.660 raeburn 10692: sub ask_for_embedded_content {
10693: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10694: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 10695: %currsubfile,%unused,$rem);
1.1071 raeburn 10696: my $counter = 0;
10697: my $numnew = 0;
1.987 raeburn 10698: my $numremref = 0;
10699: my $numinvalid = 0;
10700: my $numpathchg = 0;
10701: my $numexisting = 0;
1.1071 raeburn 10702: my $numunused = 0;
10703: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 10704: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10705: my $heading = &mt('Upload embedded files');
10706: my $buttontext = &mt('Upload');
10707:
1.1075.2.11 raeburn 10708: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 10709: if ($actionurl eq '/adm/dependencies') {
10710: $navmap = Apache::lonnavmaps::navmap->new();
10711: }
10712: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10713: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 10714: }
1.1075.2.35 raeburn 10715: if (($actionurl eq '/adm/portfolio') ||
10716: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10717: my $current_path='/';
10718: if ($env{'form.currentpath'}) {
10719: $current_path = $env{'form.currentpath'};
10720: }
10721: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10722: $udom = $cdom;
10723: $uname = $cnum;
1.984 raeburn 10724: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10725: } else {
10726: $udom = $env{'user.domain'};
10727: $uname = $env{'user.name'};
10728: $url = '/userfiles/portfolio';
10729: }
1.987 raeburn 10730: $toplevel = $url.'/';
1.984 raeburn 10731: $url .= $current_path;
10732: $getpropath = 1;
1.987 raeburn 10733: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10734: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10735: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10736: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10737: $toplevel = $url;
1.984 raeburn 10738: if ($rest ne '') {
1.987 raeburn 10739: $url .= $rest;
10740: }
10741: } elsif ($actionurl eq '/adm/coursedocs') {
10742: if (ref($args) eq 'HASH') {
1.1071 raeburn 10743: $url = $args->{'docs_url'};
10744: $toplevel = $url;
1.1075.2.11 raeburn 10745: if ($args->{'context'} eq 'paste') {
10746: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10747: ($path) =
10748: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10749: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10750: $fileloc =~ s{^/}{};
10751: }
1.1071 raeburn 10752: }
10753: } elsif ($actionurl eq '/adm/dependencies') {
10754: if ($env{'request.course.id'} ne '') {
10755: if (ref($args) eq 'HASH') {
10756: $url = $args->{'docs_url'};
10757: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10758: $toplevel = $url;
10759: unless ($toplevel =~ m{^/}) {
10760: $toplevel = "/$url";
10761: }
1.1075.2.11 raeburn 10762: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10763: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10764: $path = $1;
10765: } else {
10766: ($path) =
10767: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10768: }
1.1075.2.79 raeburn 10769: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10770: $fileloc = $toplevel;
10771: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10772: my ($udom,$uname,$fname) =
10773: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10774: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10775: } else {
10776: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10777: }
1.1071 raeburn 10778: $fileloc =~ s{^/}{};
10779: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10780: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10781: }
1.987 raeburn 10782: }
1.1075.2.35 raeburn 10783: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10784: $udom = $cdom;
10785: $uname = $cnum;
10786: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10787: $toplevel = $url;
10788: $path = $url;
10789: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10790: $fileloc =~ s{^/}{};
10791: }
10792: foreach my $file (keys(%{$allfiles})) {
10793: my $embed_file;
10794: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10795: $embed_file = $1;
10796: } else {
10797: $embed_file = $file;
10798: }
1.1075.2.55 raeburn 10799: my ($absolutepath,$cleaned_file);
10800: if ($embed_file =~ m{^\w+://}) {
10801: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10802: $newfiles{$cleaned_file} = 1;
10803: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10804: } else {
1.1075.2.55 raeburn 10805: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10806: if ($embed_file =~ m{^/}) {
10807: $absolutepath = $embed_file;
10808: }
1.1075.2.47 raeburn 10809: if ($cleaned_file =~ m{/}) {
10810: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10811: $path = &check_for_traversal($path,$url,$toplevel);
10812: my $item = $fname;
10813: if ($path ne '') {
10814: $item = $path.'/'.$fname;
10815: $subdependencies{$path}{$fname} = 1;
10816: } else {
10817: $dependencies{$item} = 1;
10818: }
10819: if ($absolutepath) {
10820: $mapping{$item} = $absolutepath;
10821: } else {
10822: $mapping{$item} = $embed_file;
10823: }
10824: } else {
10825: $dependencies{$embed_file} = 1;
10826: if ($absolutepath) {
1.1075.2.47 raeburn 10827: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10828: } else {
1.1075.2.47 raeburn 10829: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10830: }
10831: }
1.984 raeburn 10832: }
10833: }
1.1071 raeburn 10834: my $dirptr = 16384;
1.984 raeburn 10835: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10836: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10837: if (($actionurl eq '/adm/portfolio') ||
10838: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10839: my ($sublistref,$listerror) =
10840: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10841: if (ref($sublistref) eq 'ARRAY') {
10842: foreach my $line (@{$sublistref}) {
10843: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10844: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10845: }
1.984 raeburn 10846: }
1.987 raeburn 10847: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10848: if (opendir(my $dir,$url.'/'.$path)) {
10849: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10850: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10851: }
1.1075.2.11 raeburn 10852: } elsif (($actionurl eq '/adm/dependencies') ||
10853: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10854: ($args->{'context'} eq 'paste')) ||
10855: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10856: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10857: my $dir;
10858: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10859: $dir = $fileloc;
10860: } else {
10861: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10862: }
1.1071 raeburn 10863: if ($dir ne '') {
10864: my ($sublistref,$listerror) =
10865: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10866: if (ref($sublistref) eq 'ARRAY') {
10867: foreach my $line (@{$sublistref}) {
10868: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10869: undef,$mtime)=split(/\&/,$line,12);
10870: unless (($testdir&$dirptr) ||
10871: ($file_name =~ /^\.\.?$/)) {
10872: $currsubfile{$path}{$file_name} = [$size,$mtime];
10873: }
10874: }
10875: }
10876: }
1.984 raeburn 10877: }
10878: }
10879: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10880: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10881: my $item = $path.'/'.$file;
10882: unless ($mapping{$item} eq $item) {
10883: $pathchanges{$item} = 1;
10884: }
10885: $existing{$item} = 1;
10886: $numexisting ++;
10887: } else {
10888: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10889: }
10890: }
1.1071 raeburn 10891: if ($actionurl eq '/adm/dependencies') {
10892: foreach my $path (keys(%currsubfile)) {
10893: if (ref($currsubfile{$path}) eq 'HASH') {
10894: foreach my $file (keys(%{$currsubfile{$path}})) {
10895: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10896: next if (($rem ne '') &&
10897: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10898: (ref($navmap) &&
10899: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10900: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10901: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10902: $unused{$path.'/'.$file} = 1;
10903: }
10904: }
10905: }
10906: }
10907: }
1.984 raeburn 10908: }
1.987 raeburn 10909: my %currfile;
1.1075.2.35 raeburn 10910: if (($actionurl eq '/adm/portfolio') ||
10911: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10912: my ($dirlistref,$listerror) =
10913: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10914: if (ref($dirlistref) eq 'ARRAY') {
10915: foreach my $line (@{$dirlistref}) {
10916: my ($file_name,$rest) = split(/\&/,$line,2);
10917: $currfile{$file_name} = 1;
10918: }
1.984 raeburn 10919: }
1.987 raeburn 10920: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10921: if (opendir(my $dir,$url)) {
1.987 raeburn 10922: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10923: map {$currfile{$_} = 1;} @dir_list;
10924: }
1.1075.2.11 raeburn 10925: } elsif (($actionurl eq '/adm/dependencies') ||
10926: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10927: ($args->{'context'} eq 'paste')) ||
10928: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10929: if ($env{'request.course.id'} ne '') {
10930: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10931: if ($dir ne '') {
10932: my ($dirlistref,$listerror) =
10933: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10934: if (ref($dirlistref) eq 'ARRAY') {
10935: foreach my $line (@{$dirlistref}) {
10936: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10937: $size,undef,$mtime)=split(/\&/,$line,12);
10938: unless (($testdir&$dirptr) ||
10939: ($file_name =~ /^\.\.?$/)) {
10940: $currfile{$file_name} = [$size,$mtime];
10941: }
10942: }
10943: }
10944: }
10945: }
1.984 raeburn 10946: }
10947: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10948: if (exists($currfile{$file})) {
1.987 raeburn 10949: unless ($mapping{$file} eq $file) {
10950: $pathchanges{$file} = 1;
10951: }
10952: $existing{$file} = 1;
10953: $numexisting ++;
10954: } else {
1.984 raeburn 10955: $newfiles{$file} = 1;
10956: }
10957: }
1.1071 raeburn 10958: foreach my $file (keys(%currfile)) {
10959: unless (($file eq $filename) ||
10960: ($file eq $filename.'.bak') ||
10961: ($dependencies{$file})) {
1.1075.2.11 raeburn 10962: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10963: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10964: next if (($rem ne '') &&
10965: (($env{"httpref.$rem".$file} ne '') ||
10966: (ref($navmap) &&
10967: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10968: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10969: ($navmap->getResourceByUrl($rem.$1)))))));
10970: }
1.1075.2.11 raeburn 10971: }
1.1071 raeburn 10972: $unused{$file} = 1;
10973: }
10974: }
1.1075.2.11 raeburn 10975: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10976: ($args->{'context'} eq 'paste')) {
10977: $counter = scalar(keys(%existing));
10978: $numpathchg = scalar(keys(%pathchanges));
10979: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10980: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10981: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10982: $counter = scalar(keys(%existing));
10983: $numpathchg = scalar(keys(%pathchanges));
10984: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10985: }
1.984 raeburn 10986: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10987: if ($actionurl eq '/adm/dependencies') {
10988: next if ($embed_file =~ m{^\w+://});
10989: }
1.660 raeburn 10990: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10991: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10992: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10993: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10994: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10995: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10996: }
1.1075.2.35 raeburn 10997: $upload_output .= '</td>';
1.1071 raeburn 10998: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10999: $upload_output.='<td align="right">'.
11000: '<span class="LC_info LC_fontsize_medium">'.
11001: &mt("URL points to web address").'</span>';
1.987 raeburn 11002: $numremref++;
1.660 raeburn 11003: } elsif ($args->{'error_on_invalid_names'}
11004: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 11005: $upload_output.='<td align="right"><span class="LC_warning">'.
11006: &mt('Invalid characters').'</span>';
1.987 raeburn 11007: $numinvalid++;
1.660 raeburn 11008: } else {
1.1075.2.35 raeburn 11009: $upload_output .= '<td>'.
11010: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11011: $embed_file,\%mapping,
1.1071 raeburn 11012: $allfiles,$codebase,'upload');
11013: $counter ++;
11014: $numnew ++;
1.987 raeburn 11015: }
11016: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11017: }
11018: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11019: if ($actionurl eq '/adm/dependencies') {
11020: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11021: $modify_output .= &start_data_table_row().
11022: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11023: '<img src="'.&icon($embed_file).'" border="0" />'.
11024: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11025: '<td>'.$size.'</td>'.
11026: '<td>'.$mtime.'</td>'.
11027: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11028: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11029: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11030: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11031: &embedded_file_element('upload_embedded',$counter,
11032: $embed_file,\%mapping,
11033: $allfiles,$codebase,'modify').
11034: '</div></td>'.
11035: &end_data_table_row()."\n";
11036: $counter ++;
11037: } else {
11038: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 11039: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11040: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11041: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11042: &Apache::loncommon::end_data_table_row()."\n";
11043: }
11044: }
11045: my $delidx = $counter;
11046: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11047: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11048: $delete_output .= &start_data_table_row().
11049: '<td><img src="'.&icon($oldfile).'" />'.
11050: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11051: '<td>'.$size.'</td>'.
11052: '<td>'.$mtime.'</td>'.
11053: '<td><label><input type="checkbox" name="del_upload_dep" '.
11054: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11055: &embedded_file_element('upload_embedded',$delidx,
11056: $oldfile,\%mapping,$allfiles,
11057: $codebase,'delete').'</td>'.
11058: &end_data_table_row()."\n";
11059: $numunused ++;
11060: $delidx ++;
1.987 raeburn 11061: }
11062: if ($upload_output) {
11063: $upload_output = &start_data_table().
11064: $upload_output.
11065: &end_data_table()."\n";
11066: }
1.1071 raeburn 11067: if ($modify_output) {
11068: $modify_output = &start_data_table().
11069: &start_data_table_header_row().
11070: '<th>'.&mt('File').'</th>'.
11071: '<th>'.&mt('Size (KB)').'</th>'.
11072: '<th>'.&mt('Modified').'</th>'.
11073: '<th>'.&mt('Upload replacement?').'</th>'.
11074: &end_data_table_header_row().
11075: $modify_output.
11076: &end_data_table()."\n";
11077: }
11078: if ($delete_output) {
11079: $delete_output = &start_data_table().
11080: &start_data_table_header_row().
11081: '<th>'.&mt('File').'</th>'.
11082: '<th>'.&mt('Size (KB)').'</th>'.
11083: '<th>'.&mt('Modified').'</th>'.
11084: '<th>'.&mt('Delete?').'</th>'.
11085: &end_data_table_header_row().
11086: $delete_output.
11087: &end_data_table()."\n";
11088: }
1.987 raeburn 11089: my $applies = 0;
11090: if ($numremref) {
11091: $applies ++;
11092: }
11093: if ($numinvalid) {
11094: $applies ++;
11095: }
11096: if ($numexisting) {
11097: $applies ++;
11098: }
1.1071 raeburn 11099: if ($counter || $numunused) {
1.987 raeburn 11100: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11101: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11102: $state.'<h3>'.$heading.'</h3>';
11103: if ($actionurl eq '/adm/dependencies') {
11104: if ($numnew) {
11105: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11106: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11107: $upload_output.'<br />'."\n";
11108: }
11109: if ($numexisting) {
11110: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11111: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11112: $modify_output.'<br />'."\n";
11113: $buttontext = &mt('Save changes');
11114: }
11115: if ($numunused) {
11116: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11117: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11118: $delete_output.'<br />'."\n";
11119: $buttontext = &mt('Save changes');
11120: }
11121: } else {
11122: $output .= $upload_output.'<br />'."\n";
11123: }
11124: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11125: $counter.'" />'."\n";
11126: if ($actionurl eq '/adm/dependencies') {
11127: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11128: $numnew.'" />'."\n";
11129: } elsif ($actionurl eq '') {
1.987 raeburn 11130: $output .= '<input type="hidden" name="phase" value="three" />';
11131: }
11132: } elsif ($applies) {
11133: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11134: if ($applies > 1) {
11135: $output .=
1.1075.2.35 raeburn 11136: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11137: if ($numremref) {
11138: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11139: }
11140: if ($numinvalid) {
11141: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11142: }
11143: if ($numexisting) {
11144: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11145: }
11146: $output .= '</ul><br />';
11147: } elsif ($numremref) {
11148: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11149: } elsif ($numinvalid) {
11150: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11151: } elsif ($numexisting) {
11152: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11153: }
11154: $output .= $upload_output.'<br />';
11155: }
11156: my ($pathchange_output,$chgcount);
1.1071 raeburn 11157: $chgcount = $counter;
1.987 raeburn 11158: if (keys(%pathchanges) > 0) {
11159: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11160: if ($counter) {
1.987 raeburn 11161: $output .= &embedded_file_element('pathchange',$chgcount,
11162: $embed_file,\%mapping,
1.1071 raeburn 11163: $allfiles,$codebase,'change');
1.987 raeburn 11164: } else {
11165: $pathchange_output .=
11166: &start_data_table_row().
11167: '<td><input type ="checkbox" name="namechange" value="'.
11168: $chgcount.'" checked="checked" /></td>'.
11169: '<td>'.$mapping{$embed_file}.'</td>'.
11170: '<td>'.$embed_file.
11171: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11172: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11173: '</td>'.&end_data_table_row();
1.660 raeburn 11174: }
1.987 raeburn 11175: $numpathchg ++;
11176: $chgcount ++;
1.660 raeburn 11177: }
11178: }
1.1075.2.35 raeburn 11179: if (($counter) || ($numunused)) {
1.987 raeburn 11180: if ($numpathchg) {
11181: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11182: $numpathchg.'" />'."\n";
11183: }
11184: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11185: ($actionurl eq '/adm/imsimport')) {
11186: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11187: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11188: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11189: } elsif ($actionurl eq '/adm/dependencies') {
11190: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11191: }
1.1075.2.35 raeburn 11192: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11193: } elsif ($numpathchg) {
11194: my %pathchange = ();
11195: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11196: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11197: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 11198: }
1.987 raeburn 11199: }
1.1071 raeburn 11200: return ($output,$counter,$numpathchg);
1.987 raeburn 11201: }
11202:
1.1075.2.47 raeburn 11203: =pod
11204:
11205: =item * clean_path($name)
11206:
11207: Performs clean-up of directories, subdirectories and filename in an
11208: embedded object, referenced in an HTML file which is being uploaded
11209: to a course or portfolio, where
11210: "Upload embedded images/multimedia files if HTML file" checkbox was
11211: checked.
11212:
11213: Clean-up is similar to replacements in lonnet::clean_filename()
11214: except each / between sub-directory and next level is preserved.
11215:
11216: =cut
11217:
11218: sub clean_path {
11219: my ($embed_file) = @_;
11220: $embed_file =~s{^/+}{};
11221: my @contents;
11222: if ($embed_file =~ m{/}) {
11223: @contents = split(/\//,$embed_file);
11224: } else {
11225: @contents = ($embed_file);
11226: }
11227: my $lastidx = scalar(@contents)-1;
11228: for (my $i=0; $i<=$lastidx; $i++) {
11229: $contents[$i]=~s{\\}{/}g;
11230: $contents[$i]=~s/\s+/\_/g;
11231: $contents[$i]=~s{[^/\w\.\-]}{}g;
11232: if ($i == $lastidx) {
11233: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11234: }
11235: }
11236: if ($lastidx > 0) {
11237: return join('/',@contents);
11238: } else {
11239: return $contents[0];
11240: }
11241: }
11242:
1.987 raeburn 11243: sub embedded_file_element {
1.1071 raeburn 11244: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11245: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11246: (ref($codebase) eq 'HASH'));
11247: my $output;
1.1071 raeburn 11248: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11249: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11250: }
11251: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11252: &escape($embed_file).'" />';
11253: unless (($context eq 'upload_embedded') &&
11254: ($mapping->{$embed_file} eq $embed_file)) {
11255: $output .='
11256: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11257: }
11258: my $attrib;
11259: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11260: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11261: }
11262: $output .=
11263: "\n\t\t".
11264: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11265: $attrib.'" />';
11266: if (exists($codebase->{$mapping->{$embed_file}})) {
11267: $output .=
11268: "\n\t\t".
11269: '<input name="codebase_'.$num.'" type="hidden" value="'.
11270: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11271: }
1.987 raeburn 11272: return $output;
1.660 raeburn 11273: }
11274:
1.1071 raeburn 11275: sub get_dependency_details {
11276: my ($currfile,$currsubfile,$embed_file) = @_;
11277: my ($size,$mtime,$showsize,$showmtime);
11278: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11279: if ($embed_file =~ m{/}) {
11280: my ($path,$fname) = split(/\//,$embed_file);
11281: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11282: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11283: }
11284: } else {
11285: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11286: ($size,$mtime) = @{$currfile->{$embed_file}};
11287: }
11288: }
11289: $showsize = $size/1024.0;
11290: $showsize = sprintf("%.1f",$showsize);
11291: if ($mtime > 0) {
11292: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11293: }
11294: }
11295: return ($showsize,$showmtime);
11296: }
11297:
11298: sub ask_embedded_js {
11299: return <<"END";
11300: <script type="text/javascript"">
11301: // <![CDATA[
11302: function toggleBrowse(counter) {
11303: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11304: var fileid = document.getElementById('embedded_item_'+counter);
11305: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11306: if (chkboxid.checked == true) {
11307: uploaddivid.style.display='block';
11308: } else {
11309: uploaddivid.style.display='none';
11310: fileid.value = '';
11311: }
11312: }
11313: // ]]>
11314: </script>
11315:
11316: END
11317: }
11318:
1.661 raeburn 11319: sub upload_embedded {
11320: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11321: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11322: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11323: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11324: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11325: my $orig_uploaded_filename =
11326: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11327: foreach my $type ('orig','ref','attrib','codebase') {
11328: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11329: $env{'form.embedded_'.$type.'_'.$i} =
11330: &unescape($env{'form.embedded_'.$type.'_'.$i});
11331: }
11332: }
1.661 raeburn 11333: my ($path,$fname) =
11334: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11335: # no path, whole string is fname
11336: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11337: $fname = &Apache::lonnet::clean_filename($fname);
11338: # See if there is anything left
11339: next if ($fname eq '');
11340:
11341: # Check if file already exists as a file or directory.
11342: my ($state,$msg);
11343: if ($context eq 'portfolio') {
11344: my $port_path = $dirpath;
11345: if ($group ne '') {
11346: $port_path = "groups/$group/$port_path";
11347: }
1.987 raeburn 11348: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11349: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11350: $dir_root,$port_path,$disk_quota,
11351: $current_disk_usage,$uname,$udom);
11352: if ($state eq 'will_exceed_quota'
1.984 raeburn 11353: || $state eq 'file_locked') {
1.661 raeburn 11354: $output .= $msg;
11355: next;
11356: }
11357: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11358: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11359: if ($state eq 'exists') {
11360: $output .= $msg;
11361: next;
11362: }
11363: }
11364: # Check if extension is valid
11365: if (($fname =~ /\.(\w+)$/) &&
11366: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 11367: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11368: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11369: next;
11370: } elsif (($fname =~ /\.(\w+)$/) &&
11371: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11372: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11373: next;
11374: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 11375: $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 11376: next;
11377: }
11378: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 11379: my $subdir = $path;
11380: $subdir =~ s{/+$}{};
1.661 raeburn 11381: if ($context eq 'portfolio') {
1.984 raeburn 11382: my $result;
11383: if ($state eq 'existingfile') {
11384: $result=
11385: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 11386: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11387: } else {
1.984 raeburn 11388: $result=
11389: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11390: $dirpath.
1.1075.2.35 raeburn 11391: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11392: if ($result !~ m|^/uploaded/|) {
11393: $output .= '<span class="LC_error">'
11394: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11395: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11396: .'</span><br />';
11397: next;
11398: } else {
1.987 raeburn 11399: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11400: $path.$fname.'</span>').'<br />';
1.984 raeburn 11401: }
1.661 raeburn 11402: }
1.1075.2.35 raeburn 11403: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
11404: my $extendedsubdir = $dirpath.'/'.$subdir;
11405: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11406: my $result =
1.1075.2.35 raeburn 11407: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11408: if ($result !~ m|^/uploaded/|) {
11409: $output .= '<span class="LC_error">'
11410: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11411: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11412: .'</span><br />';
11413: next;
11414: } else {
11415: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11416: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 11417: if ($context eq 'syllabus') {
11418: &Apache::lonnet::make_public_indefinitely($result);
11419: }
1.987 raeburn 11420: }
1.661 raeburn 11421: } else {
11422: # Save the file
11423: my $target = $env{'form.embedded_item_'.$i};
11424: my $fullpath = $dir_root.$dirpath.'/'.$path;
11425: my $dest = $fullpath.$fname;
11426: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11427: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11428: my $count;
11429: my $filepath = $dir_root;
1.1027 raeburn 11430: foreach my $subdir (@parts) {
11431: $filepath .= "/$subdir";
11432: if (!-e $filepath) {
1.661 raeburn 11433: mkdir($filepath,0770);
11434: }
11435: }
11436: my $fh;
11437: if (!open($fh,'>'.$dest)) {
11438: &Apache::lonnet::logthis('Failed to create '.$dest);
11439: $output .= '<span class="LC_error">'.
1.1071 raeburn 11440: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11441: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11442: '</span><br />';
11443: } else {
11444: if (!print $fh $env{'form.embedded_item_'.$i}) {
11445: &Apache::lonnet::logthis('Failed to write to '.$dest);
11446: $output .= '<span class="LC_error">'.
1.1071 raeburn 11447: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11448: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11449: '</span><br />';
11450: } else {
1.987 raeburn 11451: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11452: $url.'</span>').'<br />';
11453: unless ($context eq 'testbank') {
11454: $footer .= &mt('View embedded file: [_1]',
11455: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11456: }
11457: }
11458: close($fh);
11459: }
11460: }
11461: if ($env{'form.embedded_ref_'.$i}) {
11462: $pathchange{$i} = 1;
11463: }
11464: }
11465: if ($output) {
11466: $output = '<p>'.$output.'</p>';
11467: }
11468: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11469: $returnflag = 'ok';
1.1071 raeburn 11470: my $numpathchgs = scalar(keys(%pathchange));
11471: if ($numpathchgs > 0) {
1.987 raeburn 11472: if ($context eq 'portfolio') {
11473: $output .= '<p>'.&mt('or').'</p>';
11474: } elsif ($context eq 'testbank') {
1.1071 raeburn 11475: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11476: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11477: $returnflag = 'modify_orightml';
11478: }
11479: }
1.1071 raeburn 11480: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11481: }
11482:
11483: sub modify_html_form {
11484: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11485: my $end = 0;
11486: my $modifyform;
11487: if ($context eq 'upload_embedded') {
11488: return unless (ref($pathchange) eq 'HASH');
11489: if ($env{'form.number_embedded_items'}) {
11490: $end += $env{'form.number_embedded_items'};
11491: }
11492: if ($env{'form.number_pathchange_items'}) {
11493: $end += $env{'form.number_pathchange_items'};
11494: }
11495: if ($end) {
11496: for (my $i=0; $i<$end; $i++) {
11497: if ($i < $env{'form.number_embedded_items'}) {
11498: next unless($pathchange->{$i});
11499: }
11500: $modifyform .=
11501: &start_data_table_row().
11502: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11503: 'checked="checked" /></td>'.
11504: '<td>'.$env{'form.embedded_ref_'.$i}.
11505: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11506: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11507: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11508: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11509: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11510: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11511: '<td>'.$env{'form.embedded_orig_'.$i}.
11512: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11513: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11514: &end_data_table_row();
1.1071 raeburn 11515: }
1.987 raeburn 11516: }
11517: } else {
11518: $modifyform = $pathchgtable;
11519: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11520: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11521: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11522: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11523: }
11524: }
11525: if ($modifyform) {
1.1071 raeburn 11526: if ($actionurl eq '/adm/dependencies') {
11527: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11528: }
1.987 raeburn 11529: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11530: '<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".
11531: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11532: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11533: '</ol></p>'."\n".'<p>'.
11534: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11535: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11536: &start_data_table()."\n".
11537: &start_data_table_header_row().
11538: '<th>'.&mt('Change?').'</th>'.
11539: '<th>'.&mt('Current reference').'</th>'.
11540: '<th>'.&mt('Required reference').'</th>'.
11541: &end_data_table_header_row()."\n".
11542: $modifyform.
11543: &end_data_table().'<br />'."\n".$hiddenstate.
11544: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11545: '</form>'."\n";
11546: }
11547: return;
11548: }
11549:
11550: sub modify_html_refs {
1.1075.2.35 raeburn 11551: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11552: my $container;
11553: if ($context eq 'portfolio') {
11554: $container = $env{'form.container'};
11555: } elsif ($context eq 'coursedoc') {
11556: $container = $env{'form.primaryurl'};
1.1071 raeburn 11557: } elsif ($context eq 'manage_dependencies') {
11558: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11559: $container = "/$container";
1.1075.2.35 raeburn 11560: } elsif ($context eq 'syllabus') {
11561: $container = $url;
1.987 raeburn 11562: } else {
1.1027 raeburn 11563: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11564: }
11565: my (%allfiles,%codebase,$output,$content);
11566: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 11567: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11568: if (wantarray) {
11569: return ('',0,0);
11570: } else {
11571: return;
11572: }
11573: }
11574: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11575: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11576: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11577: if (wantarray) {
11578: return ('',0,0);
11579: } else {
11580: return;
11581: }
11582: }
1.987 raeburn 11583: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11584: if ($content eq '-1') {
11585: if (wantarray) {
11586: return ('',0,0);
11587: } else {
11588: return;
11589: }
11590: }
1.987 raeburn 11591: } else {
1.1071 raeburn 11592: unless ($container =~ /^\Q$dir_root\E/) {
11593: if (wantarray) {
11594: return ('',0,0);
11595: } else {
11596: return;
11597: }
11598: }
1.1075.2.128 raeburn 11599: if (open(my $fh,'<',$container)) {
1.987 raeburn 11600: $content = join('', <$fh>);
11601: close($fh);
11602: } else {
1.1071 raeburn 11603: if (wantarray) {
11604: return ('',0,0);
11605: } else {
11606: return;
11607: }
1.987 raeburn 11608: }
11609: }
11610: my ($count,$codebasecount) = (0,0);
11611: my $mm = new File::MMagic;
11612: my $mime_type = $mm->checktype_contents($content);
11613: if ($mime_type eq 'text/html') {
11614: my $parse_result =
11615: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11616: \%codebase,\$content);
11617: if ($parse_result eq 'ok') {
11618: foreach my $i (@changes) {
11619: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11620: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11621: if ($allfiles{$ref}) {
11622: my $newname = $orig;
11623: my ($attrib_regexp,$codebase);
1.1006 raeburn 11624: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11625: if ($attrib_regexp =~ /:/) {
11626: $attrib_regexp =~ s/\:/|/g;
11627: }
11628: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11629: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11630: $count += $numchg;
1.1075.2.35 raeburn 11631: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 11632: delete($allfiles{$ref});
1.987 raeburn 11633: }
11634: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11635: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11636: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11637: $codebasecount ++;
11638: }
11639: }
11640: }
1.1075.2.35 raeburn 11641: my $skiprewrites;
1.987 raeburn 11642: if ($count || $codebasecount) {
11643: my $saveresult;
1.1071 raeburn 11644: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11645: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11646: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11647: if ($url eq $container) {
11648: my ($fname) = ($container =~ m{/([^/]+)$});
11649: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11650: $count,'<span class="LC_filename">'.
1.1071 raeburn 11651: $fname.'</span>').'</p>';
1.987 raeburn 11652: } else {
11653: $output = '<p class="LC_error">'.
11654: &mt('Error: update failed for: [_1].',
11655: '<span class="LC_filename">'.
11656: $container.'</span>').'</p>';
11657: }
1.1075.2.35 raeburn 11658: if ($context eq 'syllabus') {
11659: unless ($saveresult eq 'ok') {
11660: $skiprewrites = 1;
11661: }
11662: }
1.987 raeburn 11663: } else {
1.1075.2.128 raeburn 11664: if (open(my $fh,'>',$container)) {
1.987 raeburn 11665: print $fh $content;
11666: close($fh);
11667: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11668: $count,'<span class="LC_filename">'.
11669: $container.'</span>').'</p>';
1.661 raeburn 11670: } else {
1.987 raeburn 11671: $output = '<p class="LC_error">'.
11672: &mt('Error: could not update [_1].',
11673: '<span class="LC_filename">'.
11674: $container.'</span>').'</p>';
1.661 raeburn 11675: }
11676: }
11677: }
1.1075.2.35 raeburn 11678: if (($context eq 'syllabus') && (!$skiprewrites)) {
11679: my ($actionurl,$state);
11680: $actionurl = "/public/$udom/$uname/syllabus";
11681: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11682: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11683: \%codebase,
11684: {'context' => 'rewrites',
11685: 'ignore_remote_references' => 1,});
11686: if (ref($mapping) eq 'HASH') {
11687: my $rewrites = 0;
11688: foreach my $key (keys(%{$mapping})) {
11689: next if ($key =~ m{^https?://});
11690: my $ref = $mapping->{$key};
11691: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11692: my $attrib;
11693: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11694: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11695: }
11696: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11697: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11698: $rewrites += $numchg;
11699: }
11700: }
11701: if ($rewrites) {
11702: my $saveresult;
11703: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11704: if ($url eq $container) {
11705: my ($fname) = ($container =~ m{/([^/]+)$});
11706: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11707: $count,'<span class="LC_filename">'.
11708: $fname.'</span>').'</p>';
11709: } else {
11710: $output .= '<p class="LC_error">'.
11711: &mt('Error: could not update links in [_1].',
11712: '<span class="LC_filename">'.
11713: $container.'</span>').'</p>';
11714:
11715: }
11716: }
11717: }
11718: }
1.987 raeburn 11719: } else {
11720: &logthis('Failed to parse '.$container.
11721: ' to modify references: '.$parse_result);
1.661 raeburn 11722: }
11723: }
1.1071 raeburn 11724: if (wantarray) {
11725: return ($output,$count,$codebasecount);
11726: } else {
11727: return $output;
11728: }
1.661 raeburn 11729: }
11730:
11731: sub check_for_existing {
11732: my ($path,$fname,$element) = @_;
11733: my ($state,$msg);
11734: if (-d $path.'/'.$fname) {
11735: $state = 'exists';
11736: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11737: } elsif (-e $path.'/'.$fname) {
11738: $state = 'exists';
11739: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11740: }
11741: if ($state eq 'exists') {
11742: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11743: }
11744: return ($state,$msg);
11745: }
11746:
11747: sub check_for_upload {
11748: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11749: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11750: my $filesize = length($env{'form.'.$element});
11751: if (!$filesize) {
11752: my $msg = '<span class="LC_error">'.
11753: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11754: '<span class="LC_filename">'.$fname.'</span>',
11755: $filesize).'<br />'.
1.1007 raeburn 11756: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11757: '</span>';
11758: return ('zero_bytes',$msg);
11759: }
11760: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11761: my $getpropath = 1;
1.1021 raeburn 11762: my ($dirlistref,$listerror) =
11763: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11764: my $found_file = 0;
11765: my $locked_file = 0;
1.991 raeburn 11766: my @lockers;
11767: my $navmap;
11768: if ($env{'request.course.id'}) {
11769: $navmap = Apache::lonnavmaps::navmap->new();
11770: }
1.1021 raeburn 11771: if (ref($dirlistref) eq 'ARRAY') {
11772: foreach my $line (@{$dirlistref}) {
11773: my ($file_name,$rest)=split(/\&/,$line,2);
11774: if ($file_name eq $fname){
11775: $file_name = $path.$file_name;
11776: if ($group ne '') {
11777: $file_name = $group.$file_name;
11778: }
11779: $found_file = 1;
11780: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11781: foreach my $lock (@lockers) {
11782: if (ref($lock) eq 'ARRAY') {
11783: my ($symb,$crsid) = @{$lock};
11784: if ($crsid eq $env{'request.course.id'}) {
11785: if (ref($navmap)) {
11786: my $res = $navmap->getBySymb($symb);
11787: foreach my $part (@{$res->parts()}) {
11788: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11789: unless (($slot_status == $res->RESERVED) ||
11790: ($slot_status == $res->RESERVED_LOCATION)) {
11791: $locked_file = 1;
11792: }
1.991 raeburn 11793: }
1.1021 raeburn 11794: } else {
11795: $locked_file = 1;
1.991 raeburn 11796: }
11797: } else {
11798: $locked_file = 1;
11799: }
11800: }
1.1021 raeburn 11801: }
11802: } else {
11803: my @info = split(/\&/,$rest);
11804: my $currsize = $info[6]/1000;
11805: if ($currsize < $filesize) {
11806: my $extra = $filesize - $currsize;
11807: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11808: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11809: &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.1075.2.69 raeburn 11810: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11811: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11812: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11813: return ('will_exceed_quota',$msg);
11814: }
1.984 raeburn 11815: }
11816: }
1.661 raeburn 11817: }
11818: }
11819: }
11820: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11821: my $msg = '<p class="LC_warning">'.
11822: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11823: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11824: return ('will_exceed_quota',$msg);
11825: } elsif ($found_file) {
11826: if ($locked_file) {
1.1075.2.69 raeburn 11827: my $msg = '<p class="LC_warning">';
1.661 raeburn 11828: $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.1075.2.69 raeburn 11829: $msg .= '</p>';
1.661 raeburn 11830: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11831: return ('file_locked',$msg);
11832: } else {
1.1075.2.69 raeburn 11833: my $msg = '<p class="LC_error">';
1.984 raeburn 11834: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69 raeburn 11835: $msg .= '</p>';
1.984 raeburn 11836: return ('existingfile',$msg);
1.661 raeburn 11837: }
11838: }
11839: }
11840:
1.987 raeburn 11841: sub check_for_traversal {
11842: my ($path,$url,$toplevel) = @_;
11843: my @parts=split(/\//,$path);
11844: my $cleanpath;
11845: my $fullpath = $url;
11846: for (my $i=0;$i<@parts;$i++) {
11847: next if ($parts[$i] eq '.');
11848: if ($parts[$i] eq '..') {
11849: $fullpath =~ s{([^/]+/)$}{};
11850: } else {
11851: $fullpath .= $parts[$i].'/';
11852: }
11853: }
11854: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11855: $cleanpath = $1;
11856: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11857: my $curr_toprel = $1;
11858: my @parts = split(/\//,$curr_toprel);
11859: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11860: my @urlparts = split(/\//,$url_toprel);
11861: my $doubledots;
11862: my $startdiff = -1;
11863: for (my $i=0; $i<@urlparts; $i++) {
11864: if ($startdiff == -1) {
11865: unless ($urlparts[$i] eq $parts[$i]) {
11866: $startdiff = $i;
11867: $doubledots .= '../';
11868: }
11869: } else {
11870: $doubledots .= '../';
11871: }
11872: }
11873: if ($startdiff > -1) {
11874: $cleanpath = $doubledots;
11875: for (my $i=$startdiff; $i<@parts; $i++) {
11876: $cleanpath .= $parts[$i].'/';
11877: }
11878: }
11879: }
11880: $cleanpath =~ s{(/)$}{};
11881: return $cleanpath;
11882: }
1.31 albertel 11883:
1.1053 raeburn 11884: sub is_archive_file {
11885: my ($mimetype) = @_;
11886: if (($mimetype eq 'application/octet-stream') ||
11887: ($mimetype eq 'application/x-stuffit') ||
11888: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11889: return 1;
11890: }
11891: return;
11892: }
11893:
11894: sub decompress_form {
1.1065 raeburn 11895: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11896: my %lt = &Apache::lonlocal::texthash (
11897: this => 'This file is an archive file.',
1.1067 raeburn 11898: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11899: itsc => 'Its contents are as follows:',
1.1053 raeburn 11900: youm => 'You may wish to extract its contents.',
11901: extr => 'Extract contents',
1.1067 raeburn 11902: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11903: proa => 'Process automatically?',
1.1053 raeburn 11904: yes => 'Yes',
11905: no => 'No',
1.1067 raeburn 11906: fold => 'Title for folder containing movie',
11907: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11908: );
1.1065 raeburn 11909: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11910: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11911: my $info = &list_archive_contents($fileloc,\@paths);
11912: if (@paths) {
11913: foreach my $path (@paths) {
11914: $path =~ s{^/}{};
1.1067 raeburn 11915: if ($path =~ m{^([^/]+)/$}) {
11916: $topdir = $1;
11917: }
1.1065 raeburn 11918: if ($path =~ m{^([^/]+)/}) {
11919: $toplevel{$1} = $path;
11920: } else {
11921: $toplevel{$path} = $path;
11922: }
11923: }
11924: }
1.1067 raeburn 11925: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11926: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11927: "$topdir/media/",
11928: "$topdir/media/$topdir.mp4",
11929: "$topdir/media/FirstFrame.png",
11930: "$topdir/media/player.swf",
11931: "$topdir/media/swfobject.js",
11932: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11933: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11934: "$topdir/$topdir.mp4",
11935: "$topdir/$topdir\_config.xml",
11936: "$topdir/$topdir\_controller.swf",
11937: "$topdir/$topdir\_embed.css",
11938: "$topdir/$topdir\_First_Frame.png",
11939: "$topdir/$topdir\_player.html",
11940: "$topdir/$topdir\_Thumbnails.png",
11941: "$topdir/playerProductInstall.swf",
11942: "$topdir/scripts/",
11943: "$topdir/scripts/config_xml.js",
11944: "$topdir/scripts/handlebars.js",
11945: "$topdir/scripts/jquery-1.7.1.min.js",
11946: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11947: "$topdir/scripts/modernizr.js",
11948: "$topdir/scripts/player-min.js",
11949: "$topdir/scripts/swfobject.js",
11950: "$topdir/skins/",
11951: "$topdir/skins/configuration_express.xml",
11952: "$topdir/skins/express_show/",
11953: "$topdir/skins/express_show/player-min.css",
11954: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11955: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11956: "$topdir/$topdir.mp4",
11957: "$topdir/$topdir\_config.xml",
11958: "$topdir/$topdir\_controller.swf",
11959: "$topdir/$topdir\_embed.css",
11960: "$topdir/$topdir\_First_Frame.png",
11961: "$topdir/$topdir\_player.html",
11962: "$topdir/$topdir\_Thumbnails.png",
11963: "$topdir/playerProductInstall.swf",
11964: "$topdir/scripts/",
11965: "$topdir/scripts/config_xml.js",
11966: "$topdir/scripts/techsmith-smart-player.min.js",
11967: "$topdir/skins/",
11968: "$topdir/skins/configuration_express.xml",
11969: "$topdir/skins/express_show/",
11970: "$topdir/skins/express_show/spritesheet.min.css",
11971: "$topdir/skins/express_show/spritesheet.png",
11972: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11973: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11974: if (@diffs == 0) {
1.1075.2.59 raeburn 11975: $is_camtasia = 6;
11976: } else {
1.1075.2.81 raeburn 11977: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11978: if (@diffs == 0) {
11979: $is_camtasia = 8;
1.1075.2.81 raeburn 11980: } else {
11981: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11982: if (@diffs == 0) {
11983: $is_camtasia = 8;
11984: }
1.1075.2.59 raeburn 11985: }
1.1067 raeburn 11986: }
11987: }
11988: my $output;
11989: if ($is_camtasia) {
11990: $output = <<"ENDCAM";
11991: <script type="text/javascript" language="Javascript">
11992: // <![CDATA[
11993:
11994: function camtasiaToggle() {
11995: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11996: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11997: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11998: document.getElementById('camtasia_titles').style.display='block';
11999: } else {
12000: document.getElementById('camtasia_titles').style.display='none';
12001: }
12002: }
12003: }
12004: return;
12005: }
12006:
12007: // ]]>
12008: </script>
12009: <p>$lt{'camt'}</p>
12010: ENDCAM
1.1065 raeburn 12011: } else {
1.1067 raeburn 12012: $output = '<p>'.$lt{'this'};
12013: if ($info eq '') {
12014: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12015: } else {
12016: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12017: '<div><pre>'.$info.'</pre></div>';
12018: }
1.1065 raeburn 12019: }
1.1067 raeburn 12020: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12021: my $duplicates;
12022: my $num = 0;
12023: if (ref($dirlist) eq 'ARRAY') {
12024: foreach my $item (@{$dirlist}) {
12025: if (ref($item) eq 'ARRAY') {
12026: if (exists($toplevel{$item->[0]})) {
12027: $duplicates .=
12028: &start_data_table_row().
12029: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12030: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12031: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12032: 'value="1" />'.&mt('Yes').'</label>'.
12033: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12034: '<td>'.$item->[0].'</td>';
12035: if ($item->[2]) {
12036: $duplicates .= '<td>'.&mt('Directory').'</td>';
12037: } else {
12038: $duplicates .= '<td>'.&mt('File').'</td>';
12039: }
12040: $duplicates .= '<td>'.$item->[3].'</td>'.
12041: '<td>'.
12042: &Apache::lonlocal::locallocaltime($item->[4]).
12043: '</td>'.
12044: &end_data_table_row();
12045: $num ++;
12046: }
12047: }
12048: }
12049: }
12050: my $itemcount;
12051: if (@paths > 0) {
12052: $itemcount = scalar(@paths);
12053: } else {
12054: $itemcount = 1;
12055: }
1.1067 raeburn 12056: if ($is_camtasia) {
12057: $output .= $lt{'auto'}.'<br />'.
12058: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 12059: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12060: $lt{'yes'}.'</label> <label>'.
12061: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12062: $lt{'no'}.'</label></span><br />'.
12063: '<div id="camtasia_titles" style="display:block">'.
12064: &Apache::lonhtmlcommon::start_pick_box().
12065: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12066: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12067: &Apache::lonhtmlcommon::row_closure().
12068: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12069: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12070: &Apache::lonhtmlcommon::row_closure(1).
12071: &Apache::lonhtmlcommon::end_pick_box().
12072: '</div>';
12073: }
1.1065 raeburn 12074: $output .=
12075: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12076: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12077: "\n";
1.1065 raeburn 12078: if ($duplicates ne '') {
12079: $output .= '<p><span class="LC_warning">'.
12080: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12081: &start_data_table().
12082: &start_data_table_header_row().
12083: '<th>'.&mt('Overwrite?').'</th>'.
12084: '<th>'.&mt('Name').'</th>'.
12085: '<th>'.&mt('Type').'</th>'.
12086: '<th>'.&mt('Size').'</th>'.
12087: '<th>'.&mt('Last modified').'</th>'.
12088: &end_data_table_header_row().
12089: $duplicates.
12090: &end_data_table().
12091: '</p>';
12092: }
1.1067 raeburn 12093: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12094: if (ref($hiddenelements) eq 'HASH') {
12095: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12096: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12097: }
12098: }
12099: $output .= <<"END";
1.1067 raeburn 12100: <br />
1.1053 raeburn 12101: <input type="submit" name="decompress" value="$lt{'extr'}" />
12102: </form>
12103: $noextract
12104: END
12105: return $output;
12106: }
12107:
1.1065 raeburn 12108: sub decompression_utility {
12109: my ($program) = @_;
12110: my @utilities = ('tar','gunzip','bunzip2','unzip');
12111: my $location;
12112: if (grep(/^\Q$program\E$/,@utilities)) {
12113: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12114: '/usr/sbin/') {
12115: if (-x $dir.$program) {
12116: $location = $dir.$program;
12117: last;
12118: }
12119: }
12120: }
12121: return $location;
12122: }
12123:
12124: sub list_archive_contents {
12125: my ($file,$pathsref) = @_;
12126: my (@cmd,$output);
12127: my $needsregexp;
12128: if ($file =~ /\.zip$/) {
12129: @cmd = (&decompression_utility('unzip'),"-l");
12130: $needsregexp = 1;
12131: } elsif (($file =~ m/\.tar\.gz$/) ||
12132: ($file =~ /\.tgz$/)) {
12133: @cmd = (&decompression_utility('tar'),"-ztf");
12134: } elsif ($file =~ /\.tar\.bz2$/) {
12135: @cmd = (&decompression_utility('tar'),"-jtf");
12136: } elsif ($file =~ m|\.tar$|) {
12137: @cmd = (&decompression_utility('tar'),"-tf");
12138: }
12139: if (@cmd) {
12140: undef($!);
12141: undef($@);
12142: if (open(my $fh,"-|", @cmd, $file)) {
12143: while (my $line = <$fh>) {
12144: $output .= $line;
12145: chomp($line);
12146: my $item;
12147: if ($needsregexp) {
12148: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12149: } else {
12150: $item = $line;
12151: }
12152: if ($item ne '') {
12153: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12154: push(@{$pathsref},$item);
12155: }
12156: }
12157: }
12158: close($fh);
12159: }
12160: }
12161: return $output;
12162: }
12163:
1.1053 raeburn 12164: sub decompress_uploaded_file {
12165: my ($file,$dir) = @_;
12166: &Apache::lonnet::appenv({'cgi.file' => $file});
12167: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12168: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12169: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12170: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12171: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12172: my $decompressed = $env{'cgi.decompressed'};
12173: &Apache::lonnet::delenv('cgi.file');
12174: &Apache::lonnet::delenv('cgi.dir');
12175: &Apache::lonnet::delenv('cgi.decompressed');
12176: return ($decompressed,$result);
12177: }
12178:
1.1055 raeburn 12179: sub process_decompression {
12180: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128 raeburn 12181: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12182: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12183: &mt('Unexpected file path.').'</p>'."\n";
12184: }
12185: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12186: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12187: &mt('Unexpected course context.').'</p>'."\n";
12188: }
12189: unless ($file eq &Apache::lonnet::clean_filename($file)) {
12190: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12191: &mt('Filename contained unexpected characters.').'</p>'."\n";
12192: }
1.1055 raeburn 12193: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 12194: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 12195: $error = &mt('Filename not a supported archive file type.').
12196: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12197: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12198: } else {
12199: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12200: if ($docuhome eq 'no_host') {
12201: $error = &mt('Could not determine home server for course.');
12202: } else {
12203: my @ids=&Apache::lonnet::current_machine_ids();
12204: my $currdir = "$dir_root/$destination";
12205: if (grep(/^\Q$docuhome\E$/,@ids)) {
12206: $dir = &LONCAPA::propath($docudom,$docuname).
12207: "$dir_root/$destination";
12208: } else {
12209: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12210: "$dir_root/$docudom/$docuname/$destination";
12211: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12212: $error = &mt('Archive file not found.');
12213: }
12214: }
1.1065 raeburn 12215: my (@to_overwrite,@to_skip);
12216: if ($env{'form.archive_overwrite_total'} > 0) {
12217: my $total = $env{'form.archive_overwrite_total'};
12218: for (my $i=0; $i<$total; $i++) {
12219: if ($env{'form.archive_overwrite_'.$i} == 1) {
12220: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12221: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12222: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12223: }
12224: }
12225: }
12226: my $numskip = scalar(@to_skip);
1.1075.2.128 raeburn 12227: my $numoverwrite = scalar(@to_overwrite);
12228: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12229: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12230: } elsif ($dir eq '') {
1.1055 raeburn 12231: $error = &mt('Directory containing archive file unavailable.');
12232: } elsif (!$error) {
1.1065 raeburn 12233: my ($decompressed,$display);
1.1075.2.128 raeburn 12234: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12235: my $tempdir = time.'_'.$$.int(rand(10000));
12236: mkdir("$dir/$tempdir",0755);
1.1075.2.128 raeburn 12237: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12238: ($decompressed,$display) =
12239: &decompress_uploaded_file($file,"$dir/$tempdir");
12240: foreach my $item (@to_skip) {
12241: if (($item ne '') && ($item !~ /\.\./)) {
12242: if (-f "$dir/$tempdir/$item") {
12243: unlink("$dir/$tempdir/$item");
12244: } elsif (-d "$dir/$tempdir/$item") {
12245: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
12246: }
12247: }
12248: }
12249: foreach my $item (@to_overwrite) {
12250: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
12251: if (($item ne '') && ($item !~ /\.\./)) {
12252: if (-f "$dir/$item") {
12253: unlink("$dir/$item");
12254: } elsif (-d "$dir/$item") {
12255: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
12256: }
12257: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
12258: }
1.1065 raeburn 12259: }
12260: }
1.1075.2.128 raeburn 12261: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
12262: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
12263: }
1.1065 raeburn 12264: }
12265: } else {
12266: ($decompressed,$display) =
12267: &decompress_uploaded_file($file,$dir);
12268: }
1.1055 raeburn 12269: if ($decompressed eq 'ok') {
1.1065 raeburn 12270: $output = '<p class="LC_info">'.
12271: &mt('Files extracted successfully from archive.').
12272: '</p>'."\n";
1.1055 raeburn 12273: my ($warning,$result,@contents);
12274: my ($newdirlistref,$newlisterror) =
12275: &Apache::lonnet::dirlist($currdir,$docudom,
12276: $docuname,1);
12277: my (%is_dir,%changes,@newitems);
12278: my $dirptr = 16384;
1.1065 raeburn 12279: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12280: foreach my $dir_line (@{$newdirlistref}) {
12281: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128 raeburn 12282: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 12283: push(@newitems,$item);
12284: if ($dirptr&$testdir) {
12285: $is_dir{$item} = 1;
12286: }
12287: $changes{$item} = 1;
12288: }
12289: }
12290: }
12291: if (keys(%changes) > 0) {
12292: foreach my $item (sort(@newitems)) {
12293: if ($changes{$item}) {
12294: push(@contents,$item);
12295: }
12296: }
12297: }
12298: if (@contents > 0) {
1.1067 raeburn 12299: my $wantform;
12300: unless ($env{'form.autoextract_camtasia'}) {
12301: $wantform = 1;
12302: }
1.1056 raeburn 12303: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12304: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12305: $currdir,\%is_dir,
12306: \%children,\%parent,
1.1056 raeburn 12307: \@contents,\%dirorder,
12308: \%titles,$wantform);
1.1055 raeburn 12309: if ($datatable ne '') {
12310: $output .= &archive_options_form('decompressed',$datatable,
12311: $count,$hiddenelem);
1.1065 raeburn 12312: my $startcount = 6;
1.1055 raeburn 12313: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12314: \%titles,\%children);
1.1055 raeburn 12315: }
1.1067 raeburn 12316: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 12317: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12318: my %displayed;
12319: my $total = 1;
12320: $env{'form.archive_directory'} = [];
12321: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12322: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12323: $path =~ s{/$}{};
12324: my $item;
12325: if ($path ne '') {
12326: $item = "$path/$titles{$i}";
12327: } else {
12328: $item = $titles{$i};
12329: }
12330: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12331: if ($item eq $contents[0]) {
12332: push(@{$env{'form.archive_directory'}},$i);
12333: $env{'form.archive_'.$i} = 'display';
12334: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12335: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 12336: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12337: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12338: $env{'form.archive_'.$i} = 'display';
12339: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12340: $displayed{'web'} = $i;
12341: } else {
1.1075.2.59 raeburn 12342: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12343: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12344: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12345: push(@{$env{'form.archive_directory'}},$i);
12346: }
12347: $env{'form.archive_'.$i} = 'dependency';
12348: }
12349: $total ++;
12350: }
12351: for (my $i=1; $i<$total; $i++) {
12352: next if ($i == $displayed{'web'});
12353: next if ($i == $displayed{'folder'});
12354: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12355: }
12356: $env{'form.phase'} = 'decompress_cleanup';
12357: $env{'form.archivedelete'} = 1;
12358: $env{'form.archive_count'} = $total-1;
12359: $output .=
12360: &process_extracted_files('coursedocs',$docudom,
12361: $docuname,$destination,
12362: $dir_root,$hiddenelem);
12363: }
1.1055 raeburn 12364: } else {
12365: $warning = &mt('No new items extracted from archive file.');
12366: }
12367: } else {
12368: $output = $display;
12369: $error = &mt('An error occurred during extraction from the archive file.');
12370: }
12371: }
12372: }
12373: }
12374: if ($error) {
12375: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12376: $error.'</p>'."\n";
12377: }
12378: if ($warning) {
12379: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12380: }
12381: return $output;
12382: }
12383:
12384: sub get_extracted {
1.1056 raeburn 12385: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12386: $titles,$wantform) = @_;
1.1055 raeburn 12387: my $count = 0;
12388: my $depth = 0;
12389: my $datatable;
1.1056 raeburn 12390: my @hierarchy;
1.1055 raeburn 12391: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12392: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12393: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12394: foreach my $item (@{$contents}) {
12395: $count ++;
1.1056 raeburn 12396: @{$dirorder->{$count}} = @hierarchy;
12397: $titles->{$count} = $item;
1.1055 raeburn 12398: &archive_hierarchy($depth,$count,$parent,$children);
12399: if ($wantform) {
12400: $datatable .= &archive_row($is_dir->{$item},$item,
12401: $currdir,$depth,$count);
12402: }
12403: if ($is_dir->{$item}) {
12404: $depth ++;
1.1056 raeburn 12405: push(@hierarchy,$count);
12406: $parent->{$depth} = $count;
1.1055 raeburn 12407: $datatable .=
12408: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12409: \$depth,\$count,\@hierarchy,$dirorder,
12410: $children,$parent,$titles,$wantform);
1.1055 raeburn 12411: $depth --;
1.1056 raeburn 12412: pop(@hierarchy);
1.1055 raeburn 12413: }
12414: }
12415: return ($count,$datatable);
12416: }
12417:
12418: sub recurse_extracted_archive {
1.1056 raeburn 12419: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12420: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12421: my $result='';
1.1056 raeburn 12422: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12423: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12424: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12425: return $result;
12426: }
12427: my $dirptr = 16384;
12428: my ($newdirlistref,$newlisterror) =
12429: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12430: if (ref($newdirlistref) eq 'ARRAY') {
12431: foreach my $dir_line (@{$newdirlistref}) {
12432: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12433: unless ($item =~ /^\.+$/) {
12434: $$count ++;
1.1056 raeburn 12435: @{$dirorder->{$$count}} = @{$hierarchy};
12436: $titles->{$$count} = $item;
1.1055 raeburn 12437: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12438:
1.1055 raeburn 12439: my $is_dir;
12440: if ($dirptr&$testdir) {
12441: $is_dir = 1;
12442: }
12443: if ($wantform) {
12444: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12445: }
12446: if ($is_dir) {
12447: $$depth ++;
1.1056 raeburn 12448: push(@{$hierarchy},$$count);
12449: $parent->{$$depth} = $$count;
1.1055 raeburn 12450: $result .=
12451: &recurse_extracted_archive("$currdir/$item",$docudom,
12452: $docuname,$depth,$count,
1.1056 raeburn 12453: $hierarchy,$dirorder,$children,
12454: $parent,$titles,$wantform);
1.1055 raeburn 12455: $$depth --;
1.1056 raeburn 12456: pop(@{$hierarchy});
1.1055 raeburn 12457: }
12458: }
12459: }
12460: }
12461: return $result;
12462: }
12463:
12464: sub archive_hierarchy {
12465: my ($depth,$count,$parent,$children) =@_;
12466: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12467: if (exists($parent->{$depth})) {
12468: $children->{$parent->{$depth}} .= $count.':';
12469: }
12470: }
12471: return;
12472: }
12473:
12474: sub archive_row {
12475: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12476: my ($name) = ($item =~ m{([^/]+)$});
12477: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12478: 'display' => 'Add as file',
1.1055 raeburn 12479: 'dependency' => 'Include as dependency',
12480: 'discard' => 'Discard',
12481: );
12482: if ($is_dir) {
1.1059 raeburn 12483: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12484: }
1.1056 raeburn 12485: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12486: my $offset = 0;
1.1055 raeburn 12487: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12488: $offset ++;
1.1065 raeburn 12489: if ($action ne 'display') {
12490: $offset ++;
12491: }
1.1055 raeburn 12492: $output .= '<td><span class="LC_nobreak">'.
12493: '<label><input type="radio" name="archive_'.$count.
12494: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12495: my $text = $choices{$action};
12496: if ($is_dir) {
12497: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12498: if ($action eq 'display') {
1.1059 raeburn 12499: $text = &mt('Add as folder');
1.1055 raeburn 12500: }
1.1056 raeburn 12501: } else {
12502: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12503:
12504: }
12505: $output .= ' /> '.$choices{$action}.'</label></span>';
12506: if ($action eq 'dependency') {
12507: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12508: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12509: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12510: '<option value=""></option>'."\n".
12511: '</select>'."\n".
12512: '</div>';
1.1059 raeburn 12513: } elsif ($action eq 'display') {
12514: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12515: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12516: '</div>';
1.1055 raeburn 12517: }
1.1056 raeburn 12518: $output .= '</td>';
1.1055 raeburn 12519: }
12520: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12521: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12522: for (my $i=0; $i<$depth; $i++) {
12523: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12524: }
12525: if ($is_dir) {
12526: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12527: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12528: } else {
12529: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12530: }
12531: $output .= ' '.$name.'</td>'."\n".
12532: &end_data_table_row();
12533: return $output;
12534: }
12535:
12536: sub archive_options_form {
1.1065 raeburn 12537: my ($form,$display,$count,$hiddenelem) = @_;
12538: my %lt = &Apache::lonlocal::texthash(
12539: perm => 'Permanently remove archive file?',
12540: hows => 'How should each extracted item be incorporated in the course?',
12541: cont => 'Content actions for all',
12542: addf => 'Add as folder/file',
12543: incd => 'Include as dependency for a displayed file',
12544: disc => 'Discard',
12545: no => 'No',
12546: yes => 'Yes',
12547: save => 'Save',
12548: );
12549: my $output = <<"END";
12550: <form name="$form" method="post" action="">
12551: <p><span class="LC_nobreak">$lt{'perm'}
12552: <label>
12553: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12554: </label>
12555:
12556: <label>
12557: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12558: </span>
12559: </p>
12560: <input type="hidden" name="phase" value="decompress_cleanup" />
12561: <br />$lt{'hows'}
12562: <div class="LC_columnSection">
12563: <fieldset>
12564: <legend>$lt{'cont'}</legend>
12565: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12566: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12567: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12568: </fieldset>
12569: </div>
12570: END
12571: return $output.
1.1055 raeburn 12572: &start_data_table()."\n".
1.1065 raeburn 12573: $display."\n".
1.1055 raeburn 12574: &end_data_table()."\n".
12575: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12576: $hiddenelem.
1.1065 raeburn 12577: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12578: '</form>';
12579: }
12580:
12581: sub archive_javascript {
1.1056 raeburn 12582: my ($startcount,$numitems,$titles,$children) = @_;
12583: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12584: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12585: my $scripttag = <<START;
12586: <script type="text/javascript">
12587: // <![CDATA[
12588:
12589: function checkAll(form,prefix) {
12590: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12591: for (var i=0; i < form.elements.length; i++) {
12592: var id = form.elements[i].id;
12593: if ((id != '') && (id != undefined)) {
12594: if (idstr.test(id)) {
12595: if (form.elements[i].type == 'radio') {
12596: form.elements[i].checked = true;
1.1056 raeburn 12597: var nostart = i-$startcount;
1.1059 raeburn 12598: var offset = nostart%7;
12599: var count = (nostart-offset)/7;
1.1056 raeburn 12600: dependencyCheck(form,count,offset);
1.1055 raeburn 12601: }
12602: }
12603: }
12604: }
12605: }
12606:
12607: function propagateCheck(form,count) {
12608: if (count > 0) {
1.1059 raeburn 12609: var startelement = $startcount + ((count-1) * 7);
12610: for (var j=1; j<6; j++) {
12611: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12612: var item = startelement + j;
12613: if (form.elements[item].type == 'radio') {
12614: if (form.elements[item].checked) {
12615: containerCheck(form,count,j);
12616: break;
12617: }
1.1055 raeburn 12618: }
12619: }
12620: }
12621: }
12622: }
12623:
12624: numitems = $numitems
1.1056 raeburn 12625: var titles = new Array(numitems);
12626: var parents = new Array(numitems);
1.1055 raeburn 12627: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12628: parents[i] = new Array;
1.1055 raeburn 12629: }
1.1059 raeburn 12630: var maintitle = '$maintitle';
1.1055 raeburn 12631:
12632: START
12633:
1.1056 raeburn 12634: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12635: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12636: for (my $i=0; $i<@contents; $i ++) {
12637: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12638: }
12639: }
12640:
1.1056 raeburn 12641: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12642: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12643: }
12644:
1.1055 raeburn 12645: $scripttag .= <<END;
12646:
12647: function containerCheck(form,count,offset) {
12648: if (count > 0) {
1.1056 raeburn 12649: dependencyCheck(form,count,offset);
1.1059 raeburn 12650: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12651: form.elements[item].checked = true;
12652: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12653: if (parents[count].length > 0) {
12654: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12655: containerCheck(form,parents[count][j],offset);
12656: }
12657: }
12658: }
12659: }
12660: }
12661:
12662: function dependencyCheck(form,count,offset) {
12663: if (count > 0) {
1.1059 raeburn 12664: var chosen = (offset+$startcount)+7*(count-1);
12665: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12666: var currtype = form.elements[depitem].type;
12667: if (form.elements[chosen].value == 'dependency') {
12668: document.getElementById('arc_depon_'+count).style.display='block';
12669: form.elements[depitem].options.length = 0;
12670: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 12671: for (var i=1; i<=numitems; i++) {
12672: if (i == count) {
12673: continue;
12674: }
1.1059 raeburn 12675: var startelement = $startcount + (i-1) * 7;
12676: for (var j=1; j<6; j++) {
12677: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12678: var item = startelement + j;
12679: if (form.elements[item].type == 'radio') {
12680: if (form.elements[item].checked) {
12681: if (form.elements[item].value == 'display') {
12682: var n = form.elements[depitem].options.length;
12683: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12684: }
12685: }
12686: }
12687: }
12688: }
12689: }
12690: } else {
12691: document.getElementById('arc_depon_'+count).style.display='none';
12692: form.elements[depitem].options.length = 0;
12693: form.elements[depitem].options[0] = new Option('Select','',true,true);
12694: }
1.1059 raeburn 12695: titleCheck(form,count,offset);
1.1056 raeburn 12696: }
12697: }
12698:
12699: function propagateSelect(form,count,offset) {
12700: if (count > 0) {
1.1065 raeburn 12701: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12702: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12703: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12704: if (parents[count].length > 0) {
12705: for (var j=0; j<parents[count].length; j++) {
12706: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12707: }
12708: }
12709: }
12710: }
12711: }
1.1056 raeburn 12712:
12713: function containerSelect(form,count,offset,picked) {
12714: if (count > 0) {
1.1065 raeburn 12715: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12716: if (form.elements[item].type == 'radio') {
12717: if (form.elements[item].value == 'dependency') {
12718: if (form.elements[item+1].type == 'select-one') {
12719: for (var i=0; i<form.elements[item+1].options.length; i++) {
12720: if (form.elements[item+1].options[i].value == picked) {
12721: form.elements[item+1].selectedIndex = i;
12722: break;
12723: }
12724: }
12725: }
12726: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12727: if (parents[count].length > 0) {
12728: for (var j=0; j<parents[count].length; j++) {
12729: containerSelect(form,parents[count][j],offset,picked);
12730: }
12731: }
12732: }
12733: }
12734: }
12735: }
12736: }
12737:
1.1059 raeburn 12738: function titleCheck(form,count,offset) {
12739: if (count > 0) {
12740: var chosen = (offset+$startcount)+7*(count-1);
12741: var depitem = $startcount + ((count-1) * 7) + 2;
12742: var currtype = form.elements[depitem].type;
12743: if (form.elements[chosen].value == 'display') {
12744: document.getElementById('arc_title_'+count).style.display='block';
12745: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12746: document.getElementById('archive_title_'+count).value=maintitle;
12747: }
12748: } else {
12749: document.getElementById('arc_title_'+count).style.display='none';
12750: if (currtype == 'text') {
12751: document.getElementById('archive_title_'+count).value='';
12752: }
12753: }
12754: }
12755: return;
12756: }
12757:
1.1055 raeburn 12758: // ]]>
12759: </script>
12760: END
12761: return $scripttag;
12762: }
12763:
12764: sub process_extracted_files {
1.1067 raeburn 12765: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12766: my $numitems = $env{'form.archive_count'};
1.1075.2.128 raeburn 12767: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 12768: my @ids=&Apache::lonnet::current_machine_ids();
12769: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12770: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12771: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12772: if (grep(/^\Q$docuhome\E$/,@ids)) {
12773: $prefix = &LONCAPA::propath($docudom,$docuname);
12774: $pathtocheck = "$dir_root/$destination";
12775: $dir = $dir_root;
12776: $ishome = 1;
12777: } else {
12778: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12779: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128 raeburn 12780: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 12781: }
12782: my $currdir = "$dir_root/$destination";
12783: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12784: if ($env{'form.folderpath'}) {
12785: my @items = split('&',$env{'form.folderpath'});
12786: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12787: if ($env{'form.folderpath'} =~ /\:1$/) {
12788: $containers{'0'}='page';
12789: } else {
12790: $containers{'0'}='sequence';
12791: }
1.1055 raeburn 12792: }
12793: my @archdirs = &get_env_multiple('form.archive_directory');
12794: if ($numitems) {
12795: for (my $i=1; $i<=$numitems; $i++) {
12796: my $path = $env{'form.archive_content_'.$i};
12797: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12798: my $item = $1;
12799: $toplevelitems{$item} = $i;
12800: if (grep(/^\Q$i\E$/,@archdirs)) {
12801: $is_dir{$item} = 1;
12802: }
12803: }
12804: }
12805: }
1.1067 raeburn 12806: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12807: if (keys(%toplevelitems) > 0) {
12808: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12809: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12810: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12811: }
1.1066 raeburn 12812: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12813: if ($numitems) {
12814: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12815: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12816: my $path = $env{'form.archive_content_'.$i};
12817: if ($path =~ /^\Q$pathtocheck\E/) {
12818: if ($env{'form.archive_'.$i} eq 'discard') {
12819: if ($prefix ne '' && $path ne '') {
12820: if (-e $prefix.$path) {
1.1066 raeburn 12821: if ((@archdirs > 0) &&
12822: (grep(/^\Q$i\E$/,@archdirs))) {
12823: $todeletedir{$prefix.$path} = 1;
12824: } else {
12825: $todelete{$prefix.$path} = 1;
12826: }
1.1055 raeburn 12827: }
12828: }
12829: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12830: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12831: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12832: $docstitle = $env{'form.archive_title_'.$i};
12833: if ($docstitle eq '') {
12834: $docstitle = $title;
12835: }
1.1055 raeburn 12836: $outer = 0;
1.1056 raeburn 12837: if (ref($dirorder{$i}) eq 'ARRAY') {
12838: if (@{$dirorder{$i}} > 0) {
12839: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12840: if ($env{'form.archive_'.$item} eq 'display') {
12841: $outer = $item;
12842: last;
12843: }
12844: }
12845: }
12846: }
12847: my ($errtext,$fatal) =
12848: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12849: '/'.$folders{$outer}.'.'.
12850: $containers{$outer});
12851: next if ($fatal);
12852: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12853: if ($context eq 'coursedocs') {
1.1056 raeburn 12854: $mapinner{$i} = time;
1.1055 raeburn 12855: $folders{$i} = 'default_'.$mapinner{$i};
12856: $containers{$i} = 'sequence';
12857: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12858: $folders{$i}.'.'.$containers{$i};
12859: my $newidx = &LONCAPA::map::getresidx();
12860: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12861: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12862: push(@LONCAPA::map::order,$newidx);
12863: my ($outtext,$errtext) =
12864: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12865: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12866: '.'.$containers{$outer},1,1);
1.1056 raeburn 12867: $newseqid{$i} = $newidx;
1.1067 raeburn 12868: unless ($errtext) {
1.1075.2.128 raeburn 12869: $result .= '<li>'.&mt('Folder: [_1] added to course',
12870: &HTML::Entities::encode($docstitle,'<>&"'))..
12871: '</li>'."\n";
1.1067 raeburn 12872: }
1.1055 raeburn 12873: }
12874: } else {
12875: if ($context eq 'coursedocs') {
12876: my $newidx=&LONCAPA::map::getresidx();
12877: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12878: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12879: $title;
1.1075.2.128 raeburn 12880: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
12881: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12882: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067 raeburn 12883: }
1.1075.2.128 raeburn 12884: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12885: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12886: }
12887: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12888: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
12889: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
12890: unless ($ishome) {
12891: my $fetch = "$newdest{$i}/$title";
12892: $fetch =~ s/^\Q$prefix$dir\E//;
12893: $prompttofetch{$fetch} = 1;
12894: }
12895: }
12896: }
12897: $LONCAPA::map::resources[$newidx]=
12898: $docstitle.':'.$url.':false:normal:res';
12899: push(@LONCAPA::map::order, $newidx);
12900: my ($outtext,$errtext)=
12901: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12902: $docuname.'/'.$folders{$outer}.
12903: '.'.$containers{$outer},1,1);
12904: unless ($errtext) {
12905: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12906: $result .= '<li>'.&mt('File: [_1] added to course',
12907: &HTML::Entities::encode($docstitle,'<>&"')).
12908: '</li>'."\n";
12909: }
1.1067 raeburn 12910: }
1.1075.2.128 raeburn 12911: } else {
12912: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
12913: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067 raeburn 12914: }
1.1055 raeburn 12915: }
12916: }
1.1075.2.11 raeburn 12917: }
12918: } else {
1.1075.2.128 raeburn 12919: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
12920: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11 raeburn 12921: }
12922: }
12923: for (my $i=1; $i<=$numitems; $i++) {
12924: next unless ($env{'form.archive_'.$i} eq 'dependency');
12925: my $path = $env{'form.archive_content_'.$i};
12926: if ($path =~ /^\Q$pathtocheck\E/) {
12927: my ($title) = ($path =~ m{/([^/]+)$});
12928: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12929: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12930: if (ref($dirorder{$i}) eq 'ARRAY') {
12931: my ($itemidx,$fullpath,$relpath);
12932: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12933: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12934: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12935: if ($dirorder{$i}->[$j] eq $container) {
12936: $itemidx = $j;
1.1056 raeburn 12937: }
12938: }
1.1075.2.11 raeburn 12939: }
12940: if ($itemidx eq '') {
12941: $itemidx = 0;
12942: }
12943: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12944: if ($mapinner{$referrer{$i}}) {
12945: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12946: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12947: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12948: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12949: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12950: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12951: if (!-e $fullpath) {
12952: mkdir($fullpath,0755);
1.1056 raeburn 12953: }
12954: }
1.1075.2.11 raeburn 12955: } else {
12956: last;
1.1056 raeburn 12957: }
1.1075.2.11 raeburn 12958: }
12959: }
12960: } elsif ($newdest{$referrer{$i}}) {
12961: $fullpath = $newdest{$referrer{$i}};
12962: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12963: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12964: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12965: last;
12966: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12967: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12968: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12969: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12970: if (!-e $fullpath) {
12971: mkdir($fullpath,0755);
1.1056 raeburn 12972: }
12973: }
1.1075.2.11 raeburn 12974: } else {
12975: last;
1.1056 raeburn 12976: }
1.1075.2.11 raeburn 12977: }
12978: }
12979: if ($fullpath ne '') {
12980: if (-e "$prefix$path") {
1.1075.2.128 raeburn 12981: unless (rename("$prefix$path","$fullpath/$title")) {
12982: $warning .= &mt('Failed to rename dependency').'<br />';
12983: }
1.1075.2.11 raeburn 12984: }
12985: if (-e "$fullpath/$title") {
12986: my $showpath;
12987: if ($relpath ne '') {
12988: $showpath = "$relpath/$title";
12989: } else {
12990: $showpath = "/$title";
1.1056 raeburn 12991: }
1.1075.2.128 raeburn 12992: $result .= '<li>'.&mt('[_1] included as a dependency',
12993: &HTML::Entities::encode($showpath,'<>&"')).
12994: '</li>'."\n";
12995: unless ($ishome) {
12996: my $fetch = "$fullpath/$title";
12997: $fetch =~ s/^\Q$prefix$dir\E//;
12998: $prompttofetch{$fetch} = 1;
12999: }
1.1055 raeburn 13000: }
13001: }
13002: }
1.1075.2.11 raeburn 13003: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13004: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128 raeburn 13005: &HTML::Entities::encode($path,'<>&"'),
13006: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13007: '<br />';
1.1055 raeburn 13008: }
13009: } else {
1.1075.2.128 raeburn 13010: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13011: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13012: }
13013: }
13014: if (keys(%todelete)) {
13015: foreach my $key (keys(%todelete)) {
13016: unlink($key);
1.1066 raeburn 13017: }
13018: }
13019: if (keys(%todeletedir)) {
13020: foreach my $key (keys(%todeletedir)) {
13021: rmdir($key);
13022: }
13023: }
13024: foreach my $dir (sort(keys(%is_dir))) {
13025: if (($pathtocheck ne '') && ($dir ne '')) {
13026: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13027: }
13028: }
1.1067 raeburn 13029: if ($result ne '') {
13030: $output .= '<ul>'."\n".
13031: $result."\n".
13032: '</ul>';
13033: }
13034: unless ($ishome) {
13035: my $replicationfail;
13036: foreach my $item (keys(%prompttofetch)) {
13037: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13038: unless ($fetchresult eq 'ok') {
13039: $replicationfail .= '<li>'.$item.'</li>'."\n";
13040: }
13041: }
13042: if ($replicationfail) {
13043: $output .= '<p class="LC_error">'.
13044: &mt('Course home server failed to retrieve:').'<ul>'.
13045: $replicationfail.
13046: '</ul></p>';
13047: }
13048: }
1.1055 raeburn 13049: } else {
13050: $warning = &mt('No items found in archive.');
13051: }
13052: if ($error) {
13053: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13054: $error.'</p>'."\n";
13055: }
13056: if ($warning) {
13057: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13058: }
13059: return $output;
13060: }
13061:
1.1066 raeburn 13062: sub cleanup_empty_dirs {
13063: my ($path) = @_;
13064: if (($path ne '') && (-d $path)) {
13065: if (opendir(my $dirh,$path)) {
13066: my @dircontents = grep(!/^\./,readdir($dirh));
13067: my $numitems = 0;
13068: foreach my $item (@dircontents) {
13069: if (-d "$path/$item") {
1.1075.2.28 raeburn 13070: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13071: if (-e "$path/$item") {
13072: $numitems ++;
13073: }
13074: } else {
13075: $numitems ++;
13076: }
13077: }
13078: if ($numitems == 0) {
13079: rmdir($path);
13080: }
13081: closedir($dirh);
13082: }
13083: }
13084: return;
13085: }
13086:
1.41 ng 13087: =pod
1.45 matthew 13088:
1.1075.2.56 raeburn 13089: =item * &get_folder_hierarchy()
1.1068 raeburn 13090:
13091: Provides hierarchy of names of folders/sub-folders containing the current
13092: item,
13093:
13094: Inputs: 3
13095: - $navmap - navmaps object
13096:
13097: - $map - url for map (either the trigger itself, or map containing
13098: the resource, which is the trigger).
13099:
13100: - $showitem - 1 => show title for map itself; 0 => do not show.
13101:
13102: Outputs: 1 @pathitems - array of folder/subfolder names.
13103:
13104: =cut
13105:
13106: sub get_folder_hierarchy {
13107: my ($navmap,$map,$showitem) = @_;
13108: my @pathitems;
13109: if (ref($navmap)) {
13110: my $mapres = $navmap->getResourceByUrl($map);
13111: if (ref($mapres)) {
13112: my $pcslist = $mapres->map_hierarchy();
13113: if ($pcslist ne '') {
13114: my @pcs = split(/,/,$pcslist);
13115: foreach my $pc (@pcs) {
13116: if ($pc == 1) {
1.1075.2.38 raeburn 13117: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13118: } else {
13119: my $res = $navmap->getByMapPc($pc);
13120: if (ref($res)) {
13121: my $title = $res->compTitle();
13122: $title =~ s/\W+/_/g;
13123: if ($title ne '') {
13124: push(@pathitems,$title);
13125: }
13126: }
13127: }
13128: }
13129: }
1.1071 raeburn 13130: if ($showitem) {
13131: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 13132: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13133: } else {
13134: my $maptitle = $mapres->compTitle();
13135: $maptitle =~ s/\W+/_/g;
13136: if ($maptitle ne '') {
13137: push(@pathitems,$maptitle);
13138: }
1.1068 raeburn 13139: }
13140: }
13141: }
13142: }
13143: return @pathitems;
13144: }
13145:
13146: =pod
13147:
1.1015 raeburn 13148: =item * &get_turnedin_filepath()
13149:
13150: Determines path in a user's portfolio file for storage of files uploaded
13151: to a specific essayresponse or dropbox item.
13152:
13153: Inputs: 3 required + 1 optional.
13154: $symb is symb for resource, $uname and $udom are for current user (required).
13155: $caller is optional (can be "submission", if routine is called when storing
13156: an upoaded file when "Submit Answer" button was pressed).
13157:
13158: Returns array containing $path and $multiresp.
13159: $path is path in portfolio. $multiresp is 1 if this resource contains more
13160: than one file upload item. Callers of routine should append partid as a
13161: subdirectory to $path in cases where $multiresp is 1.
13162:
13163: Called by: homework/essayresponse.pm and homework/structuretags.pm
13164:
13165: =cut
13166:
13167: sub get_turnedin_filepath {
13168: my ($symb,$uname,$udom,$caller) = @_;
13169: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13170: my $turnindir;
13171: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13172: $turnindir = $userhash{'turnindir'};
13173: my ($path,$multiresp);
13174: if ($turnindir eq '') {
13175: if ($caller eq 'submission') {
13176: $turnindir = &mt('turned in');
13177: $turnindir =~ s/\W+/_/g;
13178: my %newhash = (
13179: 'turnindir' => $turnindir,
13180: );
13181: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13182: }
13183: }
13184: if ($turnindir ne '') {
13185: $path = '/'.$turnindir.'/';
13186: my ($multipart,$turnin,@pathitems);
13187: my $navmap = Apache::lonnavmaps::navmap->new();
13188: if (defined($navmap)) {
13189: my $mapres = $navmap->getResourceByUrl($map);
13190: if (ref($mapres)) {
13191: my $pcslist = $mapres->map_hierarchy();
13192: if ($pcslist ne '') {
13193: foreach my $pc (split(/,/,$pcslist)) {
13194: my $res = $navmap->getByMapPc($pc);
13195: if (ref($res)) {
13196: my $title = $res->compTitle();
13197: $title =~ s/\W+/_/g;
13198: if ($title ne '') {
1.1075.2.48 raeburn 13199: if (($pc > 1) && (length($title) > 12)) {
13200: $title = substr($title,0,12);
13201: }
1.1015 raeburn 13202: push(@pathitems,$title);
13203: }
13204: }
13205: }
13206: }
13207: my $maptitle = $mapres->compTitle();
13208: $maptitle =~ s/\W+/_/g;
13209: if ($maptitle ne '') {
1.1075.2.48 raeburn 13210: if (length($maptitle) > 12) {
13211: $maptitle = substr($maptitle,0,12);
13212: }
1.1015 raeburn 13213: push(@pathitems,$maptitle);
13214: }
13215: unless ($env{'request.state'} eq 'construct') {
13216: my $res = $navmap->getBySymb($symb);
13217: if (ref($res)) {
13218: my $partlist = $res->parts();
13219: my $totaluploads = 0;
13220: if (ref($partlist) eq 'ARRAY') {
13221: foreach my $part (@{$partlist}) {
13222: my @types = $res->responseType($part);
13223: my @ids = $res->responseIds($part);
13224: for (my $i=0; $i < scalar(@ids); $i++) {
13225: if ($types[$i] eq 'essay') {
13226: my $partid = $part.'_'.$ids[$i];
13227: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13228: $totaluploads ++;
13229: }
13230: }
13231: }
13232: }
13233: if ($totaluploads > 1) {
13234: $multiresp = 1;
13235: }
13236: }
13237: }
13238: }
13239: } else {
13240: return;
13241: }
13242: } else {
13243: return;
13244: }
13245: my $restitle=&Apache::lonnet::gettitle($symb);
13246: $restitle =~ s/\W+/_/g;
13247: if ($restitle eq '') {
13248: $restitle = ($resurl =~ m{/[^/]+$});
13249: if ($restitle eq '') {
13250: $restitle = time;
13251: }
13252: }
1.1075.2.48 raeburn 13253: if (length($restitle) > 12) {
13254: $restitle = substr($restitle,0,12);
13255: }
1.1015 raeburn 13256: push(@pathitems,$restitle);
13257: $path .= join('/',@pathitems);
13258: }
13259: return ($path,$multiresp);
13260: }
13261:
13262: =pod
13263:
1.464 albertel 13264: =back
1.41 ng 13265:
1.112 bowersj2 13266: =head1 CSV Upload/Handling functions
1.38 albertel 13267:
1.41 ng 13268: =over 4
13269:
1.648 raeburn 13270: =item * &upfile_store($r)
1.41 ng 13271:
13272: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13273: needs $env{'form.upfile'}
1.41 ng 13274: returns $datatoken to be put into hidden field
13275:
13276: =cut
1.31 albertel 13277:
13278: sub upfile_store {
13279: my $r=shift;
1.258 albertel 13280: $env{'form.upfile'}=~s/\r/\n/gs;
13281: $env{'form.upfile'}=~s/\f/\n/gs;
13282: $env{'form.upfile'}=~s/\n+/\n/gs;
13283: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13284:
1.1075.2.128 raeburn 13285: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
13286: '_enroll_'.$env{'request.course.id'}.'_'.
13287: time.'_'.$$);
13288: return if ($datatoken eq '');
13289:
1.31 albertel 13290: {
1.158 raeburn 13291: my $datafile = $r->dir_config('lonDaemons').
13292: '/tmp/'.$datatoken.'.tmp';
1.1075.2.128 raeburn 13293: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 13294: print $fh $env{'form.upfile'};
1.158 raeburn 13295: close($fh);
13296: }
1.31 albertel 13297: }
13298: return $datatoken;
13299: }
13300:
1.56 matthew 13301: =pod
13302:
1.1075.2.128 raeburn 13303: =item * &load_tmp_file($r,$datatoken)
1.41 ng 13304:
13305: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128 raeburn 13306: $datatoken is the name to assign to the temporary file.
1.258 albertel 13307: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13308:
13309: =cut
1.31 albertel 13310:
13311: sub load_tmp_file {
1.1075.2.128 raeburn 13312: my ($r,$datatoken) = @_;
13313: return if ($datatoken eq '');
1.31 albertel 13314: my @studentdata=();
13315: {
1.158 raeburn 13316: my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128 raeburn 13317: '/tmp/'.$datatoken.'.tmp';
13318: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 13319: @studentdata=<$fh>;
13320: close($fh);
13321: }
1.31 albertel 13322: }
1.258 albertel 13323: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13324: }
13325:
1.1075.2.128 raeburn 13326: sub valid_datatoken {
13327: my ($datatoken) = @_;
1.1075.2.131 raeburn 13328: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128 raeburn 13329: return $datatoken;
13330: }
13331: return;
13332: }
13333:
1.56 matthew 13334: =pod
13335:
1.648 raeburn 13336: =item * &upfile_record_sep()
1.41 ng 13337:
13338: Separate uploaded file into records
13339: returns array of records,
1.258 albertel 13340: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13341:
13342: =cut
1.31 albertel 13343:
13344: sub upfile_record_sep {
1.258 albertel 13345: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13346: } else {
1.248 albertel 13347: my @records;
1.258 albertel 13348: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13349: if ($line=~/^\s*$/) { next; }
13350: push(@records,$line);
13351: }
13352: return @records;
1.31 albertel 13353: }
13354: }
13355:
1.56 matthew 13356: =pod
13357:
1.648 raeburn 13358: =item * &record_sep($record)
1.41 ng 13359:
1.258 albertel 13360: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13361:
13362: =cut
13363:
1.263 www 13364: sub takeleft {
13365: my $index=shift;
13366: return substr('0000'.$index,-4,4);
13367: }
13368:
1.31 albertel 13369: sub record_sep {
13370: my $record=shift;
13371: my %components=();
1.258 albertel 13372: if ($env{'form.upfiletype'} eq 'xml') {
13373: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13374: my $i=0;
1.356 albertel 13375: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13376: $field=~s/^(\"|\')//;
13377: $field=~s/(\"|\')$//;
1.263 www 13378: $components{&takeleft($i)}=$field;
1.31 albertel 13379: $i++;
13380: }
1.258 albertel 13381: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13382: my $i=0;
1.356 albertel 13383: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13384: $field=~s/^(\"|\')//;
13385: $field=~s/(\"|\')$//;
1.263 www 13386: $components{&takeleft($i)}=$field;
1.31 albertel 13387: $i++;
13388: }
13389: } else {
1.561 www 13390: my $separator=',';
1.480 banghart 13391: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13392: $separator=';';
1.480 banghart 13393: }
1.31 albertel 13394: my $i=0;
1.561 www 13395: # the character we are looking for to indicate the end of a quote or a record
13396: my $looking_for=$separator;
13397: # do not add the characters to the fields
13398: my $ignore=0;
13399: # we just encountered a separator (or the beginning of the record)
13400: my $just_found_separator=1;
13401: # store the field we are working on here
13402: my $field='';
13403: # work our way through all characters in record
13404: foreach my $character ($record=~/(.)/g) {
13405: if ($character eq $looking_for) {
13406: if ($character ne $separator) {
13407: # Found the end of a quote, again looking for separator
13408: $looking_for=$separator;
13409: $ignore=1;
13410: } else {
13411: # Found a separator, store away what we got
13412: $components{&takeleft($i)}=$field;
13413: $i++;
13414: $just_found_separator=1;
13415: $ignore=0;
13416: $field='';
13417: }
13418: next;
13419: }
13420: # single or double quotation marks after a separator indicate beginning of a quote
13421: # we are now looking for the end of the quote and need to ignore separators
13422: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13423: $looking_for=$character;
13424: next;
13425: }
13426: # ignore would be true after we reached the end of a quote
13427: if ($ignore) { next; }
13428: if (($just_found_separator) && ($character=~/\s/)) { next; }
13429: $field.=$character;
13430: $just_found_separator=0;
1.31 albertel 13431: }
1.561 www 13432: # catch the very last entry, since we never encountered the separator
13433: $components{&takeleft($i)}=$field;
1.31 albertel 13434: }
13435: return %components;
13436: }
13437:
1.144 matthew 13438: ######################################################
13439: ######################################################
13440:
1.56 matthew 13441: =pod
13442:
1.648 raeburn 13443: =item * &upfile_select_html()
1.41 ng 13444:
1.144 matthew 13445: Return HTML code to select a file from the users machine and specify
13446: the file type.
1.41 ng 13447:
13448: =cut
13449:
1.144 matthew 13450: ######################################################
13451: ######################################################
1.31 albertel 13452: sub upfile_select_html {
1.144 matthew 13453: my %Types = (
13454: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13455: semisv => &mt('Semicolon separated values'),
1.144 matthew 13456: space => &mt('Space separated'),
13457: tab => &mt('Tabulator separated'),
13458: # xml => &mt('HTML/XML'),
13459: );
13460: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13461: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13462: foreach my $type (sort(keys(%Types))) {
13463: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13464: }
13465: $Str .= "</select>\n";
13466: return $Str;
1.31 albertel 13467: }
13468:
1.301 albertel 13469: sub get_samples {
13470: my ($records,$toget) = @_;
13471: my @samples=({});
13472: my $got=0;
13473: foreach my $rec (@$records) {
13474: my %temp = &record_sep($rec);
13475: if (! grep(/\S/, values(%temp))) { next; }
13476: if (%temp) {
13477: $samples[$got]=\%temp;
13478: $got++;
13479: if ($got == $toget) { last; }
13480: }
13481: }
13482: return \@samples;
13483: }
13484:
1.144 matthew 13485: ######################################################
13486: ######################################################
13487:
1.56 matthew 13488: =pod
13489:
1.648 raeburn 13490: =item * &csv_print_samples($r,$records)
1.41 ng 13491:
13492: Prints a table of sample values from each column uploaded $r is an
13493: Apache Request ref, $records is an arrayref from
13494: &Apache::loncommon::upfile_record_sep
13495:
13496: =cut
13497:
1.144 matthew 13498: ######################################################
13499: ######################################################
1.31 albertel 13500: sub csv_print_samples {
13501: my ($r,$records) = @_;
1.662 bisitz 13502: my $samples = &get_samples($records,5);
1.301 albertel 13503:
1.594 raeburn 13504: $r->print(&mt('Samples').'<br />'.&start_data_table().
13505: &start_data_table_header_row());
1.356 albertel 13506: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13507: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13508: $r->print(&end_data_table_header_row());
1.301 albertel 13509: foreach my $hash (@$samples) {
1.594 raeburn 13510: $r->print(&start_data_table_row());
1.356 albertel 13511: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13512: $r->print('<td>');
1.356 albertel 13513: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13514: $r->print('</td>');
13515: }
1.594 raeburn 13516: $r->print(&end_data_table_row());
1.31 albertel 13517: }
1.594 raeburn 13518: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13519: }
13520:
1.144 matthew 13521: ######################################################
13522: ######################################################
13523:
1.56 matthew 13524: =pod
13525:
1.648 raeburn 13526: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13527:
13528: Prints a table to create associations between values and table columns.
1.144 matthew 13529:
1.41 ng 13530: $r is an Apache Request ref,
13531: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13532: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13533:
13534: =cut
13535:
1.144 matthew 13536: ######################################################
13537: ######################################################
1.31 albertel 13538: sub csv_print_select_table {
13539: my ($r,$records,$d) = @_;
1.301 albertel 13540: my $i=0;
13541: my $samples = &get_samples($records,1);
1.144 matthew 13542: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13543: &start_data_table().&start_data_table_header_row().
1.144 matthew 13544: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13545: '<th>'.&mt('Column').'</th>'.
13546: &end_data_table_header_row()."\n");
1.356 albertel 13547: foreach my $array_ref (@$d) {
13548: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13549: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13550:
1.875 bisitz 13551: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13552: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13553: $r->print('<option value="none"></option>');
1.356 albertel 13554: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13555: $r->print('<option value="'.$sample.'"'.
13556: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13557: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13558: }
1.594 raeburn 13559: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13560: $i++;
13561: }
1.594 raeburn 13562: $r->print(&end_data_table());
1.31 albertel 13563: $i--;
13564: return $i;
13565: }
1.56 matthew 13566:
1.144 matthew 13567: ######################################################
13568: ######################################################
13569:
1.56 matthew 13570: =pod
1.31 albertel 13571:
1.648 raeburn 13572: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13573:
13574: Prints a table of sample values from the upload and can make associate samples to internal names.
13575:
13576: $r is an Apache Request ref,
13577: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13578: $d is an array of 2 element arrays (internal name, displayed name)
13579:
13580: =cut
13581:
1.144 matthew 13582: ######################################################
13583: ######################################################
1.31 albertel 13584: sub csv_samples_select_table {
13585: my ($r,$records,$d) = @_;
13586: my $i=0;
1.144 matthew 13587: #
1.662 bisitz 13588: my $max_samples = 5;
13589: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13590: $r->print(&start_data_table().
13591: &start_data_table_header_row().'<th>'.
13592: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13593: &end_data_table_header_row());
1.301 albertel 13594:
13595: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13596: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13597: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13598: foreach my $option (@$d) {
13599: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13600: $r->print('<option value="'.$value.'"'.
1.253 albertel 13601: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13602: $display.'</option>');
1.31 albertel 13603: }
13604: $r->print('</select></td><td>');
1.662 bisitz 13605: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13606: if (defined($samples->[$line]{$key})) {
13607: $r->print($samples->[$line]{$key}."<br />\n");
13608: }
13609: }
1.594 raeburn 13610: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13611: $i++;
13612: }
1.594 raeburn 13613: $r->print(&end_data_table());
1.31 albertel 13614: $i--;
13615: return($i);
1.115 matthew 13616: }
13617:
1.144 matthew 13618: ######################################################
13619: ######################################################
13620:
1.115 matthew 13621: =pod
13622:
1.648 raeburn 13623: =item * &clean_excel_name($name)
1.115 matthew 13624:
13625: Returns a replacement for $name which does not contain any illegal characters.
13626:
13627: =cut
13628:
1.144 matthew 13629: ######################################################
13630: ######################################################
1.115 matthew 13631: sub clean_excel_name {
13632: my ($name) = @_;
13633: $name =~ s/[:\*\?\/\\]//g;
13634: if (length($name) > 31) {
13635: $name = substr($name,0,31);
13636: }
13637: return $name;
1.25 albertel 13638: }
1.84 albertel 13639:
1.85 albertel 13640: =pod
13641:
1.648 raeburn 13642: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13643:
13644: Returns either 1 or undef
13645:
13646: 1 if the part is to be hidden, undef if it is to be shown
13647:
13648: Arguments are:
13649:
13650: $id the id of the part to be checked
13651: $symb, optional the symb of the resource to check
13652: $udom, optional the domain of the user to check for
13653: $uname, optional the username of the user to check for
13654:
13655: =cut
1.84 albertel 13656:
13657: sub check_if_partid_hidden {
13658: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13659: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13660: $symb,$udom,$uname);
1.141 albertel 13661: my $truth=1;
13662: #if the string starts with !, then the list is the list to show not hide
13663: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13664: my @hiddenlist=split(/,/,$hiddenparts);
13665: foreach my $checkid (@hiddenlist) {
1.141 albertel 13666: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13667: }
1.141 albertel 13668: return !$truth;
1.84 albertel 13669: }
1.127 matthew 13670:
1.138 matthew 13671:
13672: ############################################################
13673: ############################################################
13674:
13675: =pod
13676:
1.157 matthew 13677: =back
13678:
1.138 matthew 13679: =head1 cgi-bin script and graphing routines
13680:
1.157 matthew 13681: =over 4
13682:
1.648 raeburn 13683: =item * &get_cgi_id()
1.138 matthew 13684:
13685: Inputs: none
13686:
13687: Returns an id which can be used to pass environment variables
13688: to various cgi-bin scripts. These environment variables will
13689: be removed from the users environment after a given time by
13690: the routine &Apache::lonnet::transfer_profile_to_env.
13691:
13692: =cut
13693:
13694: ############################################################
13695: ############################################################
1.152 albertel 13696: my $uniq=0;
1.136 matthew 13697: sub get_cgi_id {
1.154 albertel 13698: $uniq=($uniq+1)%100000;
1.280 albertel 13699: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13700: }
13701:
1.127 matthew 13702: ############################################################
13703: ############################################################
13704:
13705: =pod
13706:
1.648 raeburn 13707: =item * &DrawBarGraph()
1.127 matthew 13708:
1.138 matthew 13709: Facilitates the plotting of data in a (stacked) bar graph.
13710: Puts plot definition data into the users environment in order for
13711: graph.png to plot it. Returns an <img> tag for the plot.
13712: The bars on the plot are labeled '1','2',...,'n'.
13713:
13714: Inputs:
13715:
13716: =over 4
13717:
13718: =item $Title: string, the title of the plot
13719:
13720: =item $xlabel: string, text describing the X-axis of the plot
13721:
13722: =item $ylabel: string, text describing the Y-axis of the plot
13723:
13724: =item $Max: scalar, the maximum Y value to use in the plot
13725: If $Max is < any data point, the graph will not be rendered.
13726:
1.140 matthew 13727: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13728: they are plotted. If undefined, default values will be used.
13729:
1.178 matthew 13730: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13731:
1.138 matthew 13732: =item @Values: An array of array references. Each array reference holds data
13733: to be plotted in a stacked bar chart.
13734:
1.239 matthew 13735: =item If the final element of @Values is a hash reference the key/value
13736: pairs will be added to the graph definition.
13737:
1.138 matthew 13738: =back
13739:
13740: Returns:
13741:
13742: An <img> tag which references graph.png and the appropriate identifying
13743: information for the plot.
13744:
1.127 matthew 13745: =cut
13746:
13747: ############################################################
13748: ############################################################
1.134 matthew 13749: sub DrawBarGraph {
1.178 matthew 13750: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13751: #
13752: if (! defined($colors)) {
13753: $colors = ['#33ff00',
13754: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13755: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13756: ];
13757: }
1.228 matthew 13758: my $extra_settings = {};
13759: if (ref($Values[-1]) eq 'HASH') {
13760: $extra_settings = pop(@Values);
13761: }
1.127 matthew 13762: #
1.136 matthew 13763: my $identifier = &get_cgi_id();
13764: my $id = 'cgi.'.$identifier;
1.129 matthew 13765: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13766: return '';
13767: }
1.225 matthew 13768: #
13769: my @Labels;
13770: if (defined($labels)) {
13771: @Labels = @$labels;
13772: } else {
13773: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119 raeburn 13774: push(@Labels,$i+1);
1.225 matthew 13775: }
13776: }
13777: #
1.129 matthew 13778: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13779: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13780: my %ValuesHash;
13781: my $NumSets=1;
13782: foreach my $array (@Values) {
13783: next if (! ref($array));
1.136 matthew 13784: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13785: join(',',@$array);
1.129 matthew 13786: }
1.127 matthew 13787: #
1.136 matthew 13788: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13789: if ($NumBars < 3) {
13790: $width = 120+$NumBars*32;
1.220 matthew 13791: $xskip = 1;
1.225 matthew 13792: $bar_width = 30;
13793: } elsif ($NumBars < 5) {
13794: $width = 120+$NumBars*20;
13795: $xskip = 1;
13796: $bar_width = 20;
1.220 matthew 13797: } elsif ($NumBars < 10) {
1.136 matthew 13798: $width = 120+$NumBars*15;
13799: $xskip = 1;
13800: $bar_width = 15;
13801: } elsif ($NumBars <= 25) {
13802: $width = 120+$NumBars*11;
13803: $xskip = 5;
13804: $bar_width = 8;
13805: } elsif ($NumBars <= 50) {
13806: $width = 120+$NumBars*8;
13807: $xskip = 5;
13808: $bar_width = 4;
13809: } else {
13810: $width = 120+$NumBars*8;
13811: $xskip = 5;
13812: $bar_width = 4;
13813: }
13814: #
1.137 matthew 13815: $Max = 1 if ($Max < 1);
13816: if ( int($Max) < $Max ) {
13817: $Max++;
13818: $Max = int($Max);
13819: }
1.127 matthew 13820: $Title = '' if (! defined($Title));
13821: $xlabel = '' if (! defined($xlabel));
13822: $ylabel = '' if (! defined($ylabel));
1.369 www 13823: $ValuesHash{$id.'.title'} = &escape($Title);
13824: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13825: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13826: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13827: $ValuesHash{$id.'.NumBars'} = $NumBars;
13828: $ValuesHash{$id.'.NumSets'} = $NumSets;
13829: $ValuesHash{$id.'.PlotType'} = 'bar';
13830: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13831: $ValuesHash{$id.'.height'} = $height;
13832: $ValuesHash{$id.'.width'} = $width;
13833: $ValuesHash{$id.'.xskip'} = $xskip;
13834: $ValuesHash{$id.'.bar_width'} = $bar_width;
13835: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13836: #
1.228 matthew 13837: # Deal with other parameters
13838: while (my ($key,$value) = each(%$extra_settings)) {
13839: $ValuesHash{$id.'.'.$key} = $value;
13840: }
13841: #
1.646 raeburn 13842: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13843: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13844: }
13845:
13846: ############################################################
13847: ############################################################
13848:
13849: =pod
13850:
1.648 raeburn 13851: =item * &DrawXYGraph()
1.137 matthew 13852:
1.138 matthew 13853: Facilitates the plotting of data in an XY graph.
13854: Puts plot definition data into the users environment in order for
13855: graph.png to plot it. Returns an <img> tag for the plot.
13856:
13857: Inputs:
13858:
13859: =over 4
13860:
13861: =item $Title: string, the title of the plot
13862:
13863: =item $xlabel: string, text describing the X-axis of the plot
13864:
13865: =item $ylabel: string, text describing the Y-axis of the plot
13866:
13867: =item $Max: scalar, the maximum Y value to use in the plot
13868: If $Max is < any data point, the graph will not be rendered.
13869:
13870: =item $colors: Array ref containing the hex color codes for the data to be
13871: plotted in. If undefined, default values will be used.
13872:
13873: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13874:
13875: =item $Ydata: Array ref containing Array refs.
1.185 www 13876: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13877:
13878: =item %Values: hash indicating or overriding any default values which are
13879: passed to graph.png.
13880: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13881:
13882: =back
13883:
13884: Returns:
13885:
13886: An <img> tag which references graph.png and the appropriate identifying
13887: information for the plot.
13888:
1.137 matthew 13889: =cut
13890:
13891: ############################################################
13892: ############################################################
13893: sub DrawXYGraph {
13894: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13895: #
13896: # Create the identifier for the graph
13897: my $identifier = &get_cgi_id();
13898: my $id = 'cgi.'.$identifier;
13899: #
13900: $Title = '' if (! defined($Title));
13901: $xlabel = '' if (! defined($xlabel));
13902: $ylabel = '' if (! defined($ylabel));
13903: my %ValuesHash =
13904: (
1.369 www 13905: $id.'.title' => &escape($Title),
13906: $id.'.xlabel' => &escape($xlabel),
13907: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13908: $id.'.y_max_value'=> $Max,
13909: $id.'.labels' => join(',',@$Xlabels),
13910: $id.'.PlotType' => 'XY',
13911: );
13912: #
13913: if (defined($colors) && ref($colors) eq 'ARRAY') {
13914: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13915: }
13916: #
13917: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13918: return '';
13919: }
13920: my $NumSets=1;
1.138 matthew 13921: foreach my $array (@{$Ydata}){
1.137 matthew 13922: next if (! ref($array));
13923: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13924: }
1.138 matthew 13925: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13926: #
13927: # Deal with other parameters
13928: while (my ($key,$value) = each(%Values)) {
13929: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13930: }
13931: #
1.646 raeburn 13932: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13933: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13934: }
13935:
13936: ############################################################
13937: ############################################################
13938:
13939: =pod
13940:
1.648 raeburn 13941: =item * &DrawXYYGraph()
1.138 matthew 13942:
13943: Facilitates the plotting of data in an XY graph with two Y axes.
13944: Puts plot definition data into the users environment in order for
13945: graph.png to plot it. Returns an <img> tag for the plot.
13946:
13947: Inputs:
13948:
13949: =over 4
13950:
13951: =item $Title: string, the title of the plot
13952:
13953: =item $xlabel: string, text describing the X-axis of the plot
13954:
13955: =item $ylabel: string, text describing the Y-axis of the plot
13956:
13957: =item $colors: Array ref containing the hex color codes for the data to be
13958: plotted in. If undefined, default values will be used.
13959:
13960: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13961:
13962: =item $Ydata1: The first data set
13963:
13964: =item $Min1: The minimum value of the left Y-axis
13965:
13966: =item $Max1: The maximum value of the left Y-axis
13967:
13968: =item $Ydata2: The second data set
13969:
13970: =item $Min2: The minimum value of the right Y-axis
13971:
13972: =item $Max2: The maximum value of the left Y-axis
13973:
13974: =item %Values: hash indicating or overriding any default values which are
13975: passed to graph.png.
13976: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13977:
13978: =back
13979:
13980: Returns:
13981:
13982: An <img> tag which references graph.png and the appropriate identifying
13983: information for the plot.
1.136 matthew 13984:
13985: =cut
13986:
13987: ############################################################
13988: ############################################################
1.137 matthew 13989: sub DrawXYYGraph {
13990: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13991: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13992: #
13993: # Create the identifier for the graph
13994: my $identifier = &get_cgi_id();
13995: my $id = 'cgi.'.$identifier;
13996: #
13997: $Title = '' if (! defined($Title));
13998: $xlabel = '' if (! defined($xlabel));
13999: $ylabel = '' if (! defined($ylabel));
14000: my %ValuesHash =
14001: (
1.369 www 14002: $id.'.title' => &escape($Title),
14003: $id.'.xlabel' => &escape($xlabel),
14004: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14005: $id.'.labels' => join(',',@$Xlabels),
14006: $id.'.PlotType' => 'XY',
14007: $id.'.NumSets' => 2,
1.137 matthew 14008: $id.'.two_axes' => 1,
14009: $id.'.y1_max_value' => $Max1,
14010: $id.'.y1_min_value' => $Min1,
14011: $id.'.y2_max_value' => $Max2,
14012: $id.'.y2_min_value' => $Min2,
1.136 matthew 14013: );
14014: #
1.137 matthew 14015: if (defined($colors) && ref($colors) eq 'ARRAY') {
14016: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14017: }
14018: #
14019: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14020: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14021: return '';
14022: }
14023: my $NumSets=1;
1.137 matthew 14024: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14025: next if (! ref($array));
14026: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14027: }
14028: #
14029: # Deal with other parameters
14030: while (my ($key,$value) = each(%Values)) {
14031: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14032: }
14033: #
1.646 raeburn 14034: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14035: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14036: }
14037:
14038: ############################################################
14039: ############################################################
14040:
14041: =pod
14042:
1.157 matthew 14043: =back
14044:
1.139 matthew 14045: =head1 Statistics helper routines?
14046:
14047: Bad place for them but what the hell.
14048:
1.157 matthew 14049: =over 4
14050:
1.648 raeburn 14051: =item * &chartlink()
1.139 matthew 14052:
14053: Returns a link to the chart for a specific student.
14054:
14055: Inputs:
14056:
14057: =over 4
14058:
14059: =item $linktext: The text of the link
14060:
14061: =item $sname: The students username
14062:
14063: =item $sdomain: The students domain
14064:
14065: =back
14066:
1.157 matthew 14067: =back
14068:
1.139 matthew 14069: =cut
14070:
14071: ############################################################
14072: ############################################################
14073: sub chartlink {
14074: my ($linktext, $sname, $sdomain) = @_;
14075: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14076: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14077: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14078: '">'.$linktext.'</a>';
1.153 matthew 14079: }
14080:
14081: #######################################################
14082: #######################################################
14083:
14084: =pod
14085:
14086: =head1 Course Environment Routines
1.157 matthew 14087:
14088: =over 4
1.153 matthew 14089:
1.648 raeburn 14090: =item * &restore_course_settings()
1.153 matthew 14091:
1.648 raeburn 14092: =item * &store_course_settings()
1.153 matthew 14093:
14094: Restores/Store indicated form parameters from the course environment.
14095: Will not overwrite existing values of the form parameters.
14096:
14097: Inputs:
14098: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14099:
14100: a hash ref describing the data to be stored. For example:
14101:
14102: %Save_Parameters = ('Status' => 'scalar',
14103: 'chartoutputmode' => 'scalar',
14104: 'chartoutputdata' => 'scalar',
14105: 'Section' => 'array',
1.373 raeburn 14106: 'Group' => 'array',
1.153 matthew 14107: 'StudentData' => 'array',
14108: 'Maps' => 'array');
14109:
14110: Returns: both routines return nothing
14111:
1.631 raeburn 14112: =back
14113:
1.153 matthew 14114: =cut
14115:
14116: #######################################################
14117: #######################################################
14118: sub store_course_settings {
1.496 albertel 14119: return &store_settings($env{'request.course.id'},@_);
14120: }
14121:
14122: sub store_settings {
1.153 matthew 14123: # save to the environment
14124: # appenv the same items, just to be safe
1.300 albertel 14125: my $udom = $env{'user.domain'};
14126: my $uname = $env{'user.name'};
1.496 albertel 14127: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14128: my %SaveHash;
14129: my %AppHash;
14130: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14131: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14132: my $envname = 'environment.'.$basename;
1.258 albertel 14133: if (exists($env{'form.'.$setting})) {
1.153 matthew 14134: # Save this value away
14135: if ($type eq 'scalar' &&
1.258 albertel 14136: (! exists($env{$envname}) ||
14137: $env{$envname} ne $env{'form.'.$setting})) {
14138: $SaveHash{$basename} = $env{'form.'.$setting};
14139: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14140: } elsif ($type eq 'array') {
14141: my $stored_form;
1.258 albertel 14142: if (ref($env{'form.'.$setting})) {
1.153 matthew 14143: $stored_form = join(',',
14144: map {
1.369 www 14145: &escape($_);
1.258 albertel 14146: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14147: } else {
14148: $stored_form =
1.369 www 14149: &escape($env{'form.'.$setting});
1.153 matthew 14150: }
14151: # Determine if the array contents are the same.
1.258 albertel 14152: if ($stored_form ne $env{$envname}) {
1.153 matthew 14153: $SaveHash{$basename} = $stored_form;
14154: $AppHash{$envname} = $stored_form;
14155: }
14156: }
14157: }
14158: }
14159: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14160: $udom,$uname);
1.153 matthew 14161: if ($put_result !~ /^(ok|delayed)/) {
14162: &Apache::lonnet::logthis('unable to save form parameters, '.
14163: 'got error:'.$put_result);
14164: }
14165: # Make sure these settings stick around in this session, too
1.646 raeburn 14166: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14167: return;
14168: }
14169:
14170: sub restore_course_settings {
1.499 albertel 14171: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14172: }
14173:
14174: sub restore_settings {
14175: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14176: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14177: next if (exists($env{'form.'.$setting}));
1.496 albertel 14178: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14179: '.'.$setting;
1.258 albertel 14180: if (exists($env{$envname})) {
1.153 matthew 14181: if ($type eq 'scalar') {
1.258 albertel 14182: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14183: } elsif ($type eq 'array') {
1.258 albertel 14184: $env{'form.'.$setting} = [
1.153 matthew 14185: map {
1.369 www 14186: &unescape($_);
1.258 albertel 14187: } split(',',$env{$envname})
1.153 matthew 14188: ];
14189: }
14190: }
14191: }
1.127 matthew 14192: }
14193:
1.618 raeburn 14194: #######################################################
14195: #######################################################
14196:
14197: =pod
14198:
14199: =head1 Domain E-mail Routines
14200:
14201: =over 4
14202:
1.648 raeburn 14203: =item * &build_recipient_list()
1.618 raeburn 14204:
1.1075.2.44 raeburn 14205: Build recipient lists for following types of e-mail:
1.766 raeburn 14206: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 14207: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14208: module change checking, student/employee ID conflict checks, as
14209: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14210: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14211:
14212: Inputs:
1.1075.2.44 raeburn 14213: defmail (scalar - email address of default recipient),
14214: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14215: requestsmail, updatesmail, or idconflictsmail).
14216:
1.619 raeburn 14217: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 14218:
14219: origmail (scalar - email address of recipient from loncapa.conf,
14220: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14221:
1.1075.2.139 raeburn 14222: $requname username of requester (if mailing type is helpdeskmail)
14223:
14224: $requdom domain of requester (if mailing type is helpdeskmail)
14225:
14226: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14227:
1.655 raeburn 14228: Returns: comma separated list of addresses to which to send e-mail.
14229:
14230: =back
1.618 raeburn 14231:
14232: =cut
14233:
14234: ############################################################
14235: ############################################################
14236: sub build_recipient_list {
1.1075.2.139 raeburn 14237: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14238: my @recipients;
1.1075.2.122 raeburn 14239: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14240: my %domconfig =
1.1075.2.122 raeburn 14241: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14242: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14243: if (exists($domconfig{'contacts'}{$mailing})) {
14244: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14245: my @contacts = ('adminemail','supportemail');
14246: foreach my $item (@contacts) {
14247: if ($domconfig{'contacts'}{$mailing}{$item}) {
14248: my $addr = $domconfig{'contacts'}{$item};
14249: if (!grep(/^\Q$addr\E$/,@recipients)) {
14250: push(@recipients,$addr);
14251: }
1.619 raeburn 14252: }
1.1075.2.122 raeburn 14253: }
14254: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14255: if ($mailing eq 'helpdeskmail') {
14256: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14257: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14258: my @ok_bccs;
14259: foreach my $bcc (@bccs) {
14260: $bcc =~ s/^\s+//g;
14261: $bcc =~ s/\s+$//g;
14262: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14263: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14264: push(@ok_bccs,$bcc);
14265: }
14266: }
14267: }
14268: if (@ok_bccs > 0) {
14269: $allbcc = join(', ',@ok_bccs);
14270: }
14271: }
14272: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14273: }
14274: }
1.766 raeburn 14275: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 14276: $lastresort = $origmail;
1.618 raeburn 14277: }
1.1075.2.139 raeburn 14278: if ($mailing eq 'helpdeskmail') {
14279: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
14280: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
14281: my ($inststatus,$inststatus_checked);
14282: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
14283: ($env{'user.domain'} ne 'public')) {
14284: $inststatus_checked = 1;
14285: $inststatus = $env{'environment.inststatus'};
14286: }
14287: unless ($inststatus_checked) {
14288: if (($requname ne '') && ($requdom ne '')) {
14289: if (($requname =~ /^$match_username$/) &&
14290: ($requdom =~ /^$match_domain$/) &&
14291: (&Apache::lonnet::domain($requdom))) {
14292: my $requhome = &Apache::lonnet::homeserver($requname,
14293: $requdom);
14294: unless ($requhome eq 'no_host') {
14295: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
14296: $inststatus = $userenv{'inststatus'};
14297: $inststatus_checked = 1;
14298: }
14299: }
14300: }
14301: }
14302: unless ($inststatus_checked) {
14303: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
14304: my %srch = (srchby => 'email',
14305: srchdomain => $defdom,
14306: srchterm => $reqemail,
14307: srchtype => 'exact');
14308: my %srch_results = &Apache::lonnet::usersearch(\%srch);
14309: foreach my $uname (keys(%srch_results)) {
14310: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14311: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14312: $inststatus_checked = 1;
14313: last;
14314: }
14315: }
14316: unless ($inststatus_checked) {
14317: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
14318: if ($dirsrchres eq 'ok') {
14319: foreach my $uname (keys(%srch_results)) {
14320: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14321: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14322: $inststatus_checked = 1;
14323: last;
14324: }
14325: }
14326: }
14327: }
14328: }
14329: }
14330: if ($inststatus ne '') {
14331: foreach my $status (split(/\:/,$inststatus)) {
14332: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
14333: my @contacts = ('adminemail','supportemail');
14334: foreach my $item (@contacts) {
14335: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
14336: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
14337: if (!grep(/^\Q$addr\E$/,@recipients)) {
14338: push(@recipients,$addr);
14339: }
14340: }
14341: }
14342: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
14343: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
14344: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
14345: my @ok_bccs;
14346: foreach my $bcc (@bccs) {
14347: $bcc =~ s/^\s+//g;
14348: $bcc =~ s/\s+$//g;
14349: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14350: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14351: push(@ok_bccs,$bcc);
14352: }
14353: }
14354: }
14355: if (@ok_bccs > 0) {
14356: $allbcc = join(', ',@ok_bccs);
14357: }
14358: }
14359: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
14360: last;
14361: }
14362: }
14363: }
14364: }
14365: }
1.619 raeburn 14366: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 14367: $lastresort = $origmail;
14368: }
1.1075.2.128 raeburn 14369: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122 raeburn 14370: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
14371: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
14372: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
14373: my %what = (
14374: perlvar => 1,
14375: );
14376: my $primary = &Apache::lonnet::domain($defdom,'primary');
14377: if ($primary) {
14378: my $gotaddr;
14379: my ($result,$returnhash) =
14380: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
14381: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
14382: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
14383: $lastresort = $returnhash->{'lonSupportEMail'};
14384: $gotaddr = 1;
14385: }
14386: }
14387: unless ($gotaddr) {
14388: my $uintdom = &Apache::lonnet::internet_dom($primary);
14389: my $intdom = &Apache::lonnet::internet_dom($lonhost);
14390: unless ($uintdom eq $intdom) {
14391: my %domconfig =
14392: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
14393: if (ref($domconfig{'contacts'}) eq 'HASH') {
14394: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
14395: my @contacts = ('adminemail','supportemail');
14396: foreach my $item (@contacts) {
14397: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
14398: my $addr = $domconfig{'contacts'}{$item};
14399: if (!grep(/^\Q$addr\E$/,@recipients)) {
14400: push(@recipients,$addr);
14401: }
14402: }
14403: }
14404: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
14405: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
14406: }
14407: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
14408: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
14409: my @ok_bccs;
14410: foreach my $bcc (@bccs) {
14411: $bcc =~ s/^\s+//g;
14412: $bcc =~ s/\s+$//g;
14413: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14414: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14415: push(@ok_bccs,$bcc);
14416: }
14417: }
14418: }
14419: if (@ok_bccs > 0) {
14420: $allbcc = join(', ',@ok_bccs);
14421: }
14422: }
14423: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
14424: }
14425: }
14426: }
14427: }
14428: }
14429: }
1.618 raeburn 14430: }
1.688 raeburn 14431: if (defined($defmail)) {
14432: if ($defmail ne '') {
14433: push(@recipients,$defmail);
14434: }
1.618 raeburn 14435: }
14436: if ($otheremails) {
1.619 raeburn 14437: my @others;
14438: if ($otheremails =~ /,/) {
14439: @others = split(/,/,$otheremails);
1.618 raeburn 14440: } else {
1.619 raeburn 14441: push(@others,$otheremails);
14442: }
14443: foreach my $addr (@others) {
14444: if (!grep(/^\Q$addr\E$/,@recipients)) {
14445: push(@recipients,$addr);
14446: }
1.618 raeburn 14447: }
14448: }
1.1075.2.128 raeburn 14449: if ($mailing eq 'helpdeskmail') {
1.1075.2.122 raeburn 14450: if ((!@recipients) && ($lastresort ne '')) {
14451: push(@recipients,$lastresort);
14452: }
14453: } elsif ($lastresort ne '') {
14454: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
14455: push(@recipients,$lastresort);
14456: }
14457: }
14458: my $recipientlist = join(',',@recipients);
14459: if (wantarray) {
14460: return ($recipientlist,$allbcc,$addtext);
14461: } else {
14462: return $recipientlist;
14463: }
1.618 raeburn 14464: }
14465:
1.127 matthew 14466: ############################################################
14467: ############################################################
1.154 albertel 14468:
1.655 raeburn 14469: =pod
14470:
14471: =head1 Course Catalog Routines
14472:
14473: =over 4
14474:
14475: =item * &gather_categories()
14476:
14477: Converts category definitions - keys of categories hash stored in
14478: coursecategories in configuration.db on the primary library server in a
14479: domain - to an array. Also generates javascript and idx hash used to
14480: generate Domain Coordinator interface for editing Course Categories.
14481:
14482: Inputs:
1.663 raeburn 14483:
1.655 raeburn 14484: categories (reference to hash of category definitions).
1.663 raeburn 14485:
1.655 raeburn 14486: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14487: categories and subcategories).
1.663 raeburn 14488:
1.655 raeburn 14489: idx (reference to hash of counters used in Domain Coordinator interface for
14490: editing Course Categories).
1.663 raeburn 14491:
1.655 raeburn 14492: jsarray (reference to array of categories used to create Javascript arrays for
14493: Domain Coordinator interface for editing Course Categories).
14494:
14495: Returns: nothing
14496:
14497: Side effects: populates cats, idx and jsarray.
14498:
14499: =cut
14500:
14501: sub gather_categories {
14502: my ($categories,$cats,$idx,$jsarray) = @_;
14503: my %counters;
14504: my $num = 0;
14505: foreach my $item (keys(%{$categories})) {
14506: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14507: if ($container eq '' && $depth == 0) {
14508: $cats->[$depth][$categories->{$item}] = $cat;
14509: } else {
14510: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14511: }
14512: my ($escitem,$tail) = split(/:/,$item,2);
14513: if ($counters{$tail} eq '') {
14514: $counters{$tail} = $num;
14515: $num ++;
14516: }
14517: if (ref($idx) eq 'HASH') {
14518: $idx->{$item} = $counters{$tail};
14519: }
14520: if (ref($jsarray) eq 'ARRAY') {
14521: push(@{$jsarray->[$counters{$tail}]},$item);
14522: }
14523: }
14524: return;
14525: }
14526:
14527: =pod
14528:
14529: =item * &extract_categories()
14530:
14531: Used to generate breadcrumb trails for course categories.
14532:
14533: Inputs:
1.663 raeburn 14534:
1.655 raeburn 14535: categories (reference to hash of category definitions).
1.663 raeburn 14536:
1.655 raeburn 14537: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14538: categories and subcategories).
1.663 raeburn 14539:
1.655 raeburn 14540: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14541:
1.655 raeburn 14542: allitems (reference to hash - key is category key
14543: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14544:
1.655 raeburn 14545: idx (reference to hash of counters used in Domain Coordinator interface for
14546: editing Course Categories).
1.663 raeburn 14547:
1.655 raeburn 14548: jsarray (reference to array of categories used to create Javascript arrays for
14549: Domain Coordinator interface for editing Course Categories).
14550:
1.665 raeburn 14551: subcats (reference to hash of arrays containing all subcategories within each
14552: category, -recursive)
14553:
1.1075.2.132 raeburn 14554: maxd (reference to hash used to hold max depth for all top-level categories).
14555:
1.655 raeburn 14556: Returns: nothing
14557:
14558: Side effects: populates trails and allitems hash references.
14559:
14560: =cut
14561:
14562: sub extract_categories {
1.1075.2.132 raeburn 14563: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 14564: if (ref($categories) eq 'HASH') {
14565: &gather_categories($categories,$cats,$idx,$jsarray);
14566: if (ref($cats->[0]) eq 'ARRAY') {
14567: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14568: my $name = $cats->[0][$i];
14569: my $item = &escape($name).'::0';
14570: my $trailstr;
14571: if ($name eq 'instcode') {
14572: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14573: } elsif ($name eq 'communities') {
14574: $trailstr = &mt('Communities');
1.655 raeburn 14575: } else {
14576: $trailstr = $name;
14577: }
14578: if ($allitems->{$item} eq '') {
14579: push(@{$trails},$trailstr);
14580: $allitems->{$item} = scalar(@{$trails})-1;
14581: }
14582: my @parents = ($name);
14583: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14584: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14585: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14586: if (ref($subcats) eq 'HASH') {
14587: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14588: }
1.1075.2.132 raeburn 14589: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 14590: }
14591: } else {
14592: if (ref($subcats) eq 'HASH') {
14593: $subcats->{$item} = [];
1.655 raeburn 14594: }
1.1075.2.132 raeburn 14595: if (ref($maxd) eq 'HASH') {
14596: $maxd->{$name} = 1;
14597: }
1.655 raeburn 14598: }
14599: }
14600: }
14601: }
14602: return;
14603: }
14604:
14605: =pod
14606:
1.1075.2.56 raeburn 14607: =item * &recurse_categories()
1.655 raeburn 14608:
14609: Recursively used to generate breadcrumb trails for course categories.
14610:
14611: Inputs:
1.663 raeburn 14612:
1.655 raeburn 14613: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14614: categories and subcategories).
1.663 raeburn 14615:
1.655 raeburn 14616: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14617:
14618: category (current course category, for which breadcrumb trail is being generated).
14619:
14620: trails (reference to array of breadcrumb trails for each category).
14621:
1.655 raeburn 14622: allitems (reference to hash - key is category key
14623: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14624:
1.655 raeburn 14625: parents (array containing containers directories for current category,
14626: back to top level).
14627:
14628: Returns: nothing
14629:
14630: Side effects: populates trails and allitems hash references
14631:
14632: =cut
14633:
14634: sub recurse_categories {
1.1075.2.132 raeburn 14635: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 14636: my $shallower = $depth - 1;
14637: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14638: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14639: my $name = $cats->[$depth]{$category}[$k];
14640: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14641: my $trailstr = join(' -> ',(@{$parents},$category));
14642: if ($allitems->{$item} eq '') {
14643: push(@{$trails},$trailstr);
14644: $allitems->{$item} = scalar(@{$trails})-1;
14645: }
14646: my $deeper = $depth+1;
14647: push(@{$parents},$category);
1.665 raeburn 14648: if (ref($subcats) eq 'HASH') {
14649: my $subcat = &escape($name).':'.$category.':'.$depth;
14650: for (my $j=@{$parents}; $j>=0; $j--) {
14651: my $higher;
14652: if ($j > 0) {
14653: $higher = &escape($parents->[$j]).':'.
14654: &escape($parents->[$j-1]).':'.$j;
14655: } else {
14656: $higher = &escape($parents->[$j]).'::'.$j;
14657: }
14658: push(@{$subcats->{$higher}},$subcat);
14659: }
14660: }
14661: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132 raeburn 14662: $subcats,$maxd);
1.655 raeburn 14663: pop(@{$parents});
14664: }
14665: } else {
14666: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132 raeburn 14667: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 14668: if ($allitems->{$item} eq '') {
14669: push(@{$trails},$trailstr);
14670: $allitems->{$item} = scalar(@{$trails})-1;
14671: }
1.1075.2.132 raeburn 14672: if (ref($maxd) eq 'HASH') {
14673: if ($depth > $maxd->{$parents->[0]}) {
14674: $maxd->{$parents->[0]} = $depth;
14675: }
14676: }
1.655 raeburn 14677: }
14678: return;
14679: }
14680:
1.663 raeburn 14681: =pod
14682:
1.1075.2.56 raeburn 14683: =item * &assign_categories_table()
1.663 raeburn 14684:
14685: Create a datatable for display of hierarchical categories in a domain,
14686: with checkboxes to allow a course to be categorized.
14687:
14688: Inputs:
14689:
14690: cathash - reference to hash of categories defined for the domain (from
14691: configuration.db)
14692:
14693: currcat - scalar with an & separated list of categories assigned to a course.
14694:
1.919 raeburn 14695: type - scalar contains course type (Course or Community).
14696:
1.1075.2.117 raeburn 14697: disabled - scalar (optional) contains disabled="disabled" if input elements are
14698: to be readonly (e.g., Domain Helpdesk role viewing course settings).
14699:
1.663 raeburn 14700: Returns: $output (markup to be displayed)
14701:
14702: =cut
14703:
14704: sub assign_categories_table {
1.1075.2.117 raeburn 14705: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 14706: my $output;
14707: if (ref($cathash) eq 'HASH') {
1.1075.2.132 raeburn 14708: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
14709: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 14710: $maxdepth = scalar(@cats);
14711: if (@cats > 0) {
14712: my $itemcount = 0;
14713: if (ref($cats[0]) eq 'ARRAY') {
14714: my @currcategories;
14715: if ($currcat ne '') {
14716: @currcategories = split('&',$currcat);
14717: }
1.919 raeburn 14718: my $table;
1.663 raeburn 14719: for (my $i=0; $i<@{$cats[0]}; $i++) {
14720: my $parent = $cats[0][$i];
1.919 raeburn 14721: next if ($parent eq 'instcode');
14722: if ($type eq 'Community') {
14723: next unless ($parent eq 'communities');
14724: } else {
14725: next if ($parent eq 'communities');
14726: }
1.663 raeburn 14727: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14728: my $item = &escape($parent).'::0';
14729: my $checked = '';
14730: if (@currcategories > 0) {
14731: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14732: $checked = ' checked="checked"';
1.663 raeburn 14733: }
14734: }
1.919 raeburn 14735: my $parent_title = $parent;
14736: if ($parent eq 'communities') {
14737: $parent_title = &mt('Communities');
14738: }
14739: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14740: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 14741: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 14742: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14743: my $depth = 1;
14744: push(@path,$parent);
1.1075.2.117 raeburn 14745: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 14746: pop(@path);
1.919 raeburn 14747: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14748: $itemcount ++;
14749: }
1.919 raeburn 14750: if ($itemcount) {
14751: $output = &Apache::loncommon::start_data_table().
14752: $table.
14753: &Apache::loncommon::end_data_table();
14754: }
1.663 raeburn 14755: }
14756: }
14757: }
14758: return $output;
14759: }
14760:
14761: =pod
14762:
1.1075.2.56 raeburn 14763: =item * &assign_category_rows()
1.663 raeburn 14764:
14765: Create a datatable row for display of nested categories in a domain,
14766: with checkboxes to allow a course to be categorized,called recursively.
14767:
14768: Inputs:
14769:
14770: itemcount - track row number for alternating colors
14771:
14772: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14773: categories and subcategories.
14774:
14775: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14776:
14777: parent - parent of current category item
14778:
14779: path - Array containing all categories back up through the hierarchy from the
14780: current category to the top level.
14781:
14782: currcategories - reference to array of current categories assigned to the course
14783:
1.1075.2.117 raeburn 14784: disabled - scalar (optional) contains disabled="disabled" if input elements are
14785: to be readonly (e.g., Domain Helpdesk role viewing course settings).
14786:
1.663 raeburn 14787: Returns: $output (markup to be displayed).
14788:
14789: =cut
14790:
14791: sub assign_category_rows {
1.1075.2.117 raeburn 14792: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 14793: my ($text,$name,$item,$chgstr);
14794: if (ref($cats) eq 'ARRAY') {
14795: my $maxdepth = scalar(@{$cats});
14796: if (ref($cats->[$depth]) eq 'HASH') {
14797: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14798: my $numchildren = @{$cats->[$depth]{$parent}};
14799: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 14800: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14801: for (my $j=0; $j<$numchildren; $j++) {
14802: $name = $cats->[$depth]{$parent}[$j];
14803: $item = &escape($name).':'.&escape($parent).':'.$depth;
14804: my $deeper = $depth+1;
14805: my $checked = '';
14806: if (ref($currcategories) eq 'ARRAY') {
14807: if (@{$currcategories} > 0) {
14808: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14809: $checked = ' checked="checked"';
1.663 raeburn 14810: }
14811: }
14812: }
1.664 raeburn 14813: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14814: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 14815: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 14816: '<input type="hidden" name="catname" value="'.$name.'" />'.
14817: '</td><td>';
1.663 raeburn 14818: if (ref($path) eq 'ARRAY') {
14819: push(@{$path},$name);
1.1075.2.117 raeburn 14820: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 14821: pop(@{$path});
14822: }
14823: $text .= '</td></tr>';
14824: }
14825: $text .= '</table></td>';
14826: }
14827: }
14828: }
14829: return $text;
14830: }
14831:
1.1075.2.69 raeburn 14832: =pod
14833:
14834: =back
14835:
14836: =cut
14837:
1.655 raeburn 14838: ############################################################
14839: ############################################################
14840:
14841:
1.443 albertel 14842: sub commit_customrole {
1.664 raeburn 14843: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14844: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14845: ($start?', '.&mt('starting').' '.localtime($start):'').
14846: ($end?', ending '.localtime($end):'').': <b>'.
14847: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14848: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14849: '</b><br />';
14850: return $output;
14851: }
14852:
14853: sub commit_standardrole {
1.1075.2.31 raeburn 14854: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14855: my ($output,$logmsg,$linefeed);
14856: if ($context eq 'auto') {
14857: $linefeed = "\n";
14858: } else {
14859: $linefeed = "<br />\n";
14860: }
1.443 albertel 14861: if ($three eq 'st') {
1.541 raeburn 14862: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 14863: $one,$two,$sec,$context,$credits);
1.541 raeburn 14864: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14865: ($result eq 'unknown_course') || ($result eq 'refused')) {
14866: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14867: } else {
1.541 raeburn 14868: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14869: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14870: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14871: if ($context eq 'auto') {
14872: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14873: } else {
14874: $output .= '<b>'.$result.'</b>'.$linefeed.
14875: &mt('Add to classlist').': <b>ok</b>';
14876: }
14877: $output .= $linefeed;
1.443 albertel 14878: }
14879: } else {
14880: $output = &mt('Assigning').' '.$three.' in '.$url.
14881: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14882: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14883: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14884: if ($context eq 'auto') {
14885: $output .= $result.$linefeed;
14886: } else {
14887: $output .= '<b>'.$result.'</b>'.$linefeed;
14888: }
1.443 albertel 14889: }
14890: return $output;
14891: }
14892:
14893: sub commit_studentrole {
1.1075.2.31 raeburn 14894: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14895: $credits) = @_;
1.626 raeburn 14896: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14897: if ($context eq 'auto') {
14898: $linefeed = "\n";
14899: } else {
14900: $linefeed = '<br />'."\n";
14901: }
1.443 albertel 14902: if (defined($one) && defined($two)) {
14903: my $cid=$one.'_'.$two;
14904: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14905: my $secchange = 0;
14906: my $expire_role_result;
14907: my $modify_section_result;
1.628 raeburn 14908: if ($oldsec ne '-1') {
14909: if ($oldsec ne $sec) {
1.443 albertel 14910: $secchange = 1;
1.628 raeburn 14911: my $now = time;
1.443 albertel 14912: my $uurl='/'.$cid;
14913: $uurl=~s/\_/\//g;
14914: if ($oldsec) {
14915: $uurl.='/'.$oldsec;
14916: }
1.626 raeburn 14917: $oldsecurl = $uurl;
1.628 raeburn 14918: $expire_role_result =
1.652 raeburn 14919: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14920: if ($env{'request.course.sec'} ne '') {
14921: if ($expire_role_result eq 'refused') {
14922: my @roles = ('st');
14923: my @statuses = ('previous');
14924: my @roledoms = ($one);
14925: my $withsec = 1;
14926: my %roleshash =
14927: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14928: \@statuses,\@roles,\@roledoms,$withsec);
14929: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14930: my ($oldstart,$oldend) =
14931: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14932: if ($oldend > 0 && $oldend <= $now) {
14933: $expire_role_result = 'ok';
14934: }
14935: }
14936: }
14937: }
1.443 albertel 14938: $result = $expire_role_result;
14939: }
14940: }
14941: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 14942: $modify_section_result =
14943: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14944: undef,undef,undef,$sec,
14945: $end,$start,'','',$cid,
14946: '',$context,$credits);
1.443 albertel 14947: if ($modify_section_result =~ /^ok/) {
14948: if ($secchange == 1) {
1.628 raeburn 14949: if ($sec eq '') {
14950: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14951: } else {
14952: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14953: }
1.443 albertel 14954: } elsif ($oldsec eq '-1') {
1.628 raeburn 14955: if ($sec eq '') {
14956: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14957: } else {
14958: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14959: }
1.443 albertel 14960: } else {
1.628 raeburn 14961: if ($sec eq '') {
14962: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14963: } else {
14964: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14965: }
1.443 albertel 14966: }
14967: } else {
1.628 raeburn 14968: if ($secchange) {
14969: $$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;
14970: } else {
14971: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14972: }
1.443 albertel 14973: }
14974: $result = $modify_section_result;
14975: } elsif ($secchange == 1) {
1.628 raeburn 14976: if ($oldsec eq '') {
1.1075.2.20 raeburn 14977: $$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 14978: } else {
14979: $$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;
14980: }
1.626 raeburn 14981: if ($expire_role_result eq 'refused') {
14982: my $newsecurl = '/'.$cid;
14983: $newsecurl =~ s/\_/\//g;
14984: if ($sec ne '') {
14985: $newsecurl.='/'.$sec;
14986: }
14987: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14988: if ($sec eq '') {
14989: $$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;
14990: } else {
14991: $$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;
14992: }
14993: }
14994: }
1.443 albertel 14995: }
14996: } else {
1.626 raeburn 14997: $$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 14998: $result = "error: incomplete course id\n";
14999: }
15000: return $result;
15001: }
15002:
1.1075.2.25 raeburn 15003: sub show_role_extent {
15004: my ($scope,$context,$role) = @_;
15005: $scope =~ s{^/}{};
15006: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15007: push(@courseroles,'co');
15008: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15009: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15010: $scope =~ s{/}{_};
15011: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15012: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15013: my ($audom,$auname) = split(/\//,$scope);
15014: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15015: &Apache::loncommon::plainname($auname,$audom).'</span>');
15016: } else {
15017: $scope =~ s{/$}{};
15018: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15019: &Apache::lonnet::domain($scope,'description').'</span>');
15020: }
15021: }
15022:
1.443 albertel 15023: ############################################################
15024: ############################################################
15025:
1.566 albertel 15026: sub check_clone {
1.578 raeburn 15027: my ($args,$linefeed) = @_;
1.566 albertel 15028: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15029: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15030: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15031: my $clonemsg;
15032: my $can_clone = 0;
1.944 raeburn 15033: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15034: if ($lctype ne 'community') {
15035: $lctype = 'course';
15036: }
1.566 albertel 15037: if ($clonehome eq 'no_host') {
1.944 raeburn 15038: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15039: $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'});
15040: } else {
15041: $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'});
15042: }
1.566 albertel 15043: } else {
15044: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15045: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15046: if ($clonedesc{'type'} ne 'Community') {
15047: $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'});
15048: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15049: }
15050: }
1.1075.2.119 raeburn 15051: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15052: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15053: $can_clone = 1;
15054: } else {
1.1075.2.95 raeburn 15055: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15056: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 15057: if ($clonehash{'cloners'} eq '') {
15058: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15059: if ($domdefs{'canclone'}) {
15060: unless ($domdefs{'canclone'} eq 'none') {
15061: if ($domdefs{'canclone'} eq 'domain') {
15062: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15063: $can_clone = 1;
15064: }
15065: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15066: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15067: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15068: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15069: $can_clone = 1;
15070: }
15071: }
15072: }
1.908 raeburn 15073: }
1.1075.2.95 raeburn 15074: } else {
15075: my @cloners = split(/,/,$clonehash{'cloners'});
15076: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15077: $can_clone = 1;
1.1075.2.95 raeburn 15078: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15079: $can_clone = 1;
1.1075.2.96 raeburn 15080: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15081: $can_clone = 1;
1.1075.2.95 raeburn 15082: }
15083: unless ($can_clone) {
1.1075.2.96 raeburn 15084: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15085: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 15086: my (%gotdomdefaults,%gotcodedefaults);
15087: foreach my $cloner (@cloners) {
15088: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15089: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15090: my (%codedefaults,@code_order);
15091: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15092: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15093: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15094: }
15095: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15096: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15097: }
15098: } else {
15099: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15100: \%codedefaults,
15101: \@code_order);
15102: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15103: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15104: }
15105: if (@code_order > 0) {
15106: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15107: $cloner,$clonehash{'internal.coursecode'},
15108: $args->{'crscode'})) {
15109: $can_clone = 1;
15110: last;
15111: }
15112: }
15113: }
15114: }
15115: }
1.1075.2.96 raeburn 15116: }
15117: }
15118: unless ($can_clone) {
15119: my $ccrole = 'cc';
15120: if ($args->{'crstype'} eq 'Community') {
15121: $ccrole = 'co';
15122: }
15123: my %roleshash =
15124: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15125: $args->{'ccdomain'},
15126: 'userroles',['active'],[$ccrole],
15127: [$args->{'clonedomain'}]);
15128: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15129: $can_clone = 1;
15130: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15131: $args->{'ccuname'},$args->{'ccdomain'})) {
15132: $can_clone = 1;
1.1075.2.95 raeburn 15133: }
15134: }
15135: unless ($can_clone) {
15136: if ($args->{'crstype'} eq 'Community') {
15137: $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'});
15138: } else {
15139: $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'});
1.578 raeburn 15140: }
1.566 albertel 15141: }
1.578 raeburn 15142: }
1.566 albertel 15143: }
15144: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15145: }
15146:
1.444 albertel 15147: sub construct_course {
1.1075.2.119 raeburn 15148: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
15149: $cnum,$category,$coderef) = @_;
1.444 albertel 15150: my $outcome;
1.541 raeburn 15151: my $linefeed = '<br />'."\n";
15152: if ($context eq 'auto') {
15153: $linefeed = "\n";
15154: }
1.566 albertel 15155:
15156: #
15157: # Are we cloning?
15158: #
15159: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15160: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15161: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15162: if ($context ne 'auto') {
1.578 raeburn 15163: if ($clonemsg ne '') {
15164: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15165: }
1.566 albertel 15166: }
15167: $outcome .= $clonemsg.$linefeed;
15168:
15169: if (!$can_clone) {
15170: return (0,$outcome);
15171: }
15172: }
15173:
1.444 albertel 15174: #
15175: # Open course
15176: #
15177: my $crstype = lc($args->{'crstype'});
15178: my %cenv=();
15179: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15180: $args->{'cdescr'},
15181: $args->{'curl'},
15182: $args->{'course_home'},
15183: $args->{'nonstandard'},
15184: $args->{'crscode'},
15185: $args->{'ccuname'}.':'.
15186: $args->{'ccdomain'},
1.882 raeburn 15187: $args->{'crstype'},
1.885 raeburn 15188: $cnum,$context,$category);
1.444 albertel 15189:
15190: # Note: The testing routines depend on this being output; see
15191: # Utils::Course. This needs to at least be output as a comment
15192: # if anyone ever decides to not show this, and Utils::Course::new
15193: # will need to be suitably modified.
1.541 raeburn 15194: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 15195: if ($$courseid =~ /^error:/) {
15196: return (0,$outcome);
15197: }
15198:
1.444 albertel 15199: #
15200: # Check if created correctly
15201: #
1.479 albertel 15202: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15203: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15204: if ($crsuhome eq 'no_host') {
15205: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15206: return (0,$outcome);
15207: }
1.541 raeburn 15208: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15209:
1.444 albertel 15210: #
1.566 albertel 15211: # Do the cloning
15212: #
15213: if ($can_clone && $cloneid) {
15214: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
15215: if ($context ne 'auto') {
15216: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15217: }
15218: $outcome .= $clonemsg.$linefeed;
15219: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15220: # Copy all files
1.637 www 15221: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15222: # Restore URL
1.566 albertel 15223: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15224: # Restore title
1.566 albertel 15225: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15226: # Restore creation date, creator and creation context.
15227: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15228: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15229: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15230: # Mark as cloned
1.566 albertel 15231: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15232: # Need to clone grading mode
15233: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15234: $cenv{'grading'}=$newenv{'grading'};
15235: # Do not clone these environment entries
15236: &Apache::lonnet::del('environment',
15237: ['default_enrollment_start_date',
15238: 'default_enrollment_end_date',
15239: 'question.email',
15240: 'policy.email',
15241: 'comment.email',
15242: 'pch.users.denied',
1.725 raeburn 15243: 'plc.users.denied',
15244: 'hidefromcat',
1.1075.2.36 raeburn 15245: 'checkforpriv',
1.1075.2.59 raeburn 15246: 'categories',
15247: 'internal.uniquecode'],
1.638 www 15248: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 15249: if ($args->{'textbook'}) {
15250: $cenv{'internal.textbook'} = $args->{'textbook'};
15251: }
1.444 albertel 15252: }
1.566 albertel 15253:
1.444 albertel 15254: #
15255: # Set environment (will override cloned, if existing)
15256: #
15257: my @sections = ();
15258: my @xlists = ();
15259: if ($args->{'crstype'}) {
15260: $cenv{'type'}=$args->{'crstype'};
15261: }
15262: if ($args->{'crsid'}) {
15263: $cenv{'courseid'}=$args->{'crsid'};
15264: }
15265: if ($args->{'crscode'}) {
15266: $cenv{'internal.coursecode'}=$args->{'crscode'};
15267: }
15268: if ($args->{'crsquota'} ne '') {
15269: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15270: } else {
15271: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15272: }
15273: if ($args->{'ccuname'}) {
15274: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15275: ':'.$args->{'ccdomain'};
15276: } else {
15277: $cenv{'internal.courseowner'} = $args->{'curruser'};
15278: }
1.1075.2.31 raeburn 15279: if ($args->{'defaultcredits'}) {
15280: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15281: }
1.444 albertel 15282: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15283: if ($args->{'crssections'}) {
15284: $cenv{'internal.sectionnums'} = '';
15285: if ($args->{'crssections'} =~ m/,/) {
15286: @sections = split/,/,$args->{'crssections'};
15287: } else {
15288: $sections[0] = $args->{'crssections'};
15289: }
15290: if (@sections > 0) {
15291: foreach my $item (@sections) {
15292: my ($sec,$gp) = split/:/,$item;
15293: my $class = $args->{'crscode'}.$sec;
15294: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15295: $cenv{'internal.sectionnums'} .= $item.',';
15296: unless ($addcheck eq 'ok') {
1.1075.2.119 raeburn 15297: push(@badclasses,$class);
1.444 albertel 15298: }
15299: }
15300: $cenv{'internal.sectionnums'} =~ s/,$//;
15301: }
15302: }
15303: # do not hide course coordinator from staff listing,
15304: # even if privileged
15305: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 15306: # add course coordinator's domain to domains to check for privileged users
15307: # if different to course domain
15308: if ($$crsudom ne $args->{'ccdomain'}) {
15309: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15310: }
1.444 albertel 15311: # add crosslistings
15312: if ($args->{'crsxlist'}) {
15313: $cenv{'internal.crosslistings'}='';
15314: if ($args->{'crsxlist'} =~ m/,/) {
15315: @xlists = split/,/,$args->{'crsxlist'};
15316: } else {
15317: $xlists[0] = $args->{'crsxlist'};
15318: }
15319: if (@xlists > 0) {
15320: foreach my $item (@xlists) {
15321: my ($xl,$gp) = split/:/,$item;
15322: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15323: $cenv{'internal.crosslistings'} .= $item.',';
15324: unless ($addcheck eq 'ok') {
1.1075.2.119 raeburn 15325: push(@badclasses,$xl);
1.444 albertel 15326: }
15327: }
15328: $cenv{'internal.crosslistings'} =~ s/,$//;
15329: }
15330: }
15331: if ($args->{'autoadds'}) {
15332: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15333: }
15334: if ($args->{'autodrops'}) {
15335: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15336: }
15337: # check for notification of enrollment changes
15338: my @notified = ();
15339: if ($args->{'notify_owner'}) {
15340: if ($args->{'ccuname'} ne '') {
15341: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15342: }
15343: }
15344: if ($args->{'notify_dc'}) {
15345: if ($uname ne '') {
1.630 raeburn 15346: push(@notified,$uname.':'.$udom);
1.444 albertel 15347: }
15348: }
15349: if (@notified > 0) {
15350: my $notifylist;
15351: if (@notified > 1) {
15352: $notifylist = join(',',@notified);
15353: } else {
15354: $notifylist = $notified[0];
15355: }
15356: $cenv{'internal.notifylist'} = $notifylist;
15357: }
15358: if (@badclasses > 0) {
15359: my %lt=&Apache::lonlocal::texthash(
1.1075.2.119 raeburn 15360: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
15361: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
15362: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 15363: );
1.1075.2.119 raeburn 15364: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
15365: &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 15366: if ($context eq 'auto') {
15367: $outcome .= $badclass_msg.$linefeed;
1.1075.2.119 raeburn 15368: } else {
1.566 albertel 15369: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119 raeburn 15370: }
15371: foreach my $item (@badclasses) {
1.541 raeburn 15372: if ($context eq 'auto') {
1.1075.2.119 raeburn 15373: $outcome .= " - $item\n";
1.541 raeburn 15374: } else {
1.1075.2.119 raeburn 15375: $outcome .= "<li>$item</li>\n";
1.541 raeburn 15376: }
1.1075.2.119 raeburn 15377: }
15378: if ($context eq 'auto') {
15379: $outcome .= $linefeed;
15380: } else {
15381: $outcome .= "</ul><br /><br /></div>\n";
15382: }
1.444 albertel 15383: }
15384: if ($args->{'no_end_date'}) {
15385: $args->{'endaccess'} = 0;
15386: }
15387: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15388: $cenv{'internal.autoend'}=$args->{'enrollend'};
15389: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15390: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15391: if ($args->{'showphotos'}) {
15392: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15393: }
15394: $cenv{'internal.authtype'} = $args->{'authtype'};
15395: $cenv{'internal.autharg'} = $args->{'autharg'};
15396: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15397: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15398: 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');
15399: if ($context eq 'auto') {
15400: $outcome .= $krb_msg;
15401: } else {
1.566 albertel 15402: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15403: }
15404: $outcome .= $linefeed;
1.444 albertel 15405: }
15406: }
15407: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15408: if ($args->{'setpolicy'}) {
15409: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15410: }
15411: if ($args->{'setcontent'}) {
15412: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15413: }
1.1075.2.110 raeburn 15414: if ($args->{'setcomment'}) {
15415: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15416: }
1.444 albertel 15417: }
15418: if ($args->{'reshome'}) {
15419: $cenv{'reshome'}=$args->{'reshome'}.'/';
15420: $cenv{'reshome'}=~s/\/+$/\//;
15421: }
15422: #
15423: # course has keyed access
15424: #
15425: if ($args->{'setkeys'}) {
15426: $cenv{'keyaccess'}='yes';
15427: }
15428: # if specified, key authority is not course, but user
15429: # only active if keyaccess is yes
15430: if ($args->{'keyauth'}) {
1.487 albertel 15431: my ($user,$domain) = split(':',$args->{'keyauth'});
15432: $user = &LONCAPA::clean_username($user);
15433: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15434: if ($user ne '' && $domain ne '') {
1.487 albertel 15435: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15436: }
15437: }
15438:
1.1075.2.59 raeburn 15439: #
15440: # generate and store uniquecode (available to course requester), if course should have one.
15441: #
15442: if ($args->{'uniquecode'}) {
15443: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15444: if ($code) {
15445: $cenv{'internal.uniquecode'} = $code;
15446: my %crsinfo =
15447: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15448: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15449: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15450: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15451: }
15452: if (ref($coderef)) {
15453: $$coderef = $code;
15454: }
15455: }
15456: }
15457:
1.444 albertel 15458: if ($args->{'disresdis'}) {
15459: $cenv{'pch.roles.denied'}='st';
15460: }
15461: if ($args->{'disablechat'}) {
15462: $cenv{'plc.roles.denied'}='st';
15463: }
15464:
15465: # Record we've not yet viewed the Course Initialization Helper for this
15466: # course
15467: $cenv{'course.helper.not.run'} = 1;
15468: #
15469: # Use new Randomseed
15470: #
15471: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15472: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15473: #
15474: # The encryption code and receipt prefix for this course
15475: #
15476: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15477: $cenv{'internal.encpref'}=100+int(9*rand(99));
15478: #
15479: # By default, use standard grading
15480: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15481:
1.541 raeburn 15482: $outcome .= $linefeed.&mt('Setting environment').': '.
15483: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15484: #
15485: # Open all assignments
15486: #
15487: if ($args->{'openall'}) {
15488: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15489: my %storecontent = ($storeunder => time,
15490: $storeunder.'.type' => 'date_start');
15491:
15492: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15493: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15494: }
15495: #
15496: # Set first page
15497: #
15498: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15499: || ($cloneid)) {
1.445 albertel 15500: use LONCAPA::map;
1.444 albertel 15501: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15502:
15503: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15504: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15505:
1.444 albertel 15506: $outcome .= ($fatal?$errtext:'read ok').' - ';
15507: my $title; my $url;
15508: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15509: $title=&mt('Syllabus');
1.444 albertel 15510: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15511: } else {
1.963 raeburn 15512: $title=&mt('Table of Contents');
1.444 albertel 15513: $url='/adm/navmaps';
15514: }
1.445 albertel 15515:
15516: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15517: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15518:
15519: if ($errtext) { $fatal=2; }
1.541 raeburn 15520: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15521: }
1.566 albertel 15522:
15523: return (1,$outcome);
1.444 albertel 15524: }
15525:
1.1075.2.59 raeburn 15526: sub make_unique_code {
15527: my ($cdom,$cnum) = @_;
15528: # get lock on uniquecodes db
15529: my $lockhash = {
15530: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15531: ':'.$env{'user.domain'},
15532: };
15533: my $tries = 0;
15534: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15535: my ($code,$error);
15536:
15537: while (($gotlock ne 'ok') && ($tries<3)) {
15538: $tries ++;
15539: sleep 1;
15540: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15541: }
15542: if ($gotlock eq 'ok') {
15543: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15544: my $gotcode;
15545: my $attempts = 0;
15546: while ((!$gotcode) && ($attempts < 100)) {
15547: $code = &generate_code();
15548: if (!exists($currcodes{$code})) {
15549: $gotcode = 1;
15550: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15551: $error = 'nostore';
15552: }
15553: }
15554: $attempts ++;
15555: }
15556: my @del_lock = ($cnum."\0".'uniquecodes');
15557: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15558: } else {
15559: $error = 'nolock';
15560: }
15561: return ($code,$error);
15562: }
15563:
15564: sub generate_code {
15565: my $code;
15566: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15567: for (my $i=0; $i<6; $i++) {
15568: my $lettnum = int (rand 2);
15569: my $item = '';
15570: if ($lettnum) {
15571: $item = $letts[int( rand(18) )];
15572: } else {
15573: $item = 1+int( rand(8) );
15574: }
15575: $code .= $item;
15576: }
15577: return $code;
15578: }
15579:
1.444 albertel 15580: ############################################################
15581: ############################################################
15582:
1.953 droeschl 15583: #SD
15584: # only Community and Course, or anything else?
1.378 raeburn 15585: sub course_type {
15586: my ($cid) = @_;
15587: if (!defined($cid)) {
15588: $cid = $env{'request.course.id'};
15589: }
1.404 albertel 15590: if (defined($env{'course.'.$cid.'.type'})) {
15591: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15592: } else {
15593: return 'Course';
1.377 raeburn 15594: }
15595: }
1.156 albertel 15596:
1.406 raeburn 15597: sub group_term {
15598: my $crstype = &course_type();
15599: my %names = (
15600: 'Course' => 'group',
1.865 raeburn 15601: 'Community' => 'group',
1.406 raeburn 15602: );
15603: return $names{$crstype};
15604: }
15605:
1.902 raeburn 15606: sub course_types {
1.1075.2.59 raeburn 15607: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 15608: my %typename = (
15609: official => 'Official course',
15610: unofficial => 'Unofficial course',
15611: community => 'Community',
1.1075.2.59 raeburn 15612: textbook => 'Textbook course',
1.902 raeburn 15613: );
15614: return (\@types,\%typename);
15615: }
15616:
1.156 albertel 15617: sub icon {
15618: my ($file)=@_;
1.505 albertel 15619: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15620: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15621: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15622: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15623: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15624: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15625: $curfext.".gif") {
15626: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15627: $curfext.".gif";
15628: }
15629: }
1.249 albertel 15630: return &lonhttpdurl($iconname);
1.154 albertel 15631: }
1.84 albertel 15632:
1.575 albertel 15633: sub lonhttpdurl {
1.692 www 15634: #
15635: # Had been used for "small fry" static images on separate port 8080.
15636: # Modify here if lightweight http functionality desired again.
15637: # Currently eliminated due to increasing firewall issues.
15638: #
1.575 albertel 15639: my ($url)=@_;
1.692 www 15640: return $url;
1.215 albertel 15641: }
15642:
1.213 albertel 15643: sub connection_aborted {
15644: my ($r)=@_;
15645: $r->print(" ");$r->rflush();
15646: my $c = $r->connection;
15647: return $c->aborted();
15648: }
15649:
1.221 foxr 15650: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 15651: # strings as 'strings'.
15652: sub escape_single {
1.221 foxr 15653: my ($input) = @_;
1.223 albertel 15654: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 15655: $input =~ s/\'/\\\'/g; # Esacpe the 's....
15656: return $input;
15657: }
1.223 albertel 15658:
1.222 foxr 15659: # Same as escape_single, but escape's "'s This
15660: # can be used for "strings"
15661: sub escape_double {
15662: my ($input) = @_;
15663: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
15664: $input =~ s/\"/\\\"/g; # Esacpe the "s....
15665: return $input;
15666: }
1.223 albertel 15667:
1.222 foxr 15668: # Escapes the last element of a full URL.
15669: sub escape_url {
15670: my ($url) = @_;
1.238 raeburn 15671: my @urlslices = split(/\//, $url,-1);
1.369 www 15672: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 15673: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 15674: }
1.462 albertel 15675:
1.820 raeburn 15676: sub compare_arrays {
15677: my ($arrayref1,$arrayref2) = @_;
15678: my (@difference,%count);
15679: @difference = ();
15680: %count = ();
15681: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
15682: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
15683: foreach my $element (keys(%count)) {
15684: if ($count{$element} == 1) {
15685: push(@difference,$element);
15686: }
15687: }
15688: }
15689: return @difference;
15690: }
15691:
1.817 bisitz 15692: # -------------------------------------------------------- Initialize user login
1.462 albertel 15693: sub init_user_environment {
1.463 albertel 15694: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 15695: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
15696:
15697: my $public=($username eq 'public' && $domain eq 'public');
15698:
15699: # See if old ID present, if so, remove
15700:
1.1062 raeburn 15701: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 15702: my $now=time;
15703:
15704: if ($public) {
15705: my $max_public=100;
15706: my $oldest;
15707: my $oldest_time=0;
15708: for(my $next=1;$next<=$max_public;$next++) {
15709: if (-e $lonids."/publicuser_$next.id") {
15710: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15711: if ($mtime<$oldest_time || !$oldest_time) {
15712: $oldest_time=$mtime;
15713: $oldest=$next;
15714: }
15715: } else {
15716: $cookie="publicuser_$next";
15717: last;
15718: }
15719: }
15720: if (!$cookie) { $cookie="publicuser_$oldest"; }
15721: } else {
1.463 albertel 15722: # if this isn't a robot, kill any existing non-robot sessions
15723: if (!$args->{'robot'}) {
15724: opendir(DIR,$lonids);
15725: while ($filename=readdir(DIR)) {
15726: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136 raeburn 15727: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
15728: &GDBM_READER(),0640)) {
15729: my $linkedfile;
15730: if (exists($oldenv{'user.linkedenv'})) {
15731: $linkedfile = $oldenv{'user.linkedenv'};
15732: }
15733: untie(%oldenv);
15734: if (unlink("$lonids/$filename")) {
15735: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
15736: if (-l "$lonids/$linkedfile.id") {
15737: unlink("$lonids/$linkedfile.id");
15738: }
15739: }
15740: }
15741: } else {
15742: unlink($lonids.'/'.$filename);
15743: }
1.463 albertel 15744: }
1.462 albertel 15745: }
1.463 albertel 15746: closedir(DIR);
1.1075.2.84 raeburn 15747: # If there is a undeleted lockfile for the user's paste buffer remove it.
15748: my $namespace = 'nohist_courseeditor';
15749: my $lockingkey = 'paste'."\0".'locked_num';
15750: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15751: $domain,$username);
15752: if (exists($lockhash{$lockingkey})) {
15753: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15754: unless ($delresult eq 'ok') {
15755: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15756: }
15757: }
1.462 albertel 15758: }
15759: # Give them a new cookie
1.463 albertel 15760: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15761: : $now.$$.int(rand(10000)));
1.463 albertel 15762: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15763:
15764: # Initialize roles
15765:
1.1062 raeburn 15766: ($userroles,$firstaccenv,$timerintenv) =
15767: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15768: }
15769: # ------------------------------------ Check browser type and MathML capability
15770:
1.1075.2.77 raeburn 15771: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15772: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15773:
15774: # ------------------------------------------------------------- Get environment
15775:
15776: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15777: my ($tmp) = keys(%userenv);
15778: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15779: } else {
15780: undef(%userenv);
15781: }
15782: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15783: $form->{'interface'}=$userenv{'interface'};
15784: }
15785: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15786:
15787: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15788: foreach my $option ('interface','localpath','localres') {
15789: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15790: }
15791: # --------------------------------------------------------- Write first profile
15792:
15793: {
15794: my %initial_env =
15795: ("user.name" => $username,
15796: "user.domain" => $domain,
15797: "user.home" => $authhost,
15798: "browser.type" => $clientbrowser,
15799: "browser.version" => $clientversion,
15800: "browser.mathml" => $clientmathml,
15801: "browser.unicode" => $clientunicode,
15802: "browser.os" => $clientos,
1.1075.2.42 raeburn 15803: "browser.mobile" => $clientmobile,
15804: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 15805: "browser.osversion" => $clientosversion,
1.462 albertel 15806: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15807: "request.course.fn" => '',
15808: "request.course.uri" => '',
15809: "request.course.sec" => '',
15810: "request.role" => 'cm',
15811: "request.role.adv" => $env{'user.adv'},
15812: "request.host" => $ENV{'REMOTE_ADDR'},);
15813:
15814: if ($form->{'localpath'}) {
15815: $initial_env{"browser.localpath"} = $form->{'localpath'};
15816: $initial_env{"browser.localres"} = $form->{'localres'};
15817: }
15818:
15819: if ($form->{'interface'}) {
15820: $form->{'interface'}=~s/\W//gs;
15821: $initial_env{"browser.interface"} = $form->{'interface'};
15822: $env{'browser.interface'}=$form->{'interface'};
15823: }
15824:
1.1075.2.54 raeburn 15825: if ($form->{'iptoken'}) {
15826: my $lonhost = $r->dir_config('lonHostID');
15827: $initial_env{"user.noloadbalance"} = $lonhost;
15828: $env{'user.noloadbalance'} = $lonhost;
15829: }
15830:
1.1075.2.120 raeburn 15831: if ($form->{'noloadbalance'}) {
15832: my @hosts = &Apache::lonnet::current_machine_ids();
15833: my $hosthere = $form->{'noloadbalance'};
15834: if (grep(/^\Q$hosthere\E$/,@hosts)) {
15835: $initial_env{"user.noloadbalance"} = $hosthere;
15836: $env{'user.noloadbalance'} = $hosthere;
15837: }
15838: }
15839:
1.1016 raeburn 15840: unless ($domain eq 'public') {
1.1075.2.125 raeburn 15841: my %is_adv = ( is_adv => $env{'user.adv'} );
15842: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980 raeburn 15843:
1.1075.2.125 raeburn 15844: foreach my $tool ('aboutme','blog','webdav','portfolio') {
15845: $userenv{'availabletools.'.$tool} =
15846: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15847: undef,\%userenv,\%domdef,\%is_adv);
15848: }
1.724 raeburn 15849:
1.1075.2.125 raeburn 15850: foreach my $crstype ('official','unofficial','community','textbook') {
15851: $userenv{'canrequest.'.$crstype} =
15852: &Apache::lonnet::usertools_access($username,$domain,$crstype,
15853: 'reload','requestcourses',
15854: \%userenv,\%domdef,\%is_adv);
15855: }
1.765 raeburn 15856:
1.1075.2.125 raeburn 15857: $userenv{'canrequest.author'} =
15858: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15859: 'reload','requestauthor',
15860: \%userenv,\%domdef,\%is_adv);
15861: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15862: $domain,$username);
15863: my $reqstatus = $reqauthor{'author_status'};
15864: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15865: if (ref($reqauthor{'author'}) eq 'HASH') {
15866: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15867: $reqauthor{'author'}{'timestamp'};
15868: }
1.1075.2.14 raeburn 15869: }
15870: }
15871:
1.462 albertel 15872: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15873:
1.462 albertel 15874: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15875: &GDBM_WRCREAT(),0640)) {
15876: &_add_to_env(\%disk_env,\%initial_env);
15877: &_add_to_env(\%disk_env,\%userenv,'environment.');
15878: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15879: if (ref($firstaccenv) eq 'HASH') {
15880: &_add_to_env(\%disk_env,$firstaccenv);
15881: }
15882: if (ref($timerintenv) eq 'HASH') {
15883: &_add_to_env(\%disk_env,$timerintenv);
15884: }
1.463 albertel 15885: if (ref($args->{'extra_env'})) {
15886: &_add_to_env(\%disk_env,$args->{'extra_env'});
15887: }
1.462 albertel 15888: untie(%disk_env);
15889: } else {
1.705 tempelho 15890: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15891: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15892: return 'error: '.$!;
15893: }
15894: }
15895: $env{'request.role'}='cm';
15896: $env{'request.role.adv'}=$env{'user.adv'};
15897: $env{'browser.type'}=$clientbrowser;
15898:
15899: return $cookie;
15900:
15901: }
15902:
15903: sub _add_to_env {
15904: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15905: if (ref($env_data) eq 'HASH') {
15906: while (my ($key,$value) = each(%$env_data)) {
15907: $idf->{$prefix.$key} = $value;
15908: $env{$prefix.$key} = $value;
15909: }
1.462 albertel 15910: }
15911: }
15912:
1.685 tempelho 15913: # --- Get the symbolic name of a problem and the url
15914: sub get_symb {
15915: my ($request,$silent) = @_;
1.726 raeburn 15916: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15917: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15918: if ($symb eq '') {
15919: if (!$silent) {
1.1071 raeburn 15920: if (ref($request)) {
15921: $request->print("Unable to handle ambiguous references:$url:.");
15922: }
1.685 tempelho 15923: return ();
15924: }
15925: }
15926: &Apache::lonenc::check_decrypt(\$symb);
15927: return ($symb);
15928: }
15929:
15930: # --------------------------------------------------------------Get annotation
15931:
15932: sub get_annotation {
15933: my ($symb,$enc) = @_;
15934:
15935: my $key = $symb;
15936: if (!$enc) {
15937: $key =
15938: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15939: }
15940: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15941: return $annotation{$key};
15942: }
15943:
15944: sub clean_symb {
1.731 raeburn 15945: my ($symb,$delete_enc) = @_;
1.685 tempelho 15946:
15947: &Apache::lonenc::check_decrypt(\$symb);
15948: my $enc = $env{'request.enc'};
1.731 raeburn 15949: if ($delete_enc) {
1.730 raeburn 15950: delete($env{'request.enc'});
15951: }
1.685 tempelho 15952:
15953: return ($symb,$enc);
15954: }
1.462 albertel 15955:
1.1075.2.69 raeburn 15956: ############################################################
15957: ############################################################
15958:
15959: =pod
15960:
15961: =head1 Routines for building display used to search for courses
15962:
15963:
15964: =over 4
15965:
15966: =item * &build_filters()
15967:
15968: Create markup for a table used to set filters to use when selecting
15969: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15970: and quotacheck.pl
15971:
15972:
15973: Inputs:
15974:
15975: filterlist - anonymous array of fields to include as potential filters
15976:
15977: crstype - course type
15978:
15979: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15980: to pop-open a course selector (will contain "extra element").
15981:
15982: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15983:
15984: filter - anonymous hash of criteria and their values
15985:
15986: action - form action
15987:
15988: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15989:
15990: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
15991:
15992: cloneruname - username of owner of new course who wants to clone
15993:
15994: clonerudom - domain of owner of new course who wants to clone
15995:
15996: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15997:
15998: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15999:
16000: codedom - domain
16001:
16002: formname - value of form element named "form".
16003:
16004: fixeddom - domain, if fixed.
16005:
16006: prevphase - value to assign to form element named "phase" when going back to the previous screen
16007:
16008: cnameelement - name of form element in form on opener page which will receive title of selected course
16009:
16010: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16011:
16012: cdomelement - name of form element in form on opener page which will receive domain of selected course
16013:
16014: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16015:
16016: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16017:
16018: clonewarning - warning message about missing information for intended course owner when DC creates a course
16019:
16020:
16021: Returns: $output - HTML for display of search criteria, and hidden form elements.
16022:
16023:
16024: Side Effects: None
16025:
16026: =cut
16027:
16028: # ---------------------------------------------- search for courses based on last activity etc.
16029:
16030: sub build_filters {
16031: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16032: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16033: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16034: $cnameelement,$cnumelement,$cdomelement,$setroles,
16035: $clonetext,$clonewarning) = @_;
16036: my ($list,$jscript);
16037: my $onchange = 'javascript:updateFilters(this)';
16038: my ($domainselectform,$sincefilterform,$createdfilterform,
16039: $ownerdomselectform,$persondomselectform,$instcodeform,
16040: $typeselectform,$instcodetitle);
16041: if ($formname eq '') {
16042: $formname = $caller;
16043: }
16044: foreach my $item (@{$filterlist}) {
16045: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16046: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16047: if ($item eq 'domainfilter') {
16048: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16049: } elsif ($item eq 'coursefilter') {
16050: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16051: } elsif ($item eq 'ownerfilter') {
16052: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16053: } elsif ($item eq 'ownerdomfilter') {
16054: $filter->{'ownerdomfilter'} =
16055: &LONCAPA::clean_domain($filter->{$item});
16056: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16057: 'ownerdomfilter',1);
16058: } elsif ($item eq 'personfilter') {
16059: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16060: } elsif ($item eq 'persondomfilter') {
16061: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16062: 'persondomfilter',1);
16063: } else {
16064: $filter->{$item} =~ s/\W//g;
16065: }
16066: if (!$filter->{$item}) {
16067: $filter->{$item} = '';
16068: }
16069: }
16070: if ($item eq 'domainfilter') {
16071: my $allow_blank = 1;
16072: if ($formname eq 'portform') {
16073: $allow_blank=0;
16074: } elsif ($formname eq 'studentform') {
16075: $allow_blank=0;
16076: }
16077: if ($fixeddom) {
16078: $domainselectform = '<input type="hidden" name="domainfilter"'.
16079: ' value="'.$codedom.'" />'.
16080: &Apache::lonnet::domain($codedom,'description');
16081: } else {
16082: $domainselectform = &select_dom_form($filter->{$item},
16083: 'domainfilter',
16084: $allow_blank,'',$onchange);
16085: }
16086: } else {
16087: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16088: }
16089: }
16090:
16091: # last course activity filter and selection
16092: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16093:
16094: # course created filter and selection
16095: if (exists($filter->{'createdfilter'})) {
16096: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16097: }
16098:
16099: my %lt = &Apache::lonlocal::texthash(
16100: 'cac' => "$crstype Activity",
16101: 'ccr' => "$crstype Created",
16102: 'cde' => "$crstype Title",
16103: 'cdo' => "$crstype Domain",
16104: 'ins' => 'Institutional Code',
16105: 'inc' => 'Institutional Categorization',
16106: 'cow' => "$crstype Owner/Co-owner",
16107: 'cop' => "$crstype Personnel Includes",
16108: 'cog' => 'Type',
16109: );
16110:
16111: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16112: my $typeval = 'Course';
16113: if ($crstype eq 'Community') {
16114: $typeval = 'Community';
16115: }
16116: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16117: } else {
16118: $typeselectform = '<select name="type" size="1"';
16119: if ($onchange) {
16120: $typeselectform .= ' onchange="'.$onchange.'"';
16121: }
16122: $typeselectform .= '>'."\n";
16123: foreach my $posstype ('Course','Community') {
16124: $typeselectform.='<option value="'.$posstype.'"'.
16125: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
16126: }
16127: $typeselectform.="</select>";
16128: }
16129:
16130: my ($cloneableonlyform,$cloneabletitle);
16131: if (exists($filter->{'cloneableonly'})) {
16132: my $cloneableon = '';
16133: my $cloneableoff = ' checked="checked"';
16134: if ($filter->{'cloneableonly'}) {
16135: $cloneableon = $cloneableoff;
16136: $cloneableoff = '';
16137: }
16138: $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>';
16139: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 16140: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 16141: } else {
16142: $cloneabletitle = &mt('Cloneable by you');
16143: }
16144: }
16145: my $officialjs;
16146: if ($crstype eq 'Course') {
16147: if (exists($filter->{'instcodefilter'})) {
16148: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16149: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16150: if ($codedom) {
16151: $officialjs = 1;
16152: ($instcodeform,$jscript,$$numtitlesref) =
16153: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16154: $officialjs,$codetitlesref);
16155: if ($jscript) {
16156: $jscript = '<script type="text/javascript">'."\n".
16157: '// <![CDATA['."\n".
16158: $jscript."\n".
16159: '// ]]>'."\n".
16160: '</script>'."\n";
16161: }
16162: }
16163: if ($instcodeform eq '') {
16164: $instcodeform =
16165: '<input type="text" name="instcodefilter" size="10" value="'.
16166: $list->{'instcodefilter'}.'" />';
16167: $instcodetitle = $lt{'ins'};
16168: } else {
16169: $instcodetitle = $lt{'inc'};
16170: }
16171: if ($fixeddom) {
16172: $instcodetitle .= '<br />('.$codedom.')';
16173: }
16174: }
16175: }
16176: my $output = qq|
16177: <form method="post" name="filterpicker" action="$action">
16178: <input type="hidden" name="form" value="$formname" />
16179: |;
16180: if ($formname eq 'modifycourse') {
16181: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16182: '<input type="hidden" name="prevphase" value="'.
16183: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 16184: } elsif ($formname eq 'quotacheck') {
16185: $output .= qq|
16186: <input type="hidden" name="sortby" value="" />
16187: <input type="hidden" name="sortorder" value="" />
16188: |;
16189: } else {
1.1075.2.69 raeburn 16190: my $name_input;
16191: if ($cnameelement ne '') {
16192: $name_input = '<input type="hidden" name="cnameelement" value="'.
16193: $cnameelement.'" />';
16194: }
16195: $output .= qq|
16196: <input type="hidden" name="cnumelement" value="$cnumelement" />
16197: <input type="hidden" name="cdomelement" value="$cdomelement" />
16198: $name_input
16199: $roleelement
16200: $multelement
16201: $typeelement
16202: |;
16203: if ($formname eq 'portform') {
16204: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16205: }
16206: }
16207: if ($fixeddom) {
16208: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16209: }
16210: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16211: if ($sincefilterform) {
16212: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16213: .$sincefilterform
16214: .&Apache::lonhtmlcommon::row_closure();
16215: }
16216: if ($createdfilterform) {
16217: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16218: .$createdfilterform
16219: .&Apache::lonhtmlcommon::row_closure();
16220: }
16221: if ($domainselectform) {
16222: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16223: .$domainselectform
16224: .&Apache::lonhtmlcommon::row_closure();
16225: }
16226: if ($typeselectform) {
16227: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16228: $output .= $typeselectform;
16229: } else {
16230: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16231: .$typeselectform
16232: .&Apache::lonhtmlcommon::row_closure();
16233: }
16234: }
16235: if ($instcodeform) {
16236: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16237: .$instcodeform
16238: .&Apache::lonhtmlcommon::row_closure();
16239: }
16240: if (exists($filter->{'ownerfilter'})) {
16241: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16242: '<table><tr><td>'.&mt('Username').'<br />'.
16243: '<input type="text" name="ownerfilter" size="20" value="'.
16244: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16245: $ownerdomselectform.'</td></tr></table>'.
16246: &Apache::lonhtmlcommon::row_closure();
16247: }
16248: if (exists($filter->{'personfilter'})) {
16249: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16250: '<table><tr><td>'.&mt('Username').'<br />'.
16251: '<input type="text" name="personfilter" size="20" value="'.
16252: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16253: $persondomselectform.'</td></tr></table>'.
16254: &Apache::lonhtmlcommon::row_closure();
16255: }
16256: if (exists($filter->{'coursefilter'})) {
16257: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16258: .'<input type="text" name="coursefilter" size="25" value="'
16259: .$list->{'coursefilter'}.'" />'
16260: .&Apache::lonhtmlcommon::row_closure();
16261: }
16262: if ($cloneableonlyform) {
16263: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16264: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16265: }
16266: if (exists($filter->{'descriptfilter'})) {
16267: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16268: .'<input type="text" name="descriptfilter" size="40" value="'
16269: .$list->{'descriptfilter'}.'" />'
16270: .&Apache::lonhtmlcommon::row_closure(1);
16271: }
16272: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16273: '<input type="hidden" name="updater" value="" />'."\n".
16274: '<input type="submit" name="gosearch" value="'.
16275: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16276: return $jscript.$clonewarning.$output;
16277: }
16278:
16279: =pod
16280:
16281: =item * &timebased_select_form()
16282:
16283: Create markup for a dropdown list used to select a time-based
16284: filter e.g., Course Activity, Course Created, when searching for courses
16285: or communities
16286:
16287: Inputs:
16288:
16289: item - name of form element (sincefilter or createdfilter)
16290:
16291: filter - anonymous hash of criteria and their values
16292:
16293: Returns: HTML for a select box contained a blank, then six time selections,
16294: with value set in incoming form variables currently selected.
16295:
16296: Side Effects: None
16297:
16298: =cut
16299:
16300: sub timebased_select_form {
16301: my ($item,$filter) = @_;
16302: if (ref($filter) eq 'HASH') {
16303: $filter->{$item} =~ s/[^\d-]//g;
16304: if (!$filter->{$item}) { $filter->{$item}=-1; }
16305: return &select_form(
16306: $filter->{$item},
16307: $item,
16308: { '-1' => '',
16309: '86400' => &mt('today'),
16310: '604800' => &mt('last week'),
16311: '2592000' => &mt('last month'),
16312: '7776000' => &mt('last three months'),
16313: '15552000' => &mt('last six months'),
16314: '31104000' => &mt('last year'),
16315: 'select_form_order' =>
16316: ['-1','86400','604800','2592000','7776000',
16317: '15552000','31104000']});
16318: }
16319: }
16320:
16321: =pod
16322:
16323: =item * &js_changer()
16324:
16325: Create script tag containing Javascript used to submit course search form
16326: when course type or domain is changed, and also to hide 'Searching ...' on
16327: page load completion for page showing search result.
16328:
16329: Inputs: None
16330:
16331: Returns: markup containing updateFilters() and hideSearching() javascript functions.
16332:
16333: Side Effects: None
16334:
16335: =cut
16336:
16337: sub js_changer {
16338: return <<ENDJS;
16339: <script type="text/javascript">
16340: // <![CDATA[
16341: function updateFilters(caller) {
16342: if (typeof(caller) != "undefined") {
16343: document.filterpicker.updater.value = caller.name;
16344: }
16345: document.filterpicker.submit();
16346: }
16347:
16348: function hideSearching() {
16349: if (document.getElementById('searching')) {
16350: document.getElementById('searching').style.display = 'none';
16351: }
16352: return;
16353: }
16354:
16355: // ]]>
16356: </script>
16357:
16358: ENDJS
16359: }
16360:
16361: =pod
16362:
16363: =item * &search_courses()
16364:
16365: Process selected filters form course search form and pass to lonnet::courseiddump
16366: to retrieve a hash for which keys are courseIDs which match the selected filters.
16367:
16368: Inputs:
16369:
16370: dom - domain being searched
16371:
16372: type - course type ('Course' or 'Community' or '.' if any).
16373:
16374: filter - anonymous hash of criteria and their values
16375:
16376: numtitles - for institutional codes - number of categories
16377:
16378: cloneruname - optional username of new course owner
16379:
16380: clonerudom - optional domain of new course owner
16381:
1.1075.2.95 raeburn 16382: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 16383: (used when DC is using course creation form)
16384:
16385: codetitles - reference to array of titles of components in institutional codes (official courses).
16386:
1.1075.2.95 raeburn 16387: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16388: (and so can clone automatically)
16389:
16390: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16391:
16392: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16393: courses to clone
1.1075.2.69 raeburn 16394:
16395: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16396:
16397:
16398: Side Effects: None
16399:
16400: =cut
16401:
16402:
16403: sub search_courses {
1.1075.2.95 raeburn 16404: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16405: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 16406: my (%courses,%showcourses,$cloner);
16407: if (($filter->{'ownerfilter'} ne '') ||
16408: ($filter->{'ownerdomfilter'} ne '')) {
16409: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16410: $filter->{'ownerdomfilter'};
16411: }
16412: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16413: if (!$filter->{$item}) {
16414: $filter->{$item}='.';
16415: }
16416: }
16417: my $now = time;
16418: my $timefilter =
16419: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16420: my ($createdbefore,$createdafter);
16421: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16422: $createdbefore = $now;
16423: $createdafter = $now-$filter->{'createdfilter'};
16424: }
16425: my ($instcodefilter,$regexpok);
16426: if ($numtitles) {
16427: if ($env{'form.official'} eq 'on') {
16428: $instcodefilter =
16429: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16430: $regexpok = 1;
16431: } elsif ($env{'form.official'} eq 'off') {
16432: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16433: unless ($instcodefilter eq '') {
16434: $regexpok = -1;
16435: }
16436: }
16437: } else {
16438: $instcodefilter = $filter->{'instcodefilter'};
16439: }
16440: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16441: if ($type eq '') { $type = '.'; }
16442:
16443: if (($clonerudom ne '') && ($cloneruname ne '')) {
16444: $cloner = $cloneruname.':'.$clonerudom;
16445: }
16446: %courses = &Apache::lonnet::courseiddump($dom,
16447: $filter->{'descriptfilter'},
16448: $timefilter,
16449: $instcodefilter,
16450: $filter->{'combownerfilter'},
16451: $filter->{'coursefilter'},
16452: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 16453: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 16454: $filter->{'cloneableonly'},
16455: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 16456: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 16457: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16458: my $ccrole;
16459: if ($type eq 'Community') {
16460: $ccrole = 'co';
16461: } else {
16462: $ccrole = 'cc';
16463: }
16464: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16465: $filter->{'persondomfilter'},
16466: 'userroles',undef,
16467: [$ccrole,'in','ad','ep','ta','cr'],
16468: $dom);
16469: foreach my $role (keys(%rolehash)) {
16470: my ($cnum,$cdom,$courserole) = split(':',$role);
16471: my $cid = $cdom.'_'.$cnum;
16472: if (exists($courses{$cid})) {
16473: if (ref($courses{$cid}) eq 'HASH') {
16474: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16475: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119 raeburn 16476: push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69 raeburn 16477: }
16478: } else {
16479: $courses{$cid}{roles} = [$courserole];
16480: }
16481: $showcourses{$cid} = $courses{$cid};
16482: }
16483: }
16484: }
16485: %courses = %showcourses;
16486: }
16487: return %courses;
16488: }
16489:
16490: =pod
16491:
16492: =back
16493:
1.1075.2.88 raeburn 16494: =head1 Routines for version requirements for current course.
16495:
16496: =over 4
16497:
16498: =item * &check_release_required()
16499:
16500: Compares required LON-CAPA version with version on server, and
16501: if required version is newer looks for a server with the required version.
16502:
16503: Looks first at servers in user's owen domain; if none suitable, looks at
16504: servers in course's domain are permitted to host sessions for user's domain.
16505:
16506: Inputs:
16507:
16508: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16509:
16510: $courseid - Course ID of current course
16511:
16512: $rolecode - User's current role in course (for switchserver query string).
16513:
16514: $required - LON-CAPA version needed by course (format: Major.Minor).
16515:
16516:
16517: Returns:
16518:
16519: $switchserver - query string tp append to /adm/switchserver call (if
16520: current server's LON-CAPA version is too old.
16521:
16522: $warning - Message is displayed if no suitable server could be found.
16523:
16524: =cut
16525:
16526: sub check_release_required {
16527: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16528: my ($switchserver,$warning);
16529: if ($required ne '') {
16530: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16531: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16532: if ($reqdmajor ne '' && $reqdminor ne '') {
16533: my $otherserver;
16534: if (($major eq '' && $minor eq '') ||
16535: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16536: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16537: my $switchlcrev =
16538: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16539: $userdomserver);
16540: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16541: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16542: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16543: my $cdom = $env{'course.'.$courseid.'.domain'};
16544: if ($cdom ne $env{'user.domain'}) {
16545: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16546: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16547: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16548: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16549: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16550: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16551: my $canhost =
16552: &Apache::lonnet::can_host_session($env{'user.domain'},
16553: $coursedomserver,
16554: $remoterev,
16555: $udomdefaults{'remotesessions'},
16556: $defdomdefaults{'hostedsessions'});
16557:
16558: if ($canhost) {
16559: $otherserver = $coursedomserver;
16560: } else {
16561: $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.");
16562: }
16563: } else {
16564: $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).");
16565: }
16566: } else {
16567: $otherserver = $userdomserver;
16568: }
16569: }
16570: if ($otherserver ne '') {
16571: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16572: }
16573: }
16574: }
16575: return ($switchserver,$warning);
16576: }
16577:
16578: =pod
16579:
16580: =item * &check_release_result()
16581:
16582: Inputs:
16583:
16584: $switchwarning - Warning message if no suitable server found to host session.
16585:
16586: $switchserver - query string to append to /adm/switchserver containing lonHostID
16587: and current role.
16588:
16589: Returns: HTML to display with information about requirement to switch server.
16590: Either displaying warning with link to Roles/Courses screen or
16591: display link to switchserver.
16592:
1.1075.2.69 raeburn 16593: =cut
16594:
1.1075.2.88 raeburn 16595: sub check_release_result {
16596: my ($switchwarning,$switchserver) = @_;
16597: my $output = &start_page('Selected course unavailable on this server').
16598: '<p class="LC_warning">';
16599: if ($switchwarning) {
16600: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16601: if (&show_course()) {
16602: $output .= &mt('Display courses');
16603: } else {
16604: $output .= &mt('Display roles');
16605: }
16606: $output .= '</a>';
16607: } elsif ($switchserver) {
16608: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
16609: '<br />'.
16610: '<a href="/adm/switchserver?'.$switchserver.'">'.
16611: &mt('Switch Server').
16612: '</a>';
16613: }
16614: $output .= '</p>'.&end_page();
16615: return $output;
16616: }
16617:
16618: =pod
16619:
16620: =item * &needs_coursereinit()
16621:
16622: Determine if course contents stored for user's session needs to be
16623: refreshed, because content has changed since "Big Hash" last tied.
16624:
16625: Check for change is made if time last checked is more than 10 minutes ago
16626: (by default).
16627:
16628: Inputs:
16629:
16630: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16631:
16632: $interval (optional) - Time which may elapse (in s) between last check for content
16633: change in current course. (default: 600 s).
16634:
16635: Returns: an array; first element is:
16636:
16637: =over 4
16638:
16639: 'switch' - if content updates mean user's session
16640: needs to be switched to a server running a newer LON-CAPA version
16641:
16642: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
16643: on current server hosting user's session
16644:
16645: '' - if no action required.
16646:
16647: =back
16648:
16649: If first item element is 'switch':
16650:
16651: second item is $switchwarning - Warning message if no suitable server found to host session.
16652:
16653: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
16654: and current role.
16655:
16656: otherwise: no other elements returned.
16657:
16658: =back
16659:
16660: =cut
16661:
16662: sub needs_coursereinit {
16663: my ($loncaparev,$interval) = @_;
16664: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
16665: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
16666: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
16667: my $now = time;
16668: if ($interval eq '') {
16669: $interval = 600;
16670: }
16671: if (($now-$env{'request.course.timechecked'})>$interval) {
16672: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
16673: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
16674: if ($lastchange > $env{'request.course.tied'}) {
16675: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16676: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
16677: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
16678: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
16679: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
16680: $curr_reqd_hash{'internal.releaserequired'}});
16681: my ($switchserver,$switchwarning) =
16682: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
16683: $curr_reqd_hash{'internal.releaserequired'});
16684: if ($switchwarning ne '' || $switchserver ne '') {
16685: return ('switch',$switchwarning,$switchserver);
16686: }
16687: }
16688: }
16689: return ('update');
16690: }
16691: }
16692: return ();
16693: }
1.1075.2.69 raeburn 16694:
1.1075.2.11 raeburn 16695: sub update_content_constraints {
16696: my ($cdom,$cnum,$chome,$cid) = @_;
16697: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16698: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
16699: my %checkresponsetypes;
16700: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
16701: my ($item,$name,$value) = split(/:/,$key);
16702: if ($item eq 'resourcetag') {
16703: if ($name eq 'responsetype') {
16704: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
16705: }
16706: }
16707: }
16708: my $navmap = Apache::lonnavmaps::navmap->new();
16709: if (defined($navmap)) {
16710: my %allresponses;
16711: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
16712: my %responses = $res->responseTypes();
16713: foreach my $key (keys(%responses)) {
16714: next unless(exists($checkresponsetypes{$key}));
16715: $allresponses{$key} += $responses{$key};
16716: }
16717: }
16718: foreach my $key (keys(%allresponses)) {
16719: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
16720: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
16721: ($reqdmajor,$reqdminor) = ($major,$minor);
16722: }
16723: }
16724: undef($navmap);
16725: }
16726: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
16727: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
16728: }
16729: return;
16730: }
16731:
1.1075.2.27 raeburn 16732: sub allmaps_incourse {
16733: my ($cdom,$cnum,$chome,$cid) = @_;
16734: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
16735: $cid = $env{'request.course.id'};
16736: $cdom = $env{'course.'.$cid.'.domain'};
16737: $cnum = $env{'course.'.$cid.'.num'};
16738: $chome = $env{'course.'.$cid.'.home'};
16739: }
16740: my %allmaps = ();
16741: my $lastchange =
16742: &Apache::lonnet::get_coursechange($cdom,$cnum);
16743: if ($lastchange > $env{'request.course.tied'}) {
16744: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16745: unless ($ferr) {
16746: &update_content_constraints($cdom,$cnum,$chome,$cid);
16747: }
16748: }
16749: my $navmap = Apache::lonnavmaps::navmap->new();
16750: if (defined($navmap)) {
16751: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16752: $allmaps{$res->src()} = 1;
16753: }
16754: }
16755: return \%allmaps;
16756: }
16757:
1.1075.2.11 raeburn 16758: sub parse_supplemental_title {
16759: my ($title) = @_;
16760:
16761: my ($foldertitle,$renametitle);
16762: if ($title =~ /&&&/) {
16763: $title = &HTML::Entites::decode($title);
16764: }
16765: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16766: $renametitle=$4;
16767: my ($time,$uname,$udom) = ($1,$2,$3);
16768: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16769: my $name = &plainname($uname,$udom);
16770: $name = &HTML::Entities::encode($name,'"<>&\'');
16771: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16772: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16773: $name.': <br />'.$foldertitle;
16774: }
16775: if (wantarray) {
16776: return ($title,$foldertitle,$renametitle);
16777: }
16778: return $title;
16779: }
16780:
1.1075.2.43 raeburn 16781: sub recurse_supplemental {
16782: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16783: if ($suppmap) {
16784: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16785: if ($fatal) {
16786: $errors ++;
16787: } else {
16788: if ($#LONCAPA::map::resources > 0) {
16789: foreach my $res (@LONCAPA::map::resources) {
16790: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16791: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 16792: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16793: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 16794: } else {
16795: $numfiles ++;
16796: }
16797: }
16798: }
16799: }
16800: }
16801: }
16802: return ($numfiles,$errors);
16803: }
16804:
1.1075.2.18 raeburn 16805: sub symb_to_docspath {
1.1075.2.119 raeburn 16806: my ($symb,$navmapref) = @_;
16807: return unless ($symb && ref($navmapref));
1.1075.2.18 raeburn 16808: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16809: if ($resurl=~/\.(sequence|page)$/) {
16810: $mapurl=$resurl;
16811: } elsif ($resurl eq 'adm/navmaps') {
16812: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16813: }
16814: my $mapresobj;
1.1075.2.119 raeburn 16815: unless (ref($$navmapref)) {
16816: $$navmapref = Apache::lonnavmaps::navmap->new();
16817: }
16818: if (ref($$navmapref)) {
16819: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18 raeburn 16820: }
16821: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16822: my $type=$2;
16823: my $path;
16824: if (ref($mapresobj)) {
16825: my $pcslist = $mapresobj->map_hierarchy();
16826: if ($pcslist ne '') {
16827: foreach my $pc (split(/,/,$pcslist)) {
16828: next if ($pc <= 1);
1.1075.2.119 raeburn 16829: my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18 raeburn 16830: if (ref($res)) {
16831: my $thisurl = $res->src();
16832: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16833: my $thistitle = $res->title();
16834: $path .= '&'.
16835: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 16836: &escape($thistitle).
1.1075.2.18 raeburn 16837: ':'.$res->randompick().
16838: ':'.$res->randomout().
16839: ':'.$res->encrypted().
16840: ':'.$res->randomorder().
16841: ':'.$res->is_page();
16842: }
16843: }
16844: }
16845: $path =~ s/^\&//;
16846: my $maptitle = $mapresobj->title();
16847: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 16848: $maptitle = 'Main Content';
1.1075.2.18 raeburn 16849: }
16850: $path .= (($path ne '')? '&' : '').
16851: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 16852: &escape($maptitle).
1.1075.2.18 raeburn 16853: ':'.$mapresobj->randompick().
16854: ':'.$mapresobj->randomout().
16855: ':'.$mapresobj->encrypted().
16856: ':'.$mapresobj->randomorder().
16857: ':'.$mapresobj->is_page();
16858: } else {
16859: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16860: my $ispage = (($type eq 'page')? 1 : '');
16861: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 16862: $maptitle = 'Main Content';
1.1075.2.18 raeburn 16863: }
16864: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 16865: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 16866: }
16867: unless ($mapurl eq 'default') {
16868: $path = 'default&'.
1.1075.2.46 raeburn 16869: &escape('Main Content').
1.1075.2.18 raeburn 16870: ':::::&'.$path;
16871: }
16872: return $path;
16873: }
16874:
1.1075.2.14 raeburn 16875: sub captcha_display {
1.1075.2.137 raeburn 16876: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 16877: my ($output,$error);
1.1075.2.107 raeburn 16878: my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137 raeburn 16879: &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 16880: if ($captcha eq 'original') {
16881: $output = &create_captcha();
16882: unless ($output) {
16883: $error = 'captcha';
16884: }
16885: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 16886: $output = &create_recaptcha($pubkey,$version);
1.1075.2.14 raeburn 16887: unless ($output) {
16888: $error = 'recaptcha';
16889: }
16890: }
1.1075.2.107 raeburn 16891: return ($output,$error,$captcha,$version);
1.1075.2.14 raeburn 16892: }
16893:
16894: sub captcha_response {
1.1075.2.137 raeburn 16895: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 16896: my ($captcha_chk,$captcha_error);
1.1075.2.137 raeburn 16897: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 16898: if ($captcha eq 'original') {
16899: ($captcha_chk,$captcha_error) = &check_captcha();
16900: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 16901: $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14 raeburn 16902: } else {
16903: $captcha_chk = 1;
16904: }
16905: return ($captcha_chk,$captcha_error);
16906: }
16907:
16908: sub get_captcha_config {
1.1075.2.137 raeburn 16909: my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107 raeburn 16910: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14 raeburn 16911: my $hostname = &Apache::lonnet::hostname($lonhost);
16912: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16913: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16914: if ($context eq 'usercreation') {
16915: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16916: if (ref($domconfig{$context}) eq 'HASH') {
16917: $hashtocheck = $domconfig{$context}{'cancreate'};
16918: if (ref($hashtocheck) eq 'HASH') {
16919: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16920: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16921: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16922: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16923: }
16924: if ($privkey && $pubkey) {
16925: $captcha = 'recaptcha';
1.1075.2.107 raeburn 16926: $version = $hashtocheck->{'recaptchaversion'};
16927: if ($version ne '2') {
16928: $version = 1;
16929: }
1.1075.2.14 raeburn 16930: } else {
16931: $captcha = 'original';
16932: }
16933: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16934: $captcha = 'original';
16935: }
16936: }
16937: } else {
16938: $captcha = 'captcha';
16939: }
16940: } elsif ($context eq 'login') {
16941: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16942: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16943: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16944: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
16945: if ($privkey && $pubkey) {
16946: $captcha = 'recaptcha';
1.1075.2.107 raeburn 16947: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
16948: if ($version ne '2') {
16949: $version = 1;
16950: }
1.1075.2.14 raeburn 16951: } else {
16952: $captcha = 'original';
16953: }
16954: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16955: $captcha = 'original';
16956: }
1.1075.2.137 raeburn 16957: } elsif ($context eq 'passwords') {
16958: if ($dom_in_effect) {
16959: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
16960: if ($passwdconf{'captcha'} eq 'recaptcha') {
16961: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
16962: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
16963: $privkey = $passwdconf{'recaptchakeys'}{'private'};
16964: }
16965: if ($privkey && $pubkey) {
16966: $captcha = 'recaptcha';
16967: $version = $passwdconf{'recaptchaversion'};
16968: if ($version ne '2') {
16969: $version = 1;
16970: }
16971: } else {
16972: $captcha = 'original';
16973: }
16974: } elsif ($passwdconf{'captcha'} ne 'notused') {
16975: $captcha = 'original';
16976: }
16977: }
1.1075.2.14 raeburn 16978: }
1.1075.2.107 raeburn 16979: return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14 raeburn 16980: }
16981:
16982: sub create_captcha {
16983: my %captcha_params = &captcha_settings();
16984: my ($output,$maxtries,$tries) = ('',10,0);
16985: while ($tries < $maxtries) {
16986: $tries ++;
16987: my $captcha = Authen::Captcha->new (
16988: output_folder => $captcha_params{'output_dir'},
16989: data_folder => $captcha_params{'db_dir'},
16990: );
16991: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16992:
16993: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16994: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16995: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 16996: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16997: '<br />'.
16998: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 16999: last;
17000: }
17001: }
17002: return $output;
17003: }
17004:
17005: sub captcha_settings {
17006: my %captcha_params = (
17007: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17008: www_output_dir => "/captchaspool",
17009: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17010: numchars => '5',
17011: );
17012: return %captcha_params;
17013: }
17014:
17015: sub check_captcha {
17016: my ($captcha_chk,$captcha_error);
17017: my $code = $env{'form.code'};
17018: my $md5sum = $env{'form.crypt'};
17019: my %captcha_params = &captcha_settings();
17020: my $captcha = Authen::Captcha->new(
17021: output_folder => $captcha_params{'output_dir'},
17022: data_folder => $captcha_params{'db_dir'},
17023: );
1.1075.2.26 raeburn 17024: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 17025: my %captcha_hash = (
17026: 0 => 'Code not checked (file error)',
17027: -1 => 'Failed: code expired',
17028: -2 => 'Failed: invalid code (not in database)',
17029: -3 => 'Failed: invalid code (code does not match crypt)',
17030: );
17031: if ($captcha_chk != 1) {
17032: $captcha_error = $captcha_hash{$captcha_chk}
17033: }
17034: return ($captcha_chk,$captcha_error);
17035: }
17036:
17037: sub create_recaptcha {
1.1075.2.107 raeburn 17038: my ($pubkey,$version) = @_;
17039: if ($version >= 2) {
17040: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17041: } else {
17042: my $use_ssl;
17043: if ($ENV{'SERVER_PORT'} == 443) {
17044: $use_ssl = 1;
17045: }
17046: my $captcha = Captcha::reCAPTCHA->new;
17047: return $captcha->get_options_setter({theme => 'white'})."\n".
17048: $captcha->get_html($pubkey,undef,$use_ssl).
17049: &mt('If the text is hard to read, [_1] will replace them.',
17050: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17051: '<br /><br />';
17052: }
1.1075.2.14 raeburn 17053: }
17054:
17055: sub check_recaptcha {
1.1075.2.107 raeburn 17056: my ($privkey,$version) = @_;
1.1075.2.14 raeburn 17057: my $captcha_chk;
1.1075.2.107 raeburn 17058: if ($version >= 2) {
17059: my $ua = LWP::UserAgent->new;
17060: $ua->timeout(10);
17061: my %info = (
17062: secret => $privkey,
17063: response => $env{'form.g-recaptcha-response'},
17064: remoteip => $ENV{'REMOTE_ADDR'},
17065: );
17066: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
17067: if ($response->is_success) {
17068: my $data = JSON::DWIW->from_json($response->decoded_content);
17069: if (ref($data) eq 'HASH') {
17070: if ($data->{'success'}) {
17071: $captcha_chk = 1;
17072: }
17073: }
17074: }
17075: } else {
17076: my $captcha = Captcha::reCAPTCHA->new;
17077: my $captcha_result =
17078: $captcha->check_answer(
17079: $privkey,
17080: $ENV{'REMOTE_ADDR'},
17081: $env{'form.recaptcha_challenge_field'},
17082: $env{'form.recaptcha_response_field'},
17083: );
17084: if ($captcha_result->{is_valid}) {
17085: $captcha_chk = 1;
17086: }
1.1075.2.14 raeburn 17087: }
17088: return $captcha_chk;
17089: }
17090:
1.1075.2.64 raeburn 17091: sub emailusername_info {
1.1075.2.103 raeburn 17092: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64 raeburn 17093: my %titles = &Apache::lonlocal::texthash (
17094: lastname => 'Last Name',
17095: firstname => 'First Name',
17096: institution => 'School/college/university',
17097: location => "School's city, state/province, country",
17098: web => "School's web address",
17099: officialemail => 'E-mail address at institution (if different)',
1.1075.2.103 raeburn 17100: id => 'Student/Employee ID',
1.1075.2.64 raeburn 17101: );
17102: return (\@fields,\%titles);
17103: }
17104:
1.1075.2.56 raeburn 17105: sub cleanup_html {
17106: my ($incoming) = @_;
17107: my $outgoing;
17108: if ($incoming ne '') {
17109: $outgoing = $incoming;
17110: $outgoing =~ s/;/;/g;
17111: $outgoing =~ s/\#/#/g;
17112: $outgoing =~ s/\&/&/g;
17113: $outgoing =~ s/</</g;
17114: $outgoing =~ s/>/>/g;
17115: $outgoing =~ s/\(/(/g;
17116: $outgoing =~ s/\)/)/g;
17117: $outgoing =~ s/"/"/g;
17118: $outgoing =~ s/'/'/g;
17119: $outgoing =~ s/\$/$/g;
17120: $outgoing =~ s{/}{/}g;
17121: $outgoing =~ s/=/=/g;
17122: $outgoing =~ s/\\/\/g
17123: }
17124: return $outgoing;
17125: }
17126:
1.1075.2.74 raeburn 17127: # Checks for critical messages and returns a redirect url if one exists.
17128: # $interval indicates how often to check for messages.
17129: sub critical_redirect {
17130: my ($interval) = @_;
17131: if ((time-$env{'user.criticalcheck.time'})>$interval) {
17132: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17133: $env{'user.name'});
17134: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
17135: my $redirecturl;
17136: if ($what[0]) {
17137: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17138: $redirecturl='/adm/email?critical=display';
17139: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17140: return (1, $url);
17141: }
17142: }
17143: }
17144: return ();
17145: }
17146:
1.1075.2.64 raeburn 17147: # Use:
17148: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17149: #
17150: ##################################################
17151: # password associated functions #
17152: ##################################################
17153: sub des_keys {
17154: # Make a new key for DES encryption.
17155: # Each key has two parts which are returned separately.
17156: # Please note: Each key must be passed through the &hex function
17157: # before it is output to the web browser. The hex versions cannot
17158: # be used to decrypt.
17159: my @hexstr=('0','1','2','3','4','5','6','7',
17160: '8','9','a','b','c','d','e','f');
17161: my $lkey='';
17162: for (0..7) {
17163: $lkey.=$hexstr[rand(15)];
17164: }
17165: my $ukey='';
17166: for (0..7) {
17167: $ukey.=$hexstr[rand(15)];
17168: }
17169: return ($lkey,$ukey);
17170: }
17171:
17172: sub des_decrypt {
17173: my ($key,$cyphertext) = @_;
17174: my $keybin=pack("H16",$key);
17175: my $cypher;
17176: if ($Crypt::DES::VERSION>=2.03) {
17177: $cypher=new Crypt::DES $keybin;
17178: } else {
17179: $cypher=new DES $keybin;
17180: }
1.1075.2.106 raeburn 17181: my $plaintext='';
17182: my $cypherlength = length($cyphertext);
17183: my $numchunks = int($cypherlength/32);
17184: for (my $j=0; $j<$numchunks; $j++) {
17185: my $start = $j*32;
17186: my $cypherblock = substr($cyphertext,$start,32);
17187: my $chunk =
17188: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17189: $chunk .=
17190: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17191: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17192: $plaintext .= $chunk;
17193: }
1.1075.2.64 raeburn 17194: return $plaintext;
17195: }
17196:
1.1075.2.141. .1(raebu 17197:20): sub make_short_symbs {
17198:20): my ($cdom,$cnum,$navmap) = @_;
17199:20): return unless (ref($navmap));
17200:20): my ($numnew,@errors);
17201:20): my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
17202:20): if (@toshorten) {
17203:20): my (%maps,%resources,%titles);
17204:20): &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
17205:20): 'shorturls',$cdom,$cnum);
17206:20): my %tocreate;
17207:20): if (keys(%resources)) {
17208:20): foreach my $item (sort {$a <=> $b} (@toshorten)) {
17209:20): my $symb = $resources{$item};
17210:20): if ($symb) {
17211:20): $tocreate{$cnum.'&'.$symb} = 1;
17212:20): }
17213:20): }
17214:20): }
17215:20): if (keys(%tocreate)) {
17216:20): my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
17217:20): my $su = Short::URL->new(no_vowels => 1);
17218:20): my $init = '';
17219:20): my (%newunique,%addcourse,%courseonly,%failed);
17220:20): # get lock on tiny db
17221:20): my $now = time;
17222:20): my $lockhash = {
17223:20): "lock\0$now" => $env{'user.name'}.
17224:20): ':'.$env{'user.domain'},
17225:20): };
17226:20): my $tries = 0;
17227:20): my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
17228:20): my ($code,$error);
17229:20): while (($gotlock ne 'ok') && ($tries<3)) {
17230:20): $tries ++;
17231:20): sleep 1;
17232:20): $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
17233:20): }
17234:20): if ($gotlock eq 'ok') {
17235:20): $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
17236:20): \%addcourse,\%courseonly,\%failed);
17237:20): if (keys(%failed)) {
17238:20): my $numfailed = scalar(keys(%failed));
17239:20): push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
17240:20): }
17241:20): if (keys(%newunique)) {
17242:20): my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
17243:20): if ($putres eq 'ok') {
17244:20): $numnew = scalar(keys(%newunique));
17245:20): my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
17246:20): unless ($newputres eq 'ok') {
17247:20): push(@errors,&mt('error: could not store course look-up of short URLs'));
17248:20): }
17249:20): } else {
17250:20): push(@errors,&mt('error: could not store unique six character URLs'));
17251:20): }
17252:20): }
17253:20): }
17254:20): }
17255:20): }
17256:20): return ($numnew,\@errors);
17257:20): }
17258:20):
17259:20): sub shorten_symbs {
17260:20): my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
17261:20): return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
17262:20): (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
17263:20): (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
17264:20): my (%possibles,%collisions);
17265:20): foreach my $key (keys(%{$tocreate})) {
17266:20): my $num = String::CRC32::crc32($key);
17267:20): my $tiny = $su->encode($num,$init);
17268:20): if ($tiny) {
17269:20): $possibles{$tiny} = $key;
17270:20): }
17271:20): }
17272:20): if (!$init) {
17273:20): $init = 1;
17274:20): } else {
17275:20): $init ++;
17276:20): }
17277:20): if (keys(%possibles)) {
17278:20): my @posstiny = keys(%possibles);
17279:20): my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
17280:20): my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
17281:20): if (keys(%currtiny)) {
17282:20): foreach my $key (keys(%currtiny)) {
17283:20): next if ($currtiny{$key} eq '');
17284:20): if ($currtiny{$key} eq $possibles{$key}) {
17285:20): my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
17286:20): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
17287:20): $courseonly->{$tsymb} = $key;
17288:20): }
17289:20): } else {
17290:20): $collisions{$possibles{$key}} = 1;
17291:20): }
17292:20): delete($possibles{$key});
17293:20): }
17294:20): }
17295:20): foreach my $key (keys(%possibles)) {
17296:20): $newunique->{$key} = $possibles{$key};
17297:20): my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
17298:20): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
17299:20): $addcourse->{$tsymb} = $key;
17300:20): }
17301:20): }
17302:20): }
17303:20): if (keys(%collisions)) {
17304:20): if ($init <5) {
17305:20): if (!$init) {
17306:20): $init = 1;
17307:20): } else {
17308:20): $init ++;
17309:20): }
17310:20): $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
17311:20): $newunique,$addcourse,$courseonly,$failed);
17312:20): } else {
17313:20): foreach my $key (keys(%collisions)) {
17314:20): $failed->{$key} = 1;
17315:20): $failed->{$key} = 1;
17316:20): }
17317:20): }
17318:20): }
17319:20): return $init;
17320:20): }
17321:20):
1.1075.2.135 raeburn 17322: sub is_nonframeable {
17323: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
17324: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
17325: return if (($remprotocol eq '') || ($remhost eq ''));
17326:
17327: $remprotocol = lc($remprotocol);
17328: $remhost = lc($remhost);
17329: my $remport = 80;
17330: if ($remprotocol eq 'https') {
17331: $remport = 443;
17332: }
17333: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
17334: if ($cached) {
17335: unless ($nocache) {
17336: if ($result) {
17337: return 1;
17338: } else {
17339: return 0;
17340: }
17341: }
17342: }
17343: my $uselink;
17344: my $request = new HTTP::Request('HEAD',$url);
17345: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
17346: if ($response->is_success()) {
17347: my $secpolicy = lc($response->header('content-security-policy'));
17348: my $xframeop = lc($response->header('x-frame-options'));
17349: $secpolicy =~ s/^\s+|\s+$//g;
17350: $xframeop =~ s/^\s+|\s+$//g;
17351: if (($secpolicy ne '') || ($xframeop ne '')) {
17352: my $remotehost = $remprotocol.'://'.$remhost;
17353: my ($origin,$protocol,$port);
17354: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
17355: $port = $ENV{'SERVER_PORT'};
17356: } else {
17357: $port = 80;
17358: }
17359: if ($absolute eq '') {
17360: $protocol = 'http:';
17361: if ($port == 443) {
17362: $protocol = 'https:';
17363: }
17364: $origin = $protocol.'//'.lc($hostname);
17365: } else {
17366: $origin = lc($absolute);
17367: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
17368: }
17369: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
17370: my $framepolicy = $1;
17371: $framepolicy =~ s/^\s+|\s+$//g;
17372: my @policies = split(/\s+/,$framepolicy);
17373: if (@policies) {
17374: if (grep(/^\Q'none'\E$/,@policies)) {
17375: $uselink = 1;
17376: } else {
17377: $uselink = 1;
17378: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
17379: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
17380: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
17381: undef($uselink);
17382: }
17383: if ($uselink) {
17384: if (grep(/^\Q'self'\E$/,@policies)) {
17385: if (($origin ne '') && ($remotehost eq $origin)) {
17386: undef($uselink);
17387: }
17388: }
17389: }
17390: if ($uselink) {
17391: my @possok;
17392: if ($ip ne '') {
17393: push(@possok,$ip);
17394: }
17395: my $hoststr = '';
17396: foreach my $part (reverse(split(/\./,$hostname))) {
17397: if ($hoststr eq '') {
17398: $hoststr = $part;
17399: } else {
17400: $hoststr = "$part.$hoststr";
17401: }
17402: if ($hoststr eq $hostname) {
17403: push(@possok,$hostname);
17404: } else {
17405: push(@possok,"*.$hoststr");
17406: }
17407: }
17408: if (@possok) {
17409: foreach my $poss (@possok) {
17410: last if (!$uselink);
17411: foreach my $policy (@policies) {
17412: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
17413: undef($uselink);
17414: last;
17415: }
17416: }
17417: }
17418: }
17419: }
17420: }
17421: }
17422: } elsif ($xframeop ne '') {
17423: $uselink = 1;
17424: my @policies = split(/\s*,\s*/,$xframeop);
17425: if (@policies) {
17426: unless (grep(/^deny$/,@policies)) {
17427: if ($origin ne '') {
17428: if (grep(/^sameorigin$/,@policies)) {
17429: if ($remotehost eq $origin) {
17430: undef($uselink);
17431: }
17432: }
17433: if ($uselink) {
17434: foreach my $policy (@policies) {
17435: if ($policy =~ /^allow-from\s*(.+)$/) {
17436: my $allowfrom = $1;
17437: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
17438: undef($uselink);
17439: last;
17440: }
17441: }
17442: }
17443: }
17444: }
17445: }
17446: }
17447: }
17448: }
17449: }
17450: if ($nocache) {
17451: if ($cached) {
17452: my $devalidate;
17453: if ($uselink && !$result) {
17454: $devalidate = 1;
17455: } elsif (!$uselink && $result) {
17456: $devalidate = 1;
17457: }
17458: if ($devalidate) {
17459: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
17460: }
17461: }
17462: } else {
17463: if ($uselink) {
17464: $result = 1;
17465: } else {
17466: $result = 0;
17467: }
17468: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
17469: }
17470: return $uselink;
17471: }
17472:
1.112 bowersj2 17473: 1;
17474: __END__;
1.41 ng 17475:
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