Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.90
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.90! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.89 2015/04/01 23:42:05 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.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1075.2.14 raeburn 76: use Authen::Captcha;
77: use Captcha::reCAPTCHA;
1.1075.2.64 raeburn 78: use Crypt::DES;
79: use DynaLoader; # for Crypt::DES version
1.117 www 80:
1.517 raeburn 81: # ---------------------------------------------- Designs
82: use vars qw(%defaultdesign);
83:
1.22 www 84: my $readit;
85:
1.517 raeburn 86:
1.157 matthew 87: ##
88: ## Global Variables
89: ##
1.46 matthew 90:
1.643 foxr 91:
92: # ----------------------------------------------- SSI with retries:
93: #
94:
95: =pod
96:
1.648 raeburn 97: =head1 Server Side include with retries:
1.643 foxr 98:
99: =over 4
100:
1.648 raeburn 101: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 102:
103: Performs an ssi with some number of retries. Retries continue either
104: until the result is ok or until the retry count supplied by the
105: caller is exhausted.
106:
107: Inputs:
1.648 raeburn 108:
109: =over 4
110:
1.643 foxr 111: resource - Identifies the resource to insert.
1.648 raeburn 112:
1.643 foxr 113: retries - Count of the number of retries allowed.
1.648 raeburn 114:
1.643 foxr 115: form - Hash that identifies the rendering options.
116:
1.648 raeburn 117: =back
118:
119: Returns:
120:
121: =over 4
122:
1.643 foxr 123: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 124:
1.643 foxr 125: response - The response from the last attempt (which may or may not have been successful.
126:
1.648 raeburn 127: =back
128:
129: =back
130:
1.643 foxr 131: =cut
132:
133: sub ssi_with_retries {
134: my ($resource, $retries, %form) = @_;
135:
136:
137: my $ok = 0; # True if we got a good response.
138: my $content;
139: my $response;
140:
141: # Try to get the ssi done. within the retries count:
142:
143: do {
144: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
145: $ok = $response->is_success;
1.650 www 146: if (!$ok) {
147: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
148: }
1.643 foxr 149: $retries--;
150: } while (!$ok && ($retries > 0));
151:
152: if (!$ok) {
153: $content = ''; # On error return an empty content.
154: }
155: return ($content, $response);
156:
157: }
158:
159:
160:
1.20 www 161: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 162: my %language;
1.124 www 163: my %supported_language;
1.1048 foxr 164: my %latex_language; # For choosing hyphenation in <transl..>
165: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 166: my %cprtag;
1.192 taceyjo1 167: my %scprtag;
1.351 www 168: my %fe; my %fd; my %fm;
1.41 ng 169: my %category_extensions;
1.12 harris41 170:
1.46 matthew 171: # ---------------------------------------------- Thesaurus variables
1.144 matthew 172: #
173: # %Keywords:
174: # A hash used by &keyword to determine if a word is considered a keyword.
175: # $thesaurus_db_file
176: # Scalar containing the full path to the thesaurus database.
1.46 matthew 177:
178: my %Keywords;
179: my $thesaurus_db_file;
180:
1.144 matthew 181: #
182: # Initialize values from language.tab, copyright.tab, filetypes.tab,
183: # thesaurus.tab, and filecategories.tab.
184: #
1.18 www 185: BEGIN {
1.46 matthew 186: # Variable initialization
187: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
188: #
1.22 www 189: unless ($readit) {
1.12 harris41 190: # ------------------------------------------------------------------- languages
191: {
1.158 raeburn 192: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
193: '/language.tab';
194: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 195: while (my $line = <$fh>) {
196: next if ($line=~/^\#/);
197: chomp($line);
1.1048 foxr 198: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 199: $language{$key}=$val.' - '.$enc;
200: if ($sup) {
201: $supported_language{$key}=$sup;
202: }
1.1048 foxr 203: if ($latex) {
204: $latex_language_bykey{$key} = $latex;
205: $latex_language{$two} = $latex;
206: }
1.158 raeburn 207: }
208: close($fh);
209: }
1.12 harris41 210: }
211: # ------------------------------------------------------------------ copyrights
212: {
1.158 raeburn 213: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
214: '/copyright.tab';
215: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 216: while (my $line = <$fh>) {
217: next if ($line=~/^\#/);
218: chomp($line);
219: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 220: $cprtag{$key}=$val;
221: }
222: close($fh);
223: }
1.12 harris41 224: }
1.351 www 225: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 226: {
227: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
228: '/source_copyright.tab';
229: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 230: while (my $line = <$fh>) {
231: next if ($line =~ /^\#/);
232: chomp($line);
233: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 234: $scprtag{$key}=$val;
235: }
236: close($fh);
237: }
238: }
1.63 www 239:
1.517 raeburn 240: # -------------------------------------------------------------- default domain designs
1.63 www 241: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 242: my $designfile = $designdir.'/default.tab';
243: if ( open (my $fh,"<$designfile") ) {
244: while (my $line = <$fh>) {
245: next if ($line =~ /^\#/);
246: chomp($line);
247: my ($key,$val)=(split(/\=/,$line));
248: if ($val) { $defaultdesign{$key}=$val; }
249: }
250: close($fh);
1.63 www 251: }
252:
1.15 harris41 253: # ------------------------------------------------------------- file categories
254: {
1.158 raeburn 255: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
256: '/filecategories.tab';
257: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 258: while (my $line = <$fh>) {
259: next if ($line =~ /^\#/);
260: chomp($line);
261: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 262: push @{$category_extensions{lc($category)}},$extension;
263: }
264: close($fh);
265: }
266:
1.15 harris41 267: }
1.12 harris41 268: # ------------------------------------------------------------------ file types
269: {
1.158 raeburn 270: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
271: '/filetypes.tab';
272: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 273: while (my $line = <$fh>) {
274: next if ($line =~ /^\#/);
275: chomp($line);
276: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 277: if ($descr ne '') {
278: $fe{$ending}=lc($emb);
279: $fd{$ending}=$descr;
1.351 www 280: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 281: }
282: }
283: close($fh);
284: }
1.12 harris41 285: }
1.22 www 286: &Apache::lonnet::logthis(
1.705 tempelho 287: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 288: $readit=1;
1.46 matthew 289: } # end of unless($readit)
1.32 matthew 290:
291: }
1.112 bowersj2 292:
1.42 matthew 293: ###############################################################
294: ## HTML and Javascript Helper Functions ##
295: ###############################################################
296:
297: =pod
298:
1.112 bowersj2 299: =head1 HTML and Javascript Functions
1.42 matthew 300:
1.112 bowersj2 301: =over 4
302:
1.648 raeburn 303: =item * &browser_and_searcher_javascript()
1.112 bowersj2 304:
305: X<browsing, javascript>X<searching, javascript>Returns a string
306: containing javascript with two functions, C<openbrowser> and
307: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
308: tags.
1.42 matthew 309:
1.648 raeburn 310: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 311:
312: inputs: formname, elementname, only, omit
313:
314: formname and elementname indicate the name of the html form and name of
315: the element that the results of the browsing selection are to be placed in.
316:
317: Specifying 'only' will restrict the browser to displaying only files
1.185 www 318: with the given extension. Can be a comma separated list.
1.42 matthew 319:
320: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 321: with the given extension. Can be a comma separated list.
1.42 matthew 322:
1.648 raeburn 323: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 324:
325: Inputs: formname, elementname
326:
327: formname and elementname specify the name of the html form and the name
328: of the element the selection from the search results will be placed in.
1.542 raeburn 329:
1.42 matthew 330: =cut
331:
332: sub browser_and_searcher_javascript {
1.199 albertel 333: my ($mode)=@_;
334: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 335: my $resurl=&escape_single(&lastresurl());
1.42 matthew 336: return <<END;
1.219 albertel 337: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 338: var editbrowser = null;
1.135 albertel 339: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 340: var url = '$resurl/?';
1.42 matthew 341: if (editbrowser == null) {
342: url += 'launch=1&';
343: }
344: url += 'catalogmode=interactive&';
1.199 albertel 345: url += 'mode=$mode&';
1.611 albertel 346: url += 'inhibitmenu=yes&';
1.42 matthew 347: url += 'form=' + formname + '&';
348: if (only != null) {
349: url += 'only=' + only + '&';
1.217 albertel 350: } else {
351: url += 'only=&';
352: }
1.42 matthew 353: if (omit != null) {
354: url += 'omit=' + omit + '&';
1.217 albertel 355: } else {
356: url += 'omit=&';
357: }
1.135 albertel 358: if (titleelement != null) {
359: url += 'titleelement=' + titleelement + '&';
1.217 albertel 360: } else {
361: url += 'titleelement=&';
362: }
1.42 matthew 363: url += 'element=' + elementname + '';
364: var title = 'Browser';
1.435 albertel 365: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 366: options += ',width=700,height=600';
367: editbrowser = open(url,title,options,'1');
368: editbrowser.focus();
369: }
370: var editsearcher;
1.135 albertel 371: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 372: var url = '/adm/searchcat?';
373: if (editsearcher == null) {
374: url += 'launch=1&';
375: }
376: url += 'catalogmode=interactive&';
1.199 albertel 377: url += 'mode=$mode&';
1.42 matthew 378: url += 'form=' + formname + '&';
1.135 albertel 379: if (titleelement != null) {
380: url += 'titleelement=' + titleelement + '&';
1.217 albertel 381: } else {
382: url += 'titleelement=&';
383: }
1.42 matthew 384: url += 'element=' + elementname + '';
385: var title = 'Search';
1.435 albertel 386: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 387: options += ',width=700,height=600';
388: editsearcher = open(url,title,options,'1');
389: editsearcher.focus();
390: }
1.219 albertel 391: // END LON-CAPA Internal -->
1.42 matthew 392: END
1.170 www 393: }
394:
395: sub lastresurl {
1.258 albertel 396: if ($env{'environment.lastresurl'}) {
397: return $env{'environment.lastresurl'}
1.170 www 398: } else {
399: return '/res';
400: }
401: }
402:
403: sub storeresurl {
404: my $resurl=&Apache::lonnet::clutter(shift);
405: unless ($resurl=~/^\/res/) { return 0; }
406: $resurl=~s/\/$//;
407: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 408: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 409: return 1;
1.42 matthew 410: }
411:
1.74 www 412: sub studentbrowser_javascript {
1.111 www 413: unless (
1.258 albertel 414: (($env{'request.course.id'}) &&
1.302 albertel 415: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
416: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
417: '/'.$env{'request.course.sec'})
418: ))
1.258 albertel 419: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 420: ) { return ''; }
1.74 www 421: return (<<'ENDSTDBRW');
1.776 bisitz 422: <script type="text/javascript" language="Javascript">
1.824 bisitz 423: // <![CDATA[
1.74 www 424: var stdeditbrowser;
1.999 www 425: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 426: var url = '/adm/pickstudent?';
427: var filter;
1.558 albertel 428: if (!ignorefilter) {
429: eval('filter=document.'+formname+'.'+uname+'.value;');
430: }
1.74 www 431: if (filter != null) {
432: if (filter != '') {
433: url += 'filter='+filter+'&';
434: }
435: }
436: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 437: '&udomelement='+udom+
438: '&clicker='+clicker;
1.111 www 439: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 440: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 441: var title = 'Student_Browser';
1.74 www 442: var options = 'scrollbars=1,resizable=1,menubar=0';
443: options += ',width=700,height=600';
444: stdeditbrowser = open(url,title,options,'1');
445: stdeditbrowser.focus();
446: }
1.824 bisitz 447: // ]]>
1.74 www 448: </script>
449: ENDSTDBRW
450: }
1.42 matthew 451:
1.1003 www 452: sub resourcebrowser_javascript {
453: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 454: return (<<'ENDRESBRW');
1.1003 www 455: <script type="text/javascript" language="Javascript">
456: // <![CDATA[
457: var reseditbrowser;
1.1004 www 458: function openresbrowser(formname,reslink) {
1.1005 www 459: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 460: var title = 'Resource_Browser';
461: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 462: options += ',width=700,height=500';
1.1004 www 463: reseditbrowser = open(url,title,options,'1');
464: reseditbrowser.focus();
1.1003 www 465: }
466: // ]]>
467: </script>
1.1004 www 468: ENDRESBRW
1.1003 www 469: }
470:
1.74 www 471: sub selectstudent_link {
1.999 www 472: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
473: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
474: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
475: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 476: if ($env{'request.course.id'}) {
1.302 albertel 477: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
478: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
479: '/'.$env{'request.course.sec'})) {
1.111 www 480: return '';
481: }
1.999 www 482: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 483: if ($courseadvonly) {
484: $callargs .= ",'',1,1";
485: }
486: return '<span class="LC_nobreak">'.
487: '<a href="javascript:openstdbrowser('.$callargs.');">'.
488: &mt('Select User').'</a></span>';
1.74 www 489: }
1.258 albertel 490: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 491: $callargs .= ",'',1";
1.793 raeburn 492: return '<span class="LC_nobreak">'.
493: '<a href="javascript:openstdbrowser('.$callargs.');">'.
494: &mt('Select User').'</a></span>';
1.111 www 495: }
496: return '';
1.91 www 497: }
498:
1.1004 www 499: sub selectresource_link {
500: my ($form,$reslink,$arg)=@_;
501:
502: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
503: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
504: unless ($env{'request.course.id'}) { return $arg; }
505: return '<span class="LC_nobreak">'.
506: '<a href="javascript:openresbrowser('.$callargs.');">'.
507: $arg.'</a></span>';
508: }
509:
510:
511:
1.653 raeburn 512: sub authorbrowser_javascript {
513: return <<"ENDAUTHORBRW";
1.776 bisitz 514: <script type="text/javascript" language="JavaScript">
1.824 bisitz 515: // <![CDATA[
1.653 raeburn 516: var stdeditbrowser;
517:
518: function openauthorbrowser(formname,udom) {
519: var url = '/adm/pickauthor?';
520: url += 'form='+formname+'&roledom='+udom;
521: var title = 'Author_Browser';
522: var options = 'scrollbars=1,resizable=1,menubar=0';
523: options += ',width=700,height=600';
524: stdeditbrowser = open(url,title,options,'1');
525: stdeditbrowser.focus();
526: }
527:
1.824 bisitz 528: // ]]>
1.653 raeburn 529: </script>
530: ENDAUTHORBRW
531: }
532:
1.91 www 533: sub coursebrowser_javascript {
1.1075.2.31 raeburn 534: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
535: $credits_element) = @_;
1.932 raeburn 536: my $wintitle = 'Course_Browser';
1.931 raeburn 537: if ($crstype eq 'Community') {
1.932 raeburn 538: $wintitle = 'Community_Browser';
1.909 raeburn 539: }
1.876 raeburn 540: my $id_functions = &javascript_index_functions();
541: my $output = '
1.776 bisitz 542: <script type="text/javascript" language="JavaScript">
1.824 bisitz 543: // <![CDATA[
1.468 raeburn 544: var stdeditbrowser;'."\n";
1.876 raeburn 545:
546: $output .= <<"ENDSTDBRW";
1.909 raeburn 547: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 548: var url = '/adm/pickcourse?';
1.895 raeburn 549: var formid = getFormIdByName(formname);
1.876 raeburn 550: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 551: if (domainfilter != null) {
552: if (domainfilter != '') {
553: url += 'domainfilter='+domainfilter+'&';
554: }
555: }
1.91 www 556: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 557: '&cdomelement='+udom+
558: '&cnameelement='+desc;
1.468 raeburn 559: if (extra_element !=null && extra_element != '') {
1.594 raeburn 560: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 561: url += '&roleelement='+extra_element;
562: if (domainfilter == null || domainfilter == '') {
563: url += '&domainfilter='+extra_element;
564: }
1.234 raeburn 565: }
1.468 raeburn 566: else {
567: if (formname == 'portform') {
568: url += '&setroles='+extra_element;
1.800 raeburn 569: } else {
570: if (formname == 'rules') {
571: url += '&fixeddom='+extra_element;
572: }
1.468 raeburn 573: }
574: }
1.230 raeburn 575: }
1.909 raeburn 576: if (type != null && type != '') {
577: url += '&type='+type;
578: }
579: if (type_elem != null && type_elem != '') {
580: url += '&typeelement='+type_elem;
581: }
1.872 raeburn 582: if (formname == 'ccrs') {
583: var ownername = document.forms[formid].ccuname.value;
584: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
585: url += '&cloner='+ownername+':'+ownerdom;
586: }
1.293 raeburn 587: if (multflag !=null && multflag != '') {
588: url += '&multiple='+multflag;
589: }
1.909 raeburn 590: var title = '$wintitle';
1.91 www 591: var options = 'scrollbars=1,resizable=1,menubar=0';
592: options += ',width=700,height=600';
593: stdeditbrowser = open(url,title,options,'1');
594: stdeditbrowser.focus();
595: }
1.876 raeburn 596: $id_functions
597: ENDSTDBRW
1.1075.2.31 raeburn 598: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
599: $output .= &setsec_javascript($sec_element,$formname,$role_element,
600: $credits_element);
1.876 raeburn 601: }
602: $output .= '
603: // ]]>
604: </script>';
605: return $output;
606: }
607:
608: sub javascript_index_functions {
609: return <<"ENDJS";
610:
611: function getFormIdByName(formname) {
612: for (var i=0;i<document.forms.length;i++) {
613: if (document.forms[i].name == formname) {
614: return i;
615: }
616: }
617: return -1;
618: }
619:
620: function getIndexByName(formid,item) {
621: for (var i=0;i<document.forms[formid].elements.length;i++) {
622: if (document.forms[formid].elements[i].name == item) {
623: return i;
624: }
625: }
626: return -1;
627: }
1.468 raeburn 628:
1.876 raeburn 629: function getDomainFromSelectbox(formname,udom) {
630: var userdom;
631: var formid = getFormIdByName(formname);
632: if (formid > -1) {
633: var domid = getIndexByName(formid,udom);
634: if (domid > -1) {
635: if (document.forms[formid].elements[domid].type == 'select-one') {
636: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
637: }
638: if (document.forms[formid].elements[domid].type == 'hidden') {
639: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 640: }
641: }
642: }
1.876 raeburn 643: return userdom;
644: }
645:
646: ENDJS
1.468 raeburn 647:
1.876 raeburn 648: }
649:
1.1017 raeburn 650: sub javascript_array_indexof {
1.1018 raeburn 651: return <<ENDJS;
1.1017 raeburn 652: <script type="text/javascript" language="JavaScript">
653: // <![CDATA[
654:
655: if (!Array.prototype.indexOf) {
656: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
657: "use strict";
658: if (this === void 0 || this === null) {
659: throw new TypeError();
660: }
661: var t = Object(this);
662: var len = t.length >>> 0;
663: if (len === 0) {
664: return -1;
665: }
666: var n = 0;
667: if (arguments.length > 0) {
668: n = Number(arguments[1]);
669: if (n !== n) { // shortcut for verifying if it's NaN
670: n = 0;
671: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
672: n = (n > 0 || -1) * Math.floor(Math.abs(n));
673: }
674: }
675: if (n >= len) {
676: return -1;
677: }
678: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
679: for (; k < len; k++) {
680: if (k in t && t[k] === searchElement) {
681: return k;
682: }
683: }
684: return -1;
685: }
686: }
687:
688: // ]]>
689: </script>
690:
691: ENDJS
692:
693: }
694:
1.876 raeburn 695: sub userbrowser_javascript {
696: my $id_functions = &javascript_index_functions();
697: return <<"ENDUSERBRW";
698:
1.888 raeburn 699: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 700: var url = '/adm/pickuser?';
701: var userdom = getDomainFromSelectbox(formname,udom);
702: if (userdom != null) {
703: if (userdom != '') {
704: url += 'srchdom='+userdom+'&';
705: }
706: }
707: url += 'form=' + formname + '&unameelement='+uname+
708: '&udomelement='+udom+
709: '&ulastelement='+ulast+
710: '&ufirstelement='+ufirst+
711: '&uemailelement='+uemail+
1.881 raeburn 712: '&hideudomelement='+hideudom+
713: '&coursedom='+crsdom;
1.888 raeburn 714: if ((caller != null) && (caller != undefined)) {
715: url += '&caller='+caller;
716: }
1.876 raeburn 717: var title = 'User_Browser';
718: var options = 'scrollbars=1,resizable=1,menubar=0';
719: options += ',width=700,height=600';
720: var stdeditbrowser = open(url,title,options,'1');
721: stdeditbrowser.focus();
722: }
723:
1.888 raeburn 724: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 725: var formid = getFormIdByName(formname);
726: if (formid > -1) {
1.888 raeburn 727: var unameid = getIndexByName(formid,uname);
1.876 raeburn 728: var domid = getIndexByName(formid,udom);
729: var hidedomid = getIndexByName(formid,origdom);
730: if (hidedomid > -1) {
731: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 732: var unameval = document.forms[formid].elements[unameid].value;
733: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
734: if (domid > -1) {
735: var slct = document.forms[formid].elements[domid];
736: if (slct.type == 'select-one') {
737: var i;
738: for (i=0;i<slct.length;i++) {
739: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
740: }
741: }
742: if (slct.type == 'hidden') {
743: slct.value = fixeddom;
1.876 raeburn 744: }
745: }
1.468 raeburn 746: }
747: }
748: }
1.876 raeburn 749: return;
750: }
751:
752: $id_functions
753: ENDUSERBRW
1.468 raeburn 754: }
755:
756: sub setsec_javascript {
1.1075.2.31 raeburn 757: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 758: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
759: $communityrolestr);
760: if ($role_element ne '') {
761: my @allroles = ('st','ta','ep','in','ad');
762: foreach my $crstype ('Course','Community') {
763: if ($crstype eq 'Community') {
764: foreach my $role (@allroles) {
765: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
766: }
767: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
768: } else {
769: foreach my $role (@allroles) {
770: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
771: }
772: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
773: }
774: }
775: $rolestr = '"'.join('","',@allroles).'"';
776: $courserolestr = '"'.join('","',@courserolenames).'"';
777: $communityrolestr = '"'.join('","',@communityrolenames).'"';
778: }
1.468 raeburn 779: my $setsections = qq|
780: function setSect(sectionlist) {
1.629 raeburn 781: var sectionsArray = new Array();
782: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
783: sectionsArray = sectionlist.split(",");
784: }
1.468 raeburn 785: var numSections = sectionsArray.length;
786: document.$formname.$sec_element.length = 0;
787: if (numSections == 0) {
788: document.$formname.$sec_element.multiple=false;
789: document.$formname.$sec_element.size=1;
790: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
791: } else {
792: if (numSections == 1) {
793: document.$formname.$sec_element.multiple=false;
794: document.$formname.$sec_element.size=1;
795: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
796: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
797: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
798: } else {
799: for (var i=0; i<numSections; i++) {
800: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
801: }
802: document.$formname.$sec_element.multiple=true
803: if (numSections < 3) {
804: document.$formname.$sec_element.size=numSections;
805: } else {
806: document.$formname.$sec_element.size=3;
807: }
808: document.$formname.$sec_element.options[0].selected = false
809: }
810: }
1.91 www 811: }
1.905 raeburn 812:
813: function setRole(crstype) {
1.468 raeburn 814: |;
1.905 raeburn 815: if ($role_element eq '') {
816: $setsections .= ' return;
817: }
818: ';
819: } else {
820: $setsections .= qq|
821: var elementLength = document.$formname.$role_element.length;
822: var allroles = Array($rolestr);
823: var courserolenames = Array($courserolestr);
824: var communityrolenames = Array($communityrolestr);
825: if (elementLength != undefined) {
826: if (document.$formname.$role_element.options[5].value == 'cc') {
827: if (crstype == 'Course') {
828: return;
829: } else {
830: allroles[5] = 'co';
831: for (var i=0; i<6; i++) {
832: document.$formname.$role_element.options[i].value = allroles[i];
833: document.$formname.$role_element.options[i].text = communityrolenames[i];
834: }
835: }
836: } else {
837: if (crstype == 'Community') {
838: return;
839: } else {
840: allroles[5] = 'cc';
841: for (var i=0; i<6; i++) {
842: document.$formname.$role_element.options[i].value = allroles[i];
843: document.$formname.$role_element.options[i].text = courserolenames[i];
844: }
845: }
846: }
847: }
848: return;
849: }
850: |;
851: }
1.1075.2.31 raeburn 852: if ($credits_element) {
853: $setsections .= qq|
854: function setCredits(defaultcredits) {
855: document.$formname.$credits_element.value = defaultcredits;
856: return;
857: }
858: |;
859: }
1.468 raeburn 860: return $setsections;
861: }
862:
1.91 www 863: sub selectcourse_link {
1.909 raeburn 864: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
865: $typeelement) = @_;
866: my $type = $selecttype;
1.871 raeburn 867: my $linktext = &mt('Select Course');
868: if ($selecttype eq 'Community') {
1.909 raeburn 869: $linktext = &mt('Select Community');
1.906 raeburn 870: } elsif ($selecttype eq 'Course/Community') {
871: $linktext = &mt('Select Course/Community');
1.909 raeburn 872: $type = '';
1.1019 raeburn 873: } elsif ($selecttype eq 'Select') {
874: $linktext = &mt('Select');
875: $type = '';
1.871 raeburn 876: }
1.787 bisitz 877: return '<span class="LC_nobreak">'
878: ."<a href='"
879: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
880: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 881: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 882: ."'>".$linktext.'</a>'
1.787 bisitz 883: .'</span>';
1.74 www 884: }
1.42 matthew 885:
1.653 raeburn 886: sub selectauthor_link {
887: my ($form,$udom)=@_;
888: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
889: &mt('Select Author').'</a>';
890: }
891:
1.876 raeburn 892: sub selectuser_link {
1.881 raeburn 893: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 894: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 895: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 896: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 897: ');">'.$linktext.'</a>';
1.876 raeburn 898: }
899:
1.273 raeburn 900: sub check_uncheck_jscript {
901: my $jscript = <<"ENDSCRT";
902: function checkAll(field) {
903: if (field.length > 0) {
904: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 905: if (!field[i].disabled) {
906: field[i].checked = true;
907: }
1.273 raeburn 908: }
909: } else {
1.1075.2.14 raeburn 910: if (!field.disabled) {
911: field.checked = true;
912: }
1.273 raeburn 913: }
914: }
915:
916: function uncheckAll(field) {
917: if (field.length > 0) {
918: for (i = 0; i < field.length; i++) {
919: field[i].checked = false ;
1.543 albertel 920: }
921: } else {
1.273 raeburn 922: field.checked = false ;
923: }
924: }
925: ENDSCRT
926: return $jscript;
927: }
928:
1.656 www 929: sub select_timezone {
1.659 raeburn 930: my ($name,$selected,$onchange,$includeempty)=@_;
931: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
932: if ($includeempty) {
933: $output .= '<option value=""';
934: if (($selected eq '') || ($selected eq 'local')) {
935: $output .= ' selected="selected" ';
936: }
937: $output .= '> </option>';
938: }
1.657 raeburn 939: my @timezones = DateTime::TimeZone->all_names;
940: foreach my $tzone (@timezones) {
941: $output.= '<option value="'.$tzone.'"';
942: if ($tzone eq $selected) {
943: $output.=' selected="selected"';
944: }
945: $output.=">$tzone</option>\n";
1.656 www 946: }
947: $output.="</select>";
948: return $output;
949: }
1.273 raeburn 950:
1.687 raeburn 951: sub select_datelocale {
952: my ($name,$selected,$onchange,$includeempty)=@_;
953: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
954: if ($includeempty) {
955: $output .= '<option value=""';
956: if ($selected eq '') {
957: $output .= ' selected="selected" ';
958: }
959: $output .= '> </option>';
960: }
961: my (@possibles,%locale_names);
962: my @locales = DateTime::Locale::Catalog::Locales;
963: foreach my $locale (@locales) {
964: if (ref($locale) eq 'HASH') {
965: my $id = $locale->{'id'};
966: if ($id ne '') {
967: my $en_terr = $locale->{'en_territory'};
968: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 969: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 970: if (grep(/^en$/,@languages) || !@languages) {
971: if ($en_terr ne '') {
972: $locale_names{$id} = '('.$en_terr.')';
973: } elsif ($native_terr ne '') {
974: $locale_names{$id} = $native_terr;
975: }
976: } else {
977: if ($native_terr ne '') {
978: $locale_names{$id} = $native_terr.' ';
979: } elsif ($en_terr ne '') {
980: $locale_names{$id} = '('.$en_terr.')';
981: }
982: }
983: push (@possibles,$id);
984: }
985: }
986: }
987: foreach my $item (sort(@possibles)) {
988: $output.= '<option value="'.$item.'"';
989: if ($item eq $selected) {
990: $output.=' selected="selected"';
991: }
992: $output.=">$item";
993: if ($locale_names{$item} ne '') {
994: $output.=" $locale_names{$item}</option>\n";
995: }
996: $output.="</option>\n";
997: }
998: $output.="</select>";
999: return $output;
1000: }
1001:
1.792 raeburn 1002: sub select_language {
1003: my ($name,$selected,$includeempty) = @_;
1004: my %langchoices;
1005: if ($includeempty) {
1.1075.2.32 raeburn 1006: %langchoices = ('' => 'No language preference');
1.792 raeburn 1007: }
1008: foreach my $id (&languageids()) {
1009: my $code = &supportedlanguagecode($id);
1010: if ($code) {
1011: $langchoices{$code} = &plainlanguagedescription($id);
1012: }
1013: }
1.1075.2.32 raeburn 1014: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1015: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1016: }
1017:
1.42 matthew 1018: =pod
1.36 matthew 1019:
1.648 raeburn 1020: =item * &linked_select_forms(...)
1.36 matthew 1021:
1022: linked_select_forms returns a string containing a <script></script> block
1023: and html for two <select> menus. The select menus will be linked in that
1024: changing the value of the first menu will result in new values being placed
1025: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1026: order unless a defined order is provided.
1.36 matthew 1027:
1028: linked_select_forms takes the following ordered inputs:
1029:
1030: =over 4
1031:
1.112 bowersj2 1032: =item * $formname, the name of the <form> tag
1.36 matthew 1033:
1.112 bowersj2 1034: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1035:
1.112 bowersj2 1036: =item * $firstdefault, the default value for the first menu
1.36 matthew 1037:
1.112 bowersj2 1038: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1039:
1.112 bowersj2 1040: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1041:
1.112 bowersj2 1042: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1043:
1.609 raeburn 1044: =item * $menuorder, the order of values in the first menu
1045:
1.1075.2.31 raeburn 1046: =item * $onchangefirst, additional javascript call to execute for an onchange
1047: event for the first <select> tag
1048:
1049: =item * $onchangesecond, additional javascript call to execute for an onchange
1050: event for the second <select> tag
1051:
1.41 ng 1052: =back
1053:
1.36 matthew 1054: Below is an example of such a hash. Only the 'text', 'default', and
1055: 'select2' keys must appear as stated. keys(%menu) are the possible
1056: values for the first select menu. The text that coincides with the
1.41 ng 1057: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1058: and text for the second menu are given in the hash pointed to by
1059: $menu{$choice1}->{'select2'}.
1060:
1.112 bowersj2 1061: my %menu = ( A1 => { text =>"Choice A1" ,
1062: default => "B3",
1063: select2 => {
1064: B1 => "Choice B1",
1065: B2 => "Choice B2",
1066: B3 => "Choice B3",
1067: B4 => "Choice B4"
1.609 raeburn 1068: },
1069: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1070: },
1071: A2 => { text =>"Choice A2" ,
1072: default => "C2",
1073: select2 => {
1074: C1 => "Choice C1",
1075: C2 => "Choice C2",
1076: C3 => "Choice C3"
1.609 raeburn 1077: },
1078: order => ['C2','C1','C3'],
1.112 bowersj2 1079: },
1080: A3 => { text =>"Choice A3" ,
1081: default => "D6",
1082: select2 => {
1083: D1 => "Choice D1",
1084: D2 => "Choice D2",
1085: D3 => "Choice D3",
1086: D4 => "Choice D4",
1087: D5 => "Choice D5",
1088: D6 => "Choice D6",
1089: D7 => "Choice D7"
1.609 raeburn 1090: },
1091: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1092: }
1093: );
1.36 matthew 1094:
1095: =cut
1096:
1097: sub linked_select_forms {
1098: my ($formname,
1099: $middletext,
1100: $firstdefault,
1101: $firstselectname,
1102: $secondselectname,
1.609 raeburn 1103: $hashref,
1104: $menuorder,
1.1075.2.31 raeburn 1105: $onchangefirst,
1106: $onchangesecond
1.36 matthew 1107: ) = @_;
1108: my $second = "document.$formname.$secondselectname";
1109: my $first = "document.$formname.$firstselectname";
1110: # output the javascript to do the changing
1111: my $result = '';
1.776 bisitz 1112: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1113: $result.="// <![CDATA[\n";
1.36 matthew 1114: $result.="var select2data = new Object();\n";
1115: $" = '","';
1116: my $debug = '';
1117: foreach my $s1 (sort(keys(%$hashref))) {
1118: $result.="select2data.d_$s1 = new Object();\n";
1119: $result.="select2data.d_$s1.def = new String('".
1120: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1121: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1122: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1123: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1124: @s2values = @{$hashref->{$s1}->{'order'}};
1125: }
1.36 matthew 1126: $result.="\"@s2values\");\n";
1127: $result.="select2data.d_$s1.texts = new Array(";
1128: my @s2texts;
1129: foreach my $value (@s2values) {
1130: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1131: }
1132: $result.="\"@s2texts\");\n";
1133: }
1134: $"=' ';
1135: $result.= <<"END";
1136:
1137: function select1_changed() {
1138: // Determine new choice
1139: var newvalue = "d_" + $first.value;
1140: // update select2
1141: var values = select2data[newvalue].values;
1142: var texts = select2data[newvalue].texts;
1143: var select2def = select2data[newvalue].def;
1144: var i;
1145: // out with the old
1146: for (i = 0; i < $second.options.length; i++) {
1147: $second.options[i] = null;
1148: }
1149: // in with the nuclear
1150: for (i=0;i<values.length; i++) {
1151: $second.options[i] = new Option(values[i]);
1.143 matthew 1152: $second.options[i].value = values[i];
1.36 matthew 1153: $second.options[i].text = texts[i];
1154: if (values[i] == select2def) {
1155: $second.options[i].selected = true;
1156: }
1157: }
1158: }
1.824 bisitz 1159: // ]]>
1.36 matthew 1160: </script>
1161: END
1162: # output the initial values for the selection lists
1.1075.2.31 raeburn 1163: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1164: my @order = sort(keys(%{$hashref}));
1165: if (ref($menuorder) eq 'ARRAY') {
1166: @order = @{$menuorder};
1167: }
1168: foreach my $value (@order) {
1.36 matthew 1169: $result.=" <option value=\"$value\" ";
1.253 albertel 1170: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1171: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1172: }
1173: $result .= "</select>\n";
1174: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1175: $result .= $middletext;
1.1075.2.31 raeburn 1176: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1177: if ($onchangesecond) {
1178: $result .= ' onchange="'.$onchangesecond.'"';
1179: }
1180: $result .= ">\n";
1.36 matthew 1181: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1182:
1183: my @secondorder = sort(keys(%select2));
1184: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1185: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1186: }
1187: foreach my $value (@secondorder) {
1.36 matthew 1188: $result.=" <option value=\"$value\" ";
1.253 albertel 1189: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1190: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1191: }
1192: $result .= "</select>\n";
1193: # return $debug;
1194: return $result;
1195: } # end of sub linked_select_forms {
1196:
1.45 matthew 1197: =pod
1.44 bowersj2 1198:
1.973 raeburn 1199: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1200:
1.112 bowersj2 1201: Returns a string corresponding to an HTML link to the given help
1202: $topic, where $topic corresponds to the name of a .tex file in
1203: /home/httpd/html/adm/help/tex, with underscores replaced by
1204: spaces.
1205:
1206: $text will optionally be linked to the same topic, allowing you to
1207: link text in addition to the graphic. If you do not want to link
1208: text, but wish to specify one of the later parameters, pass an
1209: empty string.
1210:
1211: $stayOnPage is a value that will be interpreted as a boolean. If true,
1212: the link will not open a new window. If false, the link will open
1213: a new window using Javascript. (Default is false.)
1214:
1215: $width and $height are optional numerical parameters that will
1216: override the width and height of the popped up window, which may
1.973 raeburn 1217: be useful for certain help topics with big pictures included.
1218:
1219: $imgid is the id of the img tag used for the help icon. This may be
1220: used in a javascript call to switch the image src. See
1221: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1222:
1223: =cut
1224:
1225: sub help_open_topic {
1.973 raeburn 1226: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1227: $text = "" if (not defined $text);
1.44 bowersj2 1228: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1229: $width = 500 if (not defined $width);
1.44 bowersj2 1230: $height = 400 if (not defined $height);
1231: my $filename = $topic;
1232: $filename =~ s/ /_/g;
1233:
1.48 bowersj2 1234: my $template = "";
1235: my $link;
1.572 banghart 1236:
1.159 www 1237: $topic=~s/\W/\_/g;
1.44 bowersj2 1238:
1.572 banghart 1239: if (!$stayOnPage) {
1.1075.2.50 raeburn 1240: if ($env{'browser.mobile'}) {
1241: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1242: } else {
1243: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1244: }
1.1037 www 1245: } elsif ($stayOnPage eq 'popup') {
1246: $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 1247: } else {
1.48 bowersj2 1248: $link = "/adm/help/${filename}.hlp";
1249: }
1250:
1251: # Add the text
1.755 neumanie 1252: if ($text ne "") {
1.763 bisitz 1253: $template.='<span class="LC_help_open_topic">'
1254: .'<a target="_top" href="'.$link.'">'
1255: .$text.'</a>';
1.48 bowersj2 1256: }
1257:
1.763 bisitz 1258: # (Always) Add the graphic
1.179 matthew 1259: my $title = &mt('Online Help');
1.667 raeburn 1260: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1261: if ($imgid ne '') {
1262: $imgid = ' id="'.$imgid.'"';
1263: }
1.763 bisitz 1264: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1265: .'<img src="'.$helpicon.'" border="0"'
1266: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1267: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1268: .' /></a>';
1269: if ($text ne "") {
1270: $template.='</span>';
1271: }
1.44 bowersj2 1272: return $template;
1273:
1.106 bowersj2 1274: }
1275:
1276: # This is a quicky function for Latex cheatsheet editing, since it
1277: # appears in at least four places
1278: sub helpLatexCheatsheet {
1.1037 www 1279: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1280: my $out;
1.106 bowersj2 1281: my $addOther = '';
1.732 raeburn 1282: if ($topic) {
1.1037 www 1283: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1284: }
1285: $out = '<span>' # Start cheatsheet
1286: .$addOther
1287: .'<span>'
1.1037 www 1288: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1289: .'</span> <span>'
1.1037 www 1290: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1291: .'</span>';
1.732 raeburn 1292: unless ($not_author) {
1.763 bisitz 1293: $out .= ' <span>'
1.1037 www 1294: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1295: .'</span> <span>'
1.1075.2.78 raeburn 1296: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1297: .'</span>';
1.732 raeburn 1298: }
1.763 bisitz 1299: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1300: return $out;
1.172 www 1301: }
1302:
1.430 albertel 1303: sub general_help {
1304: my $helptopic='Student_Intro';
1305: if ($env{'request.role'}=~/^(ca|au)/) {
1306: $helptopic='Authoring_Intro';
1.907 raeburn 1307: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1308: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1309: } elsif ($env{'request.role'}=~/^dc/) {
1310: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1311: }
1312: return $helptopic;
1313: }
1314:
1315: sub update_help_link {
1316: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1317: my $origurl = $ENV{'REQUEST_URI'};
1318: $origurl=~s|^/~|/priv/|;
1319: my $timestamp = time;
1320: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1321: $$datum = &escape($$datum);
1322: }
1323:
1324: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1325: my $output .= <<"ENDOUTPUT";
1326: <script type="text/javascript">
1.824 bisitz 1327: // <![CDATA[
1.430 albertel 1328: banner_link = '$banner_link';
1.824 bisitz 1329: // ]]>
1.430 albertel 1330: </script>
1331: ENDOUTPUT
1332: return $output;
1333: }
1334:
1335: # now just updates the help link and generates a blue icon
1.193 raeburn 1336: sub help_open_menu {
1.430 albertel 1337: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1338: = @_;
1.949 droeschl 1339: $stayOnPage = 1;
1.430 albertel 1340: my $output;
1341: if ($component_help) {
1342: if (!$text) {
1343: $output=&help_open_topic($component_help,undef,$stayOnPage,
1344: $width,$height);
1345: } else {
1346: my $help_text;
1347: $help_text=&unescape($topic);
1348: $output='<table><tr><td>'.
1349: &help_open_topic($component_help,$help_text,$stayOnPage,
1350: $width,$height).'</td></tr></table>';
1351: }
1352: }
1353: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1354: return $output.$banner_link;
1355: }
1356:
1357: sub top_nav_help {
1358: my ($text) = @_;
1.436 albertel 1359: $text = &mt($text);
1.1075.2.60 raeburn 1360: my $stay_on_page;
1361: unless ($env{'environment.remote'} eq 'on') {
1362: $stay_on_page = 1;
1363: }
1.1075.2.61 raeburn 1364: my ($link,$banner_link);
1365: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1366: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1367: : "javascript:helpMenu('open')";
1368: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1369: }
1.201 raeburn 1370: my $title = &mt('Get help');
1.1075.2.61 raeburn 1371: if ($link) {
1372: return <<"END";
1.436 albertel 1373: $banner_link
1.1075.2.56 raeburn 1374: <a href="$link" title="$title">$text</a>
1.436 albertel 1375: END
1.1075.2.61 raeburn 1376: } else {
1377: return ' '.$text.' ';
1378: }
1.436 albertel 1379: }
1380:
1381: sub help_menu_js {
1.1075.2.52 raeburn 1382: my ($httphost) = @_;
1.949 droeschl 1383: my $stayOnPage = 1;
1.436 albertel 1384: my $width = 620;
1385: my $height = 600;
1.430 albertel 1386: my $helptopic=&general_help();
1.1075.2.52 raeburn 1387: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1388: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1389: my $start_page =
1390: &Apache::loncommon::start_page('Help Menu', undef,
1391: {'frameset' => 1,
1392: 'js_ready' => 1,
1.1075.2.52 raeburn 1393: 'use_absolute' => $httphost,
1.331 albertel 1394: 'add_entries' => {
1395: 'border' => '0',
1.579 raeburn 1396: 'rows' => "110,*",},});
1.331 albertel 1397: my $end_page =
1398: &Apache::loncommon::end_page({'frameset' => 1,
1399: 'js_ready' => 1,});
1400:
1.436 albertel 1401: my $template .= <<"ENDTEMPLATE";
1402: <script type="text/javascript">
1.877 bisitz 1403: // <![CDATA[
1.253 albertel 1404: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1405: var banner_link = '';
1.243 raeburn 1406: function helpMenu(target) {
1407: var caller = this;
1408: if (target == 'open') {
1409: var newWindow = null;
1410: try {
1.262 albertel 1411: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1412: }
1413: catch(error) {
1414: writeHelp(caller);
1415: return;
1416: }
1417: if (newWindow) {
1418: caller = newWindow;
1419: }
1.193 raeburn 1420: }
1.243 raeburn 1421: writeHelp(caller);
1422: return;
1423: }
1424: function writeHelp(caller) {
1.1075.2.61 raeburn 1425: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1426: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1427: caller.document.close();
1428: caller.focus();
1.193 raeburn 1429: }
1.877 bisitz 1430: // END LON-CAPA Internal -->
1.253 albertel 1431: // ]]>
1.436 albertel 1432: </script>
1.193 raeburn 1433: ENDTEMPLATE
1434: return $template;
1435: }
1436:
1.172 www 1437: sub help_open_bug {
1438: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1439: unless ($env{'user.adv'}) { return ''; }
1.172 www 1440: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1441: $text = "" if (not defined $text);
1442: $stayOnPage=1;
1.184 albertel 1443: $width = 600 if (not defined $width);
1444: $height = 600 if (not defined $height);
1.172 www 1445:
1446: $topic=~s/\W+/\+/g;
1447: my $link='';
1448: my $template='';
1.379 albertel 1449: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1450: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1451: if (!$stayOnPage)
1452: {
1453: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1454: }
1455: else
1456: {
1457: $link = $url;
1458: }
1459: # Add the text
1460: if ($text ne "")
1461: {
1462: $template .=
1463: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1464: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1465: }
1466:
1467: # Add the graphic
1.179 matthew 1468: my $title = &mt('Report a Bug');
1.215 albertel 1469: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1470: $template .= <<"ENDTEMPLATE";
1.436 albertel 1471: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1472: ENDTEMPLATE
1473: if ($text ne '') { $template.='</td></tr></table>' };
1474: return $template;
1475:
1476: }
1477:
1478: sub help_open_faq {
1479: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1480: unless ($env{'user.adv'}) { return ''; }
1.172 www 1481: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1482: $text = "" if (not defined $text);
1483: $stayOnPage=1;
1484: $width = 350 if (not defined $width);
1485: $height = 400 if (not defined $height);
1486:
1487: $topic=~s/\W+/\+/g;
1488: my $link='';
1489: my $template='';
1490: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1491: if (!$stayOnPage)
1492: {
1493: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1494: }
1495: else
1496: {
1497: $link = $url;
1498: }
1499:
1500: # Add the text
1501: if ($text ne "")
1502: {
1503: $template .=
1.173 www 1504: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1505: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1506: }
1507:
1508: # Add the graphic
1.179 matthew 1509: my $title = &mt('View the FAQ');
1.215 albertel 1510: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1511: $template .= <<"ENDTEMPLATE";
1.436 albertel 1512: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1513: ENDTEMPLATE
1514: if ($text ne '') { $template.='</td></tr></table>' };
1515: return $template;
1516:
1.44 bowersj2 1517: }
1.37 matthew 1518:
1.180 matthew 1519: ###############################################################
1520: ###############################################################
1521:
1.45 matthew 1522: =pod
1523:
1.648 raeburn 1524: =item * &change_content_javascript():
1.256 matthew 1525:
1526: This and the next function allow you to create small sections of an
1527: otherwise static HTML page that you can update on the fly with
1528: Javascript, even in Netscape 4.
1529:
1530: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1531: must be written to the HTML page once. It will prove the Javascript
1532: function "change(name, content)". Calling the change function with the
1533: name of the section
1534: you want to update, matching the name passed to C<changable_area>, and
1535: the new content you want to put in there, will put the content into
1536: that area.
1537:
1538: B<Note>: Netscape 4 only reserves enough space for the changable area
1539: to contain room for the original contents. You need to "make space"
1540: for whatever changes you wish to make, and be B<sure> to check your
1541: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1542: it's adequate for updating a one-line status display, but little more.
1543: This script will set the space to 100% width, so you only need to
1544: worry about height in Netscape 4.
1545:
1546: Modern browsers are much less limiting, and if you can commit to the
1547: user not using Netscape 4, this feature may be used freely with
1548: pretty much any HTML.
1549:
1550: =cut
1551:
1552: sub change_content_javascript {
1553: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1554: if ($env{'browser.type'} eq 'netscape' &&
1555: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1556: return (<<NETSCAPE4);
1557: function change(name, content) {
1558: doc = document.layers[name+"___escape"].layers[0].document;
1559: doc.open();
1560: doc.write(content);
1561: doc.close();
1562: }
1563: NETSCAPE4
1564: } else {
1565: # Otherwise, we need to use semi-standards-compliant code
1566: # (technically, "innerHTML" isn't standard but the equivalent
1567: # is really scary, and every useful browser supports it
1568: return (<<DOMBASED);
1569: function change(name, content) {
1570: element = document.getElementById(name);
1571: element.innerHTML = content;
1572: }
1573: DOMBASED
1574: }
1575: }
1576:
1577: =pod
1578:
1.648 raeburn 1579: =item * &changable_area($name,$origContent):
1.256 matthew 1580:
1581: This provides a "changable area" that can be modified on the fly via
1582: the Javascript code provided in C<change_content_javascript>. $name is
1583: the name you will use to reference the area later; do not repeat the
1584: same name on a given HTML page more then once. $origContent is what
1585: the area will originally contain, which can be left blank.
1586:
1587: =cut
1588:
1589: sub changable_area {
1590: my ($name, $origContent) = @_;
1591:
1.258 albertel 1592: if ($env{'browser.type'} eq 'netscape' &&
1593: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1594: # If this is netscape 4, we need to use the Layer tag
1595: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1596: } else {
1597: return "<span id='$name'>$origContent</span>";
1598: }
1599: }
1600:
1601: =pod
1602:
1.648 raeburn 1603: =item * &viewport_geometry_js
1.590 raeburn 1604:
1605: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1606:
1607: =cut
1608:
1609:
1610: sub viewport_geometry_js {
1611: return <<"GEOMETRY";
1612: var Geometry = {};
1613: function init_geometry() {
1614: if (Geometry.init) { return };
1615: Geometry.init=1;
1616: if (window.innerHeight) {
1617: Geometry.getViewportHeight = function() { return window.innerHeight; };
1618: Geometry.getViewportWidth = function() { return window.innerWidth; };
1619: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1620: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1621: }
1622: else if (document.documentElement && document.documentElement.clientHeight) {
1623: Geometry.getViewportHeight =
1624: function() { return document.documentElement.clientHeight; };
1625: Geometry.getViewportWidth =
1626: function() { return document.documentElement.clientWidth; };
1627:
1628: Geometry.getHorizontalScroll =
1629: function() { return document.documentElement.scrollLeft; };
1630: Geometry.getVerticalScroll =
1631: function() { return document.documentElement.scrollTop; };
1632: }
1633: else if (document.body.clientHeight) {
1634: Geometry.getViewportHeight =
1635: function() { return document.body.clientHeight; };
1636: Geometry.getViewportWidth =
1637: function() { return document.body.clientWidth; };
1638: Geometry.getHorizontalScroll =
1639: function() { return document.body.scrollLeft; };
1640: Geometry.getVerticalScroll =
1641: function() { return document.body.scrollTop; };
1642: }
1643: }
1644:
1645: GEOMETRY
1646: }
1647:
1648: =pod
1649:
1.648 raeburn 1650: =item * &viewport_size_js()
1.590 raeburn 1651:
1652: 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.
1653:
1654: =cut
1655:
1656: sub viewport_size_js {
1657: my $geometry = &viewport_geometry_js();
1658: return <<"DIMS";
1659:
1660: $geometry
1661:
1662: function getViewportDims(width,height) {
1663: init_geometry();
1664: width.value = Geometry.getViewportWidth();
1665: height.value = Geometry.getViewportHeight();
1666: return;
1667: }
1668:
1669: DIMS
1670: }
1671:
1672: =pod
1673:
1.648 raeburn 1674: =item * &resize_textarea_js()
1.565 albertel 1675:
1676: emits the needed javascript to resize a textarea to be as big as possible
1677:
1678: creates a function resize_textrea that takes two IDs first should be
1679: the id of the element to resize, second should be the id of a div that
1680: surrounds everything that comes after the textarea, this routine needs
1681: to be attached to the <body> for the onload and onresize events.
1682:
1.648 raeburn 1683: =back
1.565 albertel 1684:
1685: =cut
1686:
1687: sub resize_textarea_js {
1.590 raeburn 1688: my $geometry = &viewport_geometry_js();
1.565 albertel 1689: return <<"RESIZE";
1690: <script type="text/javascript">
1.824 bisitz 1691: // <![CDATA[
1.590 raeburn 1692: $geometry
1.565 albertel 1693:
1.588 albertel 1694: function getX(element) {
1695: var x = 0;
1696: while (element) {
1697: x += element.offsetLeft;
1698: element = element.offsetParent;
1699: }
1700: return x;
1701: }
1702: function getY(element) {
1703: var y = 0;
1704: while (element) {
1705: y += element.offsetTop;
1706: element = element.offsetParent;
1707: }
1708: return y;
1709: }
1710:
1711:
1.565 albertel 1712: function resize_textarea(textarea_id,bottom_id) {
1713: init_geometry();
1714: var textarea = document.getElementById(textarea_id);
1715: //alert(textarea);
1716:
1.588 albertel 1717: var textarea_top = getY(textarea);
1.565 albertel 1718: var textarea_height = textarea.offsetHeight;
1719: var bottom = document.getElementById(bottom_id);
1.588 albertel 1720: var bottom_top = getY(bottom);
1.565 albertel 1721: var bottom_height = bottom.offsetHeight;
1722: var window_height = Geometry.getViewportHeight();
1.588 albertel 1723: var fudge = 23;
1.565 albertel 1724: var new_height = window_height-fudge-textarea_top-bottom_height;
1725: if (new_height < 300) {
1726: new_height = 300;
1727: }
1728: textarea.style.height=new_height+'px';
1729: }
1.824 bisitz 1730: // ]]>
1.565 albertel 1731: </script>
1732: RESIZE
1733:
1734: }
1735:
1736: =pod
1737:
1.256 matthew 1738: =head1 Excel and CSV file utility routines
1739:
1740: =cut
1741:
1742: ###############################################################
1743: ###############################################################
1744:
1745: =pod
1746:
1.1075.2.56 raeburn 1747: =over 4
1748:
1.648 raeburn 1749: =item * &csv_translate($text)
1.37 matthew 1750:
1.185 www 1751: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1752: format.
1753:
1754: =cut
1755:
1.180 matthew 1756: ###############################################################
1757: ###############################################################
1.37 matthew 1758: sub csv_translate {
1759: my $text = shift;
1760: $text =~ s/\"/\"\"/g;
1.209 albertel 1761: $text =~ s/\n/ /g;
1.37 matthew 1762: return $text;
1763: }
1.180 matthew 1764:
1765: ###############################################################
1766: ###############################################################
1767:
1768: =pod
1769:
1.648 raeburn 1770: =item * &define_excel_formats()
1.180 matthew 1771:
1772: Define some commonly used Excel cell formats.
1773:
1774: Currently supported formats:
1775:
1776: =over 4
1777:
1778: =item header
1779:
1780: =item bold
1781:
1782: =item h1
1783:
1784: =item h2
1785:
1786: =item h3
1787:
1.256 matthew 1788: =item h4
1789:
1790: =item i
1791:
1.180 matthew 1792: =item date
1793:
1794: =back
1795:
1796: Inputs: $workbook
1797:
1798: Returns: $format, a hash reference.
1799:
1.1057 foxr 1800:
1.180 matthew 1801: =cut
1802:
1803: ###############################################################
1804: ###############################################################
1805: sub define_excel_formats {
1806: my ($workbook) = @_;
1807: my $format;
1808: $format->{'header'} = $workbook->add_format(bold => 1,
1809: bottom => 1,
1810: align => 'center');
1811: $format->{'bold'} = $workbook->add_format(bold=>1);
1812: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1813: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1814: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1815: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1816: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1817: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1818: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1819: return $format;
1820: }
1821:
1822: ###############################################################
1823: ###############################################################
1.113 bowersj2 1824:
1825: =pod
1826:
1.648 raeburn 1827: =item * &create_workbook()
1.255 matthew 1828:
1829: Create an Excel worksheet. If it fails, output message on the
1830: request object and return undefs.
1831:
1832: Inputs: Apache request object
1833:
1834: Returns (undef) on failure,
1835: Excel worksheet object, scalar with filename, and formats
1836: from &Apache::loncommon::define_excel_formats on success
1837:
1838: =cut
1839:
1840: ###############################################################
1841: ###############################################################
1842: sub create_workbook {
1843: my ($r) = @_;
1844: #
1845: # Create the excel spreadsheet
1846: my $filename = '/prtspool/'.
1.258 albertel 1847: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1848: time.'_'.rand(1000000000).'.xls';
1849: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1850: if (! defined($workbook)) {
1851: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1852: $r->print(
1853: '<p class="LC_error">'
1854: .&mt('Problems occurred in creating the new Excel file.')
1855: .' '.&mt('This error has been logged.')
1856: .' '.&mt('Please alert your LON-CAPA administrator.')
1857: .'</p>'
1858: );
1.255 matthew 1859: return (undef);
1860: }
1861: #
1.1014 foxr 1862: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1863: #
1864: my $format = &Apache::loncommon::define_excel_formats($workbook);
1865: return ($workbook,$filename,$format);
1866: }
1867:
1868: ###############################################################
1869: ###############################################################
1870:
1871: =pod
1872:
1.648 raeburn 1873: =item * &create_text_file()
1.113 bowersj2 1874:
1.542 raeburn 1875: Create a file to write to and eventually make available to the user.
1.256 matthew 1876: If file creation fails, outputs an error message on the request object and
1877: return undefs.
1.113 bowersj2 1878:
1.256 matthew 1879: Inputs: Apache request object, and file suffix
1.113 bowersj2 1880:
1.256 matthew 1881: Returns (undef) on failure,
1882: Filehandle and filename on success.
1.113 bowersj2 1883:
1884: =cut
1885:
1.256 matthew 1886: ###############################################################
1887: ###############################################################
1888: sub create_text_file {
1889: my ($r,$suffix) = @_;
1890: if (! defined($suffix)) { $suffix = 'txt'; };
1891: my $fh;
1892: my $filename = '/prtspool/'.
1.258 albertel 1893: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1894: time.'_'.rand(1000000000).'.'.$suffix;
1895: $fh = Apache::File->new('>/home/httpd'.$filename);
1896: if (! defined($fh)) {
1897: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1898: $r->print(
1899: '<p class="LC_error">'
1900: .&mt('Problems occurred in creating the output file.')
1901: .' '.&mt('This error has been logged.')
1902: .' '.&mt('Please alert your LON-CAPA administrator.')
1903: .'</p>'
1904: );
1.113 bowersj2 1905: }
1.256 matthew 1906: return ($fh,$filename)
1.113 bowersj2 1907: }
1908:
1909:
1.256 matthew 1910: =pod
1.113 bowersj2 1911:
1912: =back
1913:
1914: =cut
1.37 matthew 1915:
1916: ###############################################################
1.33 matthew 1917: ## Home server <option> list generating code ##
1918: ###############################################################
1.35 matthew 1919:
1.169 www 1920: # ------------------------------------------
1921:
1922: sub domain_select {
1923: my ($name,$value,$multiple)=@_;
1924: my %domains=map {
1.514 albertel 1925: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1926: } &Apache::lonnet::all_domains();
1.169 www 1927: if ($multiple) {
1928: $domains{''}=&mt('Any domain');
1.550 albertel 1929: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1930: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1931: } else {
1.550 albertel 1932: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1933: return &select_form($name,$value,\%domains);
1.169 www 1934: }
1935: }
1936:
1.282 albertel 1937: #-------------------------------------------
1938:
1939: =pod
1940:
1.519 raeburn 1941: =head1 Routines for form select boxes
1942:
1943: =over 4
1944:
1.648 raeburn 1945: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1946:
1947: Returns a string containing a <select> element int multiple mode
1948:
1949:
1950: Args:
1951: $name - name of the <select> element
1.506 raeburn 1952: $value - scalar or array ref of values that should already be selected
1.282 albertel 1953: $size - number of rows long the select element is
1.283 albertel 1954: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1955: (shown text should already have been &mt())
1.506 raeburn 1956: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1957:
1.282 albertel 1958: =cut
1959:
1960: #-------------------------------------------
1.169 www 1961: sub multiple_select_form {
1.284 albertel 1962: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1963: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1964: my $output='';
1.191 matthew 1965: if (! defined($size)) {
1966: $size = 4;
1.283 albertel 1967: if (scalar(keys(%$hash))<4) {
1968: $size = scalar(keys(%$hash));
1.191 matthew 1969: }
1970: }
1.734 bisitz 1971: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1972: my @order;
1.506 raeburn 1973: if (ref($order) eq 'ARRAY') {
1974: @order = @{$order};
1975: } else {
1976: @order = sort(keys(%$hash));
1.501 banghart 1977: }
1978: if (exists($$hash{'select_form_order'})) {
1979: @order = @{$$hash{'select_form_order'}};
1980: }
1981:
1.284 albertel 1982: foreach my $key (@order) {
1.356 albertel 1983: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1984: $output.='selected="selected" ' if ($selected{$key});
1985: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1986: }
1987: $output.="</select>\n";
1988: return $output;
1989: }
1990:
1.88 www 1991: #-------------------------------------------
1992:
1993: =pod
1994:
1.970 raeburn 1995: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 1996:
1997: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 1998: allow a user to select options from a ref to a hash containing:
1999: option_name => displayed text. An optional $onchange can include
2000: a javascript onchange item, e.g., onchange="this.form.submit();"
2001:
1.88 www 2002: See lonrights.pm for an example invocation and use.
2003:
2004: =cut
2005:
2006: #-------------------------------------------
2007: sub select_form {
1.970 raeburn 2008: my ($def,$name,$hashref,$onchange) = @_;
2009: return unless (ref($hashref) eq 'HASH');
2010: if ($onchange) {
2011: $onchange = ' onchange="'.$onchange.'"';
2012: }
2013: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2014: my @keys;
1.970 raeburn 2015: if (exists($hashref->{'select_form_order'})) {
2016: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2017: } else {
1.970 raeburn 2018: @keys=sort(keys(%{$hashref}));
1.128 albertel 2019: }
1.356 albertel 2020: foreach my $key (@keys) {
2021: $selectform.=
2022: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2023: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2024: ">".$hashref->{$key}."</option>\n";
1.88 www 2025: }
2026: $selectform.="</select>";
2027: return $selectform;
2028: }
2029:
1.475 www 2030: # For display filters
2031:
2032: sub display_filter {
1.1074 raeburn 2033: my ($context) = @_;
1.475 www 2034: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2035: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2036: my $phraseinput = 'hidden';
2037: my $includeinput = 'hidden';
2038: my ($checked,$includetypestext);
2039: if ($env{'form.displayfilter'} eq 'containing') {
2040: $phraseinput = 'text';
2041: if ($context eq 'parmslog') {
2042: $includeinput = 'checkbox';
2043: if ($env{'form.includetypes'}) {
2044: $checked = ' checked="checked"';
2045: }
2046: $includetypestext = &mt('Include parameter types');
2047: }
2048: } else {
2049: $includetypestext = ' ';
2050: }
2051: my ($additional,$secondid,$thirdid);
2052: if ($context eq 'parmslog') {
2053: $additional =
2054: '<label><input type="'.$includeinput.'" name="includetypes"'.
2055: $checked.' name="includetypes" value="1" id="includetypes" />'.
2056: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2057: '</label>';
2058: $secondid = 'includetypes';
2059: $thirdid = 'includetypestext';
2060: }
2061: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2062: '$secondid','$thirdid')";
2063: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2064: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2065: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2066: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2067: &mt('Filter: [_1]',
1.477 www 2068: &select_form($env{'form.displayfilter'},
2069: 'displayfilter',
1.970 raeburn 2070: {'currentfolder' => 'Current folder/page',
1.477 www 2071: 'containing' => 'Containing phrase',
1.1074 raeburn 2072: 'none' => 'None'},$onchange)).' '.
2073: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2074: &HTML::Entities::encode($env{'form.containingphrase'}).
2075: '" />'.$additional;
2076: }
2077:
2078: sub display_filter_js {
2079: my $includetext = &mt('Include parameter types');
2080: return <<"ENDJS";
2081:
2082: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2083: var firstType = 'hidden';
2084: if (setter.options[setter.selectedIndex].value == 'containing') {
2085: firstType = 'text';
2086: }
2087: firstObject = document.getElementById(firstid);
2088: if (typeof(firstObject) == 'object') {
2089: if (firstObject.type != firstType) {
2090: changeInputType(firstObject,firstType);
2091: }
2092: }
2093: if (context == 'parmslog') {
2094: var secondType = 'hidden';
2095: if (firstType == 'text') {
2096: secondType = 'checkbox';
2097: }
2098: secondObject = document.getElementById(secondid);
2099: if (typeof(secondObject) == 'object') {
2100: if (secondObject.type != secondType) {
2101: changeInputType(secondObject,secondType);
2102: }
2103: }
2104: var textItem = document.getElementById(thirdid);
2105: var currtext = textItem.innerHTML;
2106: var newtext;
2107: if (firstType == 'text') {
2108: newtext = '$includetext';
2109: } else {
2110: newtext = ' ';
2111: }
2112: if (currtext != newtext) {
2113: textItem.innerHTML = newtext;
2114: }
2115: }
2116: return;
2117: }
2118:
2119: function changeInputType(oldObject,newType) {
2120: var newObject = document.createElement('input');
2121: newObject.type = newType;
2122: if (oldObject.size) {
2123: newObject.size = oldObject.size;
2124: }
2125: if (oldObject.value) {
2126: newObject.value = oldObject.value;
2127: }
2128: if (oldObject.name) {
2129: newObject.name = oldObject.name;
2130: }
2131: if (oldObject.id) {
2132: newObject.id = oldObject.id;
2133: }
2134: oldObject.parentNode.replaceChild(newObject,oldObject);
2135: return;
2136: }
2137:
2138: ENDJS
1.475 www 2139: }
2140:
1.167 www 2141: sub gradeleveldescription {
2142: my $gradelevel=shift;
2143: my %gradelevels=(0 => 'Not specified',
2144: 1 => 'Grade 1',
2145: 2 => 'Grade 2',
2146: 3 => 'Grade 3',
2147: 4 => 'Grade 4',
2148: 5 => 'Grade 5',
2149: 6 => 'Grade 6',
2150: 7 => 'Grade 7',
2151: 8 => 'Grade 8',
2152: 9 => 'Grade 9',
2153: 10 => 'Grade 10',
2154: 11 => 'Grade 11',
2155: 12 => 'Grade 12',
2156: 13 => 'Grade 13',
2157: 14 => '100 Level',
2158: 15 => '200 Level',
2159: 16 => '300 Level',
2160: 17 => '400 Level',
2161: 18 => 'Graduate Level');
2162: return &mt($gradelevels{$gradelevel});
2163: }
2164:
1.163 www 2165: sub select_level_form {
2166: my ($deflevel,$name)=@_;
2167: unless ($deflevel) { $deflevel=0; }
1.167 www 2168: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2169: for (my $i=0; $i<=18; $i++) {
2170: $selectform.="<option value=\"$i\" ".
1.253 albertel 2171: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2172: ">".&gradeleveldescription($i)."</option>\n";
2173: }
2174: $selectform.="</select>";
2175: return $selectform;
1.163 www 2176: }
1.167 www 2177:
1.35 matthew 2178: #-------------------------------------------
2179:
1.45 matthew 2180: =pod
2181:
1.1075.2.42 raeburn 2182: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2183:
2184: Returns a string containing a <select name='$name' size='1'> form to
2185: allow a user to select the domain to preform an operation in.
2186: See loncreateuser.pm for an example invocation and use.
2187:
1.90 www 2188: If the $includeempty flag is set, it also includes an empty choice ("no domain
2189: selected");
2190:
1.743 raeburn 2191: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2192:
1.910 raeburn 2193: 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.
2194:
1.1075.2.36 raeburn 2195: The optional $incdoms is a reference to an array of domains which will be the only available options.
2196:
2197: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2198:
1.35 matthew 2199: =cut
2200:
2201: #-------------------------------------------
1.34 matthew 2202: sub select_dom_form {
1.1075.2.36 raeburn 2203: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2204: if ($onchange) {
1.874 raeburn 2205: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2206: }
1.1075.2.36 raeburn 2207: my (@domains,%exclude);
1.910 raeburn 2208: if (ref($incdoms) eq 'ARRAY') {
2209: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2210: } else {
2211: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2212: }
1.90 www 2213: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2214: if (ref($excdoms) eq 'ARRAY') {
2215: map { $exclude{$_} = 1; } @{$excdoms};
2216: }
1.743 raeburn 2217: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2218: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2219: next if ($exclude{$dom});
1.356 albertel 2220: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2221: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2222: if ($showdomdesc) {
2223: if ($dom ne '') {
2224: my $domdesc = &Apache::lonnet::domain($dom,'description');
2225: if ($domdesc ne '') {
2226: $selectdomain .= ' ('.$domdesc.')';
2227: }
2228: }
2229: }
2230: $selectdomain .= "</option>\n";
1.34 matthew 2231: }
2232: $selectdomain.="</select>";
2233: return $selectdomain;
2234: }
2235:
1.35 matthew 2236: #-------------------------------------------
2237:
1.45 matthew 2238: =pod
2239:
1.648 raeburn 2240: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2241:
1.586 raeburn 2242: input: 4 arguments (two required, two optional) -
2243: $domain - domain of new user
2244: $name - name of form element
2245: $default - Value of 'default' causes a default item to be first
2246: option, and selected by default.
2247: $hide - Value of 'hide' causes hiding of the name of the server,
2248: if 1 server found, or default, if 0 found.
1.594 raeburn 2249: output: returns 2 items:
1.586 raeburn 2250: (a) form element which contains either:
2251: (i) <select name="$name">
2252: <option value="$hostid1">$hostid $servers{$hostid}</option>
2253: <option value="$hostid2">$hostid $servers{$hostid}</option>
2254: </select>
2255: form item if there are multiple library servers in $domain, or
2256: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2257: if there is only one library server in $domain.
2258:
2259: (b) number of library servers found.
2260:
2261: See loncreateuser.pm for example of use.
1.35 matthew 2262:
2263: =cut
2264:
2265: #-------------------------------------------
1.586 raeburn 2266: sub home_server_form_item {
2267: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2268: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2269: my $result;
2270: my $numlib = keys(%servers);
2271: if ($numlib > 1) {
2272: $result .= '<select name="'.$name.'" />'."\n";
2273: if ($default) {
1.804 bisitz 2274: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2275: '</option>'."\n";
2276: }
2277: foreach my $hostid (sort(keys(%servers))) {
2278: $result.= '<option value="'.$hostid.'">'.
2279: $hostid.' '.$servers{$hostid}."</option>\n";
2280: }
2281: $result .= '</select>'."\n";
2282: } elsif ($numlib == 1) {
2283: my $hostid;
2284: foreach my $item (keys(%servers)) {
2285: $hostid = $item;
2286: }
2287: $result .= '<input type="hidden" name="'.$name.'" value="'.
2288: $hostid.'" />';
2289: if (!$hide) {
2290: $result .= $hostid.' '.$servers{$hostid};
2291: }
2292: $result .= "\n";
2293: } elsif ($default) {
2294: $result .= '<input type="hidden" name="'.$name.
2295: '" value="default" />';
2296: if (!$hide) {
2297: $result .= &mt('default');
2298: }
2299: $result .= "\n";
1.33 matthew 2300: }
1.586 raeburn 2301: return ($result,$numlib);
1.33 matthew 2302: }
1.112 bowersj2 2303:
2304: =pod
2305:
1.534 albertel 2306: =back
2307:
1.112 bowersj2 2308: =cut
1.87 matthew 2309:
2310: ###############################################################
1.112 bowersj2 2311: ## Decoding User Agent ##
1.87 matthew 2312: ###############################################################
2313:
2314: =pod
2315:
1.112 bowersj2 2316: =head1 Decoding the User Agent
2317:
2318: =over 4
2319:
2320: =item * &decode_user_agent()
1.87 matthew 2321:
2322: Inputs: $r
2323:
2324: Outputs:
2325:
2326: =over 4
2327:
1.112 bowersj2 2328: =item * $httpbrowser
1.87 matthew 2329:
1.112 bowersj2 2330: =item * $clientbrowser
1.87 matthew 2331:
1.112 bowersj2 2332: =item * $clientversion
1.87 matthew 2333:
1.112 bowersj2 2334: =item * $clientmathml
1.87 matthew 2335:
1.112 bowersj2 2336: =item * $clientunicode
1.87 matthew 2337:
1.112 bowersj2 2338: =item * $clientos
1.87 matthew 2339:
1.1075.2.42 raeburn 2340: =item * $clientmobile
2341:
2342: =item * $clientinfo
2343:
1.1075.2.77 raeburn 2344: =item * $clientosversion
2345:
1.87 matthew 2346: =back
2347:
1.157 matthew 2348: =back
2349:
1.87 matthew 2350: =cut
2351:
2352: ###############################################################
2353: ###############################################################
2354: sub decode_user_agent {
1.247 albertel 2355: my ($r)=@_;
1.87 matthew 2356: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2357: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2358: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2359: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2360: my $clientbrowser='unknown';
2361: my $clientversion='0';
2362: my $clientmathml='';
2363: my $clientunicode='0';
1.1075.2.42 raeburn 2364: my $clientmobile=0;
1.1075.2.77 raeburn 2365: my $clientosversion='';
1.87 matthew 2366: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2367: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2368: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2369: $clientbrowser=$bname;
2370: $httpbrowser=~/$vreg/i;
2371: $clientversion=$1;
2372: $clientmathml=($clientversion>=$minv);
2373: $clientunicode=($clientversion>=$univ);
2374: }
2375: }
2376: my $clientos='unknown';
1.1075.2.42 raeburn 2377: my $clientinfo;
1.87 matthew 2378: if (($httpbrowser=~/linux/i) ||
2379: ($httpbrowser=~/unix/i) ||
2380: ($httpbrowser=~/ux/i) ||
2381: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2382: if (($httpbrowser=~/vax/i) ||
2383: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2384: if ($httpbrowser=~/next/i) { $clientos='next'; }
2385: if (($httpbrowser=~/mac/i) ||
2386: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2387: if ($httpbrowser=~/win/i) {
2388: $clientos='win';
2389: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2390: $clientosversion = $1;
2391: }
2392: }
1.87 matthew 2393: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2394: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2395: $clientmobile=lc($1);
2396: }
2397: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2398: $clientinfo = 'firefox-'.$1;
2399: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2400: $clientinfo = 'chromeframe-'.$1;
2401: }
1.87 matthew 2402: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2403: $clientunicode,$clientos,$clientmobile,$clientinfo,
2404: $clientosversion);
1.87 matthew 2405: }
2406:
1.32 matthew 2407: ###############################################################
2408: ## Authentication changing form generation subroutines ##
2409: ###############################################################
2410: ##
2411: ## All of the authform_xxxxxxx subroutines take their inputs in a
2412: ## hash, and have reasonable default values.
2413: ##
2414: ## formname = the name given in the <form> tag.
1.35 matthew 2415: #-------------------------------------------
2416:
1.45 matthew 2417: =pod
2418:
1.112 bowersj2 2419: =head1 Authentication Routines
2420:
2421: =over 4
2422:
1.648 raeburn 2423: =item * &authform_xxxxxx()
1.35 matthew 2424:
2425: The authform_xxxxxx subroutines provide javascript and html forms which
2426: handle some of the conveniences required for authentication forms.
2427: This is not an optimal method, but it works.
2428:
2429: =over 4
2430:
1.112 bowersj2 2431: =item * authform_header
1.35 matthew 2432:
1.112 bowersj2 2433: =item * authform_authorwarning
1.35 matthew 2434:
1.112 bowersj2 2435: =item * authform_nochange
1.35 matthew 2436:
1.112 bowersj2 2437: =item * authform_kerberos
1.35 matthew 2438:
1.112 bowersj2 2439: =item * authform_internal
1.35 matthew 2440:
1.112 bowersj2 2441: =item * authform_filesystem
1.35 matthew 2442:
2443: =back
2444:
1.648 raeburn 2445: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2446:
1.35 matthew 2447: =cut
2448:
2449: #-------------------------------------------
1.32 matthew 2450: sub authform_header{
2451: my %in = (
2452: formname => 'cu',
1.80 albertel 2453: kerb_def_dom => '',
1.32 matthew 2454: @_,
2455: );
2456: $in{'formname'} = 'document.' . $in{'formname'};
2457: my $result='';
1.80 albertel 2458:
2459: #---------------------------------------------- Code for upper case translation
2460: my $Javascript_toUpperCase;
2461: unless ($in{kerb_def_dom}) {
2462: $Javascript_toUpperCase =<<"END";
2463: switch (choice) {
2464: case 'krb': currentform.elements[choicearg].value =
2465: currentform.elements[choicearg].value.toUpperCase();
2466: break;
2467: default:
2468: }
2469: END
2470: } else {
2471: $Javascript_toUpperCase = "";
2472: }
2473:
1.165 raeburn 2474: my $radioval = "'nochange'";
1.591 raeburn 2475: if (defined($in{'curr_authtype'})) {
2476: if ($in{'curr_authtype'} ne '') {
2477: $radioval = "'".$in{'curr_authtype'}."arg'";
2478: }
1.174 matthew 2479: }
1.165 raeburn 2480: my $argfield = 'null';
1.591 raeburn 2481: if (defined($in{'mode'})) {
1.165 raeburn 2482: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2483: if (defined($in{'curr_autharg'})) {
2484: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2485: $argfield = "'$in{'curr_autharg'}'";
2486: }
2487: }
2488: }
2489: }
2490:
1.32 matthew 2491: $result.=<<"END";
2492: var current = new Object();
1.165 raeburn 2493: current.radiovalue = $radioval;
2494: current.argfield = $argfield;
1.32 matthew 2495:
2496: function changed_radio(choice,currentform) {
2497: var choicearg = choice + 'arg';
2498: // If a radio button in changed, we need to change the argfield
2499: if (current.radiovalue != choice) {
2500: current.radiovalue = choice;
2501: if (current.argfield != null) {
2502: currentform.elements[current.argfield].value = '';
2503: }
2504: if (choice == 'nochange') {
2505: current.argfield = null;
2506: } else {
2507: current.argfield = choicearg;
2508: switch(choice) {
2509: case 'krb':
2510: currentform.elements[current.argfield].value =
2511: "$in{'kerb_def_dom'}";
2512: break;
2513: default:
2514: break;
2515: }
2516: }
2517: }
2518: return;
2519: }
1.22 www 2520:
1.32 matthew 2521: function changed_text(choice,currentform) {
2522: var choicearg = choice + 'arg';
2523: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2524: $Javascript_toUpperCase
1.32 matthew 2525: // clear old field
2526: if ((current.argfield != choicearg) && (current.argfield != null)) {
2527: currentform.elements[current.argfield].value = '';
2528: }
2529: current.argfield = choicearg;
2530: }
2531: set_auth_radio_buttons(choice,currentform);
2532: return;
1.20 www 2533: }
1.32 matthew 2534:
2535: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2536: var numauthchoices = currentform.login.length;
2537: if (typeof numauthchoices == "undefined") {
2538: return;
2539: }
1.32 matthew 2540: var i=0;
1.986 raeburn 2541: while (i < numauthchoices) {
1.32 matthew 2542: if (currentform.login[i].value == newvalue) { break; }
2543: i++;
2544: }
1.986 raeburn 2545: if (i == numauthchoices) {
1.32 matthew 2546: return;
2547: }
2548: current.radiovalue = newvalue;
2549: currentform.login[i].checked = true;
2550: return;
2551: }
2552: END
2553: return $result;
2554: }
2555:
1.1075.2.20 raeburn 2556: sub authform_authorwarning {
1.32 matthew 2557: my $result='';
1.144 matthew 2558: $result='<i>'.
2559: &mt('As a general rule, only authors or co-authors should be '.
2560: 'filesystem authenticated '.
2561: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2562: return $result;
2563: }
2564:
1.1075.2.20 raeburn 2565: sub authform_nochange {
1.32 matthew 2566: my %in = (
2567: formname => 'document.cu',
2568: kerb_def_dom => 'MSU.EDU',
2569: @_,
2570: );
1.1075.2.20 raeburn 2571: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2572: my $result;
1.1075.2.20 raeburn 2573: if (!$authnum) {
2574: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2575: } else {
2576: $result = '<label>'.&mt('[_1] Do not change login data',
2577: '<input type="radio" name="login" value="nochange" '.
2578: 'checked="checked" onclick="'.
1.281 albertel 2579: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2580: '</label>';
1.586 raeburn 2581: }
1.32 matthew 2582: return $result;
2583: }
2584:
1.591 raeburn 2585: sub authform_kerberos {
1.32 matthew 2586: my %in = (
2587: formname => 'document.cu',
2588: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2589: kerb_def_auth => 'krb4',
1.32 matthew 2590: @_,
2591: );
1.586 raeburn 2592: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2593: $autharg,$jscall);
1.1075.2.20 raeburn 2594: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2595: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2596: $check5 = ' checked="checked"';
1.80 albertel 2597: } else {
1.772 bisitz 2598: $check4 = ' checked="checked"';
1.80 albertel 2599: }
1.165 raeburn 2600: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2601: if (defined($in{'curr_authtype'})) {
2602: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2603: $krbcheck = ' checked="checked"';
1.623 raeburn 2604: if (defined($in{'mode'})) {
2605: if ($in{'mode'} eq 'modifyuser') {
2606: $krbcheck = '';
2607: }
2608: }
1.591 raeburn 2609: if (defined($in{'curr_kerb_ver'})) {
2610: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2611: $check5 = ' checked="checked"';
1.591 raeburn 2612: $check4 = '';
2613: } else {
1.772 bisitz 2614: $check4 = ' checked="checked"';
1.591 raeburn 2615: $check5 = '';
2616: }
1.586 raeburn 2617: }
1.591 raeburn 2618: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2619: $krbarg = $in{'curr_autharg'};
2620: }
1.586 raeburn 2621: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2622: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2623: $result =
2624: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2625: $in{'curr_autharg'},$krbver);
2626: } else {
2627: $result =
2628: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2629: }
2630: return $result;
2631: }
2632: }
2633: } else {
2634: if ($authnum == 1) {
1.784 bisitz 2635: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2636: }
2637: }
1.586 raeburn 2638: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2639: return;
1.587 raeburn 2640: } elsif ($authtype eq '') {
1.591 raeburn 2641: if (defined($in{'mode'})) {
1.587 raeburn 2642: if ($in{'mode'} eq 'modifycourse') {
2643: if ($authnum == 1) {
1.1075.2.20 raeburn 2644: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2645: }
2646: }
2647: }
1.586 raeburn 2648: }
2649: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2650: if ($authtype eq '') {
2651: $authtype = '<input type="radio" name="login" value="krb" '.
2652: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2653: $krbcheck.' />';
2654: }
2655: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2656: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2657: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2658: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2659: $in{'curr_authtype'} eq 'krb4')) {
2660: $result .= &mt
1.144 matthew 2661: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2662: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2663: '<label>'.$authtype,
1.281 albertel 2664: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2665: 'value="'.$krbarg.'" '.
1.144 matthew 2666: 'onchange="'.$jscall.'" />',
1.281 albertel 2667: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2668: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2669: '</label>');
1.586 raeburn 2670: } elsif ($can_assign{'krb4'}) {
2671: $result .= &mt
2672: ('[_1] Kerberos authenticated with domain [_2] '.
2673: '[_3] Version 4 [_4]',
2674: '<label>'.$authtype,
2675: '</label><input type="text" size="10" name="krbarg" '.
2676: 'value="'.$krbarg.'" '.
2677: 'onchange="'.$jscall.'" />',
2678: '<label><input type="hidden" name="krbver" value="4" />',
2679: '</label>');
2680: } elsif ($can_assign{'krb5'}) {
2681: $result .= &mt
2682: ('[_1] Kerberos authenticated with domain [_2] '.
2683: '[_3] Version 5 [_4]',
2684: '<label>'.$authtype,
2685: '</label><input type="text" size="10" name="krbarg" '.
2686: 'value="'.$krbarg.'" '.
2687: 'onchange="'.$jscall.'" />',
2688: '<label><input type="hidden" name="krbver" value="5" />',
2689: '</label>');
2690: }
1.32 matthew 2691: return $result;
2692: }
2693:
1.1075.2.20 raeburn 2694: sub authform_internal {
1.586 raeburn 2695: my %in = (
1.32 matthew 2696: formname => 'document.cu',
2697: kerb_def_dom => 'MSU.EDU',
2698: @_,
2699: );
1.586 raeburn 2700: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2701: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2702: if (defined($in{'curr_authtype'})) {
2703: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2704: if ($can_assign{'int'}) {
1.772 bisitz 2705: $intcheck = 'checked="checked" ';
1.623 raeburn 2706: if (defined($in{'mode'})) {
2707: if ($in{'mode'} eq 'modifyuser') {
2708: $intcheck = '';
2709: }
2710: }
1.591 raeburn 2711: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2712: $intarg = $in{'curr_autharg'};
2713: }
2714: } else {
2715: $result = &mt('Currently internally authenticated.');
2716: return $result;
1.165 raeburn 2717: }
2718: }
1.586 raeburn 2719: } else {
2720: if ($authnum == 1) {
1.784 bisitz 2721: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2722: }
2723: }
2724: if (!$can_assign{'int'}) {
2725: return;
1.587 raeburn 2726: } elsif ($authtype eq '') {
1.591 raeburn 2727: if (defined($in{'mode'})) {
1.587 raeburn 2728: if ($in{'mode'} eq 'modifycourse') {
2729: if ($authnum == 1) {
1.1075.2.20 raeburn 2730: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2731: }
2732: }
2733: }
1.165 raeburn 2734: }
1.586 raeburn 2735: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2736: if ($authtype eq '') {
2737: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2738: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2739: }
1.605 bisitz 2740: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2741: $intarg.'" onchange="'.$jscall.'" />';
2742: $result = &mt
1.144 matthew 2743: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2744: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2745: $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32 matthew 2746: return $result;
2747: }
2748:
1.1075.2.20 raeburn 2749: sub authform_local {
1.32 matthew 2750: my %in = (
2751: formname => 'document.cu',
2752: kerb_def_dom => 'MSU.EDU',
2753: @_,
2754: );
1.586 raeburn 2755: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2756: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2757: if (defined($in{'curr_authtype'})) {
2758: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2759: if ($can_assign{'loc'}) {
1.772 bisitz 2760: $loccheck = 'checked="checked" ';
1.623 raeburn 2761: if (defined($in{'mode'})) {
2762: if ($in{'mode'} eq 'modifyuser') {
2763: $loccheck = '';
2764: }
2765: }
1.591 raeburn 2766: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2767: $locarg = $in{'curr_autharg'};
2768: }
2769: } else {
2770: $result = &mt('Currently using local (institutional) authentication.');
2771: return $result;
1.165 raeburn 2772: }
2773: }
1.586 raeburn 2774: } else {
2775: if ($authnum == 1) {
1.784 bisitz 2776: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2777: }
2778: }
2779: if (!$can_assign{'loc'}) {
2780: return;
1.587 raeburn 2781: } elsif ($authtype eq '') {
1.591 raeburn 2782: if (defined($in{'mode'})) {
1.587 raeburn 2783: if ($in{'mode'} eq 'modifycourse') {
2784: if ($authnum == 1) {
1.1075.2.20 raeburn 2785: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2786: }
2787: }
2788: }
1.165 raeburn 2789: }
1.586 raeburn 2790: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2791: if ($authtype eq '') {
2792: $authtype = '<input type="radio" name="login" value="loc" '.
2793: $loccheck.' onchange="'.$jscall.'" onclick="'.
2794: $jscall.'" />';
2795: }
2796: $autharg = '<input type="text" size="10" name="locarg" value="'.
2797: $locarg.'" onchange="'.$jscall.'" />';
2798: $result = &mt('[_1] Local Authentication with argument [_2]',
2799: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2800: return $result;
2801: }
2802:
1.1075.2.20 raeburn 2803: sub authform_filesystem {
1.32 matthew 2804: my %in = (
2805: formname => 'document.cu',
2806: kerb_def_dom => 'MSU.EDU',
2807: @_,
2808: );
1.586 raeburn 2809: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2810: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2811: if (defined($in{'curr_authtype'})) {
2812: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2813: if ($can_assign{'fsys'}) {
1.772 bisitz 2814: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2815: if (defined($in{'mode'})) {
2816: if ($in{'mode'} eq 'modifyuser') {
2817: $fsyscheck = '';
2818: }
2819: }
1.586 raeburn 2820: } else {
2821: $result = &mt('Currently Filesystem Authenticated.');
2822: return $result;
2823: }
2824: }
2825: } else {
2826: if ($authnum == 1) {
1.784 bisitz 2827: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2828: }
2829: }
2830: if (!$can_assign{'fsys'}) {
2831: return;
1.587 raeburn 2832: } elsif ($authtype eq '') {
1.591 raeburn 2833: if (defined($in{'mode'})) {
1.587 raeburn 2834: if ($in{'mode'} eq 'modifycourse') {
2835: if ($authnum == 1) {
1.1075.2.20 raeburn 2836: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2837: }
2838: }
2839: }
1.586 raeburn 2840: }
2841: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2842: if ($authtype eq '') {
2843: $authtype = '<input type="radio" name="login" value="fsys" '.
2844: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2845: $jscall.'" />';
2846: }
2847: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2848: ' onchange="'.$jscall.'" />';
2849: $result = &mt
1.144 matthew 2850: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2851: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2852: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2853: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2854: 'onchange="'.$jscall.'" />');
1.32 matthew 2855: return $result;
2856: }
2857:
1.586 raeburn 2858: sub get_assignable_auth {
2859: my ($dom) = @_;
2860: if ($dom eq '') {
2861: $dom = $env{'request.role.domain'};
2862: }
2863: my %can_assign = (
2864: krb4 => 1,
2865: krb5 => 1,
2866: int => 1,
2867: loc => 1,
2868: );
2869: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2870: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2871: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2872: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2873: my $context;
2874: if ($env{'request.role'} =~ /^au/) {
2875: $context = 'author';
2876: } elsif ($env{'request.role'} =~ /^dc/) {
2877: $context = 'domain';
2878: } elsif ($env{'request.course.id'}) {
2879: $context = 'course';
2880: }
2881: if ($context) {
2882: if (ref($authhash->{$context}) eq 'HASH') {
2883: %can_assign = %{$authhash->{$context}};
2884: }
2885: }
2886: }
2887: }
2888: my $authnum = 0;
2889: foreach my $key (keys(%can_assign)) {
2890: if ($can_assign{$key}) {
2891: $authnum ++;
2892: }
2893: }
2894: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2895: $authnum --;
2896: }
2897: return ($authnum,%can_assign);
2898: }
2899:
1.80 albertel 2900: ###############################################################
2901: ## Get Kerberos Defaults for Domain ##
2902: ###############################################################
2903: ##
2904: ## Returns default kerberos version and an associated argument
2905: ## as listed in file domain.tab. If not listed, provides
2906: ## appropriate default domain and kerberos version.
2907: ##
2908: #-------------------------------------------
2909:
2910: =pod
2911:
1.648 raeburn 2912: =item * &get_kerberos_defaults()
1.80 albertel 2913:
2914: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2915: version and domain. If not found, it defaults to version 4 and the
2916: domain of the server.
1.80 albertel 2917:
1.648 raeburn 2918: =over 4
2919:
1.80 albertel 2920: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2921:
1.648 raeburn 2922: =back
2923:
2924: =back
2925:
1.80 albertel 2926: =cut
2927:
2928: #-------------------------------------------
2929: sub get_kerberos_defaults {
2930: my $domain=shift;
1.641 raeburn 2931: my ($krbdef,$krbdefdom);
2932: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2933: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2934: $krbdef = $domdefaults{'auth_def'};
2935: $krbdefdom = $domdefaults{'auth_arg_def'};
2936: } else {
1.80 albertel 2937: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2938: my $krbdefdom=$1;
2939: $krbdefdom=~tr/a-z/A-Z/;
2940: $krbdef = "krb4";
2941: }
2942: return ($krbdef,$krbdefdom);
2943: }
1.112 bowersj2 2944:
1.32 matthew 2945:
1.46 matthew 2946: ###############################################################
2947: ## Thesaurus Functions ##
2948: ###############################################################
1.20 www 2949:
1.46 matthew 2950: =pod
1.20 www 2951:
1.112 bowersj2 2952: =head1 Thesaurus Functions
2953:
2954: =over 4
2955:
1.648 raeburn 2956: =item * &initialize_keywords()
1.46 matthew 2957:
2958: Initializes the package variable %Keywords if it is empty. Uses the
2959: package variable $thesaurus_db_file.
2960:
2961: =cut
2962:
2963: ###################################################
2964:
2965: sub initialize_keywords {
2966: return 1 if (scalar keys(%Keywords));
2967: # If we are here, %Keywords is empty, so fill it up
2968: # Make sure the file we need exists...
2969: if (! -e $thesaurus_db_file) {
2970: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2971: " failed because it does not exist");
2972: return 0;
2973: }
2974: # Set up the hash as a database
2975: my %thesaurus_db;
2976: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2977: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2978: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2979: $thesaurus_db_file);
2980: return 0;
2981: }
2982: # Get the average number of appearances of a word.
2983: my $avecount = $thesaurus_db{'average.count'};
2984: # Put keywords (those that appear > average) into %Keywords
2985: while (my ($word,$data)=each (%thesaurus_db)) {
2986: my ($count,undef) = split /:/,$data;
2987: $Keywords{$word}++ if ($count > $avecount);
2988: }
2989: untie %thesaurus_db;
2990: # Remove special values from %Keywords.
1.356 albertel 2991: foreach my $value ('total.count','average.count') {
2992: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2993: }
1.46 matthew 2994: return 1;
2995: }
2996:
2997: ###################################################
2998:
2999: =pod
3000:
1.648 raeburn 3001: =item * &keyword($word)
1.46 matthew 3002:
3003: Returns true if $word is a keyword. A keyword is a word that appears more
3004: than the average number of times in the thesaurus database. Calls
3005: &initialize_keywords
3006:
3007: =cut
3008:
3009: ###################################################
1.20 www 3010:
3011: sub keyword {
1.46 matthew 3012: return if (!&initialize_keywords());
3013: my $word=lc(shift());
3014: $word=~s/\W//g;
3015: return exists($Keywords{$word});
1.20 www 3016: }
1.46 matthew 3017:
3018: ###############################################################
3019:
3020: =pod
1.20 www 3021:
1.648 raeburn 3022: =item * &get_related_words()
1.46 matthew 3023:
1.160 matthew 3024: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3025: an array of words. If the keyword is not in the thesaurus, an empty array
3026: will be returned. The order of the words returned is determined by the
3027: database which holds them.
3028:
3029: Uses global $thesaurus_db_file.
3030:
1.1057 foxr 3031:
1.46 matthew 3032: =cut
3033:
3034: ###############################################################
3035: sub get_related_words {
3036: my $keyword = shift;
3037: my %thesaurus_db;
3038: if (! -e $thesaurus_db_file) {
3039: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3040: "failed because the file does not exist");
3041: return ();
3042: }
3043: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3044: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3045: return ();
3046: }
3047: my @Words=();
1.429 www 3048: my $count=0;
1.46 matthew 3049: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3050: # The first element is the number of times
3051: # the word appears. We do not need it now.
1.429 www 3052: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3053: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3054: my $threshold=$mostfrequentcount/10;
3055: foreach my $possibleword (@RelatedWords) {
3056: my ($word,$wordcount)=split(/\,/,$possibleword);
3057: if ($wordcount>$threshold) {
3058: push(@Words,$word);
3059: $count++;
3060: if ($count>10) { last; }
3061: }
1.20 www 3062: }
3063: }
1.46 matthew 3064: untie %thesaurus_db;
3065: return @Words;
1.14 harris41 3066: }
1.46 matthew 3067:
1.112 bowersj2 3068: =pod
3069:
3070: =back
3071:
3072: =cut
1.61 www 3073:
3074: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3075: =pod
3076:
1.112 bowersj2 3077: =head1 User Name Functions
3078:
3079: =over 4
3080:
1.648 raeburn 3081: =item * &plainname($uname,$udom,$first)
1.81 albertel 3082:
1.112 bowersj2 3083: Takes a users logon name and returns it as a string in
1.226 albertel 3084: "first middle last generation" form
3085: if $first is set to 'lastname' then it returns it as
3086: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3087:
3088: =cut
1.61 www 3089:
1.295 www 3090:
1.81 albertel 3091: ###############################################################
1.61 www 3092: sub plainname {
1.226 albertel 3093: my ($uname,$udom,$first)=@_;
1.537 albertel 3094: return if (!defined($uname) || !defined($udom));
1.295 www 3095: my %names=&getnames($uname,$udom);
1.226 albertel 3096: my $name=&Apache::lonnet::format_name($names{'firstname'},
3097: $names{'middlename'},
3098: $names{'lastname'},
3099: $names{'generation'},$first);
3100: $name=~s/^\s+//;
1.62 www 3101: $name=~s/\s+$//;
3102: $name=~s/\s+/ /g;
1.353 albertel 3103: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3104: return $name;
1.61 www 3105: }
1.66 www 3106:
3107: # -------------------------------------------------------------------- Nickname
1.81 albertel 3108: =pod
3109:
1.648 raeburn 3110: =item * &nickname($uname,$udom)
1.81 albertel 3111:
3112: Gets a users name and returns it as a string as
3113:
3114: ""nickname""
1.66 www 3115:
1.81 albertel 3116: if the user has a nickname or
3117:
3118: "first middle last generation"
3119:
3120: if the user does not
3121:
3122: =cut
1.66 www 3123:
3124: sub nickname {
3125: my ($uname,$udom)=@_;
1.537 albertel 3126: return if (!defined($uname) || !defined($udom));
1.295 www 3127: my %names=&getnames($uname,$udom);
1.68 albertel 3128: my $name=$names{'nickname'};
1.66 www 3129: if ($name) {
3130: $name='"'.$name.'"';
3131: } else {
3132: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3133: $names{'lastname'}.' '.$names{'generation'};
3134: $name=~s/\s+$//;
3135: $name=~s/\s+/ /g;
3136: }
3137: return $name;
3138: }
3139:
1.295 www 3140: sub getnames {
3141: my ($uname,$udom)=@_;
1.537 albertel 3142: return if (!defined($uname) || !defined($udom));
1.433 albertel 3143: if ($udom eq 'public' && $uname eq 'public') {
3144: return ('lastname' => &mt('Public'));
3145: }
1.295 www 3146: my $id=$uname.':'.$udom;
3147: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3148: if ($cached) {
3149: return %{$names};
3150: } else {
3151: my %loadnames=&Apache::lonnet::get('environment',
3152: ['firstname','middlename','lastname','generation','nickname'],
3153: $udom,$uname);
3154: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3155: return %loadnames;
3156: }
3157: }
1.61 www 3158:
1.542 raeburn 3159: # -------------------------------------------------------------------- getemails
1.648 raeburn 3160:
1.542 raeburn 3161: =pod
3162:
1.648 raeburn 3163: =item * &getemails($uname,$udom)
1.542 raeburn 3164:
3165: Gets a user's email information and returns it as a hash with keys:
3166: notification, critnotification, permanentemail
3167:
3168: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3169: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3170:
1.648 raeburn 3171:
1.542 raeburn 3172: =cut
3173:
1.648 raeburn 3174:
1.466 albertel 3175: sub getemails {
3176: my ($uname,$udom)=@_;
3177: if ($udom eq 'public' && $uname eq 'public') {
3178: return;
3179: }
1.467 www 3180: if (!$udom) { $udom=$env{'user.domain'}; }
3181: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3182: my $id=$uname.':'.$udom;
3183: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3184: if ($cached) {
3185: return %{$names};
3186: } else {
3187: my %loadnames=&Apache::lonnet::get('environment',
3188: ['notification','critnotification',
3189: 'permanentemail'],
3190: $udom,$uname);
3191: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3192: return %loadnames;
3193: }
3194: }
3195:
1.551 albertel 3196: sub flush_email_cache {
3197: my ($uname,$udom)=@_;
3198: if (!$udom) { $udom =$env{'user.domain'}; }
3199: if (!$uname) { $uname=$env{'user.name'}; }
3200: return if ($udom eq 'public' && $uname eq 'public');
3201: my $id=$uname.':'.$udom;
3202: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3203: }
3204:
1.728 raeburn 3205: # -------------------------------------------------------------------- getlangs
3206:
3207: =pod
3208:
3209: =item * &getlangs($uname,$udom)
3210:
3211: Gets a user's language preference and returns it as a hash with key:
3212: language.
3213:
3214: =cut
3215:
3216:
3217: sub getlangs {
3218: my ($uname,$udom) = @_;
3219: if (!$udom) { $udom =$env{'user.domain'}; }
3220: if (!$uname) { $uname=$env{'user.name'}; }
3221: my $id=$uname.':'.$udom;
3222: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3223: if ($cached) {
3224: return %{$langs};
3225: } else {
3226: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3227: $udom,$uname);
3228: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3229: return %loadlangs;
3230: }
3231: }
3232:
3233: sub flush_langs_cache {
3234: my ($uname,$udom)=@_;
3235: if (!$udom) { $udom =$env{'user.domain'}; }
3236: if (!$uname) { $uname=$env{'user.name'}; }
3237: return if ($udom eq 'public' && $uname eq 'public');
3238: my $id=$uname.':'.$udom;
3239: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3240: }
3241:
1.61 www 3242: # ------------------------------------------------------------------ Screenname
1.81 albertel 3243:
3244: =pod
3245:
1.648 raeburn 3246: =item * &screenname($uname,$udom)
1.81 albertel 3247:
3248: Gets a users screenname and returns it as a string
3249:
3250: =cut
1.61 www 3251:
3252: sub screenname {
3253: my ($uname,$udom)=@_;
1.258 albertel 3254: if ($uname eq $env{'user.name'} &&
3255: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3256: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3257: return $names{'screenname'};
1.62 www 3258: }
3259:
1.212 albertel 3260:
1.802 bisitz 3261: # ------------------------------------------------------------- Confirm Wrapper
3262: =pod
3263:
1.1075.2.42 raeburn 3264: =item * &confirmwrapper($message)
1.802 bisitz 3265:
3266: Wrap messages about completion of operation in box
3267:
3268: =cut
3269:
3270: sub confirmwrapper {
3271: my ($message)=@_;
3272: if ($message) {
3273: return "\n".'<div class="LC_confirm_box">'."\n"
3274: .$message."\n"
3275: .'</div>'."\n";
3276: } else {
3277: return $message;
3278: }
3279: }
3280:
1.62 www 3281: # ------------------------------------------------------------- Message Wrapper
3282:
3283: sub messagewrapper {
1.369 www 3284: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3285: return
1.441 albertel 3286: '<a href="/adm/email?compose=individual&'.
3287: 'recname='.$username.'&recdom='.$domain.
3288: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3289: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3290: }
1.802 bisitz 3291:
1.74 www 3292: # --------------------------------------------------------------- Notes Wrapper
3293:
3294: sub noteswrapper {
3295: my ($link,$un,$do)=@_;
3296: return
1.896 amueller 3297: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3298: }
1.802 bisitz 3299:
1.62 www 3300: # ------------------------------------------------------------- Aboutme Wrapper
3301:
3302: sub aboutmewrapper {
1.1070 raeburn 3303: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3304: if (!defined($username) && !defined($domain)) {
3305: return;
3306: }
1.1075.2.15 raeburn 3307: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3308: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3309: }
3310:
3311: # ------------------------------------------------------------ Syllabus Wrapper
3312:
3313: sub syllabuswrapper {
1.707 bisitz 3314: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3315: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3316: }
1.14 harris41 3317:
1.802 bisitz 3318: # -----------------------------------------------------------------------------
3319:
1.208 matthew 3320: sub track_student_link {
1.887 raeburn 3321: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3322: my $link ="/adm/trackstudent?";
1.208 matthew 3323: my $title = 'View recent activity';
3324: if (defined($sname) && $sname !~ /^\s*$/ &&
3325: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3326: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3327: $title .= ' of this student';
1.268 albertel 3328: }
1.208 matthew 3329: if (defined($target) && $target !~ /^\s*$/) {
3330: $target = qq{target="$target"};
3331: } else {
3332: $target = '';
3333: }
1.268 albertel 3334: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3335: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3336: $title = &mt($title);
3337: $linktext = &mt($linktext);
1.448 albertel 3338: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3339: &help_open_topic('View_recent_activity');
1.208 matthew 3340: }
3341:
1.781 raeburn 3342: sub slot_reservations_link {
3343: my ($linktext,$sname,$sdom,$target) = @_;
3344: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3345: my $title = 'View slot reservation history';
3346: if (defined($sname) && $sname !~ /^\s*$/ &&
3347: defined($sdom) && $sdom !~ /^\s*$/) {
3348: $link .= "&uname=$sname&udom=$sdom";
3349: $title .= ' of this student';
3350: }
3351: if (defined($target) && $target !~ /^\s*$/) {
3352: $target = qq{target="$target"};
3353: } else {
3354: $target = '';
3355: }
3356: $title = &mt($title);
3357: $linktext = &mt($linktext);
3358: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3359: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3360:
3361: }
3362:
1.508 www 3363: # ===================================================== Display a student photo
3364:
3365:
1.509 albertel 3366: sub student_image_tag {
1.508 www 3367: my ($domain,$user)=@_;
3368: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3369: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3370: return '<img src="'.$imgsrc.'" align="right" />';
3371: } else {
3372: return '';
3373: }
3374: }
3375:
1.112 bowersj2 3376: =pod
3377:
3378: =back
3379:
3380: =head1 Access .tab File Data
3381:
3382: =over 4
3383:
1.648 raeburn 3384: =item * &languageids()
1.112 bowersj2 3385:
3386: returns list of all language ids
3387:
3388: =cut
3389:
1.14 harris41 3390: sub languageids {
1.16 harris41 3391: return sort(keys(%language));
1.14 harris41 3392: }
3393:
1.112 bowersj2 3394: =pod
3395:
1.648 raeburn 3396: =item * &languagedescription()
1.112 bowersj2 3397:
3398: returns description of a specified language id
3399:
3400: =cut
3401:
1.14 harris41 3402: sub languagedescription {
1.125 www 3403: my $code=shift;
3404: return ($supported_language{$code}?'* ':'').
3405: $language{$code}.
1.126 www 3406: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3407: }
3408:
1.1048 foxr 3409: =pod
3410:
3411: =item * &plainlanguagedescription
3412:
3413: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3414: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3415:
3416: =cut
3417:
1.145 www 3418: sub plainlanguagedescription {
3419: my $code=shift;
3420: return $language{$code};
3421: }
3422:
1.1048 foxr 3423: =pod
3424:
3425: =item * &supportedlanguagecode
3426:
3427: Returns the supported language code (e.g. sptutf maps to pt) given a language
3428: code.
3429:
3430: =cut
3431:
1.145 www 3432: sub supportedlanguagecode {
3433: my $code=shift;
3434: return $supported_language{$code};
1.97 www 3435: }
3436:
1.112 bowersj2 3437: =pod
3438:
1.1048 foxr 3439: =item * &latexlanguage()
3440:
3441: Given a language key code returns the correspondnig language to use
3442: to select the correct hyphenation on LaTeX printouts. This is undef if there
3443: is no supported hyphenation for the language code.
3444:
3445: =cut
3446:
3447: sub latexlanguage {
3448: my $code = shift;
3449: return $latex_language{$code};
3450: }
3451:
3452: =pod
3453:
3454: =item * &latexhyphenation()
3455:
3456: Same as above but what's supplied is the language as it might be stored
3457: in the metadata.
3458:
3459: =cut
3460:
3461: sub latexhyphenation {
3462: my $key = shift;
3463: return $latex_language_bykey{$key};
3464: }
3465:
3466: =pod
3467:
1.648 raeburn 3468: =item * ©rightids()
1.112 bowersj2 3469:
3470: returns list of all copyrights
3471:
3472: =cut
3473:
3474: sub copyrightids {
3475: return sort(keys(%cprtag));
3476: }
3477:
3478: =pod
3479:
1.648 raeburn 3480: =item * ©rightdescription()
1.112 bowersj2 3481:
3482: returns description of a specified copyright id
3483:
3484: =cut
3485:
3486: sub copyrightdescription {
1.166 www 3487: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3488: }
1.197 matthew 3489:
3490: =pod
3491:
1.648 raeburn 3492: =item * &source_copyrightids()
1.192 taceyjo1 3493:
3494: returns list of all source copyrights
3495:
3496: =cut
3497:
3498: sub source_copyrightids {
3499: return sort(keys(%scprtag));
3500: }
3501:
3502: =pod
3503:
1.648 raeburn 3504: =item * &source_copyrightdescription()
1.192 taceyjo1 3505:
3506: returns description of a specified source copyright id
3507:
3508: =cut
3509:
3510: sub source_copyrightdescription {
3511: return &mt($scprtag{shift(@_)});
3512: }
1.112 bowersj2 3513:
3514: =pod
3515:
1.648 raeburn 3516: =item * &filecategories()
1.112 bowersj2 3517:
3518: returns list of all file categories
3519:
3520: =cut
3521:
3522: sub filecategories {
3523: return sort(keys(%category_extensions));
3524: }
3525:
3526: =pod
3527:
1.648 raeburn 3528: =item * &filecategorytypes()
1.112 bowersj2 3529:
3530: returns list of file types belonging to a given file
3531: category
3532:
3533: =cut
3534:
3535: sub filecategorytypes {
1.356 albertel 3536: my ($cat) = @_;
3537: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3538: }
3539:
3540: =pod
3541:
1.648 raeburn 3542: =item * &fileembstyle()
1.112 bowersj2 3543:
3544: returns embedding style for a specified file type
3545:
3546: =cut
3547:
3548: sub fileembstyle {
3549: return $fe{lc(shift(@_))};
1.169 www 3550: }
3551:
1.351 www 3552: sub filemimetype {
3553: return $fm{lc(shift(@_))};
3554: }
3555:
1.169 www 3556:
3557: sub filecategoryselect {
3558: my ($name,$value)=@_;
1.189 matthew 3559: return &select_form($value,$name,
1.970 raeburn 3560: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3561: }
3562:
3563: =pod
3564:
1.648 raeburn 3565: =item * &filedescription()
1.112 bowersj2 3566:
3567: returns description for a specified file type
3568:
3569: =cut
3570:
3571: sub filedescription {
1.188 matthew 3572: my $file_description = $fd{lc(shift())};
3573: $file_description =~ s:([\[\]]):~$1:g;
3574: return &mt($file_description);
1.112 bowersj2 3575: }
3576:
3577: =pod
3578:
1.648 raeburn 3579: =item * &filedescriptionex()
1.112 bowersj2 3580:
3581: returns description for a specified file type with
3582: extra formatting
3583:
3584: =cut
3585:
3586: sub filedescriptionex {
3587: my $ex=shift;
1.188 matthew 3588: my $file_description = $fd{lc($ex)};
3589: $file_description =~ s:([\[\]]):~$1:g;
3590: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3591: }
3592:
3593: # End of .tab access
3594: =pod
3595:
3596: =back
3597:
3598: =cut
3599:
3600: # ------------------------------------------------------------------ File Types
3601: sub fileextensions {
3602: return sort(keys(%fe));
3603: }
3604:
1.97 www 3605: # ----------------------------------------------------------- Display Languages
3606: # returns a hash with all desired display languages
3607: #
3608:
3609: sub display_languages {
3610: my %languages=();
1.695 raeburn 3611: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3612: $languages{$lang}=1;
1.97 www 3613: }
3614: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3615: if ($env{'form.displaylanguage'}) {
1.356 albertel 3616: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3617: $languages{$lang}=1;
1.97 www 3618: }
3619: }
3620: return %languages;
1.14 harris41 3621: }
3622:
1.582 albertel 3623: sub languages {
3624: my ($possible_langs) = @_;
1.695 raeburn 3625: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3626: if (!ref($possible_langs)) {
3627: if( wantarray ) {
3628: return @preferred_langs;
3629: } else {
3630: return $preferred_langs[0];
3631: }
3632: }
3633: my %possibilities = map { $_ => 1 } (@$possible_langs);
3634: my @preferred_possibilities;
3635: foreach my $preferred_lang (@preferred_langs) {
3636: if (exists($possibilities{$preferred_lang})) {
3637: push(@preferred_possibilities, $preferred_lang);
3638: }
3639: }
3640: if( wantarray ) {
3641: return @preferred_possibilities;
3642: }
3643: return $preferred_possibilities[0];
3644: }
3645:
1.742 raeburn 3646: sub user_lang {
3647: my ($touname,$toudom,$fromcid) = @_;
3648: my @userlangs;
3649: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3650: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3651: $env{'course.'.$fromcid.'.languages'}));
3652: } else {
3653: my %langhash = &getlangs($touname,$toudom);
3654: if ($langhash{'languages'} ne '') {
3655: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3656: } else {
3657: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3658: if ($domdefs{'lang_def'} ne '') {
3659: @userlangs = ($domdefs{'lang_def'});
3660: }
3661: }
3662: }
3663: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3664: my $user_lh = Apache::localize->get_handle(@languages);
3665: return $user_lh;
3666: }
3667:
3668:
1.112 bowersj2 3669: ###############################################################
3670: ## Student Answer Attempts ##
3671: ###############################################################
3672:
3673: =pod
3674:
3675: =head1 Alternate Problem Views
3676:
3677: =over 4
3678:
1.648 raeburn 3679: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 3680: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3681:
3682: Return string with previous attempt on problem. Arguments:
3683:
3684: =over 4
3685:
3686: =item * $symb: Problem, including path
3687:
3688: =item * $username: username of the desired student
3689:
3690: =item * $domain: domain of the desired student
1.14 harris41 3691:
1.112 bowersj2 3692: =item * $course: Course ID
1.14 harris41 3693:
1.112 bowersj2 3694: =item * $getattempt: Leave blank for all attempts, otherwise put
3695: something
1.14 harris41 3696:
1.112 bowersj2 3697: =item * $regexp: if string matches this regexp, the string will be
3698: sent to $gradesub
1.14 harris41 3699:
1.112 bowersj2 3700: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3701:
1.1075.2.86 raeburn 3702: =item * $usec: section of the desired student
3703:
3704: =item * $identifier: counter for student (multiple students one problem) or
3705: problem (one student; whole sequence).
3706:
1.112 bowersj2 3707: =back
1.14 harris41 3708:
1.112 bowersj2 3709: The output string is a table containing all desired attempts, if any.
1.16 harris41 3710:
1.112 bowersj2 3711: =cut
1.1 albertel 3712:
3713: sub get_previous_attempt {
1.1075.2.86 raeburn 3714: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3715: my $prevattempts='';
1.43 ng 3716: no strict 'refs';
1.1 albertel 3717: if ($symb) {
1.3 albertel 3718: my (%returnhash)=
3719: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3720: if ($returnhash{'version'}) {
3721: my %lasthash=();
3722: my $version;
3723: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3724: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3725: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3726: }
1.1 albertel 3727: }
1.596 albertel 3728: $prevattempts=&start_data_table().&start_data_table_header_row();
3729: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 3730: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3731: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3732: foreach my $key (sort(keys(%lasthash))) {
3733: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3734: if ($#parts > 0) {
1.31 albertel 3735: my $data=$parts[-1];
1.989 raeburn 3736: next if ($data eq 'foilorder');
1.31 albertel 3737: pop(@parts);
1.1010 www 3738: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3739: if ($data eq 'type') {
3740: unless ($showsurv) {
3741: my $id = join(',',@parts);
3742: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3743: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3744: $lasthidden{$ign.'.'.$id} = 1;
3745: }
1.945 raeburn 3746: }
1.1075.2.86 raeburn 3747: if ($identifier ne '') {
3748: my $id = join(',',@parts);
3749: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
3750: $domain,$username,$usec,undef,$course) =~ /^no/) {
3751: $hidestatus{$ign.'.'.$id} = 1;
3752: }
3753: }
3754: } elsif ($data eq 'regrader') {
3755: if (($identifier ne '') && (@parts)) {
3756: my $id = join(',',@parts);
3757: $regraded{$ign.'.'.$id} = 1;
3758: }
1.1010 www 3759: }
1.31 albertel 3760: } else {
1.41 ng 3761: if ($#parts == 0) {
3762: $prevattempts.='<th>'.$parts[0].'</th>';
3763: } else {
3764: $prevattempts.='<th>'.$ign.'</th>';
3765: }
1.31 albertel 3766: }
1.16 harris41 3767: }
1.596 albertel 3768: $prevattempts.=&end_data_table_header_row();
1.40 ng 3769: if ($getattempt eq '') {
1.1075.2.86 raeburn 3770: my (%solved,%resets,%probstatus);
3771: if (($identifier ne '') && (keys(%regraded) > 0)) {
3772: for ($version=1;$version<=$returnhash{'version'};$version++) {
3773: foreach my $id (keys(%regraded)) {
3774: if (($returnhash{$version.':'.$id.'.regrader'}) &&
3775: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
3776: ($returnhash{$version.':'.$id.'.award'} eq '')) {
3777: push(@{$resets{$id}},$version);
3778: }
3779: }
3780: }
3781: }
1.40 ng 3782: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 3783: my (@hidden,@unsolved);
1.945 raeburn 3784: if (%typeparts) {
3785: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 3786: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
3787: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3788: push(@hidden,$id);
1.1075.2.86 raeburn 3789: } elsif ($identifier ne '') {
3790: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
3791: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
3792: ($hidestatus{$id})) {
3793: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
3794: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
3795: push(@{$solved{$id}},$version);
3796: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
3797: (ref($solved{$id}) eq 'ARRAY')) {
3798: my $skip;
3799: if (ref($resets{$id}) eq 'ARRAY') {
3800: foreach my $reset (@{$resets{$id}}) {
3801: if ($reset > $solved{$id}[-1]) {
3802: $skip=1;
3803: last;
3804: }
3805: }
3806: }
3807: unless ($skip) {
3808: my ($ign,$partslist) = split(/\./,$id,2);
3809: push(@unsolved,$partslist);
3810: }
3811: }
3812: }
1.945 raeburn 3813: }
3814: }
3815: }
3816: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 3817: '<td>'.&mt('Transaction [_1]',$version);
3818: if (@unsolved) {
3819: $prevattempts .= '<span class="LC_nobreak"><label>'.
3820: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
3821: &mt('Hide').'</label></span>';
3822: }
3823: $prevattempts .= '</td>';
1.945 raeburn 3824: if (@hidden) {
3825: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3826: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3827: my $hide;
3828: foreach my $id (@hidden) {
3829: if ($key =~ /^\Q$id\E/) {
3830: $hide = 1;
3831: last;
3832: }
3833: }
3834: if ($hide) {
3835: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3836: if (($data eq 'award') || ($data eq 'awarddetail')) {
3837: my $value = &format_previous_attempt_value($key,
3838: $returnhash{$version.':'.$key});
3839: $prevattempts.='<td>'.$value.' </td>';
3840: } else {
3841: $prevattempts.='<td> </td>';
3842: }
3843: } else {
3844: if ($key =~ /\./) {
3845: my $value = &format_previous_attempt_value($key,
3846: $returnhash{$version.':'.$key});
3847: $prevattempts.='<td>'.$value.' </td>';
3848: } else {
3849: $prevattempts.='<td> </td>';
3850: }
3851: }
3852: }
3853: } else {
3854: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3855: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3856: my $value = &format_previous_attempt_value($key,
3857: $returnhash{$version.':'.$key});
3858: $prevattempts.='<td>'.$value.' </td>';
3859: }
3860: }
3861: $prevattempts.=&end_data_table_row();
1.40 ng 3862: }
1.1 albertel 3863: }
1.945 raeburn 3864: my @currhidden = keys(%lasthidden);
1.596 albertel 3865: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3866: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3867: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3868: if (%typeparts) {
3869: my $hidden;
3870: foreach my $id (@currhidden) {
3871: if ($key =~ /^\Q$id\E/) {
3872: $hidden = 1;
3873: last;
3874: }
3875: }
3876: if ($hidden) {
3877: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3878: if (($data eq 'award') || ($data eq 'awarddetail')) {
3879: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3880: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3881: $value = &$gradesub($value);
3882: }
3883: $prevattempts.='<td>'.$value.' </td>';
3884: } else {
3885: $prevattempts.='<td> </td>';
3886: }
3887: } else {
3888: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3889: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3890: $value = &$gradesub($value);
3891: }
3892: $prevattempts.='<td>'.$value.' </td>';
3893: }
3894: } else {
3895: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3896: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3897: $value = &$gradesub($value);
3898: }
3899: $prevattempts.='<td>'.$value.' </td>';
3900: }
1.16 harris41 3901: }
1.596 albertel 3902: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3903: } else {
1.596 albertel 3904: $prevattempts=
3905: &start_data_table().&start_data_table_row().
3906: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3907: &end_data_table_row().&end_data_table();
1.1 albertel 3908: }
3909: } else {
1.596 albertel 3910: $prevattempts=
3911: &start_data_table().&start_data_table_row().
3912: '<td>'.&mt('No data.').'</td>'.
3913: &end_data_table_row().&end_data_table();
1.1 albertel 3914: }
1.10 albertel 3915: }
3916:
1.581 albertel 3917: sub format_previous_attempt_value {
3918: my ($key,$value) = @_;
1.1011 www 3919: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3920: $value = &Apache::lonlocal::locallocaltime($value);
3921: } elsif (ref($value) eq 'ARRAY') {
3922: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3923: } elsif ($key =~ /answerstring$/) {
3924: my %answers = &Apache::lonnet::str2hash($value);
3925: my @anskeys = sort(keys(%answers));
3926: if (@anskeys == 1) {
3927: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3928: if ($answer =~ m{\0}) {
3929: $answer =~ s{\0}{,}g;
1.988 raeburn 3930: }
3931: my $tag_internal_answer_name = 'INTERNAL';
3932: if ($anskeys[0] eq $tag_internal_answer_name) {
3933: $value = $answer;
3934: } else {
3935: $value = $anskeys[0].'='.$answer;
3936: }
3937: } else {
3938: foreach my $ans (@anskeys) {
3939: my $answer = $answers{$ans};
1.1001 raeburn 3940: if ($answer =~ m{\0}) {
3941: $answer =~ s{\0}{,}g;
1.988 raeburn 3942: }
3943: $value .= $ans.'='.$answer.'<br />';;
3944: }
3945: }
1.581 albertel 3946: } else {
3947: $value = &unescape($value);
3948: }
3949: return $value;
3950: }
3951:
3952:
1.107 albertel 3953: sub relative_to_absolute {
3954: my ($url,$output)=@_;
3955: my $parser=HTML::TokeParser->new(\$output);
3956: my $token;
3957: my $thisdir=$url;
3958: my @rlinks=();
3959: while ($token=$parser->get_token) {
3960: if ($token->[0] eq 'S') {
3961: if ($token->[1] eq 'a') {
3962: if ($token->[2]->{'href'}) {
3963: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3964: }
3965: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3966: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3967: } elsif ($token->[1] eq 'base') {
3968: $thisdir=$token->[2]->{'href'};
3969: }
3970: }
3971: }
3972: $thisdir=~s-/[^/]*$--;
1.356 albertel 3973: foreach my $link (@rlinks) {
1.726 raeburn 3974: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3975: ($link=~/^\//) ||
3976: ($link=~/^javascript:/i) ||
3977: ($link=~/^mailto:/i) ||
3978: ($link=~/^\#/)) {
3979: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3980: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3981: }
3982: }
3983: # -------------------------------------------------- Deal with Applet codebases
3984: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3985: return $output;
3986: }
3987:
1.112 bowersj2 3988: =pod
3989:
1.648 raeburn 3990: =item * &get_student_view()
1.112 bowersj2 3991:
3992: show a snapshot of what student was looking at
3993:
3994: =cut
3995:
1.10 albertel 3996: sub get_student_view {
1.186 albertel 3997: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3998: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3999: my (%form);
1.10 albertel 4000: my @elements=('symb','courseid','domain','username');
4001: foreach my $element (@elements) {
1.186 albertel 4002: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4003: }
1.186 albertel 4004: if (defined($moreenv)) {
4005: %form=(%form,%{$moreenv});
4006: }
1.236 albertel 4007: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4008: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4009: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4010: $userview=~s/\<body[^\>]*\>//gi;
4011: $userview=~s/\<\/body\>//gi;
4012: $userview=~s/\<html\>//gi;
4013: $userview=~s/\<\/html\>//gi;
4014: $userview=~s/\<head\>//gi;
4015: $userview=~s/\<\/head\>//gi;
4016: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4017: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4018: if (wantarray) {
4019: return ($userview,$response);
4020: } else {
4021: return $userview;
4022: }
4023: }
4024:
4025: sub get_student_view_with_retries {
4026: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4027:
4028: my $ok = 0; # True if we got a good response.
4029: my $content;
4030: my $response;
4031:
4032: # Try to get the student_view done. within the retries count:
4033:
4034: do {
4035: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4036: $ok = $response->is_success;
4037: if (!$ok) {
4038: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4039: }
4040: $retries--;
4041: } while (!$ok && ($retries > 0));
4042:
4043: if (!$ok) {
4044: $content = ''; # On error return an empty content.
4045: }
1.651 www 4046: if (wantarray) {
4047: return ($content, $response);
4048: } else {
4049: return $content;
4050: }
1.11 albertel 4051: }
4052:
1.112 bowersj2 4053: =pod
4054:
1.648 raeburn 4055: =item * &get_student_answers()
1.112 bowersj2 4056:
4057: show a snapshot of how student was answering problem
4058:
4059: =cut
4060:
1.11 albertel 4061: sub get_student_answers {
1.100 sakharuk 4062: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4063: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4064: my (%moreenv);
1.11 albertel 4065: my @elements=('symb','courseid','domain','username');
4066: foreach my $element (@elements) {
1.186 albertel 4067: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4068: }
1.186 albertel 4069: $moreenv{'grade_target'}='answer';
4070: %moreenv=(%form,%moreenv);
1.497 raeburn 4071: $feedurl = &Apache::lonnet::clutter($feedurl);
4072: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4073: return $userview;
1.1 albertel 4074: }
1.116 albertel 4075:
4076: =pod
4077:
4078: =item * &submlink()
4079:
1.242 albertel 4080: Inputs: $text $uname $udom $symb $target
1.116 albertel 4081:
4082: Returns: A link to grades.pm such as to see the SUBM view of a student
4083:
4084: =cut
4085:
4086: ###############################################
4087: sub submlink {
1.242 albertel 4088: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4089: if (!($uname && $udom)) {
4090: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4091: &Apache::lonnet::whichuser($symb);
1.116 albertel 4092: if (!$symb) { $symb=$cursymb; }
4093: }
1.254 matthew 4094: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4095: $symb=&escape($symb);
1.960 bisitz 4096: if ($target) { $target=" target=\"$target\""; }
4097: return
4098: '<a href="/adm/grades?command=submission'.
4099: '&symb='.$symb.
4100: '&student='.$uname.
4101: '&userdom='.$udom.'"'.
4102: $target.'>'.$text.'</a>';
1.242 albertel 4103: }
4104: ##############################################
4105:
4106: =pod
4107:
4108: =item * &pgrdlink()
4109:
4110: Inputs: $text $uname $udom $symb $target
4111:
4112: Returns: A link to grades.pm such as to see the PGRD view of a student
4113:
4114: =cut
4115:
4116: ###############################################
4117: sub pgrdlink {
4118: my $link=&submlink(@_);
4119: $link=~s/(&command=submission)/$1&showgrading=yes/;
4120: return $link;
4121: }
4122: ##############################################
4123:
4124: =pod
4125:
4126: =item * &pprmlink()
4127:
4128: Inputs: $text $uname $udom $symb $target
4129:
4130: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4131: student and a specific resource
1.242 albertel 4132:
4133: =cut
4134:
4135: ###############################################
4136: sub pprmlink {
4137: my ($text,$uname,$udom,$symb,$target)=@_;
4138: if (!($uname && $udom)) {
4139: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4140: &Apache::lonnet::whichuser($symb);
1.242 albertel 4141: if (!$symb) { $symb=$cursymb; }
4142: }
1.254 matthew 4143: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4144: $symb=&escape($symb);
1.242 albertel 4145: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4146: return '<a href="/adm/parmset?command=set&'.
4147: 'symb='.$symb.'&uname='.$uname.
4148: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4149: }
4150: ##############################################
1.37 matthew 4151:
1.112 bowersj2 4152: =pod
4153:
4154: =back
4155:
4156: =cut
4157:
1.37 matthew 4158: ###############################################
1.51 www 4159:
4160:
4161: sub timehash {
1.687 raeburn 4162: my ($thistime) = @_;
4163: my $timezone = &Apache::lonlocal::gettimezone();
4164: my $dt = DateTime->from_epoch(epoch => $thistime)
4165: ->set_time_zone($timezone);
4166: my $wday = $dt->day_of_week();
4167: if ($wday == 7) { $wday = 0; }
4168: return ( 'second' => $dt->second(),
4169: 'minute' => $dt->minute(),
4170: 'hour' => $dt->hour(),
4171: 'day' => $dt->day_of_month(),
4172: 'month' => $dt->month(),
4173: 'year' => $dt->year(),
4174: 'weekday' => $wday,
4175: 'dayyear' => $dt->day_of_year(),
4176: 'dlsav' => $dt->is_dst() );
1.51 www 4177: }
4178:
1.370 www 4179: sub utc_string {
4180: my ($date)=@_;
1.371 www 4181: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4182: }
4183:
1.51 www 4184: sub maketime {
4185: my %th=@_;
1.687 raeburn 4186: my ($epoch_time,$timezone,$dt);
4187: $timezone = &Apache::lonlocal::gettimezone();
4188: eval {
4189: $dt = DateTime->new( year => $th{'year'},
4190: month => $th{'month'},
4191: day => $th{'day'},
4192: hour => $th{'hour'},
4193: minute => $th{'minute'},
4194: second => $th{'second'},
4195: time_zone => $timezone,
4196: );
4197: };
4198: if (!$@) {
4199: $epoch_time = $dt->epoch;
4200: if ($epoch_time) {
4201: return $epoch_time;
4202: }
4203: }
1.51 www 4204: return POSIX::mktime(
4205: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4206: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4207: }
4208:
4209: #########################################
1.51 www 4210:
4211: sub findallcourses {
1.482 raeburn 4212: my ($roles,$uname,$udom) = @_;
1.355 albertel 4213: my %roles;
4214: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4215: my %courses;
1.51 www 4216: my $now=time;
1.482 raeburn 4217: if (!defined($uname)) {
4218: $uname = $env{'user.name'};
4219: }
4220: if (!defined($udom)) {
4221: $udom = $env{'user.domain'};
4222: }
4223: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4224: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4225: if (!%roles) {
4226: %roles = (
4227: cc => 1,
1.907 raeburn 4228: co => 1,
1.482 raeburn 4229: in => 1,
4230: ep => 1,
4231: ta => 1,
4232: cr => 1,
4233: st => 1,
4234: );
4235: }
4236: foreach my $entry (keys(%roleshash)) {
4237: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4238: if ($trole =~ /^cr/) {
4239: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4240: } else {
4241: next if (!exists($roles{$trole}));
4242: }
4243: if ($tend) {
4244: next if ($tend < $now);
4245: }
4246: if ($tstart) {
4247: next if ($tstart > $now);
4248: }
1.1058 raeburn 4249: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4250: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4251: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4252: if ($secpart eq '') {
4253: ($cnum,$role) = split(/_/,$cnumpart);
4254: $sec = 'none';
1.1058 raeburn 4255: $value .= $cnum.'/';
1.482 raeburn 4256: } else {
4257: $cnum = $cnumpart;
4258: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4259: $value .= $cnum.'/'.$sec;
4260: }
4261: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4262: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4263: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4264: }
4265: } else {
4266: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4267: }
1.482 raeburn 4268: }
4269: } else {
4270: foreach my $key (keys(%env)) {
1.483 albertel 4271: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4272: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4273: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4274: next if ($role eq 'ca' || $role eq 'aa');
4275: next if (%roles && !exists($roles{$role}));
4276: my ($starttime,$endtime)=split(/\./,$env{$key});
4277: my $active=1;
4278: if ($starttime) {
4279: if ($now<$starttime) { $active=0; }
4280: }
4281: if ($endtime) {
4282: if ($now>$endtime) { $active=0; }
4283: }
4284: if ($active) {
1.1058 raeburn 4285: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4286: if ($sec eq '') {
4287: $sec = 'none';
1.1058 raeburn 4288: } else {
4289: $value .= $sec;
4290: }
4291: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4292: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4293: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4294: }
4295: } else {
4296: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4297: }
1.474 raeburn 4298: }
4299: }
1.51 www 4300: }
4301: }
1.474 raeburn 4302: return %courses;
1.51 www 4303: }
1.37 matthew 4304:
1.54 www 4305: ###############################################
1.474 raeburn 4306:
4307: sub blockcheck {
1.1075.2.73 raeburn 4308: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4309:
1.1075.2.73 raeburn 4310: if (defined($udom) && defined($uname)) {
4311: # If uname and udom are for a course, check for blocks in the course.
4312: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4313: my ($startblock,$endblock,$triggerblock) =
4314: &get_blocks($setters,$activity,$udom,$uname,$url);
4315: return ($startblock,$endblock,$triggerblock);
4316: }
4317: } else {
1.490 raeburn 4318: $udom = $env{'user.domain'};
4319: $uname = $env{'user.name'};
4320: }
4321:
1.502 raeburn 4322: my $startblock = 0;
4323: my $endblock = 0;
1.1062 raeburn 4324: my $triggerblock = '';
1.482 raeburn 4325: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4326:
1.490 raeburn 4327: # If uname is for a user, and activity is course-specific, i.e.,
4328: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4329:
1.490 raeburn 4330: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4331: $activity eq 'groups' || $activity eq 'printout') &&
4332: ($env{'request.course.id'})) {
1.490 raeburn 4333: foreach my $key (keys(%live_courses)) {
4334: if ($key ne $env{'request.course.id'}) {
4335: delete($live_courses{$key});
4336: }
4337: }
4338: }
4339:
4340: my $otheruser = 0;
4341: my %own_courses;
4342: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4343: # Resource belongs to user other than current user.
4344: $otheruser = 1;
4345: # Gather courses for current user
4346: %own_courses =
4347: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4348: }
4349:
4350: # Gather active course roles - course coordinator, instructor,
4351: # exam proctor, ta, student, or custom role.
1.474 raeburn 4352:
4353: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4354: my ($cdom,$cnum);
4355: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4356: $cdom = $env{'course.'.$course.'.domain'};
4357: $cnum = $env{'course.'.$course.'.num'};
4358: } else {
1.490 raeburn 4359: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4360: }
4361: my $no_ownblock = 0;
4362: my $no_userblock = 0;
1.533 raeburn 4363: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4364: # Check if current user has 'evb' priv for this
4365: if (defined($own_courses{$course})) {
4366: foreach my $sec (keys(%{$own_courses{$course}})) {
4367: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4368: if ($sec ne 'none') {
4369: $checkrole .= '/'.$sec;
4370: }
4371: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4372: $no_ownblock = 1;
4373: last;
4374: }
4375: }
4376: }
4377: # if they have 'evb' priv and are currently not playing student
4378: next if (($no_ownblock) &&
4379: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4380: }
1.474 raeburn 4381: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4382: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4383: if ($sec ne 'none') {
1.482 raeburn 4384: $checkrole .= '/'.$sec;
1.474 raeburn 4385: }
1.490 raeburn 4386: if ($otheruser) {
4387: # Resource belongs to user other than current user.
4388: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4389: my (%allroles,%userroles);
4390: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4391: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4392: my ($trole,$tdom,$tnum,$tsec);
4393: if ($entry =~ /^cr/) {
4394: ($trole,$tdom,$tnum,$tsec) =
4395: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4396: } else {
4397: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4398: }
4399: my ($spec,$area,$trest);
4400: $area = '/'.$tdom.'/'.$tnum;
4401: $trest = $tnum;
4402: if ($tsec ne '') {
4403: $area .= '/'.$tsec;
4404: $trest .= '/'.$tsec;
4405: }
4406: $spec = $trole.'.'.$area;
4407: if ($trole =~ /^cr/) {
4408: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4409: $tdom,$spec,$trest,$area);
4410: } else {
4411: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4412: $tdom,$spec,$trest,$area);
4413: }
4414: }
4415: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4416: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4417: if ($1) {
4418: $no_userblock = 1;
4419: last;
4420: }
1.486 raeburn 4421: }
4422: }
1.490 raeburn 4423: } else {
4424: # Resource belongs to current user
4425: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4426: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4427: $no_ownblock = 1;
4428: last;
4429: }
1.474 raeburn 4430: }
4431: }
4432: # if they have the evb priv and are currently not playing student
1.482 raeburn 4433: next if (($no_ownblock) &&
1.491 albertel 4434: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4435: next if ($no_userblock);
1.474 raeburn 4436:
1.866 kalberla 4437: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4438: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4439:
1.1062 raeburn 4440: my ($start,$end,$trigger) =
4441: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4442: if (($start != 0) &&
4443: (($startblock == 0) || ($startblock > $start))) {
4444: $startblock = $start;
1.1062 raeburn 4445: if ($trigger ne '') {
4446: $triggerblock = $trigger;
4447: }
1.502 raeburn 4448: }
4449: if (($end != 0) &&
4450: (($endblock == 0) || ($endblock < $end))) {
4451: $endblock = $end;
1.1062 raeburn 4452: if ($trigger ne '') {
4453: $triggerblock = $trigger;
4454: }
1.502 raeburn 4455: }
1.490 raeburn 4456: }
1.1062 raeburn 4457: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4458: }
4459:
4460: sub get_blocks {
1.1062 raeburn 4461: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4462: my $startblock = 0;
4463: my $endblock = 0;
1.1062 raeburn 4464: my $triggerblock = '';
1.490 raeburn 4465: my $course = $cdom.'_'.$cnum;
4466: $setters->{$course} = {};
4467: $setters->{$course}{'staff'} = [];
4468: $setters->{$course}{'times'} = [];
1.1062 raeburn 4469: $setters->{$course}{'triggers'} = [];
4470: my (@blockers,%triggered);
4471: my $now = time;
4472: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4473: if ($activity eq 'docs') {
4474: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4475: foreach my $block (@blockers) {
4476: if ($block =~ /^firstaccess____(.+)$/) {
4477: my $item = $1;
4478: my $type = 'map';
4479: my $timersymb = $item;
4480: if ($item eq 'course') {
4481: $type = 'course';
4482: } elsif ($item =~ /___\d+___/) {
4483: $type = 'resource';
4484: } else {
4485: $timersymb = &Apache::lonnet::symbread($item);
4486: }
4487: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4488: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4489: $triggered{$block} = {
4490: start => $start,
4491: end => $end,
4492: type => $type,
4493: };
4494: }
4495: }
4496: } else {
4497: foreach my $block (keys(%commblocks)) {
4498: if ($block =~ m/^(\d+)____(\d+)$/) {
4499: my ($start,$end) = ($1,$2);
4500: if ($start <= time && $end >= time) {
4501: if (ref($commblocks{$block}) eq 'HASH') {
4502: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4503: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4504: unless(grep(/^\Q$block\E$/,@blockers)) {
4505: push(@blockers,$block);
4506: }
4507: }
4508: }
4509: }
4510: }
4511: } elsif ($block =~ /^firstaccess____(.+)$/) {
4512: my $item = $1;
4513: my $timersymb = $item;
4514: my $type = 'map';
4515: if ($item eq 'course') {
4516: $type = 'course';
4517: } elsif ($item =~ /___\d+___/) {
4518: $type = 'resource';
4519: } else {
4520: $timersymb = &Apache::lonnet::symbread($item);
4521: }
4522: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4523: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4524: if ($start && $end) {
4525: if (($start <= time) && ($end >= time)) {
4526: unless (grep(/^\Q$block\E$/,@blockers)) {
4527: push(@blockers,$block);
4528: $triggered{$block} = {
4529: start => $start,
4530: end => $end,
4531: type => $type,
4532: };
4533: }
4534: }
1.490 raeburn 4535: }
1.1062 raeburn 4536: }
4537: }
4538: }
4539: foreach my $blocker (@blockers) {
4540: my ($staff_name,$staff_dom,$title,$blocks) =
4541: &parse_block_record($commblocks{$blocker});
4542: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4543: my ($start,$end,$triggertype);
4544: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4545: ($start,$end) = ($1,$2);
4546: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4547: $start = $triggered{$blocker}{'start'};
4548: $end = $triggered{$blocker}{'end'};
4549: $triggertype = $triggered{$blocker}{'type'};
4550: }
4551: if ($start) {
4552: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4553: if ($triggertype) {
4554: push(@{$$setters{$course}{'triggers'}},$triggertype);
4555: } else {
4556: push(@{$$setters{$course}{'triggers'}},0);
4557: }
4558: if ( ($startblock == 0) || ($startblock > $start) ) {
4559: $startblock = $start;
4560: if ($triggertype) {
4561: $triggerblock = $blocker;
1.474 raeburn 4562: }
4563: }
1.1062 raeburn 4564: if ( ($endblock == 0) || ($endblock < $end) ) {
4565: $endblock = $end;
4566: if ($triggertype) {
4567: $triggerblock = $blocker;
4568: }
4569: }
1.474 raeburn 4570: }
4571: }
1.1062 raeburn 4572: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4573: }
4574:
4575: sub parse_block_record {
4576: my ($record) = @_;
4577: my ($setuname,$setudom,$title,$blocks);
4578: if (ref($record) eq 'HASH') {
4579: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4580: $title = &unescape($record->{'event'});
4581: $blocks = $record->{'blocks'};
4582: } else {
4583: my @data = split(/:/,$record,3);
4584: if (scalar(@data) eq 2) {
4585: $title = $data[1];
4586: ($setuname,$setudom) = split(/@/,$data[0]);
4587: } else {
4588: ($setuname,$setudom,$title) = @data;
4589: }
4590: $blocks = { 'com' => 'on' };
4591: }
4592: return ($setuname,$setudom,$title,$blocks);
4593: }
4594:
1.854 kalberla 4595: sub blocking_status {
1.1075.2.73 raeburn 4596: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4597: my %setters;
1.890 droeschl 4598:
1.1061 raeburn 4599: # check for active blocking
1.1062 raeburn 4600: my ($startblock,$endblock,$triggerblock) =
1.1075.2.73 raeburn 4601: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4602: my $blocked = 0;
4603: if ($startblock && $endblock) {
4604: $blocked = 1;
4605: }
1.890 droeschl 4606:
1.1061 raeburn 4607: # caller just wants to know whether a block is active
4608: if (!wantarray) { return $blocked; }
4609:
4610: # build a link to a popup window containing the details
4611: my $querystring = "?activity=$activity";
4612: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4613: if ($activity eq 'port') {
4614: $querystring .= "&udom=$udom" if $udom;
4615: $querystring .= "&uname=$uname" if $uname;
4616: } elsif ($activity eq 'docs') {
4617: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4618: }
1.1061 raeburn 4619:
4620: my $output .= <<'END_MYBLOCK';
4621: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4622: var options = "width=" + w + ",height=" + h + ",";
4623: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4624: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4625: var newWin = window.open(url, wdwName, options);
4626: newWin.focus();
4627: }
1.890 droeschl 4628: END_MYBLOCK
1.854 kalberla 4629:
1.1061 raeburn 4630: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4631:
1.1061 raeburn 4632: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4633: my $text = &mt('Communication Blocked');
4634: if ($activity eq 'docs') {
4635: $text = &mt('Content Access Blocked');
1.1063 raeburn 4636: } elsif ($activity eq 'printout') {
4637: $text = &mt('Printing Blocked');
1.1062 raeburn 4638: }
1.1061 raeburn 4639: $output .= <<"END_BLOCK";
1.867 kalberla 4640: <div class='LC_comblock'>
1.869 kalberla 4641: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4642: title='$text'>
4643: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4644: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4645: title='$text'>$text</a>
1.867 kalberla 4646: </div>
4647:
4648: END_BLOCK
1.474 raeburn 4649:
1.1061 raeburn 4650: return ($blocked, $output);
1.854 kalberla 4651: }
1.490 raeburn 4652:
1.60 matthew 4653: ###############################################
4654:
1.682 raeburn 4655: sub check_ip_acc {
4656: my ($acc)=@_;
4657: &Apache::lonxml::debug("acc is $acc");
4658: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4659: return 1;
4660: }
4661: my $allowed=0;
4662: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4663:
4664: my $name;
4665: foreach my $pattern (split(',',$acc)) {
4666: $pattern =~ s/^\s*//;
4667: $pattern =~ s/\s*$//;
4668: if ($pattern =~ /\*$/) {
4669: #35.8.*
4670: $pattern=~s/\*//;
4671: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4672: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4673: #35.8.3.[34-56]
4674: my $low=$2;
4675: my $high=$3;
4676: $pattern=$1;
4677: if ($ip =~ /^\Q$pattern\E/) {
4678: my $last=(split(/\./,$ip))[3];
4679: if ($last <=$high && $last >=$low) { $allowed=1; }
4680: }
4681: } elsif ($pattern =~ /^\*/) {
4682: #*.msu.edu
4683: $pattern=~s/\*//;
4684: if (!defined($name)) {
4685: use Socket;
4686: my $netaddr=inet_aton($ip);
4687: ($name)=gethostbyaddr($netaddr,AF_INET);
4688: }
4689: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4690: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4691: #127.0.0.1
4692: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4693: } else {
4694: #some.name.com
4695: if (!defined($name)) {
4696: use Socket;
4697: my $netaddr=inet_aton($ip);
4698: ($name)=gethostbyaddr($netaddr,AF_INET);
4699: }
4700: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4701: }
4702: if ($allowed) { last; }
4703: }
4704: return $allowed;
4705: }
4706:
4707: ###############################################
4708:
1.60 matthew 4709: =pod
4710:
1.112 bowersj2 4711: =head1 Domain Template Functions
4712:
4713: =over 4
4714:
4715: =item * &determinedomain()
1.60 matthew 4716:
4717: Inputs: $domain (usually will be undef)
4718:
1.63 www 4719: Returns: Determines which domain should be used for designs
1.60 matthew 4720:
4721: =cut
1.54 www 4722:
1.60 matthew 4723: ###############################################
1.63 www 4724: sub determinedomain {
4725: my $domain=shift;
1.531 albertel 4726: if (! $domain) {
1.60 matthew 4727: # Determine domain if we have not been given one
1.893 raeburn 4728: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4729: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4730: if ($env{'request.role.domain'}) {
4731: $domain=$env{'request.role.domain'};
1.60 matthew 4732: }
4733: }
1.63 www 4734: return $domain;
4735: }
4736: ###############################################
1.517 raeburn 4737:
1.518 albertel 4738: sub devalidate_domconfig_cache {
4739: my ($udom)=@_;
4740: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4741: }
4742:
4743: # ---------------------- Get domain configuration for a domain
4744: sub get_domainconf {
4745: my ($udom) = @_;
4746: my $cachetime=1800;
4747: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4748: if (defined($cached)) { return %{$result}; }
4749:
4750: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4751: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4752: my (%designhash,%legacy);
1.518 albertel 4753: if (keys(%domconfig) > 0) {
4754: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4755: if (keys(%{$domconfig{'login'}})) {
4756: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4757: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 4758: if (($key eq 'loginvia') || ($key eq 'headtag')) {
4759: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4760: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
4761: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
4762: if ($key eq 'loginvia') {
4763: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4764: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4765: $designhash{$udom.'.login.loginvia'} = $server;
4766: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4767: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4768: } else {
4769: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
4770: }
1.948 raeburn 4771: }
1.1075.2.87 raeburn 4772: } elsif ($key eq 'headtag') {
4773: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
4774: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 4775: }
1.946 raeburn 4776: }
1.1075.2.87 raeburn 4777: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
4778: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
4779: }
1.946 raeburn 4780: }
4781: }
4782: }
4783: } else {
4784: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4785: $designhash{$udom.'.login.'.$key.'_'.$img} =
4786: $domconfig{'login'}{$key}{$img};
4787: }
1.699 raeburn 4788: }
4789: } else {
4790: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4791: }
1.632 raeburn 4792: }
4793: } else {
4794: $legacy{'login'} = 1;
1.518 albertel 4795: }
1.632 raeburn 4796: } else {
4797: $legacy{'login'} = 1;
1.518 albertel 4798: }
4799: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4800: if (keys(%{$domconfig{'rolecolors'}})) {
4801: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4802: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4803: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4804: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4805: }
1.518 albertel 4806: }
4807: }
1.632 raeburn 4808: } else {
4809: $legacy{'rolecolors'} = 1;
1.518 albertel 4810: }
1.632 raeburn 4811: } else {
4812: $legacy{'rolecolors'} = 1;
1.518 albertel 4813: }
1.948 raeburn 4814: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4815: if ($domconfig{'autoenroll'}{'co-owners'}) {
4816: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4817: }
4818: }
1.632 raeburn 4819: if (keys(%legacy) > 0) {
4820: my %legacyhash = &get_legacy_domconf($udom);
4821: foreach my $item (keys(%legacyhash)) {
4822: if ($item =~ /^\Q$udom\E\.login/) {
4823: if ($legacy{'login'}) {
4824: $designhash{$item} = $legacyhash{$item};
4825: }
4826: } else {
4827: if ($legacy{'rolecolors'}) {
4828: $designhash{$item} = $legacyhash{$item};
4829: }
1.518 albertel 4830: }
4831: }
4832: }
1.632 raeburn 4833: } else {
4834: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4835: }
4836: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4837: $cachetime);
4838: return %designhash;
4839: }
4840:
1.632 raeburn 4841: sub get_legacy_domconf {
4842: my ($udom) = @_;
4843: my %legacyhash;
4844: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4845: my $designfile = $designdir.'/'.$udom.'.tab';
4846: if (-e $designfile) {
4847: if ( open (my $fh,"<$designfile") ) {
4848: while (my $line = <$fh>) {
4849: next if ($line =~ /^\#/);
4850: chomp($line);
4851: my ($key,$val)=(split(/\=/,$line));
4852: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4853: }
4854: close($fh);
4855: }
4856: }
1.1026 raeburn 4857: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4858: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4859: }
4860: return %legacyhash;
4861: }
4862:
1.63 www 4863: =pod
4864:
1.112 bowersj2 4865: =item * &domainlogo()
1.63 www 4866:
4867: Inputs: $domain (usually will be undef)
4868:
4869: Returns: A link to a domain logo, if the domain logo exists.
4870: If the domain logo does not exist, a description of the domain.
4871:
4872: =cut
1.112 bowersj2 4873:
1.63 www 4874: ###############################################
4875: sub domainlogo {
1.517 raeburn 4876: my $domain = &determinedomain(shift);
1.518 albertel 4877: my %designhash = &get_domainconf($domain);
1.517 raeburn 4878: # See if there is a logo
4879: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4880: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4881: if ($imgsrc =~ m{^/(adm|res)/}) {
4882: if ($imgsrc =~ m{^/res/}) {
4883: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4884: &Apache::lonnet::repcopy($local_name);
4885: }
4886: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4887: }
4888: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4889: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4890: return &Apache::lonnet::domain($domain,'description');
1.59 www 4891: } else {
1.60 matthew 4892: return '';
1.59 www 4893: }
4894: }
1.63 www 4895: ##############################################
4896:
4897: =pod
4898:
1.112 bowersj2 4899: =item * &designparm()
1.63 www 4900:
4901: Inputs: $which parameter; $domain (usually will be undef)
4902:
4903: Returns: value of designparamter $which
4904:
4905: =cut
1.112 bowersj2 4906:
1.397 albertel 4907:
1.400 albertel 4908: ##############################################
1.397 albertel 4909: sub designparm {
4910: my ($which,$domain)=@_;
4911: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4912: return $env{'environment.color.'.$which};
1.96 www 4913: }
1.63 www 4914: $domain=&determinedomain($domain);
1.1016 raeburn 4915: my %domdesign;
4916: unless ($domain eq 'public') {
4917: %domdesign = &get_domainconf($domain);
4918: }
1.520 raeburn 4919: my $output;
1.517 raeburn 4920: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4921: $output = $domdesign{$domain.'.'.$which};
1.63 www 4922: } else {
1.520 raeburn 4923: $output = $defaultdesign{$which};
4924: }
4925: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4926: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4927: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4928: if ($output =~ m{^/res/}) {
4929: my $local_name = &Apache::lonnet::filelocation('',$output);
4930: &Apache::lonnet::repcopy($local_name);
4931: }
1.520 raeburn 4932: $output = &lonhttpdurl($output);
4933: }
1.63 www 4934: }
1.520 raeburn 4935: return $output;
1.63 www 4936: }
1.59 www 4937:
1.822 bisitz 4938: ##############################################
4939: =pod
4940:
1.832 bisitz 4941: =item * &authorspace()
4942:
1.1028 raeburn 4943: Inputs: $url (usually will be undef).
1.832 bisitz 4944:
1.1075.2.40 raeburn 4945: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4946: directory being viewed (or for which action is being taken).
4947: If $url is provided, and begins /priv/<domain>/<uname>
4948: the path will be that portion of the $context argument.
4949: Otherwise the path will be for the author space of the current
4950: user when the current role is author, or for that of the
4951: co-author/assistant co-author space when the current role
4952: is co-author or assistant co-author.
1.832 bisitz 4953:
4954: =cut
4955:
4956: sub authorspace {
1.1028 raeburn 4957: my ($url) = @_;
4958: if ($url ne '') {
4959: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4960: return $1;
4961: }
4962: }
1.832 bisitz 4963: my $caname = '';
1.1024 www 4964: my $cadom = '';
1.1028 raeburn 4965: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4966: ($cadom,$caname) =
1.832 bisitz 4967: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4968: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4969: $caname = $env{'user.name'};
1.1024 www 4970: $cadom = $env{'user.domain'};
1.832 bisitz 4971: }
1.1028 raeburn 4972: if (($caname ne '') && ($cadom ne '')) {
4973: return "/priv/$cadom/$caname/";
4974: }
4975: return;
1.832 bisitz 4976: }
4977:
4978: ##############################################
4979: =pod
4980:
1.822 bisitz 4981: =item * &head_subbox()
4982:
4983: Inputs: $content (contains HTML code with page functions, etc.)
4984:
4985: Returns: HTML div with $content
4986: To be included in page header
4987:
4988: =cut
4989:
4990: sub head_subbox {
4991: my ($content)=@_;
4992: my $output =
1.993 raeburn 4993: '<div class="LC_head_subbox">'
1.822 bisitz 4994: .$content
4995: .'</div>'
4996: }
4997:
4998: ##############################################
4999: =pod
5000:
5001: =item * &CSTR_pageheader()
5002:
1.1026 raeburn 5003: Input: (optional) filename from which breadcrumb trail is built.
5004: In most cases no input as needed, as $env{'request.filename'}
5005: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5006:
5007: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5008: To be included on Authoring Space pages
1.822 bisitz 5009:
5010: =cut
5011:
5012: sub CSTR_pageheader {
1.1026 raeburn 5013: my ($trailfile) = @_;
5014: if ($trailfile eq '') {
5015: $trailfile = $env{'request.filename'};
5016: }
5017:
5018: # this is for resources; directories have customtitle, and crumbs
5019: # and select recent are created in lonpubdir.pm
5020:
5021: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5022: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5023: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5024: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5025: $formaction =~ s{/+}{/}g;
1.822 bisitz 5026:
5027: my $parentpath = '';
5028: my $lastitem = '';
5029: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5030: $parentpath = $1;
5031: $lastitem = $2;
5032: } else {
5033: $lastitem = $thisdisfn;
5034: }
1.921 bisitz 5035:
5036: my $output =
1.822 bisitz 5037: '<div>'
5038: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5039: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5040: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5041: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5042: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5043:
5044: if ($lastitem) {
5045: $output .=
5046: '<span class="LC_filename">'
5047: .$lastitem
5048: .'</span>';
5049: }
5050: $output .=
5051: '<br />'
1.822 bisitz 5052: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5053: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5054: .'</form>'
5055: .&Apache::lonmenu::constspaceform()
5056: .'</div>';
1.921 bisitz 5057:
5058: return $output;
1.822 bisitz 5059: }
5060:
1.60 matthew 5061: ###############################################
5062: ###############################################
5063:
5064: =pod
5065:
1.112 bowersj2 5066: =back
5067:
1.549 albertel 5068: =head1 HTML Helpers
1.112 bowersj2 5069:
5070: =over 4
5071:
5072: =item * &bodytag()
1.60 matthew 5073:
5074: Returns a uniform header for LON-CAPA web pages.
5075:
5076: Inputs:
5077:
1.112 bowersj2 5078: =over 4
5079:
5080: =item * $title, A title to be displayed on the page.
5081:
5082: =item * $function, the current role (can be undef).
5083:
5084: =item * $addentries, extra parameters for the <body> tag.
5085:
5086: =item * $bodyonly, if defined, only return the <body> tag.
5087:
5088: =item * $domain, if defined, force a given domain.
5089:
5090: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5091: text interface only)
1.60 matthew 5092:
1.814 bisitz 5093: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5094: navigational links
1.317 albertel 5095:
1.338 albertel 5096: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5097:
1.1075.2.12 raeburn 5098: =item * $no_inline_link, if true and in remote mode, don't show the
5099: 'Switch To Inline Menu' link
5100:
1.460 albertel 5101: =item * $args, optional argument valid values are
5102: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5103: inherit_jsmath -> when creating popup window in a page,
5104: should it have jsmath forced on by the
5105: current page
1.460 albertel 5106:
1.1075.2.15 raeburn 5107: =item * $advtoolsref, optional argument, ref to an array containing
5108: inlineremote items to be added in "Functions" menu below
5109: breadcrumbs.
5110:
1.112 bowersj2 5111: =back
5112:
1.60 matthew 5113: Returns: A uniform header for LON-CAPA web pages.
5114: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5115: If $bodyonly is undef or zero, an html string containing a <body> tag and
5116: other decorations will be returned.
5117:
5118: =cut
5119:
1.54 www 5120: sub bodytag {
1.831 bisitz 5121: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5122: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5123:
1.954 raeburn 5124: my $public;
5125: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5126: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5127: $public = 1;
5128: }
1.460 albertel 5129: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5130: my $httphost = $args->{'use_absolute'};
1.339 albertel 5131:
1.183 matthew 5132: $function = &get_users_function() if (!$function);
1.339 albertel 5133: my $img = &designparm($function.'.img',$domain);
5134: my $font = &designparm($function.'.font',$domain);
5135: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5136:
1.803 bisitz 5137: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5138: 'bgcolor' => $pgbg,
1.339 albertel 5139: 'text' => $font,
5140: 'alink' => &designparm($function.'.alink',$domain),
5141: 'vlink' => &designparm($function.'.vlink',$domain),
5142: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5143: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5144:
1.63 www 5145: # role and realm
1.1075.2.68 raeburn 5146: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5147: if ($realm) {
5148: $realm = '/'.$realm;
5149: }
1.378 raeburn 5150: if ($role eq 'ca') {
1.479 albertel 5151: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5152: $realm = &plainname($rname,$rdom);
1.378 raeburn 5153: }
1.55 www 5154: # realm
1.258 albertel 5155: if ($env{'request.course.id'}) {
1.378 raeburn 5156: if ($env{'request.role'} !~ /^cr/) {
5157: $role = &Apache::lonnet::plaintext($role,&course_type());
5158: }
1.898 raeburn 5159: if ($env{'request.course.sec'}) {
5160: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5161: }
1.359 albertel 5162: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5163: } else {
5164: $role = &Apache::lonnet::plaintext($role);
1.54 www 5165: }
1.433 albertel 5166:
1.359 albertel 5167: if (!$realm) { $realm=' '; }
1.330 albertel 5168:
1.438 albertel 5169: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5170:
1.101 www 5171: # construct main body tag
1.359 albertel 5172: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5173: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5174:
1.1075.2.38 raeburn 5175: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5176:
5177: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5178: return $bodytag;
1.1075.2.38 raeburn 5179: }
1.359 albertel 5180:
1.954 raeburn 5181: if ($public) {
1.433 albertel 5182: undef($role);
5183: }
1.359 albertel 5184:
1.762 bisitz 5185: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5186: #
5187: # Extra info if you are the DC
5188: my $dc_info = '';
5189: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5190: $env{'course.'.$env{'request.course.id'}.
5191: '.domain'}.'/'})) {
5192: my $cid = $env{'request.course.id'};
1.917 raeburn 5193: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5194: $dc_info =~ s/\s+$//;
1.359 albertel 5195: }
5196:
1.898 raeburn 5197: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903 droeschl 5198:
1.1075.2.13 raeburn 5199: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5200:
1.1075.2.38 raeburn 5201:
5202:
1.1075.2.21 raeburn 5203: my $funclist;
5204: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5205: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5206: Apache::lonmenu::serverform();
5207: my $forbodytag;
5208: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5209: $forcereg,$args->{'group'},
5210: $args->{'bread_crumbs'},
5211: $advtoolsref,'',\$forbodytag);
5212: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5213: $funclist = $forbodytag;
5214: }
5215: } else {
1.903 droeschl 5216:
5217: # if ($env{'request.state'} eq 'construct') {
5218: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5219: # }
5220:
1.1075.2.38 raeburn 5221: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5222: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5223:
1.1075.2.38 raeburn 5224: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5225:
1.916 droeschl 5226: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5227: if ($dc_info) {
5228: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5229: }
1.1075.2.38 raeburn 5230: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5231: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5232: return $bodytag;
5233: }
1.894 droeschl 5234:
1.927 raeburn 5235: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5236: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5237: }
1.916 droeschl 5238:
1.1075.2.38 raeburn 5239: $bodytag .= $right;
1.852 droeschl 5240:
1.917 raeburn 5241: if ($dc_info) {
5242: $dc_info = &dc_courseid_toggle($dc_info);
5243: }
5244: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5245:
1.1075.2.61 raeburn 5246: #if directed to not display the secondary menu, don't.
5247: if ($args->{'no_secondary_menu'}) {
5248: return $bodytag;
5249: }
1.903 droeschl 5250: #don't show menus for public users
1.954 raeburn 5251: if (!$public){
1.1075.2.52 raeburn 5252: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5253: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5254: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5255: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5256: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5257: $args->{'bread_crumbs'});
5258: } elsif ($forcereg) {
1.1075.2.22 raeburn 5259: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5260: $args->{'group'});
1.1075.2.15 raeburn 5261: } else {
1.1075.2.21 raeburn 5262: my $forbodytag;
5263: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5264: $forcereg,$args->{'group'},
5265: $args->{'bread_crumbs'},
5266: $advtoolsref,'',\$forbodytag);
5267: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5268: $bodytag .= $forbodytag;
5269: }
1.920 raeburn 5270: }
1.903 droeschl 5271: }else{
5272: # this is to seperate menu from content when there's no secondary
5273: # menu. Especially needed for public accessible ressources.
5274: $bodytag .= '<hr style="clear:both" />';
5275: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5276: }
1.903 droeschl 5277:
1.235 raeburn 5278: return $bodytag;
1.1075.2.12 raeburn 5279: }
5280:
5281: #
5282: # Top frame rendering, Remote is up
5283: #
5284:
5285: my $imgsrc = $img;
5286: if ($img =~ /^\/adm/) {
5287: $imgsrc = &lonhttpdurl($img);
5288: }
5289: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5290:
1.1075.2.60 raeburn 5291: my $help=($no_inline_link?''
5292: :&Apache::loncommon::top_nav_help('Help'));
5293:
1.1075.2.12 raeburn 5294: # Explicit link to get inline menu
5295: my $menu= ($no_inline_link?''
5296: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5297:
5298: if ($dc_info) {
5299: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5300: }
5301:
1.1075.2.38 raeburn 5302: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5303: unless ($public) {
5304: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5305: undef,'LC_menubuttons_link');
5306: }
5307:
1.1075.2.12 raeburn 5308: unless ($env{'form.inhibitmenu'}) {
5309: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5310: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5311: <li>$help</li>
1.1075.2.12 raeburn 5312: <li>$menu</li>
5313: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5314: }
1.1075.2.13 raeburn 5315: if ($env{'request.state'} eq 'construct') {
5316: if (!$public){
5317: if ($env{'request.state'} eq 'construct') {
5318: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5319: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5320: &Apache::lonhtmlcommon::scripttag('','end').
5321: &Apache::lonmenu::innerregister($forcereg,
5322: $args->{'bread_crumbs'});
5323: }
5324: }
5325: }
1.1075.2.21 raeburn 5326: return $bodytag."\n".$funclist;
1.182 matthew 5327: }
5328:
1.917 raeburn 5329: sub dc_courseid_toggle {
5330: my ($dc_info) = @_;
1.980 raeburn 5331: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5332: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5333: &mt('(More ...)').'</a></span>'.
5334: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5335: }
5336:
1.330 albertel 5337: sub make_attr_string {
5338: my ($register,$attr_ref) = @_;
5339:
5340: if ($attr_ref && !ref($attr_ref)) {
5341: die("addentries Must be a hash ref ".
5342: join(':',caller(1))." ".
5343: join(':',caller(0))." ");
5344: }
5345:
5346: if ($register) {
1.339 albertel 5347: my ($on_load,$on_unload);
5348: foreach my $key (keys(%{$attr_ref})) {
5349: if (lc($key) eq 'onload') {
5350: $on_load.=$attr_ref->{$key}.';';
5351: delete($attr_ref->{$key});
5352:
5353: } elsif (lc($key) eq 'onunload') {
5354: $on_unload.=$attr_ref->{$key}.';';
5355: delete($attr_ref->{$key});
5356: }
5357: }
1.1075.2.12 raeburn 5358: if ($env{'environment.remote'} eq 'on') {
5359: $attr_ref->{'onload'} =
5360: &Apache::lonmenu::loadevents(). $on_load;
5361: $attr_ref->{'onunload'}=
5362: &Apache::lonmenu::unloadevents().$on_unload;
5363: } else {
5364: $attr_ref->{'onload'} = $on_load;
5365: $attr_ref->{'onunload'}= $on_unload;
5366: }
1.330 albertel 5367: }
1.339 albertel 5368:
1.330 albertel 5369: my $attr_string;
1.1075.2.56 raeburn 5370: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5371: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5372: }
5373: return $attr_string;
5374: }
5375:
5376:
1.182 matthew 5377: ###############################################
1.251 albertel 5378: ###############################################
5379:
5380: =pod
5381:
5382: =item * &endbodytag()
5383:
5384: Returns a uniform footer for LON-CAPA web pages.
5385:
1.635 raeburn 5386: Inputs: 1 - optional reference to an args hash
5387: If in the hash, key for noredirectlink has a value which evaluates to true,
5388: a 'Continue' link is not displayed if the page contains an
5389: internal redirect in the <head></head> section,
5390: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5391:
5392: =cut
5393:
5394: sub endbodytag {
1.635 raeburn 5395: my ($args) = @_;
1.1075.2.6 raeburn 5396: my $endbodytag;
5397: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5398: $endbodytag='</body>';
5399: }
1.269 albertel 5400: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5401: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5402: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5403: $endbodytag=
5404: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5405: &mt('Continue').'</a>'.
5406: $endbodytag;
5407: }
1.315 albertel 5408: }
1.251 albertel 5409: return $endbodytag;
5410: }
5411:
1.352 albertel 5412: =pod
5413:
5414: =item * &standard_css()
5415:
5416: Returns a style sheet
5417:
5418: Inputs: (all optional)
5419: domain -> force to color decorate a page for a specific
5420: domain
5421: function -> force usage of a specific rolish color scheme
5422: bgcolor -> override the default page bgcolor
5423:
5424: =cut
5425:
1.343 albertel 5426: sub standard_css {
1.345 albertel 5427: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5428: $function = &get_users_function() if (!$function);
5429: my $img = &designparm($function.'.img', $domain);
5430: my $tabbg = &designparm($function.'.tabbg', $domain);
5431: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5432: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5433: #second colour for later usage
1.345 albertel 5434: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5435: my $pgbg_or_bgcolor =
5436: $bgcolor ||
1.352 albertel 5437: &designparm($function.'.pgbg', $domain);
1.382 albertel 5438: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5439: my $alink = &designparm($function.'.alink', $domain);
5440: my $vlink = &designparm($function.'.vlink', $domain);
5441: my $link = &designparm($function.'.link', $domain);
5442:
1.602 albertel 5443: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5444: my $mono = 'monospace';
1.850 bisitz 5445: my $data_table_head = $sidebg;
5446: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5447: my $data_table_dark = '#E0E0E0';
1.470 banghart 5448: my $data_table_darker = '#CCCCCC';
1.349 albertel 5449: my $data_table_highlight = '#FFFF00';
1.352 albertel 5450: my $mail_new = '#FFBB77';
5451: my $mail_new_hover = '#DD9955';
5452: my $mail_read = '#BBBB77';
5453: my $mail_read_hover = '#999944';
5454: my $mail_replied = '#AAAA88';
5455: my $mail_replied_hover = '#888855';
5456: my $mail_other = '#99BBBB';
5457: my $mail_other_hover = '#669999';
1.391 albertel 5458: my $table_header = '#DDDDDD';
1.489 raeburn 5459: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5460: my $lg_border_color = '#C8C8C8';
1.952 onken 5461: my $button_hover = '#BF2317';
1.392 albertel 5462:
1.608 albertel 5463: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5464: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5465: : '0 3px 0 4px';
1.448 albertel 5466:
1.523 albertel 5467:
1.343 albertel 5468: return <<END;
1.947 droeschl 5469:
5470: /* needed for iframe to allow 100% height in FF */
5471: body, html {
5472: margin: 0;
5473: padding: 0 0.5%;
5474: height: 99%; /* to avoid scrollbars */
5475: }
5476:
1.795 www 5477: body {
1.911 bisitz 5478: font-family: $sans;
5479: line-height:130%;
5480: font-size:0.83em;
5481: color:$font;
1.795 www 5482: }
5483:
1.959 onken 5484: a:focus,
5485: a:focus img {
1.795 www 5486: color: red;
5487: }
1.698 harmsja 5488:
1.911 bisitz 5489: form, .inline {
5490: display: inline;
1.795 www 5491: }
1.721 harmsja 5492:
1.795 www 5493: .LC_right {
1.911 bisitz 5494: text-align:right;
1.795 www 5495: }
5496:
5497: .LC_middle {
1.911 bisitz 5498: vertical-align:middle;
1.795 www 5499: }
1.721 harmsja 5500:
1.1075.2.38 raeburn 5501: .LC_floatleft {
5502: float: left;
5503: }
5504:
5505: .LC_floatright {
5506: float: right;
5507: }
5508:
1.911 bisitz 5509: .LC_400Box {
5510: width:400px;
5511: }
1.721 harmsja 5512:
1.947 droeschl 5513: .LC_iframecontainer {
5514: width: 98%;
5515: margin: 0;
5516: position: fixed;
5517: top: 8.5em;
5518: bottom: 0;
5519: }
5520:
5521: .LC_iframecontainer iframe{
5522: border: none;
5523: width: 100%;
5524: height: 100%;
5525: }
5526:
1.778 bisitz 5527: .LC_filename {
5528: font-family: $mono;
5529: white-space:pre;
1.921 bisitz 5530: font-size: 120%;
1.778 bisitz 5531: }
5532:
5533: .LC_fileicon {
5534: border: none;
5535: height: 1.3em;
5536: vertical-align: text-bottom;
5537: margin-right: 0.3em;
5538: text-decoration:none;
5539: }
5540:
1.1008 www 5541: .LC_setting {
5542: text-decoration:underline;
5543: }
5544:
1.350 albertel 5545: .LC_error {
5546: color: red;
5547: }
1.795 www 5548:
1.1075.2.15 raeburn 5549: .LC_warning {
5550: color: darkorange;
5551: }
5552:
1.457 albertel 5553: .LC_diff_removed {
1.733 bisitz 5554: color: red;
1.394 albertel 5555: }
1.532 albertel 5556:
5557: .LC_info,
1.457 albertel 5558: .LC_success,
5559: .LC_diff_added {
1.350 albertel 5560: color: green;
5561: }
1.795 www 5562:
1.802 bisitz 5563: div.LC_confirm_box {
5564: background-color: #FAFAFA;
5565: border: 1px solid $lg_border_color;
5566: margin-right: 0;
5567: padding: 5px;
5568: }
5569:
5570: div.LC_confirm_box .LC_error img,
5571: div.LC_confirm_box .LC_success img {
5572: vertical-align: middle;
5573: }
5574:
1.440 albertel 5575: .LC_icon {
1.771 droeschl 5576: border: none;
1.790 droeschl 5577: vertical-align: middle;
1.771 droeschl 5578: }
5579:
1.543 albertel 5580: .LC_docs_spacer {
5581: width: 25px;
5582: height: 1px;
1.771 droeschl 5583: border: none;
1.543 albertel 5584: }
1.346 albertel 5585:
1.532 albertel 5586: .LC_internal_info {
1.735 bisitz 5587: color: #999999;
1.532 albertel 5588: }
5589:
1.794 www 5590: .LC_discussion {
1.1050 www 5591: background: $data_table_dark;
1.911 bisitz 5592: border: 1px solid black;
5593: margin: 2px;
1.794 www 5594: }
5595:
5596: .LC_disc_action_left {
1.1050 www 5597: background: $sidebg;
1.911 bisitz 5598: text-align: left;
1.1050 www 5599: padding: 4px;
5600: margin: 2px;
1.794 www 5601: }
5602:
5603: .LC_disc_action_right {
1.1050 www 5604: background: $sidebg;
1.911 bisitz 5605: text-align: right;
1.1050 www 5606: padding: 4px;
5607: margin: 2px;
1.794 www 5608: }
5609:
5610: .LC_disc_new_item {
1.911 bisitz 5611: background: white;
5612: border: 2px solid red;
1.1050 www 5613: margin: 4px;
5614: padding: 4px;
1.794 www 5615: }
5616:
5617: .LC_disc_old_item {
1.911 bisitz 5618: background: white;
1.1050 www 5619: margin: 4px;
5620: padding: 4px;
1.794 www 5621: }
5622:
1.458 albertel 5623: table.LC_pastsubmission {
5624: border: 1px solid black;
5625: margin: 2px;
5626: }
5627:
1.924 bisitz 5628: table#LC_menubuttons {
1.345 albertel 5629: width: 100%;
5630: background: $pgbg;
1.392 albertel 5631: border: 2px;
1.402 albertel 5632: border-collapse: separate;
1.803 bisitz 5633: padding: 0;
1.345 albertel 5634: }
1.392 albertel 5635:
1.801 tempelho 5636: table#LC_title_bar a {
5637: color: $fontmenu;
5638: }
1.836 bisitz 5639:
1.807 droeschl 5640: table#LC_title_bar {
1.819 tempelho 5641: clear: both;
1.836 bisitz 5642: display: none;
1.807 droeschl 5643: }
5644:
1.795 www 5645: table#LC_title_bar,
1.933 droeschl 5646: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5647: table#LC_title_bar.LC_with_remote {
1.359 albertel 5648: width: 100%;
1.392 albertel 5649: border-color: $pgbg;
5650: border-style: solid;
5651: border-width: $border;
1.379 albertel 5652: background: $pgbg;
1.801 tempelho 5653: color: $fontmenu;
1.392 albertel 5654: border-collapse: collapse;
1.803 bisitz 5655: padding: 0;
1.819 tempelho 5656: margin: 0;
1.359 albertel 5657: }
1.795 www 5658:
1.933 droeschl 5659: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5660: margin: 0;
5661: padding: 0;
1.933 droeschl 5662: position: relative;
5663: list-style: none;
1.913 droeschl 5664: }
1.933 droeschl 5665: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5666: display: inline;
5667: }
1.933 droeschl 5668:
5669: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5670: padding: 0;
1.933 droeschl 5671: margin: 0;
5672: float: left;
1.913 droeschl 5673: }
1.933 droeschl 5674: .LC_breadcrumb_tools_tools {
5675: padding: 0;
5676: margin: 0;
1.913 droeschl 5677: float: right;
5678: }
5679:
1.359 albertel 5680: table#LC_title_bar td {
5681: background: $tabbg;
5682: }
1.795 www 5683:
1.911 bisitz 5684: table#LC_menubuttons img {
1.803 bisitz 5685: border: none;
1.346 albertel 5686: }
1.795 www 5687:
1.842 droeschl 5688: .LC_breadcrumbs_component {
1.911 bisitz 5689: float: right;
5690: margin: 0 1em;
1.357 albertel 5691: }
1.842 droeschl 5692: .LC_breadcrumbs_component img {
1.911 bisitz 5693: vertical-align: middle;
1.777 tempelho 5694: }
1.795 www 5695:
1.383 albertel 5696: td.LC_table_cell_checkbox {
5697: text-align: center;
5698: }
1.795 www 5699:
5700: .LC_fontsize_small {
1.911 bisitz 5701: font-size: 70%;
1.705 tempelho 5702: }
5703:
1.844 bisitz 5704: #LC_breadcrumbs {
1.911 bisitz 5705: clear:both;
5706: background: $sidebg;
5707: border-bottom: 1px solid $lg_border_color;
5708: line-height: 2.5em;
1.933 droeschl 5709: overflow: hidden;
1.911 bisitz 5710: margin: 0;
5711: padding: 0;
1.995 raeburn 5712: text-align: left;
1.819 tempelho 5713: }
1.862 bisitz 5714:
1.1075.2.16 raeburn 5715: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5716: clear:both;
5717: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5718: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5719: margin: 0 0 10px 0;
1.966 bisitz 5720: padding: 3px;
1.995 raeburn 5721: text-align: left;
1.822 bisitz 5722: }
5723:
1.795 www 5724: .LC_fontsize_medium {
1.911 bisitz 5725: font-size: 85%;
1.705 tempelho 5726: }
5727:
1.795 www 5728: .LC_fontsize_large {
1.911 bisitz 5729: font-size: 120%;
1.705 tempelho 5730: }
5731:
1.346 albertel 5732: .LC_menubuttons_inline_text {
5733: color: $font;
1.698 harmsja 5734: font-size: 90%;
1.701 harmsja 5735: padding-left:3px;
1.346 albertel 5736: }
5737:
1.934 droeschl 5738: .LC_menubuttons_inline_text img{
5739: vertical-align: middle;
5740: }
5741:
1.1051 www 5742: li.LC_menubuttons_inline_text img {
1.951 onken 5743: cursor:pointer;
1.1002 droeschl 5744: text-decoration: none;
1.951 onken 5745: }
5746:
1.526 www 5747: .LC_menubuttons_link {
5748: text-decoration: none;
5749: }
1.795 www 5750:
1.522 albertel 5751: .LC_menubuttons_category {
1.521 www 5752: color: $font;
1.526 www 5753: background: $pgbg;
1.521 www 5754: font-size: larger;
5755: font-weight: bold;
5756: }
5757:
1.346 albertel 5758: td.LC_menubuttons_text {
1.911 bisitz 5759: color: $font;
1.346 albertel 5760: }
1.706 harmsja 5761:
1.346 albertel 5762: .LC_current_location {
5763: background: $tabbg;
5764: }
1.795 www 5765:
1.938 bisitz 5766: table.LC_data_table {
1.347 albertel 5767: border: 1px solid #000000;
1.402 albertel 5768: border-collapse: separate;
1.426 albertel 5769: border-spacing: 1px;
1.610 albertel 5770: background: $pgbg;
1.347 albertel 5771: }
1.795 www 5772:
1.422 albertel 5773: .LC_data_table_dense {
5774: font-size: small;
5775: }
1.795 www 5776:
1.507 raeburn 5777: table.LC_nested_outer {
5778: border: 1px solid #000000;
1.589 raeburn 5779: border-collapse: collapse;
1.803 bisitz 5780: border-spacing: 0;
1.507 raeburn 5781: width: 100%;
5782: }
1.795 www 5783:
1.879 raeburn 5784: table.LC_innerpickbox,
1.507 raeburn 5785: table.LC_nested {
1.803 bisitz 5786: border: none;
1.589 raeburn 5787: border-collapse: collapse;
1.803 bisitz 5788: border-spacing: 0;
1.507 raeburn 5789: width: 100%;
5790: }
1.795 www 5791:
1.911 bisitz 5792: table.LC_data_table tr th,
5793: table.LC_calendar tr th,
1.879 raeburn 5794: table.LC_prior_tries tr th,
5795: table.LC_innerpickbox tr th {
1.349 albertel 5796: font-weight: bold;
5797: background-color: $data_table_head;
1.801 tempelho 5798: color:$fontmenu;
1.701 harmsja 5799: font-size:90%;
1.347 albertel 5800: }
1.795 www 5801:
1.879 raeburn 5802: table.LC_innerpickbox tr th,
5803: table.LC_innerpickbox tr td {
5804: vertical-align: top;
5805: }
5806:
1.711 raeburn 5807: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5808: background-color: #CCCCCC;
1.711 raeburn 5809: font-weight: bold;
5810: text-align: left;
5811: }
1.795 www 5812:
1.912 bisitz 5813: table.LC_data_table tr.LC_odd_row > td {
5814: background-color: $data_table_light;
5815: padding: 2px;
5816: vertical-align: top;
5817: }
5818:
1.809 bisitz 5819: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5820: background-color: $data_table_light;
1.912 bisitz 5821: vertical-align: top;
5822: }
5823:
5824: table.LC_data_table tr.LC_even_row > td {
5825: background-color: $data_table_dark;
1.425 albertel 5826: padding: 2px;
1.900 bisitz 5827: vertical-align: top;
1.347 albertel 5828: }
1.795 www 5829:
1.809 bisitz 5830: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5831: background-color: $data_table_dark;
1.900 bisitz 5832: vertical-align: top;
1.347 albertel 5833: }
1.795 www 5834:
1.425 albertel 5835: table.LC_data_table tr.LC_data_table_highlight td {
5836: background-color: $data_table_darker;
5837: }
1.795 www 5838:
1.639 raeburn 5839: table.LC_data_table tr td.LC_leftcol_header {
5840: background-color: $data_table_head;
5841: font-weight: bold;
5842: }
1.795 www 5843:
1.451 albertel 5844: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5845: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5846: font-weight: bold;
5847: font-style: italic;
5848: text-align: center;
5849: padding: 8px;
1.347 albertel 5850: }
1.795 www 5851:
1.1075.2.30 raeburn 5852: table.LC_data_table tr.LC_empty_row td,
5853: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5854: background-color: $sidebg;
5855: }
5856:
5857: table.LC_nested tr.LC_empty_row td {
5858: background-color: #FFFFFF;
5859: }
5860:
1.890 droeschl 5861: table.LC_caption {
5862: }
5863:
1.507 raeburn 5864: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5865: padding: 4ex
5866: }
1.795 www 5867:
1.507 raeburn 5868: table.LC_nested_outer tr th {
5869: font-weight: bold;
1.801 tempelho 5870: color:$fontmenu;
1.507 raeburn 5871: background-color: $data_table_head;
1.701 harmsja 5872: font-size: small;
1.507 raeburn 5873: border-bottom: 1px solid #000000;
5874: }
1.795 www 5875:
1.507 raeburn 5876: table.LC_nested_outer tr td.LC_subheader {
5877: background-color: $data_table_head;
5878: font-weight: bold;
5879: font-size: small;
5880: border-bottom: 1px solid #000000;
5881: text-align: right;
1.451 albertel 5882: }
1.795 www 5883:
1.507 raeburn 5884: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5885: background-color: #CCCCCC;
1.451 albertel 5886: font-weight: bold;
5887: font-size: small;
1.507 raeburn 5888: text-align: center;
5889: }
1.795 www 5890:
1.589 raeburn 5891: table.LC_nested tr.LC_info_row td.LC_left_item,
5892: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5893: text-align: left;
1.451 albertel 5894: }
1.795 www 5895:
1.507 raeburn 5896: table.LC_nested td {
1.735 bisitz 5897: background-color: #FFFFFF;
1.451 albertel 5898: font-size: small;
1.507 raeburn 5899: }
1.795 www 5900:
1.507 raeburn 5901: table.LC_nested_outer tr th.LC_right_item,
5902: table.LC_nested tr.LC_info_row td.LC_right_item,
5903: table.LC_nested tr.LC_odd_row td.LC_right_item,
5904: table.LC_nested tr td.LC_right_item {
1.451 albertel 5905: text-align: right;
5906: }
5907:
1.507 raeburn 5908: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5909: background-color: #EEEEEE;
1.451 albertel 5910: }
5911:
1.473 raeburn 5912: table.LC_createuser {
5913: }
5914:
5915: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5916: font-size: small;
1.473 raeburn 5917: }
5918:
5919: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5920: background-color: #CCCCCC;
1.473 raeburn 5921: font-weight: bold;
5922: text-align: center;
5923: }
5924:
1.349 albertel 5925: table.LC_calendar {
5926: border: 1px solid #000000;
5927: border-collapse: collapse;
1.917 raeburn 5928: width: 98%;
1.349 albertel 5929: }
1.795 www 5930:
1.349 albertel 5931: table.LC_calendar_pickdate {
5932: font-size: xx-small;
5933: }
1.795 www 5934:
1.349 albertel 5935: table.LC_calendar tr td {
5936: border: 1px solid #000000;
5937: vertical-align: top;
1.917 raeburn 5938: width: 14%;
1.349 albertel 5939: }
1.795 www 5940:
1.349 albertel 5941: table.LC_calendar tr td.LC_calendar_day_empty {
5942: background-color: $data_table_dark;
5943: }
1.795 www 5944:
1.779 bisitz 5945: table.LC_calendar tr td.LC_calendar_day_current {
5946: background-color: $data_table_highlight;
1.777 tempelho 5947: }
1.795 www 5948:
1.938 bisitz 5949: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5950: background-color: $mail_new;
5951: }
1.795 www 5952:
1.938 bisitz 5953: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5954: background-color: $mail_new_hover;
5955: }
1.795 www 5956:
1.938 bisitz 5957: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5958: background-color: $mail_read;
5959: }
1.795 www 5960:
1.938 bisitz 5961: /*
5962: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5963: background-color: $mail_read_hover;
5964: }
1.938 bisitz 5965: */
1.795 www 5966:
1.938 bisitz 5967: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5968: background-color: $mail_replied;
5969: }
1.795 www 5970:
1.938 bisitz 5971: /*
5972: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5973: background-color: $mail_replied_hover;
5974: }
1.938 bisitz 5975: */
1.795 www 5976:
1.938 bisitz 5977: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5978: background-color: $mail_other;
5979: }
1.795 www 5980:
1.938 bisitz 5981: /*
5982: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5983: background-color: $mail_other_hover;
5984: }
1.938 bisitz 5985: */
1.494 raeburn 5986:
1.777 tempelho 5987: table.LC_data_table tr > td.LC_browser_file,
5988: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5989: background: #AAEE77;
1.389 albertel 5990: }
1.795 www 5991:
1.777 tempelho 5992: table.LC_data_table tr > td.LC_browser_file_locked,
5993: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5994: background: #FFAA99;
1.387 albertel 5995: }
1.795 www 5996:
1.777 tempelho 5997: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5998: background: #888888;
1.779 bisitz 5999: }
1.795 www 6000:
1.777 tempelho 6001: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6002: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6003: background: #F8F866;
1.777 tempelho 6004: }
1.795 www 6005:
1.696 bisitz 6006: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6007: background: #E0E8FF;
1.387 albertel 6008: }
1.696 bisitz 6009:
1.707 bisitz 6010: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6011: /* background: #77FF77; */
1.707 bisitz 6012: }
1.795 www 6013:
1.707 bisitz 6014: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6015: border-right: 8px solid #FFFF77;
1.707 bisitz 6016: }
1.795 www 6017:
1.707 bisitz 6018: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6019: border-right: 8px solid #FFAA77;
1.707 bisitz 6020: }
1.795 www 6021:
1.707 bisitz 6022: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6023: border-right: 8px solid #FF7777;
1.707 bisitz 6024: }
1.795 www 6025:
1.707 bisitz 6026: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6027: border-right: 8px solid #AAFF77;
1.707 bisitz 6028: }
1.795 www 6029:
1.707 bisitz 6030: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6031: border-right: 8px solid #11CC55;
1.707 bisitz 6032: }
6033:
1.388 albertel 6034: span.LC_current_location {
1.701 harmsja 6035: font-size:larger;
1.388 albertel 6036: background: $pgbg;
6037: }
1.387 albertel 6038:
1.1029 www 6039: span.LC_current_nav_location {
6040: font-weight:bold;
6041: background: $sidebg;
6042: }
6043:
1.395 albertel 6044: span.LC_parm_menu_item {
6045: font-size: larger;
6046: }
1.795 www 6047:
1.395 albertel 6048: span.LC_parm_scope_all {
6049: color: red;
6050: }
1.795 www 6051:
1.395 albertel 6052: span.LC_parm_scope_folder {
6053: color: green;
6054: }
1.795 www 6055:
1.395 albertel 6056: span.LC_parm_scope_resource {
6057: color: orange;
6058: }
1.795 www 6059:
1.395 albertel 6060: span.LC_parm_part {
6061: color: blue;
6062: }
1.795 www 6063:
1.911 bisitz 6064: span.LC_parm_folder,
6065: span.LC_parm_symb {
1.395 albertel 6066: font-size: x-small;
6067: font-family: $mono;
6068: color: #AAAAAA;
6069: }
6070:
1.977 bisitz 6071: ul.LC_parm_parmlist li {
6072: display: inline-block;
6073: padding: 0.3em 0.8em;
6074: vertical-align: top;
6075: width: 150px;
6076: border-top:1px solid $lg_border_color;
6077: }
6078:
1.795 www 6079: td.LC_parm_overview_level_menu,
6080: td.LC_parm_overview_map_menu,
6081: td.LC_parm_overview_parm_selectors,
6082: td.LC_parm_overview_restrictions {
1.396 albertel 6083: border: 1px solid black;
6084: border-collapse: collapse;
6085: }
1.795 www 6086:
1.396 albertel 6087: table.LC_parm_overview_restrictions td {
6088: border-width: 1px 4px 1px 4px;
6089: border-style: solid;
6090: border-color: $pgbg;
6091: text-align: center;
6092: }
1.795 www 6093:
1.396 albertel 6094: table.LC_parm_overview_restrictions th {
6095: background: $tabbg;
6096: border-width: 1px 4px 1px 4px;
6097: border-style: solid;
6098: border-color: $pgbg;
6099: }
1.795 www 6100:
1.398 albertel 6101: table#LC_helpmenu {
1.803 bisitz 6102: border: none;
1.398 albertel 6103: height: 55px;
1.803 bisitz 6104: border-spacing: 0;
1.398 albertel 6105: }
6106:
6107: table#LC_helpmenu fieldset legend {
6108: font-size: larger;
6109: }
1.795 www 6110:
1.397 albertel 6111: table#LC_helpmenu_links {
6112: width: 100%;
6113: border: 1px solid black;
6114: background: $pgbg;
1.803 bisitz 6115: padding: 0;
1.397 albertel 6116: border-spacing: 1px;
6117: }
1.795 www 6118:
1.397 albertel 6119: table#LC_helpmenu_links tr td {
6120: padding: 1px;
6121: background: $tabbg;
1.399 albertel 6122: text-align: center;
6123: font-weight: bold;
1.397 albertel 6124: }
1.396 albertel 6125:
1.795 www 6126: table#LC_helpmenu_links a:link,
6127: table#LC_helpmenu_links a:visited,
1.397 albertel 6128: table#LC_helpmenu_links a:active {
6129: text-decoration: none;
6130: color: $font;
6131: }
1.795 www 6132:
1.397 albertel 6133: table#LC_helpmenu_links a:hover {
6134: text-decoration: underline;
6135: color: $vlink;
6136: }
1.396 albertel 6137:
1.417 albertel 6138: .LC_chrt_popup_exists {
6139: border: 1px solid #339933;
6140: margin: -1px;
6141: }
1.795 www 6142:
1.417 albertel 6143: .LC_chrt_popup_up {
6144: border: 1px solid yellow;
6145: margin: -1px;
6146: }
1.795 www 6147:
1.417 albertel 6148: .LC_chrt_popup {
6149: border: 1px solid #8888FF;
6150: background: #CCCCFF;
6151: }
1.795 www 6152:
1.421 albertel 6153: table.LC_pick_box {
6154: border-collapse: separate;
6155: background: white;
6156: border: 1px solid black;
6157: border-spacing: 1px;
6158: }
1.795 www 6159:
1.421 albertel 6160: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6161: background: $sidebg;
1.421 albertel 6162: font-weight: bold;
1.900 bisitz 6163: text-align: left;
1.740 bisitz 6164: vertical-align: top;
1.421 albertel 6165: width: 184px;
6166: padding: 8px;
6167: }
1.795 www 6168:
1.579 raeburn 6169: table.LC_pick_box td.LC_pick_box_value {
6170: text-align: left;
6171: padding: 8px;
6172: }
1.795 www 6173:
1.579 raeburn 6174: table.LC_pick_box td.LC_pick_box_select {
6175: text-align: left;
6176: padding: 8px;
6177: }
1.795 www 6178:
1.424 albertel 6179: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6180: padding: 0;
1.421 albertel 6181: height: 1px;
6182: background: black;
6183: }
1.795 www 6184:
1.421 albertel 6185: table.LC_pick_box td.LC_pick_box_submit {
6186: text-align: right;
6187: }
1.795 www 6188:
1.579 raeburn 6189: table.LC_pick_box td.LC_evenrow_value {
6190: text-align: left;
6191: padding: 8px;
6192: background-color: $data_table_light;
6193: }
1.795 www 6194:
1.579 raeburn 6195: table.LC_pick_box td.LC_oddrow_value {
6196: text-align: left;
6197: padding: 8px;
6198: background-color: $data_table_light;
6199: }
1.795 www 6200:
1.579 raeburn 6201: span.LC_helpform_receipt_cat {
6202: font-weight: bold;
6203: }
1.795 www 6204:
1.424 albertel 6205: table.LC_group_priv_box {
6206: background: white;
6207: border: 1px solid black;
6208: border-spacing: 1px;
6209: }
1.795 www 6210:
1.424 albertel 6211: table.LC_group_priv_box td.LC_pick_box_title {
6212: background: $tabbg;
6213: font-weight: bold;
6214: text-align: right;
6215: width: 184px;
6216: }
1.795 www 6217:
1.424 albertel 6218: table.LC_group_priv_box td.LC_groups_fixed {
6219: background: $data_table_light;
6220: text-align: center;
6221: }
1.795 www 6222:
1.424 albertel 6223: table.LC_group_priv_box td.LC_groups_optional {
6224: background: $data_table_dark;
6225: text-align: center;
6226: }
1.795 www 6227:
1.424 albertel 6228: table.LC_group_priv_box td.LC_groups_functionality {
6229: background: $data_table_darker;
6230: text-align: center;
6231: font-weight: bold;
6232: }
1.795 www 6233:
1.424 albertel 6234: table.LC_group_priv td {
6235: text-align: left;
1.803 bisitz 6236: padding: 0;
1.424 albertel 6237: }
6238:
6239: .LC_navbuttons {
6240: margin: 2ex 0ex 2ex 0ex;
6241: }
1.795 www 6242:
1.423 albertel 6243: .LC_topic_bar {
6244: font-weight: bold;
6245: background: $tabbg;
1.918 wenzelju 6246: margin: 1em 0em 1em 2em;
1.805 bisitz 6247: padding: 3px;
1.918 wenzelju 6248: font-size: 1.2em;
1.423 albertel 6249: }
1.795 www 6250:
1.423 albertel 6251: .LC_topic_bar span {
1.918 wenzelju 6252: left: 0.5em;
6253: position: absolute;
1.423 albertel 6254: vertical-align: middle;
1.918 wenzelju 6255: font-size: 1.2em;
1.423 albertel 6256: }
1.795 www 6257:
1.423 albertel 6258: table.LC_course_group_status {
6259: margin: 20px;
6260: }
1.795 www 6261:
1.423 albertel 6262: table.LC_status_selector td {
6263: vertical-align: top;
6264: text-align: center;
1.424 albertel 6265: padding: 4px;
6266: }
1.795 www 6267:
1.599 albertel 6268: div.LC_feedback_link {
1.616 albertel 6269: clear: both;
1.829 kalberla 6270: background: $sidebg;
1.779 bisitz 6271: width: 100%;
1.829 kalberla 6272: padding-bottom: 10px;
6273: border: 1px $tabbg solid;
1.833 kalberla 6274: height: 22px;
6275: line-height: 22px;
6276: padding-top: 5px;
6277: }
6278:
6279: div.LC_feedback_link img {
6280: height: 22px;
1.867 kalberla 6281: vertical-align:middle;
1.829 kalberla 6282: }
6283:
1.911 bisitz 6284: div.LC_feedback_link a {
1.829 kalberla 6285: text-decoration: none;
1.489 raeburn 6286: }
1.795 www 6287:
1.867 kalberla 6288: div.LC_comblock {
1.911 bisitz 6289: display:inline;
1.867 kalberla 6290: color:$font;
6291: font-size:90%;
6292: }
6293:
6294: div.LC_feedback_link div.LC_comblock {
6295: padding-left:5px;
6296: }
6297:
6298: div.LC_feedback_link div.LC_comblock a {
6299: color:$font;
6300: }
6301:
1.489 raeburn 6302: span.LC_feedback_link {
1.858 bisitz 6303: /* background: $feedback_link_bg; */
1.599 albertel 6304: font-size: larger;
6305: }
1.795 www 6306:
1.599 albertel 6307: span.LC_message_link {
1.858 bisitz 6308: /* background: $feedback_link_bg; */
1.599 albertel 6309: font-size: larger;
6310: position: absolute;
6311: right: 1em;
1.489 raeburn 6312: }
1.421 albertel 6313:
1.515 albertel 6314: table.LC_prior_tries {
1.524 albertel 6315: border: 1px solid #000000;
6316: border-collapse: separate;
6317: border-spacing: 1px;
1.515 albertel 6318: }
1.523 albertel 6319:
1.515 albertel 6320: table.LC_prior_tries td {
1.524 albertel 6321: padding: 2px;
1.515 albertel 6322: }
1.523 albertel 6323:
6324: .LC_answer_correct {
1.795 www 6325: background: lightgreen;
6326: color: darkgreen;
6327: padding: 6px;
1.523 albertel 6328: }
1.795 www 6329:
1.523 albertel 6330: .LC_answer_charged_try {
1.797 www 6331: background: #FFAAAA;
1.795 www 6332: color: darkred;
6333: padding: 6px;
1.523 albertel 6334: }
1.795 www 6335:
1.779 bisitz 6336: .LC_answer_not_charged_try,
1.523 albertel 6337: .LC_answer_no_grade,
6338: .LC_answer_late {
1.795 www 6339: background: lightyellow;
1.523 albertel 6340: color: black;
1.795 www 6341: padding: 6px;
1.523 albertel 6342: }
1.795 www 6343:
1.523 albertel 6344: .LC_answer_previous {
1.795 www 6345: background: lightblue;
6346: color: darkblue;
6347: padding: 6px;
1.523 albertel 6348: }
1.795 www 6349:
1.779 bisitz 6350: .LC_answer_no_message {
1.777 tempelho 6351: background: #FFFFFF;
6352: color: black;
1.795 www 6353: padding: 6px;
1.779 bisitz 6354: }
1.795 www 6355:
1.779 bisitz 6356: .LC_answer_unknown {
6357: background: orange;
6358: color: black;
1.795 www 6359: padding: 6px;
1.777 tempelho 6360: }
1.795 www 6361:
1.529 albertel 6362: span.LC_prior_numerical,
6363: span.LC_prior_string,
6364: span.LC_prior_custom,
6365: span.LC_prior_reaction,
6366: span.LC_prior_math {
1.925 bisitz 6367: font-family: $mono;
1.523 albertel 6368: white-space: pre;
6369: }
6370:
1.525 albertel 6371: span.LC_prior_string {
1.925 bisitz 6372: font-family: $mono;
1.525 albertel 6373: white-space: pre;
6374: }
6375:
1.523 albertel 6376: table.LC_prior_option {
6377: width: 100%;
6378: border-collapse: collapse;
6379: }
1.795 www 6380:
1.911 bisitz 6381: table.LC_prior_rank,
1.795 www 6382: table.LC_prior_match {
1.528 albertel 6383: border-collapse: collapse;
6384: }
1.795 www 6385:
1.528 albertel 6386: table.LC_prior_option tr td,
6387: table.LC_prior_rank tr td,
6388: table.LC_prior_match tr td {
1.524 albertel 6389: border: 1px solid #000000;
1.515 albertel 6390: }
6391:
1.855 bisitz 6392: .LC_nobreak {
1.544 albertel 6393: white-space: nowrap;
1.519 raeburn 6394: }
6395:
1.576 raeburn 6396: span.LC_cusr_emph {
6397: font-style: italic;
6398: }
6399:
1.633 raeburn 6400: span.LC_cusr_subheading {
6401: font-weight: normal;
6402: font-size: 85%;
6403: }
6404:
1.861 bisitz 6405: div.LC_docs_entry_move {
1.859 bisitz 6406: border: 1px solid #BBBBBB;
1.545 albertel 6407: background: #DDDDDD;
1.861 bisitz 6408: width: 22px;
1.859 bisitz 6409: padding: 1px;
6410: margin: 0;
1.545 albertel 6411: }
6412:
1.861 bisitz 6413: table.LC_data_table tr > td.LC_docs_entry_commands,
6414: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6415: font-size: x-small;
6416: }
1.795 www 6417:
1.861 bisitz 6418: .LC_docs_entry_parameter {
6419: white-space: nowrap;
6420: }
6421:
1.544 albertel 6422: .LC_docs_copy {
1.545 albertel 6423: color: #000099;
1.544 albertel 6424: }
1.795 www 6425:
1.544 albertel 6426: .LC_docs_cut {
1.545 albertel 6427: color: #550044;
1.544 albertel 6428: }
1.795 www 6429:
1.544 albertel 6430: .LC_docs_rename {
1.545 albertel 6431: color: #009900;
1.544 albertel 6432: }
1.795 www 6433:
1.544 albertel 6434: .LC_docs_remove {
1.545 albertel 6435: color: #990000;
6436: }
6437:
1.547 albertel 6438: .LC_docs_reinit_warn,
6439: .LC_docs_ext_edit {
6440: font-size: x-small;
6441: }
6442:
1.545 albertel 6443: table.LC_docs_adddocs td,
6444: table.LC_docs_adddocs th {
6445: border: 1px solid #BBBBBB;
6446: padding: 4px;
6447: background: #DDDDDD;
1.543 albertel 6448: }
6449:
1.584 albertel 6450: table.LC_sty_begin {
6451: background: #BBFFBB;
6452: }
1.795 www 6453:
1.584 albertel 6454: table.LC_sty_end {
6455: background: #FFBBBB;
6456: }
6457:
1.589 raeburn 6458: table.LC_double_column {
1.803 bisitz 6459: border-width: 0;
1.589 raeburn 6460: border-collapse: collapse;
6461: width: 100%;
6462: padding: 2px;
6463: }
6464:
6465: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6466: top: 2px;
1.589 raeburn 6467: left: 2px;
6468: width: 47%;
6469: vertical-align: top;
6470: }
6471:
6472: table.LC_double_column tr td.LC_right_col {
6473: top: 2px;
1.779 bisitz 6474: right: 2px;
1.589 raeburn 6475: width: 47%;
6476: vertical-align: top;
6477: }
6478:
1.591 raeburn 6479: div.LC_left_float {
6480: float: left;
6481: padding-right: 5%;
1.597 albertel 6482: padding-bottom: 4px;
1.591 raeburn 6483: }
6484:
6485: div.LC_clear_float_header {
1.597 albertel 6486: padding-bottom: 2px;
1.591 raeburn 6487: }
6488:
6489: div.LC_clear_float_footer {
1.597 albertel 6490: padding-top: 10px;
1.591 raeburn 6491: clear: both;
6492: }
6493:
1.597 albertel 6494: div.LC_grade_show_user {
1.941 bisitz 6495: /* border-left: 5px solid $sidebg; */
6496: border-top: 5px solid #000000;
6497: margin: 50px 0 0 0;
1.936 bisitz 6498: padding: 15px 0 5px 10px;
1.597 albertel 6499: }
1.795 www 6500:
1.936 bisitz 6501: div.LC_grade_show_user_odd_row {
1.941 bisitz 6502: /* border-left: 5px solid #000000; */
6503: }
6504:
6505: div.LC_grade_show_user div.LC_Box {
6506: margin-right: 50px;
1.597 albertel 6507: }
6508:
6509: div.LC_grade_submissions,
6510: div.LC_grade_message_center,
1.936 bisitz 6511: div.LC_grade_info_links {
1.597 albertel 6512: margin: 5px;
6513: width: 99%;
6514: background: #FFFFFF;
6515: }
1.795 www 6516:
1.597 albertel 6517: div.LC_grade_submissions_header,
1.936 bisitz 6518: div.LC_grade_message_center_header {
1.705 tempelho 6519: font-weight: bold;
6520: font-size: large;
1.597 albertel 6521: }
1.795 www 6522:
1.597 albertel 6523: div.LC_grade_submissions_body,
1.936 bisitz 6524: div.LC_grade_message_center_body {
1.597 albertel 6525: border: 1px solid black;
6526: width: 99%;
6527: background: #FFFFFF;
6528: }
1.795 www 6529:
1.613 albertel 6530: table.LC_scantron_action {
6531: width: 100%;
6532: }
1.795 www 6533:
1.613 albertel 6534: table.LC_scantron_action tr th {
1.698 harmsja 6535: font-weight:bold;
6536: font-style:normal;
1.613 albertel 6537: }
1.795 www 6538:
1.779 bisitz 6539: .LC_edit_problem_header,
1.614 albertel 6540: div.LC_edit_problem_footer {
1.705 tempelho 6541: font-weight: normal;
6542: font-size: medium;
1.602 albertel 6543: margin: 2px;
1.1060 bisitz 6544: background-color: $sidebg;
1.600 albertel 6545: }
1.795 www 6546:
1.600 albertel 6547: div.LC_edit_problem_header,
1.602 albertel 6548: div.LC_edit_problem_header div,
1.614 albertel 6549: div.LC_edit_problem_footer,
6550: div.LC_edit_problem_footer div,
1.602 albertel 6551: div.LC_edit_problem_editxml_header,
6552: div.LC_edit_problem_editxml_header div {
1.600 albertel 6553: margin-top: 5px;
6554: }
1.795 www 6555:
1.600 albertel 6556: div.LC_edit_problem_header_title {
1.705 tempelho 6557: font-weight: bold;
6558: font-size: larger;
1.602 albertel 6559: background: $tabbg;
6560: padding: 3px;
1.1060 bisitz 6561: margin: 0 0 5px 0;
1.602 albertel 6562: }
1.795 www 6563:
1.602 albertel 6564: table.LC_edit_problem_header_title {
6565: width: 100%;
1.600 albertel 6566: background: $tabbg;
1.602 albertel 6567: }
6568:
6569: div.LC_edit_problem_discards {
6570: float: left;
6571: padding-bottom: 5px;
6572: }
1.795 www 6573:
1.602 albertel 6574: div.LC_edit_problem_saves {
6575: float: right;
6576: padding-bottom: 5px;
1.600 albertel 6577: }
1.795 www 6578:
1.1075.2.34 raeburn 6579: .LC_edit_opt {
6580: padding-left: 1em;
6581: white-space: nowrap;
6582: }
6583:
1.1075.2.57 raeburn 6584: .LC_edit_problem_latexhelper{
6585: text-align: right;
6586: }
6587:
6588: #LC_edit_problem_colorful div{
6589: margin-left: 40px;
6590: }
6591:
1.911 bisitz 6592: img.stift {
1.803 bisitz 6593: border-width: 0;
6594: vertical-align: middle;
1.677 riegler 6595: }
1.680 riegler 6596:
1.923 bisitz 6597: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6598: vertical-align: top;
1.777 tempelho 6599: }
1.795 www 6600:
1.716 raeburn 6601: div.LC_createcourse {
1.911 bisitz 6602: margin: 10px 10px 10px 10px;
1.716 raeburn 6603: }
6604:
1.917 raeburn 6605: .LC_dccid {
1.1075.2.38 raeburn 6606: float: right;
1.917 raeburn 6607: margin: 0.2em 0 0 0;
6608: padding: 0;
6609: font-size: 90%;
6610: display:none;
6611: }
6612:
1.897 wenzelju 6613: ol.LC_primary_menu a:hover,
1.721 harmsja 6614: ol#LC_MenuBreadcrumbs a:hover,
6615: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6616: ul#LC_secondary_menu a:hover,
1.721 harmsja 6617: .LC_FormSectionClearButton input:hover
1.795 www 6618: ul.LC_TabContent li:hover a {
1.952 onken 6619: color:$button_hover;
1.911 bisitz 6620: text-decoration:none;
1.693 droeschl 6621: }
6622:
1.779 bisitz 6623: h1 {
1.911 bisitz 6624: padding: 0;
6625: line-height:130%;
1.693 droeschl 6626: }
1.698 harmsja 6627:
1.911 bisitz 6628: h2,
6629: h3,
6630: h4,
6631: h5,
6632: h6 {
6633: margin: 5px 0 5px 0;
6634: padding: 0;
6635: line-height:130%;
1.693 droeschl 6636: }
1.795 www 6637:
6638: .LC_hcell {
1.911 bisitz 6639: padding:3px 15px 3px 15px;
6640: margin: 0;
6641: background-color:$tabbg;
6642: color:$fontmenu;
6643: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6644: }
1.795 www 6645:
1.840 bisitz 6646: .LC_Box > .LC_hcell {
1.911 bisitz 6647: margin: 0 -10px 10px -10px;
1.835 bisitz 6648: }
6649:
1.721 harmsja 6650: .LC_noBorder {
1.911 bisitz 6651: border: 0;
1.698 harmsja 6652: }
1.693 droeschl 6653:
1.721 harmsja 6654: .LC_FormSectionClearButton input {
1.911 bisitz 6655: background-color:transparent;
6656: border: none;
6657: cursor:pointer;
6658: text-decoration:underline;
1.693 droeschl 6659: }
1.763 bisitz 6660:
6661: .LC_help_open_topic {
1.911 bisitz 6662: color: #FFFFFF;
6663: background-color: #EEEEFF;
6664: margin: 1px;
6665: padding: 4px;
6666: border: 1px solid #000033;
6667: white-space: nowrap;
6668: /* vertical-align: middle; */
1.759 neumanie 6669: }
1.693 droeschl 6670:
1.911 bisitz 6671: dl,
6672: ul,
6673: div,
6674: fieldset {
6675: margin: 10px 10px 10px 0;
6676: /* overflow: hidden; */
1.693 droeschl 6677: }
1.795 www 6678:
1.1075.2.90! raeburn 6679: article.geogebraweb div {
! 6680: margin: 0;
! 6681: }
! 6682:
1.838 bisitz 6683: fieldset > legend {
1.911 bisitz 6684: font-weight: bold;
6685: padding: 0 5px 0 5px;
1.838 bisitz 6686: }
6687:
1.813 bisitz 6688: #LC_nav_bar {
1.911 bisitz 6689: float: left;
1.995 raeburn 6690: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6691: margin: 0 0 2px 0;
1.807 droeschl 6692: }
6693:
1.916 droeschl 6694: #LC_realm {
6695: margin: 0.2em 0 0 0;
6696: padding: 0;
6697: font-weight: bold;
6698: text-align: center;
1.995 raeburn 6699: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6700: }
6701:
1.911 bisitz 6702: #LC_nav_bar em {
6703: font-weight: bold;
6704: font-style: normal;
1.807 droeschl 6705: }
6706:
1.897 wenzelju 6707: ol.LC_primary_menu {
1.934 droeschl 6708: margin: 0;
1.1075.2.2 raeburn 6709: padding: 0;
1.995 raeburn 6710: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6711: }
6712:
1.852 droeschl 6713: ol#LC_PathBreadcrumbs {
1.911 bisitz 6714: margin: 0;
1.693 droeschl 6715: }
6716:
1.897 wenzelju 6717: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6718: color: RGB(80, 80, 80);
6719: vertical-align: middle;
6720: text-align: left;
6721: list-style: none;
6722: float: left;
6723: }
6724:
6725: ol.LC_primary_menu li a {
6726: display: block;
6727: margin: 0;
6728: padding: 0 5px 0 10px;
6729: text-decoration: none;
6730: }
6731:
6732: ol.LC_primary_menu li ul {
6733: display: none;
6734: width: 10em;
6735: background-color: $data_table_light;
6736: }
6737:
6738: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6739: display: block;
6740: position: absolute;
6741: margin: 0;
6742: padding: 0;
1.1075.2.5 raeburn 6743: z-index: 2;
1.1075.2.2 raeburn 6744: }
6745:
6746: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6747: font-size: 90%;
1.911 bisitz 6748: vertical-align: top;
1.1075.2.2 raeburn 6749: float: none;
1.1075.2.5 raeburn 6750: border-left: 1px solid black;
6751: border-right: 1px solid black;
1.1075.2.2 raeburn 6752: }
6753:
6754: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6755: background-color:$data_table_light;
1.1075.2.2 raeburn 6756: }
6757:
6758: ol.LC_primary_menu li li a:hover {
6759: color:$button_hover;
6760: background-color:$data_table_dark;
1.693 droeschl 6761: }
6762:
1.897 wenzelju 6763: ol.LC_primary_menu li img {
1.911 bisitz 6764: vertical-align: bottom;
1.934 droeschl 6765: height: 1.1em;
1.1075.2.3 raeburn 6766: margin: 0.2em 0 0 0;
1.693 droeschl 6767: }
6768:
1.897 wenzelju 6769: ol.LC_primary_menu a {
1.911 bisitz 6770: color: RGB(80, 80, 80);
6771: text-decoration: none;
1.693 droeschl 6772: }
1.795 www 6773:
1.949 droeschl 6774: ol.LC_primary_menu a.LC_new_message {
6775: font-weight:bold;
6776: color: darkred;
6777: }
6778:
1.975 raeburn 6779: ol.LC_docs_parameters {
6780: margin-left: 0;
6781: padding: 0;
6782: list-style: none;
6783: }
6784:
6785: ol.LC_docs_parameters li {
6786: margin: 0;
6787: padding-right: 20px;
6788: display: inline;
6789: }
6790:
1.976 raeburn 6791: ol.LC_docs_parameters li:before {
6792: content: "\\002022 \\0020";
6793: }
6794:
6795: li.LC_docs_parameters_title {
6796: font-weight: bold;
6797: }
6798:
6799: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6800: content: "";
6801: }
6802:
1.897 wenzelju 6803: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6804: clear: right;
1.911 bisitz 6805: color: $fontmenu;
6806: background: $tabbg;
6807: list-style: none;
6808: padding: 0;
6809: margin: 0;
6810: width: 100%;
1.995 raeburn 6811: text-align: left;
1.1075.2.4 raeburn 6812: float: left;
1.808 droeschl 6813: }
6814:
1.897 wenzelju 6815: ul#LC_secondary_menu li {
1.911 bisitz 6816: font-weight: bold;
6817: line-height: 1.8em;
6818: border-right: 1px solid black;
6819: vertical-align: middle;
1.1075.2.4 raeburn 6820: float: left;
6821: }
6822:
6823: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6824: background-color: $data_table_light;
6825: }
6826:
6827: ul#LC_secondary_menu li a {
6828: padding: 0 0.8em;
6829: }
6830:
6831: ul#LC_secondary_menu li ul {
6832: display: none;
6833: }
6834:
6835: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6836: display: block;
6837: position: absolute;
6838: margin: 0;
6839: padding: 0;
6840: list-style:none;
6841: float: none;
6842: background-color: $data_table_light;
1.1075.2.5 raeburn 6843: z-index: 2;
1.1075.2.10 raeburn 6844: margin-left: -1px;
1.1075.2.4 raeburn 6845: }
6846:
6847: ul#LC_secondary_menu li ul li {
6848: font-size: 90%;
6849: vertical-align: top;
6850: border-left: 1px solid black;
6851: border-right: 1px solid black;
1.1075.2.33 raeburn 6852: background-color: $data_table_light;
1.1075.2.4 raeburn 6853: list-style:none;
6854: float: none;
6855: }
6856:
6857: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6858: background-color: $data_table_dark;
1.807 droeschl 6859: }
6860:
1.847 tempelho 6861: ul.LC_TabContent {
1.911 bisitz 6862: display:block;
6863: background: $sidebg;
6864: border-bottom: solid 1px $lg_border_color;
6865: list-style:none;
1.1020 raeburn 6866: margin: -1px -10px 0 -10px;
1.911 bisitz 6867: padding: 0;
1.693 droeschl 6868: }
6869:
1.795 www 6870: ul.LC_TabContent li,
6871: ul.LC_TabContentBigger li {
1.911 bisitz 6872: float:left;
1.741 harmsja 6873: }
1.795 www 6874:
1.897 wenzelju 6875: ul#LC_secondary_menu li a {
1.911 bisitz 6876: color: $fontmenu;
6877: text-decoration: none;
1.693 droeschl 6878: }
1.795 www 6879:
1.721 harmsja 6880: ul.LC_TabContent {
1.952 onken 6881: min-height:20px;
1.721 harmsja 6882: }
1.795 www 6883:
6884: ul.LC_TabContent li {
1.911 bisitz 6885: vertical-align:middle;
1.959 onken 6886: padding: 0 16px 0 10px;
1.911 bisitz 6887: background-color:$tabbg;
6888: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6889: border-left: solid 1px $font;
1.721 harmsja 6890: }
1.795 www 6891:
1.847 tempelho 6892: ul.LC_TabContent .right {
1.911 bisitz 6893: float:right;
1.847 tempelho 6894: }
6895:
1.911 bisitz 6896: ul.LC_TabContent li a,
6897: ul.LC_TabContent li {
6898: color:rgb(47,47,47);
6899: text-decoration:none;
6900: font-size:95%;
6901: font-weight:bold;
1.952 onken 6902: min-height:20px;
6903: }
6904:
1.959 onken 6905: ul.LC_TabContent li a:hover,
6906: ul.LC_TabContent li a:focus {
1.952 onken 6907: color: $button_hover;
1.959 onken 6908: background:none;
6909: outline:none;
1.952 onken 6910: }
6911:
6912: ul.LC_TabContent li:hover {
6913: color: $button_hover;
6914: cursor:pointer;
1.721 harmsja 6915: }
1.795 www 6916:
1.911 bisitz 6917: ul.LC_TabContent li.active {
1.952 onken 6918: color: $font;
1.911 bisitz 6919: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6920: border-bottom:solid 1px #FFFFFF;
6921: cursor: default;
1.744 ehlerst 6922: }
1.795 www 6923:
1.959 onken 6924: ul.LC_TabContent li.active a {
6925: color:$font;
6926: background:#FFFFFF;
6927: outline: none;
6928: }
1.1047 raeburn 6929:
6930: ul.LC_TabContent li.goback {
6931: float: left;
6932: border-left: none;
6933: }
6934:
1.870 tempelho 6935: #maincoursedoc {
1.911 bisitz 6936: clear:both;
1.870 tempelho 6937: }
6938:
6939: ul.LC_TabContentBigger {
1.911 bisitz 6940: display:block;
6941: list-style:none;
6942: padding: 0;
1.870 tempelho 6943: }
6944:
1.795 www 6945: ul.LC_TabContentBigger li {
1.911 bisitz 6946: vertical-align:bottom;
6947: height: 30px;
6948: font-size:110%;
6949: font-weight:bold;
6950: color: #737373;
1.841 tempelho 6951: }
6952:
1.957 onken 6953: ul.LC_TabContentBigger li.active {
6954: position: relative;
6955: top: 1px;
6956: }
6957:
1.870 tempelho 6958: ul.LC_TabContentBigger li a {
1.911 bisitz 6959: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6960: height: 30px;
6961: line-height: 30px;
6962: text-align: center;
6963: display: block;
6964: text-decoration: none;
1.958 onken 6965: outline: none;
1.741 harmsja 6966: }
1.795 www 6967:
1.870 tempelho 6968: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6969: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6970: color:$font;
1.744 ehlerst 6971: }
1.795 www 6972:
1.870 tempelho 6973: ul.LC_TabContentBigger li b {
1.911 bisitz 6974: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6975: display: block;
6976: float: left;
6977: padding: 0 30px;
1.957 onken 6978: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6979: }
6980:
1.956 onken 6981: ul.LC_TabContentBigger li:hover b {
6982: color:$button_hover;
6983: }
6984:
1.870 tempelho 6985: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6986: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6987: color:$font;
1.957 onken 6988: border: 0;
1.741 harmsja 6989: }
1.693 droeschl 6990:
1.870 tempelho 6991:
1.862 bisitz 6992: ul.LC_CourseBreadcrumbs {
6993: background: $sidebg;
1.1020 raeburn 6994: height: 2em;
1.862 bisitz 6995: padding-left: 10px;
1.1020 raeburn 6996: margin: 0;
1.862 bisitz 6997: list-style-position: inside;
6998: }
6999:
1.911 bisitz 7000: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7001: ol#LC_PathBreadcrumbs {
1.911 bisitz 7002: padding-left: 10px;
7003: margin: 0;
1.933 droeschl 7004: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7005: }
7006:
1.911 bisitz 7007: ol#LC_MenuBreadcrumbs li,
7008: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7009: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7010: display: inline;
1.933 droeschl 7011: white-space: normal;
1.693 droeschl 7012: }
7013:
1.823 bisitz 7014: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7015: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7016: text-decoration: none;
7017: font-size:90%;
1.693 droeschl 7018: }
1.795 www 7019:
1.969 droeschl 7020: ol#LC_MenuBreadcrumbs h1 {
7021: display: inline;
7022: font-size: 90%;
7023: line-height: 2.5em;
7024: margin: 0;
7025: padding: 0;
7026: }
7027:
1.795 www 7028: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7029: text-decoration:none;
7030: font-size:100%;
7031: font-weight:bold;
1.693 droeschl 7032: }
1.795 www 7033:
1.840 bisitz 7034: .LC_Box {
1.911 bisitz 7035: border: solid 1px $lg_border_color;
7036: padding: 0 10px 10px 10px;
1.746 neumanie 7037: }
1.795 www 7038:
1.1020 raeburn 7039: .LC_DocsBox {
7040: border: solid 1px $lg_border_color;
7041: padding: 0 0 10px 10px;
7042: }
7043:
1.795 www 7044: .LC_AboutMe_Image {
1.911 bisitz 7045: float:left;
7046: margin-right:10px;
1.747 neumanie 7047: }
1.795 www 7048:
7049: .LC_Clear_AboutMe_Image {
1.911 bisitz 7050: clear:left;
1.747 neumanie 7051: }
1.795 www 7052:
1.721 harmsja 7053: dl.LC_ListStyleClean dt {
1.911 bisitz 7054: padding-right: 5px;
7055: display: table-header-group;
1.693 droeschl 7056: }
7057:
1.721 harmsja 7058: dl.LC_ListStyleClean dd {
1.911 bisitz 7059: display: table-row;
1.693 droeschl 7060: }
7061:
1.721 harmsja 7062: .LC_ListStyleClean,
7063: .LC_ListStyleSimple,
7064: .LC_ListStyleNormal,
1.795 www 7065: .LC_ListStyleSpecial {
1.911 bisitz 7066: /* display:block; */
7067: list-style-position: inside;
7068: list-style-type: none;
7069: overflow: hidden;
7070: padding: 0;
1.693 droeschl 7071: }
7072:
1.721 harmsja 7073: .LC_ListStyleSimple li,
7074: .LC_ListStyleSimple dd,
7075: .LC_ListStyleNormal li,
7076: .LC_ListStyleNormal dd,
7077: .LC_ListStyleSpecial li,
1.795 www 7078: .LC_ListStyleSpecial dd {
1.911 bisitz 7079: margin: 0;
7080: padding: 5px 5px 5px 10px;
7081: clear: both;
1.693 droeschl 7082: }
7083:
1.721 harmsja 7084: .LC_ListStyleClean li,
7085: .LC_ListStyleClean dd {
1.911 bisitz 7086: padding-top: 0;
7087: padding-bottom: 0;
1.693 droeschl 7088: }
7089:
1.721 harmsja 7090: .LC_ListStyleSimple dd,
1.795 www 7091: .LC_ListStyleSimple li {
1.911 bisitz 7092: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7093: }
7094:
1.721 harmsja 7095: .LC_ListStyleSpecial li,
7096: .LC_ListStyleSpecial dd {
1.911 bisitz 7097: list-style-type: none;
7098: background-color: RGB(220, 220, 220);
7099: margin-bottom: 4px;
1.693 droeschl 7100: }
7101:
1.721 harmsja 7102: table.LC_SimpleTable {
1.911 bisitz 7103: margin:5px;
7104: border:solid 1px $lg_border_color;
1.795 www 7105: }
1.693 droeschl 7106:
1.721 harmsja 7107: table.LC_SimpleTable tr {
1.911 bisitz 7108: padding: 0;
7109: border:solid 1px $lg_border_color;
1.693 droeschl 7110: }
1.795 www 7111:
7112: table.LC_SimpleTable thead {
1.911 bisitz 7113: background:rgb(220,220,220);
1.693 droeschl 7114: }
7115:
1.721 harmsja 7116: div.LC_columnSection {
1.911 bisitz 7117: display: block;
7118: clear: both;
7119: overflow: hidden;
7120: margin: 0;
1.693 droeschl 7121: }
7122:
1.721 harmsja 7123: div.LC_columnSection>* {
1.911 bisitz 7124: float: left;
7125: margin: 10px 20px 10px 0;
7126: overflow:hidden;
1.693 droeschl 7127: }
1.721 harmsja 7128:
1.795 www 7129: table em {
1.911 bisitz 7130: font-weight: bold;
7131: font-style: normal;
1.748 schulted 7132: }
1.795 www 7133:
1.779 bisitz 7134: table.LC_tableBrowseRes,
1.795 www 7135: table.LC_tableOfContent {
1.911 bisitz 7136: border:none;
7137: border-spacing: 1px;
7138: padding: 3px;
7139: background-color: #FFFFFF;
7140: font-size: 90%;
1.753 droeschl 7141: }
1.789 droeschl 7142:
1.911 bisitz 7143: table.LC_tableOfContent {
7144: border-collapse: collapse;
1.789 droeschl 7145: }
7146:
1.771 droeschl 7147: table.LC_tableBrowseRes a,
1.768 schulted 7148: table.LC_tableOfContent a {
1.911 bisitz 7149: background-color: transparent;
7150: text-decoration: none;
1.753 droeschl 7151: }
7152:
1.795 www 7153: table.LC_tableOfContent img {
1.911 bisitz 7154: border: none;
7155: height: 1.3em;
7156: vertical-align: text-bottom;
7157: margin-right: 0.3em;
1.753 droeschl 7158: }
1.757 schulted 7159:
1.795 www 7160: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7161: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7162: }
7163:
1.795 www 7164: a#LC_content_toolbar_everything {
1.911 bisitz 7165: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7166: }
7167:
1.795 www 7168: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7169: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7170: }
7171:
1.795 www 7172: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7173: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7174: }
7175:
1.795 www 7176: a#LC_content_toolbar_changefolder {
1.911 bisitz 7177: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7178: }
7179:
1.795 www 7180: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7181: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7182: }
7183:
1.1043 raeburn 7184: a#LC_content_toolbar_edittoplevel {
7185: background-image:url(/res/adm/pages/edittoplevel.gif);
7186: }
7187:
1.795 www 7188: ul#LC_toolbar li a:hover {
1.911 bisitz 7189: background-position: bottom center;
1.757 schulted 7190: }
7191:
1.795 www 7192: ul#LC_toolbar {
1.911 bisitz 7193: padding: 0;
7194: margin: 2px;
7195: list-style:none;
7196: position:relative;
7197: background-color:white;
1.1075.2.9 raeburn 7198: overflow: auto;
1.757 schulted 7199: }
7200:
1.795 www 7201: ul#LC_toolbar li {
1.911 bisitz 7202: border:1px solid white;
7203: padding: 0;
7204: margin: 0;
7205: float: left;
7206: display:inline;
7207: vertical-align:middle;
1.1075.2.9 raeburn 7208: white-space: nowrap;
1.911 bisitz 7209: }
1.757 schulted 7210:
1.783 amueller 7211:
1.795 www 7212: a.LC_toolbarItem {
1.911 bisitz 7213: display:block;
7214: padding: 0;
7215: margin: 0;
7216: height: 32px;
7217: width: 32px;
7218: color:white;
7219: border: none;
7220: background-repeat:no-repeat;
7221: background-color:transparent;
1.757 schulted 7222: }
7223:
1.915 droeschl 7224: ul.LC_funclist {
7225: margin: 0;
7226: padding: 0.5em 1em 0.5em 0;
7227: }
7228:
1.933 droeschl 7229: ul.LC_funclist > li:first-child {
7230: font-weight:bold;
7231: margin-left:0.8em;
7232: }
7233:
1.915 droeschl 7234: ul.LC_funclist + ul.LC_funclist {
7235: /*
7236: left border as a seperator if we have more than
7237: one list
7238: */
7239: border-left: 1px solid $sidebg;
7240: /*
7241: this hides the left border behind the border of the
7242: outer box if element is wrapped to the next 'line'
7243: */
7244: margin-left: -1px;
7245: }
7246:
1.843 bisitz 7247: ul.LC_funclist li {
1.915 droeschl 7248: display: inline;
1.782 bisitz 7249: white-space: nowrap;
1.915 droeschl 7250: margin: 0 0 0 25px;
7251: line-height: 150%;
1.782 bisitz 7252: }
7253:
1.974 wenzelju 7254: .LC_hidden {
7255: display: none;
7256: }
7257:
1.1030 www 7258: .LCmodal-overlay {
7259: position:fixed;
7260: top:0;
7261: right:0;
7262: bottom:0;
7263: left:0;
7264: height:100%;
7265: width:100%;
7266: margin:0;
7267: padding:0;
7268: background:#999;
7269: opacity:.75;
7270: filter: alpha(opacity=75);
7271: -moz-opacity: 0.75;
7272: z-index:101;
7273: }
7274:
7275: * html .LCmodal-overlay {
7276: position: absolute;
7277: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7278: }
7279:
7280: .LCmodal-window {
7281: position:fixed;
7282: top:50%;
7283: left:50%;
7284: margin:0;
7285: padding:0;
7286: z-index:102;
7287: }
7288:
7289: * html .LCmodal-window {
7290: position:absolute;
7291: }
7292:
7293: .LCclose-window {
7294: position:absolute;
7295: width:32px;
7296: height:32px;
7297: right:8px;
7298: top:8px;
7299: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7300: text-indent:-99999px;
7301: overflow:hidden;
7302: cursor:pointer;
7303: }
7304:
1.1075.2.17 raeburn 7305: /*
7306: styles used by TTH when "Default set of options to pass to tth/m
7307: when converting TeX" in course settings has been set
7308:
7309: option passed: -t
7310:
7311: */
7312:
7313: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7314: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7315: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7316: td div.norm {line-height:normal;}
7317:
7318: /*
7319: option passed -y3
7320: */
7321:
7322: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7323: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7324: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7325:
1.343 albertel 7326: END
7327: }
7328:
1.306 albertel 7329: =pod
7330:
7331: =item * &headtag()
7332:
7333: Returns a uniform footer for LON-CAPA web pages.
7334:
1.307 albertel 7335: Inputs: $title - optional title for the head
7336: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7337: $args - optional arguments
1.319 albertel 7338: force_register - if is true call registerurl so the remote is
7339: informed
1.415 albertel 7340: redirect -> array ref of
7341: 1- seconds before redirect occurs
7342: 2- url to redirect to
7343: 3- whether the side effect should occur
1.315 albertel 7344: (side effect of setting
7345: $env{'internal.head.redirect'} to the url
7346: redirected too)
1.352 albertel 7347: domain -> force to color decorate a page for a specific
7348: domain
7349: function -> force usage of a specific rolish color scheme
7350: bgcolor -> override the default page bgcolor
1.460 albertel 7351: no_auto_mt_title
7352: -> prevent &mt()ing the title arg
1.464 albertel 7353:
1.306 albertel 7354: =cut
7355:
7356: sub headtag {
1.313 albertel 7357: my ($title,$head_extra,$args) = @_;
1.306 albertel 7358:
1.363 albertel 7359: my $function = $args->{'function'} || &get_users_function();
7360: my $domain = $args->{'domain'} || &determinedomain();
7361: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7362: my $httphost = $args->{'use_absolute'};
1.418 albertel 7363: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7364: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7365: #time(),
1.418 albertel 7366: $env{'environment.color.timestamp'},
1.363 albertel 7367: $function,$domain,$bgcolor);
7368:
1.369 www 7369: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7370:
1.308 albertel 7371: my $result =
7372: '<head>'.
1.1075.2.56 raeburn 7373: &font_settings($args);
1.319 albertel 7374:
1.1075.2.72 raeburn 7375: my $inhibitprint;
7376: if ($args->{'print_suppress'}) {
7377: $inhibitprint = &print_suppression();
7378: }
1.1064 raeburn 7379:
1.461 albertel 7380: if (!$args->{'frameset'}) {
7381: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7382: }
1.1075.2.12 raeburn 7383: if ($args->{'force_register'}) {
7384: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7385: }
1.436 albertel 7386: if (!$args->{'no_nav_bar'}
7387: && !$args->{'only_body'}
7388: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7389: $result .= &help_menu_js($httphost);
1.1032 www 7390: $result.=&modal_window();
1.1038 www 7391: $result.=&togglebox_script();
1.1034 www 7392: $result.=&wishlist_window();
1.1041 www 7393: $result.=&LCprogressbarUpdate_script();
1.1034 www 7394: } else {
7395: if ($args->{'add_modal'}) {
7396: $result.=&modal_window();
7397: }
7398: if ($args->{'add_wishlist'}) {
7399: $result.=&wishlist_window();
7400: }
1.1038 www 7401: if ($args->{'add_togglebox'}) {
7402: $result.=&togglebox_script();
7403: }
1.1041 www 7404: if ($args->{'add_progressbar'}) {
7405: $result.=&LCprogressbarUpdate_script();
7406: }
1.436 albertel 7407: }
1.314 albertel 7408: if (ref($args->{'redirect'})) {
1.414 albertel 7409: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7410: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7411: if (!$inhibit_continue) {
7412: $env{'internal.head.redirect'} = $url;
7413: }
1.313 albertel 7414: $result.=<<ADDMETA
7415: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7416: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7417: ADDMETA
1.1075.2.89 raeburn 7418: } else {
7419: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7420: my $requrl = $env{'request.uri'};
7421: if ($requrl eq '') {
7422: $requrl = $ENV{'REQUEST_URI'};
7423: $requrl =~ s/\?.+$//;
7424: }
7425: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7426: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7427: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7428: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7429: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7430: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7431: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7432: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7433: if ($domdefs{'offloadnow'}{$lonhost}) {
7434: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7435: if (($newserver) && ($newserver ne $lonhost)) {
7436: my $numsec = 5;
7437: my $timeout = $numsec * 1000;
7438: my ($newurl,$locknum,%locks,$msg);
7439: if ($env{'request.role.adv'}) {
7440: ($locknum,%locks) = &Apache::lonnet::get_locks();
7441: }
7442: my $disable_submit = 0;
7443: if ($requrl =~ /$LONCAPA::assess_re/) {
7444: $disable_submit = 1;
7445: }
7446: if ($locknum) {
7447: my @lockinfo = sort(values(%locks));
7448: $msg = &mt('Once the following tasks are complete: ')."\\n".
7449: join(", ",sort(values(%locks)))."\\n".
7450: &mt('your session will be transferred to a different server, after you click "Roles".');
7451: } else {
7452: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7453: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7454: }
7455: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7456: $newurl = '/adm/switchserver?otherserver='.$newserver;
7457: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7458: $newurl .= '&role='.$env{'request.role'};
7459: }
7460: if ($env{'request.symb'}) {
7461: $newurl .= '&symb='.$env{'request.symb'};
7462: } else {
7463: $newurl .= '&origurl='.$requrl;
7464: }
7465: }
7466: $result.=<<OFFLOAD
7467: <meta http-equiv="pragma" content="no-cache" />
7468: <script type="text/javascript">
7469: function LC_Offload_Now() {
7470: var dest = "$newurl";
7471: if (dest != '') {
7472: window.location.href="$newurl";
7473: }
7474: }
7475: window.alert('$msg');
7476: if ($disable_submit) {
7477: \$(document).ready(function () {
7478: \$(".LC_hwk_submit").prop("disabled", true);
7479: \$( ".LC_textline" ).prop( "readonly", "readonly");
7480: });
7481: }
7482: setTimeout('LC_Offload_Now()', $timeout);
7483: </script>
7484: OFFLOAD
7485: }
7486: }
7487: }
7488: }
7489: }
7490: }
1.313 albertel 7491: }
1.306 albertel 7492: if (!defined($title)) {
7493: $title = 'The LearningOnline Network with CAPA';
7494: }
1.460 albertel 7495: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7496: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 7497: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7498: if (!$args->{'frameset'}) {
7499: $result .= ' /';
7500: }
7501: $result .= '>'
1.1064 raeburn 7502: .$inhibitprint
1.414 albertel 7503: .$head_extra;
1.1075.2.42 raeburn 7504: if ($env{'browser.mobile'}) {
7505: $result .= '
7506: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7507: <meta name="apple-mobile-web-app-capable" content="yes" />';
7508: }
1.962 droeschl 7509: return $result.'</head>';
1.306 albertel 7510: }
7511:
7512: =pod
7513:
1.340 albertel 7514: =item * &font_settings()
7515:
7516: Returns neccessary <meta> to set the proper encoding
7517:
1.1075.2.56 raeburn 7518: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7519:
7520: =cut
7521:
7522: sub font_settings {
1.1075.2.56 raeburn 7523: my ($args) = @_;
1.340 albertel 7524: my $headerstring='';
1.1075.2.56 raeburn 7525: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7526: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 7527: $headerstring.=
1.1075.2.61 raeburn 7528: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7529: if (!$args->{'frameset'}) {
7530: $headerstring.= ' /';
7531: }
7532: $headerstring .= '>'."\n";
1.340 albertel 7533: }
7534: return $headerstring;
7535: }
7536:
1.341 albertel 7537: =pod
7538:
1.1064 raeburn 7539: =item * &print_suppression()
7540:
7541: In course context returns css which causes the body to be blank when media="print",
7542: if printout generation is unavailable for the current resource.
7543:
7544: This could be because:
7545:
7546: (a) printstartdate is in the future
7547:
7548: (b) printenddate is in the past
7549:
7550: (c) there is an active exam block with "printout"
7551: functionality blocked
7552:
7553: Users with pav, pfo or evb privileges are exempt.
7554:
7555: Inputs: none
7556:
7557: =cut
7558:
7559:
7560: sub print_suppression {
7561: my $noprint;
7562: if ($env{'request.course.id'}) {
7563: my $scope = $env{'request.course.id'};
7564: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7565: (&Apache::lonnet::allowed('pfo',$scope))) {
7566: return;
7567: }
7568: if ($env{'request.course.sec'} ne '') {
7569: $scope .= "/$env{'request.course.sec'}";
7570: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7571: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7572: return;
1.1064 raeburn 7573: }
7574: }
7575: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7576: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73 raeburn 7577: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7578: if ($blocked) {
7579: my $checkrole = "cm./$cdom/$cnum";
7580: if ($env{'request.course.sec'} ne '') {
7581: $checkrole .= "/$env{'request.course.sec'}";
7582: }
7583: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7584: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7585: $noprint = 1;
7586: }
7587: }
7588: unless ($noprint) {
7589: my $symb = &Apache::lonnet::symbread();
7590: if ($symb ne '') {
7591: my $navmap = Apache::lonnavmaps::navmap->new();
7592: if (ref($navmap)) {
7593: my $res = $navmap->getBySymb($symb);
7594: if (ref($res)) {
7595: if (!$res->resprintable()) {
7596: $noprint = 1;
7597: }
7598: }
7599: }
7600: }
7601: }
7602: if ($noprint) {
7603: return <<"ENDSTYLE";
7604: <style type="text/css" media="print">
7605: body { display:none }
7606: </style>
7607: ENDSTYLE
7608: }
7609: }
7610: return;
7611: }
7612:
7613: =pod
7614:
1.341 albertel 7615: =item * &xml_begin()
7616:
7617: Returns the needed doctype and <html>
7618:
7619: Inputs: none
7620:
7621: =cut
7622:
7623: sub xml_begin {
1.1075.2.61 raeburn 7624: my ($is_frameset) = @_;
1.341 albertel 7625: my $output='';
7626:
7627: if ($env{'browser.mathml'}) {
7628: $output='<?xml version="1.0"?>'
7629: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7630: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7631:
7632: # .'<!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">] >'
7633: .'<!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">'
7634: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7635: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 7636: } elsif ($is_frameset) {
7637: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7638: '<html>'."\n";
1.341 albertel 7639: } else {
1.1075.2.61 raeburn 7640: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7641: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7642: }
7643: return $output;
7644: }
1.340 albertel 7645:
7646: =pod
7647:
1.306 albertel 7648: =item * &start_page()
7649:
7650: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7651:
1.648 raeburn 7652: Inputs:
7653:
7654: =over 4
7655:
7656: $title - optional title for the page
7657:
7658: $head_extra - optional extra HTML to incude inside the <head>
7659:
7660: $args - additional optional args supported are:
7661:
7662: =over 8
7663:
7664: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7665: arg on
1.814 bisitz 7666: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7667: add_entries -> additional attributes to add to the <body>
7668: domain -> force to color decorate a page for a
1.317 albertel 7669: specific domain
1.648 raeburn 7670: function -> force usage of a specific rolish color
1.317 albertel 7671: scheme
1.648 raeburn 7672: redirect -> see &headtag()
7673: bgcolor -> override the default page bg color
7674: js_ready -> return a string ready for being used in
1.317 albertel 7675: a javascript writeln
1.648 raeburn 7676: html_encode -> return a string ready for being used in
1.320 albertel 7677: a html attribute
1.648 raeburn 7678: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7679: $forcereg arg
1.648 raeburn 7680: frameset -> if true will start with a <frameset>
1.330 albertel 7681: rather than <body>
1.648 raeburn 7682: skip_phases -> hash ref of
1.338 albertel 7683: head -> skip the <html><head> generation
7684: body -> skip all <body> generation
1.1075.2.12 raeburn 7685: no_inline_link -> if true and in remote mode, don't show the
7686: 'Switch To Inline Menu' link
1.648 raeburn 7687: no_auto_mt_title -> prevent &mt()ing the title arg
7688: inherit_jsmath -> when creating popup window in a page,
7689: should it have jsmath forced on by the
7690: current page
1.867 kalberla 7691: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7692: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7693: group -> includes the current group, if page is for a
7694: specific group
1.361 albertel 7695:
1.648 raeburn 7696: =back
1.460 albertel 7697:
1.648 raeburn 7698: =back
1.562 albertel 7699:
1.306 albertel 7700: =cut
7701:
7702: sub start_page {
1.309 albertel 7703: my ($title,$head_extra,$args) = @_;
1.318 albertel 7704: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7705:
1.315 albertel 7706: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7707: my ($result,@advtools);
1.964 droeschl 7708:
1.338 albertel 7709: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 7710: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7711: }
7712:
7713: if (! exists($args->{'skip_phases'}{'body'}) ) {
7714: if ($args->{'frameset'}) {
7715: my $attr_string = &make_attr_string($args->{'force_register'},
7716: $args->{'add_entries'});
7717: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7718: } else {
7719: $result .=
7720: &bodytag($title,
7721: $args->{'function'}, $args->{'add_entries'},
7722: $args->{'only_body'}, $args->{'domain'},
7723: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7724: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7725: $args, \@advtools);
1.831 bisitz 7726: }
1.330 albertel 7727: }
1.338 albertel 7728:
1.315 albertel 7729: if ($args->{'js_ready'}) {
1.713 kaisler 7730: $result = &js_ready($result);
1.315 albertel 7731: }
1.320 albertel 7732: if ($args->{'html_encode'}) {
1.713 kaisler 7733: $result = &html_encode($result);
7734: }
7735:
1.813 bisitz 7736: # Preparation for new and consistent functionlist at top of screen
7737: # if ($args->{'functionlist'}) {
7738: # $result .= &build_functionlist();
7739: #}
7740:
1.964 droeschl 7741: # Don't add anything more if only_body wanted or in const space
7742: return $result if $args->{'only_body'}
7743: || $env{'request.state'} eq 'construct';
1.813 bisitz 7744:
7745: #Breadcrumbs
1.758 kaisler 7746: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7747: &Apache::lonhtmlcommon::clear_breadcrumbs();
7748: #if any br links exists, add them to the breadcrumbs
7749: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7750: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7751: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7752: }
7753: }
1.1075.2.19 raeburn 7754: # if @advtools array contains items add then to the breadcrumbs
7755: if (@advtools > 0) {
7756: &Apache::lonmenu::advtools_crumbs(@advtools);
7757: }
1.758 kaisler 7758:
7759: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7760: if(exists($args->{'bread_crumbs_component'})){
7761: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7762: }else{
7763: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7764: }
1.1075.2.24 raeburn 7765: } elsif (($env{'environment.remote'} eq 'on') &&
7766: ($env{'form.inhibitmenu'} ne 'yes') &&
7767: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7768: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7769: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7770: }
1.315 albertel 7771: return $result;
1.306 albertel 7772: }
7773:
7774: sub end_page {
1.315 albertel 7775: my ($args) = @_;
7776: $env{'internal.end_page'}++;
1.330 albertel 7777: my $result;
1.335 albertel 7778: if ($args->{'discussion'}) {
7779: my ($target,$parser);
7780: if (ref($args->{'discussion'})) {
7781: ($target,$parser) =($args->{'discussion'}{'target'},
7782: $args->{'discussion'}{'parser'});
7783: }
7784: $result .= &Apache::lonxml::xmlend($target,$parser);
7785: }
1.330 albertel 7786: if ($args->{'frameset'}) {
7787: $result .= '</frameset>';
7788: } else {
1.635 raeburn 7789: $result .= &endbodytag($args);
1.330 albertel 7790: }
1.1075.2.6 raeburn 7791: unless ($args->{'notbody'}) {
7792: $result .= "\n</html>";
7793: }
1.330 albertel 7794:
1.315 albertel 7795: if ($args->{'js_ready'}) {
1.317 albertel 7796: $result = &js_ready($result);
1.315 albertel 7797: }
1.335 albertel 7798:
1.320 albertel 7799: if ($args->{'html_encode'}) {
7800: $result = &html_encode($result);
7801: }
1.335 albertel 7802:
1.315 albertel 7803: return $result;
7804: }
7805:
1.1034 www 7806: sub wishlist_window {
7807: return(<<'ENDWISHLIST');
1.1046 raeburn 7808: <script type="text/javascript">
1.1034 www 7809: // <![CDATA[
7810: // <!-- BEGIN LON-CAPA Internal
7811: function set_wishlistlink(title, path) {
7812: if (!title) {
7813: title = document.title;
7814: title = title.replace(/^LON-CAPA /,'');
7815: }
1.1075.2.65 raeburn 7816: title = encodeURIComponent(title);
1.1075.2.83 raeburn 7817: title = title.replace("'","\\\'");
1.1034 www 7818: if (!path) {
7819: path = location.pathname;
7820: }
1.1075.2.65 raeburn 7821: path = encodeURIComponent(path);
1.1075.2.83 raeburn 7822: path = path.replace("'","\\\'");
1.1034 www 7823: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7824: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7825: }
7826: // END LON-CAPA Internal -->
7827: // ]]>
7828: </script>
7829: ENDWISHLIST
7830: }
7831:
1.1030 www 7832: sub modal_window {
7833: return(<<'ENDMODAL');
1.1046 raeburn 7834: <script type="text/javascript">
1.1030 www 7835: // <![CDATA[
7836: // <!-- BEGIN LON-CAPA Internal
7837: var modalWindow = {
7838: parent:"body",
7839: windowId:null,
7840: content:null,
7841: width:null,
7842: height:null,
7843: close:function()
7844: {
7845: $(".LCmodal-window").remove();
7846: $(".LCmodal-overlay").remove();
7847: },
7848: open:function()
7849: {
7850: var modal = "";
7851: modal += "<div class=\"LCmodal-overlay\"></div>";
7852: 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;\">";
7853: modal += this.content;
7854: modal += "</div>";
7855:
7856: $(this.parent).append(modal);
7857:
7858: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7859: $(".LCclose-window").click(function(){modalWindow.close();});
7860: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7861: }
7862: };
1.1075.2.42 raeburn 7863: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7864: {
1.1075.2.83 raeburn 7865: source = source.replace("'","'");
1.1030 www 7866: modalWindow.windowId = "myModal";
7867: modalWindow.width = width;
7868: modalWindow.height = height;
1.1075.2.80 raeburn 7869: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7870: modalWindow.open();
1.1075.2.87 raeburn 7871: };
1.1030 www 7872: // END LON-CAPA Internal -->
7873: // ]]>
7874: </script>
7875: ENDMODAL
7876: }
7877:
7878: sub modal_link {
1.1075.2.42 raeburn 7879: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7880: unless ($width) { $width=480; }
7881: unless ($height) { $height=400; }
1.1031 www 7882: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 7883: unless ($transparency) { $transparency='true'; }
7884:
1.1074 raeburn 7885: my $target_attr;
7886: if (defined($target)) {
7887: $target_attr = 'target="'.$target.'"';
7888: }
7889: return <<"ENDLINK";
1.1075.2.42 raeburn 7890: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7891: $linktext</a>
7892: ENDLINK
1.1030 www 7893: }
7894:
1.1032 www 7895: sub modal_adhoc_script {
7896: my ($funcname,$width,$height,$content)=@_;
7897: return (<<ENDADHOC);
1.1046 raeburn 7898: <script type="text/javascript">
1.1032 www 7899: // <![CDATA[
7900: var $funcname = function()
7901: {
7902: modalWindow.windowId = "myModal";
7903: modalWindow.width = $width;
7904: modalWindow.height = $height;
7905: modalWindow.content = '$content';
7906: modalWindow.open();
7907: };
7908: // ]]>
7909: </script>
7910: ENDADHOC
7911: }
7912:
1.1041 www 7913: sub modal_adhoc_inner {
7914: my ($funcname,$width,$height,$content)=@_;
7915: my $innerwidth=$width-20;
7916: $content=&js_ready(
1.1042 www 7917: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 7918: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7919: $content.
1.1041 www 7920: &end_scrollbox().
1.1075.2.42 raeburn 7921: &end_page()
1.1041 www 7922: );
7923: return &modal_adhoc_script($funcname,$width,$height,$content);
7924: }
7925:
7926: sub modal_adhoc_window {
7927: my ($funcname,$width,$height,$content,$linktext)=@_;
7928: return &modal_adhoc_inner($funcname,$width,$height,$content).
7929: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7930: }
7931:
7932: sub modal_adhoc_launch {
7933: my ($funcname,$width,$height,$content)=@_;
7934: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7935: <script type="text/javascript">
7936: // <![CDATA[
7937: $funcname();
7938: // ]]>
7939: </script>
7940: ENDLAUNCH
7941: }
7942:
7943: sub modal_adhoc_close {
7944: return (<<ENDCLOSE);
7945: <script type="text/javascript">
7946: // <![CDATA[
7947: modalWindow.close();
7948: // ]]>
7949: </script>
7950: ENDCLOSE
7951: }
7952:
1.1038 www 7953: sub togglebox_script {
7954: return(<<ENDTOGGLE);
7955: <script type="text/javascript">
7956: // <![CDATA[
7957: function LCtoggleDisplay(id,hidetext,showtext) {
7958: link = document.getElementById(id + "link").childNodes[0];
7959: with (document.getElementById(id).style) {
7960: if (display == "none" ) {
7961: display = "inline";
7962: link.nodeValue = hidetext;
7963: } else {
7964: display = "none";
7965: link.nodeValue = showtext;
7966: }
7967: }
7968: }
7969: // ]]>
7970: </script>
7971: ENDTOGGLE
7972: }
7973:
1.1039 www 7974: sub start_togglebox {
7975: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7976: unless ($heading) { $heading=''; } else { $heading.=' '; }
7977: unless ($showtext) { $showtext=&mt('show'); }
7978: unless ($hidetext) { $hidetext=&mt('hide'); }
7979: unless ($headerbg) { $headerbg='#FFFFFF'; }
7980: return &start_data_table().
7981: &start_data_table_header_row().
7982: '<td bgcolor="'.$headerbg.'">'.$heading.
7983: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7984: $showtext.'\')">'.$showtext.'</a>]</td>'.
7985: &end_data_table_header_row().
7986: '<tr id="'.$id.'" style="display:none""><td>';
7987: }
7988:
7989: sub end_togglebox {
7990: return '</td></tr>'.&end_data_table();
7991: }
7992:
1.1041 www 7993: sub LCprogressbar_script {
1.1045 www 7994: my ($id)=@_;
1.1041 www 7995: return(<<ENDPROGRESS);
7996: <script type="text/javascript">
7997: // <![CDATA[
1.1045 www 7998: \$('#progressbar$id').progressbar({
1.1041 www 7999: value: 0,
8000: change: function(event, ui) {
8001: var newVal = \$(this).progressbar('option', 'value');
8002: \$('.pblabel', this).text(LCprogressTxt);
8003: }
8004: });
8005: // ]]>
8006: </script>
8007: ENDPROGRESS
8008: }
8009:
8010: sub LCprogressbarUpdate_script {
8011: return(<<ENDPROGRESSUPDATE);
8012: <style type="text/css">
8013: .ui-progressbar { position:relative; }
8014: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8015: </style>
8016: <script type="text/javascript">
8017: // <![CDATA[
1.1045 www 8018: var LCprogressTxt='---';
8019:
8020: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8021: LCprogressTxt=progresstext;
1.1045 www 8022: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8023: }
8024: // ]]>
8025: </script>
8026: ENDPROGRESSUPDATE
8027: }
8028:
1.1042 www 8029: my $LClastpercent;
1.1045 www 8030: my $LCidcnt;
8031: my $LCcurrentid;
1.1042 www 8032:
1.1041 www 8033: sub LCprogressbar {
1.1042 www 8034: my ($r)=(@_);
8035: $LClastpercent=0;
1.1045 www 8036: $LCidcnt++;
8037: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8038: my $starting=&mt('Starting');
8039: my $content=(<<ENDPROGBAR);
1.1045 www 8040: <div id="progressbar$LCcurrentid">
1.1041 www 8041: <span class="pblabel">$starting</span>
8042: </div>
8043: ENDPROGBAR
1.1045 www 8044: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8045: }
8046:
8047: sub LCprogressbarUpdate {
1.1042 www 8048: my ($r,$val,$text)=@_;
8049: unless ($val) {
8050: if ($LClastpercent) {
8051: $val=$LClastpercent;
8052: } else {
8053: $val=0;
8054: }
8055: }
1.1041 www 8056: if ($val<0) { $val=0; }
8057: if ($val>100) { $val=0; }
1.1042 www 8058: $LClastpercent=$val;
1.1041 www 8059: unless ($text) { $text=$val.'%'; }
8060: $text=&js_ready($text);
1.1044 www 8061: &r_print($r,<<ENDUPDATE);
1.1041 www 8062: <script type="text/javascript">
8063: // <![CDATA[
1.1045 www 8064: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8065: // ]]>
8066: </script>
8067: ENDUPDATE
1.1035 www 8068: }
8069:
1.1042 www 8070: sub LCprogressbarClose {
8071: my ($r)=@_;
8072: $LClastpercent=0;
1.1044 www 8073: &r_print($r,<<ENDCLOSE);
1.1042 www 8074: <script type="text/javascript">
8075: // <![CDATA[
1.1045 www 8076: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8077: // ]]>
8078: </script>
8079: ENDCLOSE
1.1044 www 8080: }
8081:
8082: sub r_print {
8083: my ($r,$to_print)=@_;
8084: if ($r) {
8085: $r->print($to_print);
8086: $r->rflush();
8087: } else {
8088: print($to_print);
8089: }
1.1042 www 8090: }
8091:
1.320 albertel 8092: sub html_encode {
8093: my ($result) = @_;
8094:
1.322 albertel 8095: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8096:
8097: return $result;
8098: }
1.1044 www 8099:
1.317 albertel 8100: sub js_ready {
8101: my ($result) = @_;
8102:
1.323 albertel 8103: $result =~ s/[\n\r]/ /xmsg;
8104: $result =~ s/\\/\\\\/xmsg;
8105: $result =~ s/'/\\'/xmsg;
1.372 albertel 8106: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8107:
8108: return $result;
8109: }
8110:
1.315 albertel 8111: sub validate_page {
8112: if ( exists($env{'internal.start_page'})
1.316 albertel 8113: && $env{'internal.start_page'} > 1) {
8114: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8115: $env{'internal.start_page'}.' '.
1.316 albertel 8116: $ENV{'request.filename'});
1.315 albertel 8117: }
8118: if ( exists($env{'internal.end_page'})
1.316 albertel 8119: && $env{'internal.end_page'} > 1) {
8120: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8121: $env{'internal.end_page'}.' '.
1.316 albertel 8122: $env{'request.filename'});
1.315 albertel 8123: }
8124: if ( exists($env{'internal.start_page'})
8125: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8126: &Apache::lonnet::logthis('start_page called without end_page '.
8127: $env{'request.filename'});
1.315 albertel 8128: }
8129: if ( ! exists($env{'internal.start_page'})
8130: && exists($env{'internal.end_page'})) {
1.316 albertel 8131: &Apache::lonnet::logthis('end_page called without start_page'.
8132: $env{'request.filename'});
1.315 albertel 8133: }
1.306 albertel 8134: }
1.315 albertel 8135:
1.996 www 8136:
8137: sub start_scrollbox {
1.1075.2.56 raeburn 8138: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8139: unless ($outerwidth) { $outerwidth='520px'; }
8140: unless ($width) { $width='500px'; }
8141: unless ($height) { $height='200px'; }
1.1075 raeburn 8142: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8143: if ($id ne '') {
1.1075.2.42 raeburn 8144: $table_id = ' id="table_'.$id.'"';
8145: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8146: }
1.1075 raeburn 8147: if ($bgcolor ne '') {
8148: $tdcol = "background-color: $bgcolor;";
8149: }
1.1075.2.42 raeburn 8150: my $nicescroll_js;
8151: if ($env{'browser.mobile'}) {
8152: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8153: }
1.1075 raeburn 8154: return <<"END";
1.1075.2.42 raeburn 8155: $nicescroll_js
8156:
8157: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8158: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8159: END
1.996 www 8160: }
8161:
8162: sub end_scrollbox {
1.1036 www 8163: return '</div></td></tr></table>';
1.996 www 8164: }
8165:
1.1075.2.42 raeburn 8166: sub nicescroll_javascript {
8167: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8168: my %options;
8169: if (ref($cursor) eq 'HASH') {
8170: %options = %{$cursor};
8171: }
8172: unless ($options{'railalign'} =~ /^left|right$/) {
8173: $options{'railalign'} = 'left';
8174: }
8175: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8176: my $function = &get_users_function();
8177: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8178: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8179: $options{'cursorcolor'} = '#00F';
8180: }
8181: }
8182: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8183: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8184: $options{'cursoropacity'}='1.0';
8185: }
8186: } else {
8187: $options{'cursoropacity'}='1.0';
8188: }
8189: if ($options{'cursorfixedheight'} eq 'none') {
8190: delete($options{'cursorfixedheight'});
8191: } else {
8192: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8193: }
8194: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8195: delete($options{'railoffset'});
8196: }
8197: my @niceoptions;
8198: while (my($key,$value) = each(%options)) {
8199: if ($value =~ /^\{.+\}$/) {
8200: push(@niceoptions,$key.':'.$value);
8201: } else {
8202: push(@niceoptions,$key.':"'.$value.'"');
8203: }
8204: }
8205: my $nicescroll_js = '
8206: $(document).ready(
8207: function() {
8208: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8209: }
8210: );
8211: ';
8212: if ($framecheck) {
8213: $nicescroll_js .= '
8214: function expand_div(caller) {
8215: if (top === self) {
8216: document.getElementById("'.$id.'").style.width = "auto";
8217: document.getElementById("'.$id.'").style.height = "auto";
8218: } else {
8219: try {
8220: if (parent.frames) {
8221: if (parent.frames.length > 1) {
8222: var framesrc = parent.frames[1].location.href;
8223: var currsrc = framesrc.replace(/\#.*$/,"");
8224: if ((caller == "search") || (currsrc == "'.$location.'")) {
8225: document.getElementById("'.$id.'").style.width = "auto";
8226: document.getElementById("'.$id.'").style.height = "auto";
8227: }
8228: }
8229: }
8230: } catch (e) {
8231: return;
8232: }
8233: }
8234: return;
8235: }
8236: ';
8237: }
8238: if ($needjsready) {
8239: $nicescroll_js = '
8240: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8241: } else {
8242: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8243: }
8244: return $nicescroll_js;
8245: }
8246:
1.318 albertel 8247: sub simple_error_page {
1.1075.2.49 raeburn 8248: my ($r,$title,$msg,$args) = @_;
8249: if (ref($args) eq 'HASH') {
8250: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8251: } else {
8252: $msg = &mt($msg);
8253: }
8254:
1.318 albertel 8255: my $page =
8256: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8257: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8258: &Apache::loncommon::end_page();
8259: if (ref($r)) {
8260: $r->print($page);
1.327 albertel 8261: return;
1.318 albertel 8262: }
8263: return $page;
8264: }
1.347 albertel 8265:
8266: {
1.610 albertel 8267: my @row_count;
1.961 onken 8268:
8269: sub start_data_table_count {
8270: unshift(@row_count, 0);
8271: return;
8272: }
8273:
8274: sub end_data_table_count {
8275: shift(@row_count);
8276: return;
8277: }
8278:
1.347 albertel 8279: sub start_data_table {
1.1018 raeburn 8280: my ($add_class,$id) = @_;
1.422 albertel 8281: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8282: my $table_id;
8283: if (defined($id)) {
8284: $table_id = ' id="'.$id.'"';
8285: }
1.961 onken 8286: &start_data_table_count();
1.1018 raeburn 8287: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8288: }
8289:
8290: sub end_data_table {
1.961 onken 8291: &end_data_table_count();
1.389 albertel 8292: return '</table>'."\n";;
1.347 albertel 8293: }
8294:
8295: sub start_data_table_row {
1.974 wenzelju 8296: my ($add_class, $id) = @_;
1.610 albertel 8297: $row_count[0]++;
8298: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8299: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8300: $id = (' id="'.$id.'"') unless ($id eq '');
8301: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8302: }
1.471 banghart 8303:
8304: sub continue_data_table_row {
1.974 wenzelju 8305: my ($add_class, $id) = @_;
1.610 albertel 8306: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8307: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8308: $id = (' id="'.$id.'"') unless ($id eq '');
8309: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8310: }
1.347 albertel 8311:
8312: sub end_data_table_row {
1.389 albertel 8313: return '</tr>'."\n";;
1.347 albertel 8314: }
1.367 www 8315:
1.421 albertel 8316: sub start_data_table_empty_row {
1.707 bisitz 8317: # $row_count[0]++;
1.421 albertel 8318: return '<tr class="LC_empty_row" >'."\n";;
8319: }
8320:
8321: sub end_data_table_empty_row {
8322: return '</tr>'."\n";;
8323: }
8324:
1.367 www 8325: sub start_data_table_header_row {
1.389 albertel 8326: return '<tr class="LC_header_row">'."\n";;
1.367 www 8327: }
8328:
8329: sub end_data_table_header_row {
1.389 albertel 8330: return '</tr>'."\n";;
1.367 www 8331: }
1.890 droeschl 8332:
8333: sub data_table_caption {
8334: my $caption = shift;
8335: return "<caption class=\"LC_caption\">$caption</caption>";
8336: }
1.347 albertel 8337: }
8338:
1.548 albertel 8339: =pod
8340:
8341: =item * &inhibit_menu_check($arg)
8342:
8343: Checks for a inhibitmenu state and generates output to preserve it
8344:
8345: Inputs: $arg - can be any of
8346: - undef - in which case the return value is a string
8347: to add into arguments list of a uri
8348: - 'input' - in which case the return value is a HTML
8349: <form> <input> field of type hidden to
8350: preserve the value
8351: - a url - in which case the return value is the url with
8352: the neccesary cgi args added to preserve the
8353: inhibitmenu state
8354: - a ref to a url - no return value, but the string is
8355: updated to include the neccessary cgi
8356: args to preserve the inhibitmenu state
8357:
8358: =cut
8359:
8360: sub inhibit_menu_check {
8361: my ($arg) = @_;
8362: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8363: if ($arg eq 'input') {
8364: if ($env{'form.inhibitmenu'}) {
8365: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8366: } else {
8367: return
8368: }
8369: }
8370: if ($env{'form.inhibitmenu'}) {
8371: if (ref($arg)) {
8372: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8373: } elsif ($arg eq '') {
8374: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8375: } else {
8376: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8377: }
8378: }
8379: if (!ref($arg)) {
8380: return $arg;
8381: }
8382: }
8383:
1.251 albertel 8384: ###############################################
1.182 matthew 8385:
8386: =pod
8387:
1.549 albertel 8388: =back
8389:
8390: =head1 User Information Routines
8391:
8392: =over 4
8393:
1.405 albertel 8394: =item * &get_users_function()
1.182 matthew 8395:
8396: Used by &bodytag to determine the current users primary role.
8397: Returns either 'student','coordinator','admin', or 'author'.
8398:
8399: =cut
8400:
8401: ###############################################
8402: sub get_users_function {
1.815 tempelho 8403: my $function = 'norole';
1.818 tempelho 8404: if ($env{'request.role'}=~/^(st)/) {
8405: $function='student';
8406: }
1.907 raeburn 8407: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8408: $function='coordinator';
8409: }
1.258 albertel 8410: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8411: $function='admin';
8412: }
1.826 bisitz 8413: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8414: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8415: $function='author';
8416: }
8417: return $function;
1.54 www 8418: }
1.99 www 8419:
8420: ###############################################
8421:
1.233 raeburn 8422: =pod
8423:
1.821 raeburn 8424: =item * &show_course()
8425:
8426: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8427: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8428:
8429: Inputs:
8430: None
8431:
8432: Outputs:
8433: Scalar: 1 if 'Course' to be used, 0 otherwise.
8434:
8435: =cut
8436:
8437: ###############################################
8438: sub show_course {
8439: my $course = !$env{'user.adv'};
8440: if (!$env{'user.adv'}) {
8441: foreach my $env (keys(%env)) {
8442: next if ($env !~ m/^user\.priv\./);
8443: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8444: $course = 0;
8445: last;
8446: }
8447: }
8448: }
8449: return $course;
8450: }
8451:
8452: ###############################################
8453:
8454: =pod
8455:
1.542 raeburn 8456: =item * &check_user_status()
1.274 raeburn 8457:
8458: Determines current status of supplied role for a
8459: specific user. Roles can be active, previous or future.
8460:
8461: Inputs:
8462: user's domain, user's username, course's domain,
1.375 raeburn 8463: course's number, optional section ID.
1.274 raeburn 8464:
8465: Outputs:
8466: role status: active, previous or future.
8467:
8468: =cut
8469:
8470: sub check_user_status {
1.412 raeburn 8471: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8472: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 8473: my @uroles = keys(%userinfo);
1.274 raeburn 8474: my $srchstr;
8475: my $active_chk = 'none';
1.412 raeburn 8476: my $now = time;
1.274 raeburn 8477: if (@uroles > 0) {
1.908 raeburn 8478: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8479: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8480: } else {
1.412 raeburn 8481: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8482: }
8483: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8484: my $role_end = 0;
8485: my $role_start = 0;
8486: $active_chk = 'active';
1.412 raeburn 8487: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8488: $role_end = $1;
8489: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8490: $role_start = $1;
1.274 raeburn 8491: }
8492: }
8493: if ($role_start > 0) {
1.412 raeburn 8494: if ($now < $role_start) {
1.274 raeburn 8495: $active_chk = 'future';
8496: }
8497: }
8498: if ($role_end > 0) {
1.412 raeburn 8499: if ($now > $role_end) {
1.274 raeburn 8500: $active_chk = 'previous';
8501: }
8502: }
8503: }
8504: }
8505: return $active_chk;
8506: }
8507:
8508: ###############################################
8509:
8510: =pod
8511:
1.405 albertel 8512: =item * &get_sections()
1.233 raeburn 8513:
8514: Determines all the sections for a course including
8515: sections with students and sections containing other roles.
1.419 raeburn 8516: Incoming parameters:
8517:
8518: 1. domain
8519: 2. course number
8520: 3. reference to array containing roles for which sections should
8521: be gathered (optional).
8522: 4. reference to array containing status types for which sections
8523: should be gathered (optional).
8524:
8525: If the third argument is undefined, sections are gathered for any role.
8526: If the fourth argument is undefined, sections are gathered for any status.
8527: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8528:
1.374 raeburn 8529: Returns section hash (keys are section IDs, values are
8530: number of users in each section), subject to the
1.419 raeburn 8531: optional roles filter, optional status filter
1.233 raeburn 8532:
8533: =cut
8534:
8535: ###############################################
8536: sub get_sections {
1.419 raeburn 8537: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8538: if (!defined($cdom) || !defined($cnum)) {
8539: my $cid = $env{'request.course.id'};
8540:
8541: return if (!defined($cid));
8542:
8543: $cdom = $env{'course.'.$cid.'.domain'};
8544: $cnum = $env{'course.'.$cid.'.num'};
8545: }
8546:
8547: my %sectioncount;
1.419 raeburn 8548: my $now = time;
1.240 albertel 8549:
1.1075.2.33 raeburn 8550: my $check_students = 1;
8551: my $only_students = 0;
8552: if (ref($possible_roles) eq 'ARRAY') {
8553: if (grep(/^st$/,@{$possible_roles})) {
8554: if (@{$possible_roles} == 1) {
8555: $only_students = 1;
8556: }
8557: } else {
8558: $check_students = 0;
8559: }
8560: }
8561:
8562: if ($check_students) {
1.276 albertel 8563: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8564: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8565: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8566: my $start_index = &Apache::loncoursedata::CL_START();
8567: my $end_index = &Apache::loncoursedata::CL_END();
8568: my $status;
1.366 albertel 8569: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8570: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8571: $data->[$status_index],
8572: $data->[$start_index],
8573: $data->[$end_index]);
8574: if ($stu_status eq 'Active') {
8575: $status = 'active';
8576: } elsif ($end < $now) {
8577: $status = 'previous';
8578: } elsif ($start > $now) {
8579: $status = 'future';
8580: }
8581: if ($section ne '-1' && $section !~ /^\s*$/) {
8582: if ((!defined($possible_status)) || (($status ne '') &&
8583: (grep/^\Q$status\E$/,@{$possible_status}))) {
8584: $sectioncount{$section}++;
8585: }
1.240 albertel 8586: }
8587: }
8588: }
1.1075.2.33 raeburn 8589: if ($only_students) {
8590: return %sectioncount;
8591: }
1.240 albertel 8592: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8593: foreach my $user (sort(keys(%courseroles))) {
8594: if ($user !~ /^(\w{2})/) { next; }
8595: my ($role) = ($user =~ /^(\w{2})/);
8596: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8597: my ($section,$status);
1.240 albertel 8598: if ($role eq 'cr' &&
8599: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8600: $section=$1;
8601: }
8602: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8603: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8604: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8605: if ($end == -1 && $start == -1) {
8606: next; #deleted role
8607: }
8608: if (!defined($possible_status)) {
8609: $sectioncount{$section}++;
8610: } else {
8611: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8612: $status = 'active';
8613: } elsif ($end < $now) {
8614: $status = 'future';
8615: } elsif ($start > $now) {
8616: $status = 'previous';
8617: }
8618: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8619: $sectioncount{$section}++;
8620: }
8621: }
1.233 raeburn 8622: }
1.366 albertel 8623: return %sectioncount;
1.233 raeburn 8624: }
8625:
1.274 raeburn 8626: ###############################################
1.294 raeburn 8627:
8628: =pod
1.405 albertel 8629:
8630: =item * &get_course_users()
8631:
1.275 raeburn 8632: Retrieves usernames:domains for users in the specified course
8633: with specific role(s), and access status.
8634:
8635: Incoming parameters:
1.277 albertel 8636: 1. course domain
8637: 2. course number
8638: 3. access status: users must have - either active,
1.275 raeburn 8639: previous, future, or all.
1.277 albertel 8640: 4. reference to array of permissible roles
1.288 raeburn 8641: 5. reference to array of section restrictions (optional)
8642: 6. reference to results object (hash of hashes).
8643: 7. reference to optional userdata hash
1.609 raeburn 8644: 8. reference to optional statushash
1.630 raeburn 8645: 9. flag if privileged users (except those set to unhide in
8646: course settings) should be excluded
1.609 raeburn 8647: Keys of top level results hash are roles.
1.275 raeburn 8648: Keys of inner hashes are username:domain, with
8649: values set to access type.
1.288 raeburn 8650: Optional userdata hash returns an array with arguments in the
8651: same order as loncoursedata::get_classlist() for student data.
8652:
1.609 raeburn 8653: Optional statushash returns
8654:
1.288 raeburn 8655: Entries for end, start, section and status are blank because
8656: of the possibility of multiple values for non-student roles.
8657:
1.275 raeburn 8658: =cut
1.405 albertel 8659:
1.275 raeburn 8660: ###############################################
1.405 albertel 8661:
1.275 raeburn 8662: sub get_course_users {
1.630 raeburn 8663: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8664: my %idx = ();
1.419 raeburn 8665: my %seclists;
1.288 raeburn 8666:
8667: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8668: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8669: $idx{end} = &Apache::loncoursedata::CL_END();
8670: $idx{start} = &Apache::loncoursedata::CL_START();
8671: $idx{id} = &Apache::loncoursedata::CL_ID();
8672: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8673: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8674: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8675:
1.290 albertel 8676: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8677: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8678: my $now = time;
1.277 albertel 8679: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8680: my $match = 0;
1.412 raeburn 8681: my $secmatch = 0;
1.419 raeburn 8682: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8683: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8684: if ($section eq '') {
8685: $section = 'none';
8686: }
1.291 albertel 8687: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8688: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8689: $secmatch = 1;
8690: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8691: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8692: $secmatch = 1;
8693: }
8694: } else {
1.419 raeburn 8695: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8696: $secmatch = 1;
8697: }
1.290 albertel 8698: }
1.412 raeburn 8699: if (!$secmatch) {
8700: next;
8701: }
1.419 raeburn 8702: }
1.275 raeburn 8703: if (defined($$types{'active'})) {
1.288 raeburn 8704: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8705: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8706: $match = 1;
1.275 raeburn 8707: }
8708: }
8709: if (defined($$types{'previous'})) {
1.609 raeburn 8710: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8711: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8712: $match = 1;
1.275 raeburn 8713: }
8714: }
8715: if (defined($$types{'future'})) {
1.609 raeburn 8716: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8717: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8718: $match = 1;
1.275 raeburn 8719: }
8720: }
1.609 raeburn 8721: if ($match) {
8722: push(@{$seclists{$student}},$section);
8723: if (ref($userdata) eq 'HASH') {
8724: $$userdata{$student} = $$classlist{$student};
8725: }
8726: if (ref($statushash) eq 'HASH') {
8727: $statushash->{$student}{'st'}{$section} = $status;
8728: }
1.288 raeburn 8729: }
1.275 raeburn 8730: }
8731: }
1.412 raeburn 8732: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8733: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8734: my $now = time;
1.609 raeburn 8735: my %displaystatus = ( previous => 'Expired',
8736: active => 'Active',
8737: future => 'Future',
8738: );
1.1075.2.36 raeburn 8739: my (%nothide,@possdoms);
1.630 raeburn 8740: if ($hidepriv) {
8741: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8742: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8743: if ($user !~ /:/) {
8744: $nothide{join(':',split(/[\@]/,$user))}=1;
8745: } else {
8746: $nothide{$user} = 1;
8747: }
8748: }
1.1075.2.36 raeburn 8749: my @possdoms = ($cdom);
8750: if ($coursehash{'checkforpriv'}) {
8751: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8752: }
1.630 raeburn 8753: }
1.439 raeburn 8754: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8755: my $match = 0;
1.412 raeburn 8756: my $secmatch = 0;
1.439 raeburn 8757: my $status;
1.412 raeburn 8758: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8759: $user =~ s/:$//;
1.439 raeburn 8760: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8761: if ($end == -1 || $start == -1) {
8762: next;
8763: }
8764: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8765: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8766: my ($uname,$udom) = split(/:/,$user);
8767: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8768: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8769: $secmatch = 1;
8770: } elsif ($usec eq '') {
1.420 albertel 8771: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8772: $secmatch = 1;
8773: }
8774: } else {
8775: if (grep(/^\Q$usec\E$/,@{$sections})) {
8776: $secmatch = 1;
8777: }
8778: }
8779: if (!$secmatch) {
8780: next;
8781: }
1.288 raeburn 8782: }
1.419 raeburn 8783: if ($usec eq '') {
8784: $usec = 'none';
8785: }
1.275 raeburn 8786: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8787: if ($hidepriv) {
1.1075.2.36 raeburn 8788: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8789: (!$nothide{$uname.':'.$udom})) {
8790: next;
8791: }
8792: }
1.503 raeburn 8793: if ($end > 0 && $end < $now) {
1.439 raeburn 8794: $status = 'previous';
8795: } elsif ($start > $now) {
8796: $status = 'future';
8797: } else {
8798: $status = 'active';
8799: }
1.277 albertel 8800: foreach my $type (keys(%{$types})) {
1.275 raeburn 8801: if ($status eq $type) {
1.420 albertel 8802: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8803: push(@{$$users{$role}{$user}},$type);
8804: }
1.288 raeburn 8805: $match = 1;
8806: }
8807: }
1.419 raeburn 8808: if (($match) && (ref($userdata) eq 'HASH')) {
8809: if (!exists($$userdata{$uname.':'.$udom})) {
8810: &get_user_info($udom,$uname,\%idx,$userdata);
8811: }
1.420 albertel 8812: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8813: push(@{$seclists{$uname.':'.$udom}},$usec);
8814: }
1.609 raeburn 8815: if (ref($statushash) eq 'HASH') {
8816: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8817: }
1.275 raeburn 8818: }
8819: }
8820: }
8821: }
1.290 albertel 8822: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8823: if ((defined($cdom)) && (defined($cnum))) {
8824: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8825: if ( defined($csettings{'internal.courseowner'}) ) {
8826: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8827: next if ($owner eq '');
8828: my ($ownername,$ownerdom);
8829: if ($owner =~ /^([^:]+):([^:]+)$/) {
8830: $ownername = $1;
8831: $ownerdom = $2;
8832: } else {
8833: $ownername = $owner;
8834: $ownerdom = $cdom;
8835: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8836: }
8837: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8838: if (defined($userdata) &&
1.609 raeburn 8839: !exists($$userdata{$owner})) {
8840: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8841: if (!grep(/^none$/,@{$seclists{$owner}})) {
8842: push(@{$seclists{$owner}},'none');
8843: }
8844: if (ref($statushash) eq 'HASH') {
8845: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8846: }
1.290 albertel 8847: }
1.279 raeburn 8848: }
8849: }
8850: }
1.419 raeburn 8851: foreach my $user (keys(%seclists)) {
8852: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8853: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8854: }
1.275 raeburn 8855: }
8856: return;
8857: }
8858:
1.288 raeburn 8859: sub get_user_info {
8860: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8861: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8862: &plainname($uname,$udom,'lastname');
1.291 albertel 8863: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8864: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8865: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8866: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8867: return;
8868: }
1.275 raeburn 8869:
1.472 raeburn 8870: ###############################################
8871:
8872: =pod
8873:
8874: =item * &get_user_quota()
8875:
1.1075.2.41 raeburn 8876: Retrieves quota assigned for storage of user files.
8877: Default is to report quota for portfolio files.
1.472 raeburn 8878:
8879: Incoming parameters:
8880: 1. user's username
8881: 2. user's domain
1.1075.2.41 raeburn 8882: 3. quota name - portfolio, author, or course
8883: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 8884: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 8885: course
1.472 raeburn 8886:
8887: Returns:
1.1075.2.58 raeburn 8888: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8889: 2. (Optional) Type of setting: custom or default
8890: (individually assigned or default for user's
8891: institutional status).
8892: 3. (Optional) - User's institutional status (e.g., faculty, staff
8893: or student - types as defined in localenroll::inst_usertypes
8894: for user's domain, which determines default quota for user.
8895: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8896:
8897: If a value has been stored in the user's environment,
1.536 raeburn 8898: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 8899: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8900:
8901: =cut
8902:
8903: ###############################################
8904:
8905:
8906: sub get_user_quota {
1.1075.2.42 raeburn 8907: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8908: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8909: if (!defined($udom)) {
8910: $udom = $env{'user.domain'};
8911: }
8912: if (!defined($uname)) {
8913: $uname = $env{'user.name'};
8914: }
8915: if (($udom eq '' || $uname eq '') ||
8916: ($udom eq 'public') && ($uname eq 'public')) {
8917: $quota = 0;
1.536 raeburn 8918: $quotatype = 'default';
8919: $defquota = 0;
1.472 raeburn 8920: } else {
1.536 raeburn 8921: my $inststatus;
1.1075.2.41 raeburn 8922: if ($quotaname eq 'course') {
8923: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8924: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8925: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8926: } else {
8927: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8928: $quota = $cenv{'internal.uploadquota'};
8929: }
1.536 raeburn 8930: } else {
1.1075.2.41 raeburn 8931: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8932: if ($quotaname eq 'author') {
8933: $quota = $env{'environment.authorquota'};
8934: } else {
8935: $quota = $env{'environment.portfolioquota'};
8936: }
8937: $inststatus = $env{'environment.inststatus'};
8938: } else {
8939: my %userenv =
8940: &Apache::lonnet::get('environment',['portfolioquota',
8941: 'authorquota','inststatus'],$udom,$uname);
8942: my ($tmp) = keys(%userenv);
8943: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8944: if ($quotaname eq 'author') {
8945: $quota = $userenv{'authorquota'};
8946: } else {
8947: $quota = $userenv{'portfolioquota'};
8948: }
8949: $inststatus = $userenv{'inststatus'};
8950: } else {
8951: undef(%userenv);
8952: }
8953: }
8954: }
8955: if ($quota eq '' || wantarray) {
8956: if ($quotaname eq 'course') {
8957: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 8958: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8959: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 8960: $defquota = $domdefs{$crstype.'quota'};
8961: }
8962: if ($defquota eq '') {
8963: $defquota = 500;
8964: }
1.1075.2.41 raeburn 8965: } else {
8966: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8967: }
8968: if ($quota eq '') {
8969: $quota = $defquota;
8970: $quotatype = 'default';
8971: } else {
8972: $quotatype = 'custom';
8973: }
1.472 raeburn 8974: }
8975: }
1.536 raeburn 8976: if (wantarray) {
8977: return ($quota,$quotatype,$settingstatus,$defquota);
8978: } else {
8979: return $quota;
8980: }
1.472 raeburn 8981: }
8982:
8983: ###############################################
8984:
8985: =pod
8986:
8987: =item * &default_quota()
8988:
1.536 raeburn 8989: Retrieves default quota assigned for storage of user portfolio files,
8990: given an (optional) user's institutional status.
1.472 raeburn 8991:
8992: Incoming parameters:
1.1075.2.42 raeburn 8993:
1.472 raeburn 8994: 1. domain
1.536 raeburn 8995: 2. (Optional) institutional status(es). This is a : separated list of
8996: status types (e.g., faculty, staff, student etc.)
8997: which apply to the user for whom the default is being retrieved.
8998: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 8999: default quota will be returned.
9000: 3. quota name - portfolio, author, or course
9001: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9002:
9003: Returns:
1.1075.2.42 raeburn 9004:
1.1075.2.58 raeburn 9005: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9006: 2. (Optional) institutional type which determined the value of the
9007: default quota.
1.472 raeburn 9008:
9009: If a value has been stored in the domain's configuration db,
9010: it will return that, otherwise it returns 20 (for backwards
9011: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9012: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9013:
1.536 raeburn 9014: If the user's status includes multiple types (e.g., staff and student),
9015: the largest default quota which applies to the user determines the
9016: default quota returned.
9017:
1.472 raeburn 9018: =cut
9019:
9020: ###############################################
9021:
9022:
9023: sub default_quota {
1.1075.2.41 raeburn 9024: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9025: my ($defquota,$settingstatus);
9026: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9027: ['quotas'],$udom);
1.1075.2.41 raeburn 9028: my $key = 'defaultquota';
9029: if ($quotaname eq 'author') {
9030: $key = 'authorquota';
9031: }
1.622 raeburn 9032: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9033: if ($inststatus ne '') {
1.765 raeburn 9034: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9035: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9036: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9037: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9038: if ($defquota eq '') {
1.1075.2.41 raeburn 9039: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9040: $settingstatus = $item;
1.1075.2.41 raeburn 9041: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9042: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9043: $settingstatus = $item;
9044: }
9045: }
1.1075.2.41 raeburn 9046: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9047: if ($quotahash{'quotas'}{$item} ne '') {
9048: if ($defquota eq '') {
9049: $defquota = $quotahash{'quotas'}{$item};
9050: $settingstatus = $item;
9051: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9052: $defquota = $quotahash{'quotas'}{$item};
9053: $settingstatus = $item;
9054: }
1.536 raeburn 9055: }
9056: }
9057: }
9058: }
9059: if ($defquota eq '') {
1.1075.2.41 raeburn 9060: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9061: $defquota = $quotahash{'quotas'}{$key}{'default'};
9062: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9063: $defquota = $quotahash{'quotas'}{'default'};
9064: }
1.536 raeburn 9065: $settingstatus = 'default';
1.1075.2.42 raeburn 9066: if ($defquota eq '') {
9067: if ($quotaname eq 'author') {
9068: $defquota = 500;
9069: }
9070: }
1.536 raeburn 9071: }
9072: } else {
9073: $settingstatus = 'default';
1.1075.2.41 raeburn 9074: if ($quotaname eq 'author') {
9075: $defquota = 500;
9076: } else {
9077: $defquota = 20;
9078: }
1.536 raeburn 9079: }
9080: if (wantarray) {
9081: return ($defquota,$settingstatus);
1.472 raeburn 9082: } else {
1.536 raeburn 9083: return $defquota;
1.472 raeburn 9084: }
9085: }
9086:
1.1075.2.41 raeburn 9087: ###############################################
9088:
9089: =pod
9090:
1.1075.2.42 raeburn 9091: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 9092:
9093: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 9094: of existing file within authoring space will cause quota for the authoring
9095: space to be exceeded.
9096:
9097: Same, if upload of a file directly to a course/community via Course Editor
9098: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 9099:
1.1075.2.61 raeburn 9100: Inputs: 7
1.1075.2.42 raeburn 9101: 1. username or coursenum
1.1075.2.41 raeburn 9102: 2. domain
1.1075.2.42 raeburn 9103: 3. context ('author' or 'course')
1.1075.2.41 raeburn 9104: 4. filename of file for which action is being requested
9105: 5. filesize (kB) of file
9106: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 9107: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 9108:
9109: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
9110: otherwise return null.
9111:
1.1075.2.42 raeburn 9112: =back
9113:
1.1075.2.41 raeburn 9114: =cut
9115:
1.1075.2.42 raeburn 9116: sub excess_filesize_warning {
1.1075.2.59 raeburn 9117: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 9118: my $current_disk_usage = 0;
1.1075.2.59 raeburn 9119: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 9120: if ($context eq 'author') {
9121: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9122: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9123: } else {
9124: foreach my $subdir ('docs','supplemental') {
9125: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9126: }
9127: }
1.1075.2.41 raeburn 9128: $disk_quota = int($disk_quota * 1000);
9129: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 9130: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 9131: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 9132: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9133: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 9134: $disk_quota,$current_disk_usage).
9135: '</p>';
9136: }
9137: return;
9138: }
9139:
9140: ###############################################
9141:
9142:
1.384 raeburn 9143: sub get_secgrprole_info {
9144: my ($cdom,$cnum,$needroles,$type) = @_;
9145: my %sections_count = &get_sections($cdom,$cnum);
9146: my @sections = (sort {$a <=> $b} keys(%sections_count));
9147: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9148: my @groups = sort(keys(%curr_groups));
9149: my $allroles = [];
9150: my $rolehash;
9151: my $accesshash = {
9152: active => 'Currently has access',
9153: future => 'Will have future access',
9154: previous => 'Previously had access',
9155: };
9156: if ($needroles) {
9157: $rolehash = {'all' => 'all'};
1.385 albertel 9158: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9159: if (&Apache::lonnet::error(%user_roles)) {
9160: undef(%user_roles);
9161: }
9162: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9163: my ($role)=split(/\:/,$item,2);
9164: if ($role eq 'cr') { next; }
9165: if ($role =~ /^cr/) {
9166: $$rolehash{$role} = (split('/',$role))[3];
9167: } else {
9168: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9169: }
9170: }
9171: foreach my $key (sort(keys(%{$rolehash}))) {
9172: push(@{$allroles},$key);
9173: }
9174: push (@{$allroles},'st');
9175: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9176: }
9177: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9178: }
9179:
1.555 raeburn 9180: sub user_picker {
1.994 raeburn 9181: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9182: my $currdom = $dom;
9183: my %curr_selected = (
9184: srchin => 'dom',
1.580 raeburn 9185: srchby => 'lastname',
1.555 raeburn 9186: );
9187: my $srchterm;
1.625 raeburn 9188: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9189: if ($srch->{'srchby'} ne '') {
9190: $curr_selected{'srchby'} = $srch->{'srchby'};
9191: }
9192: if ($srch->{'srchin'} ne '') {
9193: $curr_selected{'srchin'} = $srch->{'srchin'};
9194: }
9195: if ($srch->{'srchtype'} ne '') {
9196: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9197: }
9198: if ($srch->{'srchdomain'} ne '') {
9199: $currdom = $srch->{'srchdomain'};
9200: }
9201: $srchterm = $srch->{'srchterm'};
9202: }
9203: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9204: 'usr' => 'Search criteria',
1.563 raeburn 9205: 'doma' => 'Domain/institution to search',
1.558 albertel 9206: 'uname' => 'username',
9207: 'lastname' => 'last name',
1.555 raeburn 9208: 'lastfirst' => 'last name, first name',
1.558 albertel 9209: 'crs' => 'in this course',
1.576 raeburn 9210: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9211: 'alc' => 'all LON-CAPA',
1.573 raeburn 9212: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9213: 'exact' => 'is',
9214: 'contains' => 'contains',
1.569 raeburn 9215: 'begins' => 'begins with',
1.571 raeburn 9216: 'youm' => "You must include some text to search for.",
9217: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9218: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9219: 'yomc' => "You must choose a domain when using an institutional directory search.",
9220: 'ymcd' => "You must choose a domain when using a domain search.",
9221: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9222: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9223: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9224: );
1.563 raeburn 9225: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9226: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9227:
9228: my @srchins = ('crs','dom','alc','instd');
9229:
9230: foreach my $option (@srchins) {
9231: # FIXME 'alc' option unavailable until
9232: # loncreateuser::print_user_query_page()
9233: # has been completed.
9234: next if ($option eq 'alc');
1.880 raeburn 9235: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9236: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9237: if ($curr_selected{'srchin'} eq $option) {
9238: $srchinsel .= '
9239: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9240: } else {
9241: $srchinsel .= '
9242: <option value="'.$option.'">'.$lt{$option}.'</option>';
9243: }
1.555 raeburn 9244: }
1.563 raeburn 9245: $srchinsel .= "\n </select>\n";
1.555 raeburn 9246:
9247: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9248: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9249: if ($curr_selected{'srchby'} eq $option) {
9250: $srchbysel .= '
9251: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9252: } else {
9253: $srchbysel .= '
9254: <option value="'.$option.'">'.$lt{$option}.'</option>';
9255: }
9256: }
9257: $srchbysel .= "\n </select>\n";
9258:
9259: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9260: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9261: if ($curr_selected{'srchtype'} eq $option) {
9262: $srchtypesel .= '
9263: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9264: } else {
9265: $srchtypesel .= '
9266: <option value="'.$option.'">'.$lt{$option}.'</option>';
9267: }
9268: }
9269: $srchtypesel .= "\n </select>\n";
9270:
1.558 albertel 9271: my ($newuserscript,$new_user_create);
1.994 raeburn 9272: my $context_dom = $env{'request.role.domain'};
9273: if ($context eq 'requestcrs') {
9274: if ($env{'form.coursedom'} ne '') {
9275: $context_dom = $env{'form.coursedom'};
9276: }
9277: }
1.556 raeburn 9278: if ($forcenewuser) {
1.576 raeburn 9279: if (ref($srch) eq 'HASH') {
1.994 raeburn 9280: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9281: if ($cancreate) {
9282: $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>';
9283: } else {
1.799 bisitz 9284: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9285: my %usertypetext = (
9286: official => 'institutional',
9287: unofficial => 'non-institutional',
9288: );
1.799 bisitz 9289: $new_user_create = '<p class="LC_warning">'
9290: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9291: .' '
9292: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9293: ,'<a href="'.$helplink.'">','</a>')
9294: .'</p><br />';
1.627 raeburn 9295: }
1.576 raeburn 9296: }
9297: }
9298:
1.556 raeburn 9299: $newuserscript = <<"ENDSCRIPT";
9300:
1.570 raeburn 9301: function setSearch(createnew,callingForm) {
1.556 raeburn 9302: if (createnew == 1) {
1.570 raeburn 9303: for (var i=0; i<callingForm.srchby.length; i++) {
9304: if (callingForm.srchby.options[i].value == 'uname') {
9305: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9306: }
9307: }
1.570 raeburn 9308: for (var i=0; i<callingForm.srchin.length; i++) {
9309: if ( callingForm.srchin.options[i].value == 'dom') {
9310: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9311: }
9312: }
1.570 raeburn 9313: for (var i=0; i<callingForm.srchtype.length; i++) {
9314: if (callingForm.srchtype.options[i].value == 'exact') {
9315: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9316: }
9317: }
1.570 raeburn 9318: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9319: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9320: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9321: }
9322: }
9323: }
9324: }
9325: ENDSCRIPT
1.558 albertel 9326:
1.556 raeburn 9327: }
9328:
1.555 raeburn 9329: my $output = <<"END_BLOCK";
1.556 raeburn 9330: <script type="text/javascript">
1.824 bisitz 9331: // <![CDATA[
1.570 raeburn 9332: function validateEntry(callingForm) {
1.558 albertel 9333:
1.556 raeburn 9334: var checkok = 1;
1.558 albertel 9335: var srchin;
1.570 raeburn 9336: for (var i=0; i<callingForm.srchin.length; i++) {
9337: if ( callingForm.srchin[i].checked ) {
9338: srchin = callingForm.srchin[i].value;
1.558 albertel 9339: }
9340: }
9341:
1.570 raeburn 9342: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9343: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9344: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9345: var srchterm = callingForm.srchterm.value;
9346: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9347: var msg = "";
9348:
9349: if (srchterm == "") {
9350: checkok = 0;
1.571 raeburn 9351: msg += "$lt{'youm'}\\n";
1.556 raeburn 9352: }
9353:
1.569 raeburn 9354: if (srchtype== 'begins') {
9355: if (srchterm.length < 2) {
9356: checkok = 0;
1.571 raeburn 9357: msg += "$lt{'thte'}\\n";
1.569 raeburn 9358: }
9359: }
9360:
1.556 raeburn 9361: if (srchtype== 'contains') {
9362: if (srchterm.length < 3) {
9363: checkok = 0;
1.571 raeburn 9364: msg += "$lt{'thet'}\\n";
1.556 raeburn 9365: }
9366: }
9367: if (srchin == 'instd') {
9368: if (srchdomain == '') {
9369: checkok = 0;
1.571 raeburn 9370: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9371: }
9372: }
9373: if (srchin == 'dom') {
9374: if (srchdomain == '') {
9375: checkok = 0;
1.571 raeburn 9376: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9377: }
9378: }
9379: if (srchby == 'lastfirst') {
9380: if (srchterm.indexOf(",") == -1) {
9381: checkok = 0;
1.571 raeburn 9382: msg += "$lt{'whus'}\\n";
1.556 raeburn 9383: }
9384: if (srchterm.indexOf(",") == srchterm.length -1) {
9385: checkok = 0;
1.571 raeburn 9386: msg += "$lt{'whse'}\\n";
1.556 raeburn 9387: }
9388: }
9389: if (checkok == 0) {
1.571 raeburn 9390: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9391: return;
9392: }
9393: if (checkok == 1) {
1.570 raeburn 9394: callingForm.submit();
1.556 raeburn 9395: }
9396: }
9397:
9398: $newuserscript
9399:
1.824 bisitz 9400: // ]]>
1.556 raeburn 9401: </script>
1.558 albertel 9402:
9403: $new_user_create
9404:
1.555 raeburn 9405: END_BLOCK
1.558 albertel 9406:
1.876 raeburn 9407: $output .= &Apache::lonhtmlcommon::start_pick_box().
9408: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9409: $domform.
9410: &Apache::lonhtmlcommon::row_closure().
9411: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9412: $srchbysel.
9413: $srchtypesel.
9414: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9415: $srchinsel.
9416: &Apache::lonhtmlcommon::row_closure(1).
9417: &Apache::lonhtmlcommon::end_pick_box().
9418: '<br />';
1.555 raeburn 9419: return $output;
9420: }
9421:
1.612 raeburn 9422: sub user_rule_check {
1.615 raeburn 9423: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9424: my $response;
9425: if (ref($usershash) eq 'HASH') {
9426: foreach my $user (keys(%{$usershash})) {
9427: my ($uname,$udom) = split(/:/,$user);
9428: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9429: my ($id,$newuser);
1.612 raeburn 9430: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9431: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9432: $id = $usershash->{$user}->{'id'};
9433: }
9434: my $inst_response;
9435: if (ref($checks) eq 'HASH') {
9436: if (defined($checks->{'username'})) {
1.615 raeburn 9437: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9438: &Apache::lonnet::get_instuser($udom,$uname);
9439: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9440: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9441: &Apache::lonnet::get_instuser($udom,undef,$id);
9442: }
1.615 raeburn 9443: } else {
9444: ($inst_response,%{$inst_results->{$user}}) =
9445: &Apache::lonnet::get_instuser($udom,$uname);
9446: return;
1.612 raeburn 9447: }
1.615 raeburn 9448: if (!$got_rules->{$udom}) {
1.612 raeburn 9449: my %domconfig = &Apache::lonnet::get_dom('configuration',
9450: ['usercreation'],$udom);
9451: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9452: foreach my $item ('username','id') {
1.612 raeburn 9453: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9454: $$curr_rules{$udom}{$item} =
9455: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9456: }
9457: }
9458: }
1.615 raeburn 9459: $got_rules->{$udom} = 1;
1.585 raeburn 9460: }
1.612 raeburn 9461: foreach my $item (keys(%{$checks})) {
9462: if (ref($$curr_rules{$udom}) eq 'HASH') {
9463: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9464: if (@{$$curr_rules{$udom}{$item}} > 0) {
9465: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9466: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9467: if ($rule_check{$rule}) {
9468: $$rulematch{$user}{$item} = $rule;
9469: if ($inst_response eq 'ok') {
1.615 raeburn 9470: if (ref($inst_results) eq 'HASH') {
9471: if (ref($inst_results->{$user}) eq 'HASH') {
9472: if (keys(%{$inst_results->{$user}}) == 0) {
9473: $$alerts{$item}{$udom}{$uname} = 1;
9474: }
1.612 raeburn 9475: }
9476: }
1.615 raeburn 9477: }
9478: last;
1.585 raeburn 9479: }
9480: }
9481: }
9482: }
9483: }
9484: }
9485: }
9486: }
1.612 raeburn 9487: return;
9488: }
9489:
9490: sub user_rule_formats {
9491: my ($domain,$domdesc,$curr_rules,$check) = @_;
9492: my %text = (
9493: 'username' => 'Usernames',
9494: 'id' => 'IDs',
9495: );
9496: my $output;
9497: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9498: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9499: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9500: $output = '<br />'.
9501: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9502: '<span class="LC_cusr_emph">','</span>',$domdesc).
9503: ' <ul>';
1.612 raeburn 9504: foreach my $rule (@{$ruleorder}) {
9505: if (ref($curr_rules) eq 'ARRAY') {
9506: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9507: if (ref($rules->{$rule}) eq 'HASH') {
9508: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9509: $rules->{$rule}{'desc'}.'</li>';
9510: }
9511: }
9512: }
9513: }
9514: $output .= '</ul>';
9515: }
9516: }
9517: return $output;
9518: }
9519:
9520: sub instrule_disallow_msg {
1.615 raeburn 9521: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9522: my $response;
9523: my %text = (
9524: item => 'username',
9525: items => 'usernames',
9526: match => 'matches',
9527: do => 'does',
9528: action => 'a username',
9529: one => 'one',
9530: );
9531: if ($count > 1) {
9532: $text{'item'} = 'usernames';
9533: $text{'match'} ='match';
9534: $text{'do'} = 'do';
9535: $text{'action'} = 'usernames',
9536: $text{'one'} = 'ones';
9537: }
9538: if ($checkitem eq 'id') {
9539: $text{'items'} = 'IDs';
9540: $text{'item'} = 'ID';
9541: $text{'action'} = 'an ID';
1.615 raeburn 9542: if ($count > 1) {
9543: $text{'item'} = 'IDs';
9544: $text{'action'} = 'IDs';
9545: }
1.612 raeburn 9546: }
1.674 bisitz 9547: $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 9548: if ($mode eq 'upload') {
9549: if ($checkitem eq 'username') {
9550: $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'}.");
9551: } elsif ($checkitem eq 'id') {
1.674 bisitz 9552: $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 9553: }
1.669 raeburn 9554: } elsif ($mode eq 'selfcreate') {
9555: if ($checkitem eq 'id') {
9556: $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.");
9557: }
1.615 raeburn 9558: } else {
9559: if ($checkitem eq 'username') {
9560: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9561: } elsif ($checkitem eq 'id') {
9562: $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.");
9563: }
1.612 raeburn 9564: }
9565: return $response;
1.585 raeburn 9566: }
9567:
1.624 raeburn 9568: sub personal_data_fieldtitles {
9569: my %fieldtitles = &Apache::lonlocal::texthash (
9570: id => 'Student/Employee ID',
9571: permanentemail => 'E-mail address',
9572: lastname => 'Last Name',
9573: firstname => 'First Name',
9574: middlename => 'Middle Name',
9575: generation => 'Generation',
9576: gen => 'Generation',
1.765 raeburn 9577: inststatus => 'Affiliation',
1.624 raeburn 9578: );
9579: return %fieldtitles;
9580: }
9581:
1.642 raeburn 9582: sub sorted_inst_types {
9583: my ($dom) = @_;
1.1075.2.70 raeburn 9584: my ($usertypes,$order);
9585: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9586: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9587: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9588: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9589: } else {
9590: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9591: }
1.642 raeburn 9592: my $othertitle = &mt('All users');
9593: if ($env{'request.course.id'}) {
1.668 raeburn 9594: $othertitle = &mt('Any users');
1.642 raeburn 9595: }
9596: my @types;
9597: if (ref($order) eq 'ARRAY') {
9598: @types = @{$order};
9599: }
9600: if (@types == 0) {
9601: if (ref($usertypes) eq 'HASH') {
9602: @types = sort(keys(%{$usertypes}));
9603: }
9604: }
9605: if (keys(%{$usertypes}) > 0) {
9606: $othertitle = &mt('Other users');
9607: }
9608: return ($othertitle,$usertypes,\@types);
9609: }
9610:
1.645 raeburn 9611: sub get_institutional_codes {
9612: my ($settings,$allcourses,$LC_code) = @_;
9613: # Get complete list of course sections to update
9614: my @currsections = ();
9615: my @currxlists = ();
9616: my $coursecode = $$settings{'internal.coursecode'};
9617:
9618: if ($$settings{'internal.sectionnums'} ne '') {
9619: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9620: }
9621:
9622: if ($$settings{'internal.crosslistings'} ne '') {
9623: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9624: }
9625:
9626: if (@currxlists > 0) {
9627: foreach (@currxlists) {
9628: if (m/^([^:]+):(\w*)$/) {
9629: unless (grep/^$1$/,@{$allcourses}) {
9630: push @{$allcourses},$1;
9631: $$LC_code{$1} = $2;
9632: }
9633: }
9634: }
9635: }
9636:
9637: if (@currsections > 0) {
9638: foreach (@currsections) {
9639: if (m/^(\w+):(\w*)$/) {
9640: my $sec = $coursecode.$1;
9641: my $lc_sec = $2;
9642: unless (grep/^$sec$/,@{$allcourses}) {
9643: push @{$allcourses},$sec;
9644: $$LC_code{$sec} = $lc_sec;
9645: }
9646: }
9647: }
9648: }
9649: return;
9650: }
9651:
1.971 raeburn 9652: sub get_standard_codeitems {
9653: return ('Year','Semester','Department','Number','Section');
9654: }
9655:
1.112 bowersj2 9656: =pod
9657:
1.780 raeburn 9658: =head1 Slot Helpers
9659:
9660: =over 4
9661:
9662: =item * sorted_slots()
9663:
1.1040 raeburn 9664: Sorts an array of slot names in order of an optional sort key,
9665: default sort is by slot start time (earliest first).
1.780 raeburn 9666:
9667: Inputs:
9668:
9669: =over 4
9670:
9671: slotsarr - Reference to array of unsorted slot names.
9672:
9673: slots - Reference to hash of hash, where outer hash keys are slot names.
9674:
1.1040 raeburn 9675: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9676:
1.549 albertel 9677: =back
9678:
1.780 raeburn 9679: Returns:
9680:
9681: =over 4
9682:
1.1040 raeburn 9683: sorted - An array of slot names sorted by a specified sort key
9684: (default sort key is start time of the slot).
1.780 raeburn 9685:
9686: =back
9687:
9688: =cut
9689:
9690:
9691: sub sorted_slots {
1.1040 raeburn 9692: my ($slotsarr,$slots,$sortkey) = @_;
9693: if ($sortkey eq '') {
9694: $sortkey = 'starttime';
9695: }
1.780 raeburn 9696: my @sorted;
9697: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9698: @sorted =
9699: sort {
9700: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9701: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9702: }
9703: if (ref($slots->{$a})) { return -1;}
9704: if (ref($slots->{$b})) { return 1;}
9705: return 0;
9706: } @{$slotsarr};
9707: }
9708: return @sorted;
9709: }
9710:
1.1040 raeburn 9711: =pod
9712:
9713: =item * get_future_slots()
9714:
9715: Inputs:
9716:
9717: =over 4
9718:
9719: cnum - course number
9720:
9721: cdom - course domain
9722:
9723: now - current UNIX time
9724:
9725: symb - optional symb
9726:
9727: =back
9728:
9729: Returns:
9730:
9731: =over 4
9732:
9733: sorted_reservable - ref to array of student_schedulable slots currently
9734: reservable, ordered by end date of reservation period.
9735:
9736: reservable_now - ref to hash of student_schedulable slots currently
9737: reservable.
9738:
9739: Keys in inner hash are:
9740: (a) symb: either blank or symb to which slot use is restricted.
9741: (b) endreserve: end date of reservation period.
9742:
9743: sorted_future - ref to array of student_schedulable slots reservable in
9744: the future, ordered by start date of reservation period.
9745:
9746: future_reservable - ref to hash of student_schedulable slots reservable
9747: in the future.
9748:
9749: Keys in inner hash are:
9750: (a) symb: either blank or symb to which slot use is restricted.
9751: (b) startreserve: start date of reservation period.
9752:
9753: =back
9754:
9755: =cut
9756:
9757: sub get_future_slots {
9758: my ($cnum,$cdom,$now,$symb) = @_;
9759: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9760: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9761: foreach my $slot (keys(%slots)) {
9762: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9763: if ($symb) {
9764: next if (($slots{$slot}->{'symb'} ne '') &&
9765: ($slots{$slot}->{'symb'} ne $symb));
9766: }
9767: if (($slots{$slot}->{'starttime'} > $now) &&
9768: ($slots{$slot}->{'endtime'} > $now)) {
9769: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9770: my $userallowed = 0;
9771: if ($slots{$slot}->{'allowedsections'}) {
9772: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9773: if (!defined($env{'request.role.sec'})
9774: && grep(/^No section assigned$/,@allowed_sec)) {
9775: $userallowed=1;
9776: } else {
9777: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9778: $userallowed=1;
9779: }
9780: }
9781: unless ($userallowed) {
9782: if (defined($env{'request.course.groups'})) {
9783: my @groups = split(/:/,$env{'request.course.groups'});
9784: foreach my $group (@groups) {
9785: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9786: $userallowed=1;
9787: last;
9788: }
9789: }
9790: }
9791: }
9792: }
9793: if ($slots{$slot}->{'allowedusers'}) {
9794: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9795: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9796: if (grep(/^\Q$user\E$/,@allowed_users)) {
9797: $userallowed = 1;
9798: }
9799: }
9800: next unless($userallowed);
9801: }
9802: my $startreserve = $slots{$slot}->{'startreserve'};
9803: my $endreserve = $slots{$slot}->{'endreserve'};
9804: my $symb = $slots{$slot}->{'symb'};
9805: if (($startreserve < $now) &&
9806: (!$endreserve || $endreserve > $now)) {
9807: my $lastres = $endreserve;
9808: if (!$lastres) {
9809: $lastres = $slots{$slot}->{'starttime'};
9810: }
9811: $reservable_now{$slot} = {
9812: symb => $symb,
9813: endreserve => $lastres
9814: };
9815: } elsif (($startreserve > $now) &&
9816: (!$endreserve || $endreserve > $startreserve)) {
9817: $future_reservable{$slot} = {
9818: symb => $symb,
9819: startreserve => $startreserve
9820: };
9821: }
9822: }
9823: }
9824: my @unsorted_reservable = keys(%reservable_now);
9825: if (@unsorted_reservable > 0) {
9826: @sorted_reservable =
9827: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9828: }
9829: my @unsorted_future = keys(%future_reservable);
9830: if (@unsorted_future > 0) {
9831: @sorted_future =
9832: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9833: }
9834: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9835: }
1.780 raeburn 9836:
9837: =pod
9838:
1.1057 foxr 9839: =back
9840:
1.549 albertel 9841: =head1 HTTP Helpers
9842:
9843: =over 4
9844:
1.648 raeburn 9845: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9846:
1.258 albertel 9847: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9848: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9849: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9850:
9851: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9852: $possible_names is an ref to an array of form element names. As an example:
9853: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9854: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9855:
9856: =cut
1.1 albertel 9857:
1.6 albertel 9858: sub get_unprocessed_cgi {
1.25 albertel 9859: my ($query,$possible_names)= @_;
1.26 matthew 9860: # $Apache::lonxml::debug=1;
1.356 albertel 9861: foreach my $pair (split(/&/,$query)) {
9862: my ($name, $value) = split(/=/,$pair);
1.369 www 9863: $name = &unescape($name);
1.25 albertel 9864: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9865: $value =~ tr/+/ /;
9866: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9867: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9868: }
1.16 harris41 9869: }
1.6 albertel 9870: }
9871:
1.112 bowersj2 9872: =pod
9873:
1.648 raeburn 9874: =item * &cacheheader()
1.112 bowersj2 9875:
9876: returns cache-controlling header code
9877:
9878: =cut
9879:
1.7 albertel 9880: sub cacheheader {
1.258 albertel 9881: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9882: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9883: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9884: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9885: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9886: return $output;
1.7 albertel 9887: }
9888:
1.112 bowersj2 9889: =pod
9890:
1.648 raeburn 9891: =item * &no_cache($r)
1.112 bowersj2 9892:
9893: specifies header code to not have cache
9894:
9895: =cut
9896:
1.9 albertel 9897: sub no_cache {
1.216 albertel 9898: my ($r) = @_;
9899: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9900: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9901: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9902: $r->no_cache(1);
9903: $r->header_out("Expires" => $date);
9904: $r->header_out("Pragma" => "no-cache");
1.123 www 9905: }
9906:
9907: sub content_type {
1.181 albertel 9908: my ($r,$type,$charset) = @_;
1.299 foxr 9909: if ($r) {
9910: # Note that printout.pl calls this with undef for $r.
9911: &no_cache($r);
9912: }
1.258 albertel 9913: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9914: unless ($charset) {
9915: $charset=&Apache::lonlocal::current_encoding;
9916: }
9917: if ($charset) { $type.='; charset='.$charset; }
9918: if ($r) {
9919: $r->content_type($type);
9920: } else {
9921: print("Content-type: $type\n\n");
9922: }
1.9 albertel 9923: }
1.25 albertel 9924:
1.112 bowersj2 9925: =pod
9926:
1.648 raeburn 9927: =item * &add_to_env($name,$value)
1.112 bowersj2 9928:
1.258 albertel 9929: adds $name to the %env hash with value
1.112 bowersj2 9930: $value, if $name already exists, the entry is converted to an array
9931: reference and $value is added to the array.
9932:
9933: =cut
9934:
1.25 albertel 9935: sub add_to_env {
9936: my ($name,$value)=@_;
1.258 albertel 9937: if (defined($env{$name})) {
9938: if (ref($env{$name})) {
1.25 albertel 9939: #already have multiple values
1.258 albertel 9940: push(@{ $env{$name} },$value);
1.25 albertel 9941: } else {
9942: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9943: my $first=$env{$name};
9944: undef($env{$name});
9945: push(@{ $env{$name} },$first,$value);
1.25 albertel 9946: }
9947: } else {
1.258 albertel 9948: $env{$name}=$value;
1.25 albertel 9949: }
1.31 albertel 9950: }
1.149 albertel 9951:
9952: =pod
9953:
1.648 raeburn 9954: =item * &get_env_multiple($name)
1.149 albertel 9955:
1.258 albertel 9956: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9957: values may be defined and end up as an array ref.
9958:
9959: returns an array of values
9960:
9961: =cut
9962:
9963: sub get_env_multiple {
9964: my ($name) = @_;
9965: my @values;
1.258 albertel 9966: if (defined($env{$name})) {
1.149 albertel 9967: # exists is it an array
1.258 albertel 9968: if (ref($env{$name})) {
9969: @values=@{ $env{$name} };
1.149 albertel 9970: } else {
1.258 albertel 9971: $values[0]=$env{$name};
1.149 albertel 9972: }
9973: }
9974: return(@values);
9975: }
9976:
1.660 raeburn 9977: sub ask_for_embedded_content {
9978: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9979: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 9980: %currsubfile,%unused,$rem);
1.1071 raeburn 9981: my $counter = 0;
9982: my $numnew = 0;
1.987 raeburn 9983: my $numremref = 0;
9984: my $numinvalid = 0;
9985: my $numpathchg = 0;
9986: my $numexisting = 0;
1.1071 raeburn 9987: my $numunused = 0;
9988: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 9989: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9990: my $heading = &mt('Upload embedded files');
9991: my $buttontext = &mt('Upload');
9992:
1.1075.2.11 raeburn 9993: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 9994: if ($actionurl eq '/adm/dependencies') {
9995: $navmap = Apache::lonnavmaps::navmap->new();
9996: }
9997: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9998: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 9999: }
1.1075.2.35 raeburn 10000: if (($actionurl eq '/adm/portfolio') ||
10001: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10002: my $current_path='/';
10003: if ($env{'form.currentpath'}) {
10004: $current_path = $env{'form.currentpath'};
10005: }
10006: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10007: $udom = $cdom;
10008: $uname = $cnum;
1.984 raeburn 10009: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10010: } else {
10011: $udom = $env{'user.domain'};
10012: $uname = $env{'user.name'};
10013: $url = '/userfiles/portfolio';
10014: }
1.987 raeburn 10015: $toplevel = $url.'/';
1.984 raeburn 10016: $url .= $current_path;
10017: $getpropath = 1;
1.987 raeburn 10018: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10019: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10020: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10021: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10022: $toplevel = $url;
1.984 raeburn 10023: if ($rest ne '') {
1.987 raeburn 10024: $url .= $rest;
10025: }
10026: } elsif ($actionurl eq '/adm/coursedocs') {
10027: if (ref($args) eq 'HASH') {
1.1071 raeburn 10028: $url = $args->{'docs_url'};
10029: $toplevel = $url;
1.1075.2.11 raeburn 10030: if ($args->{'context'} eq 'paste') {
10031: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10032: ($path) =
10033: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10034: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10035: $fileloc =~ s{^/}{};
10036: }
1.1071 raeburn 10037: }
10038: } elsif ($actionurl eq '/adm/dependencies') {
10039: if ($env{'request.course.id'} ne '') {
10040: if (ref($args) eq 'HASH') {
10041: $url = $args->{'docs_url'};
10042: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10043: $toplevel = $url;
10044: unless ($toplevel =~ m{^/}) {
10045: $toplevel = "/$url";
10046: }
1.1075.2.11 raeburn 10047: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10048: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10049: $path = $1;
10050: } else {
10051: ($path) =
10052: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10053: }
1.1075.2.79 raeburn 10054: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10055: $fileloc = $toplevel;
10056: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10057: my ($udom,$uname,$fname) =
10058: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10059: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10060: } else {
10061: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10062: }
1.1071 raeburn 10063: $fileloc =~ s{^/}{};
10064: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10065: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10066: }
1.987 raeburn 10067: }
1.1075.2.35 raeburn 10068: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10069: $udom = $cdom;
10070: $uname = $cnum;
10071: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10072: $toplevel = $url;
10073: $path = $url;
10074: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10075: $fileloc =~ s{^/}{};
10076: }
10077: foreach my $file (keys(%{$allfiles})) {
10078: my $embed_file;
10079: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10080: $embed_file = $1;
10081: } else {
10082: $embed_file = $file;
10083: }
1.1075.2.55 raeburn 10084: my ($absolutepath,$cleaned_file);
10085: if ($embed_file =~ m{^\w+://}) {
10086: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10087: $newfiles{$cleaned_file} = 1;
10088: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10089: } else {
1.1075.2.55 raeburn 10090: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10091: if ($embed_file =~ m{^/}) {
10092: $absolutepath = $embed_file;
10093: }
1.1075.2.47 raeburn 10094: if ($cleaned_file =~ m{/}) {
10095: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10096: $path = &check_for_traversal($path,$url,$toplevel);
10097: my $item = $fname;
10098: if ($path ne '') {
10099: $item = $path.'/'.$fname;
10100: $subdependencies{$path}{$fname} = 1;
10101: } else {
10102: $dependencies{$item} = 1;
10103: }
10104: if ($absolutepath) {
10105: $mapping{$item} = $absolutepath;
10106: } else {
10107: $mapping{$item} = $embed_file;
10108: }
10109: } else {
10110: $dependencies{$embed_file} = 1;
10111: if ($absolutepath) {
1.1075.2.47 raeburn 10112: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10113: } else {
1.1075.2.47 raeburn 10114: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10115: }
10116: }
1.984 raeburn 10117: }
10118: }
1.1071 raeburn 10119: my $dirptr = 16384;
1.984 raeburn 10120: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10121: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10122: if (($actionurl eq '/adm/portfolio') ||
10123: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10124: my ($sublistref,$listerror) =
10125: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10126: if (ref($sublistref) eq 'ARRAY') {
10127: foreach my $line (@{$sublistref}) {
10128: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10129: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10130: }
1.984 raeburn 10131: }
1.987 raeburn 10132: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10133: if (opendir(my $dir,$url.'/'.$path)) {
10134: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10135: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10136: }
1.1075.2.11 raeburn 10137: } elsif (($actionurl eq '/adm/dependencies') ||
10138: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10139: ($args->{'context'} eq 'paste')) ||
10140: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10141: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10142: my $dir;
10143: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10144: $dir = $fileloc;
10145: } else {
10146: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10147: }
1.1071 raeburn 10148: if ($dir ne '') {
10149: my ($sublistref,$listerror) =
10150: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10151: if (ref($sublistref) eq 'ARRAY') {
10152: foreach my $line (@{$sublistref}) {
10153: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10154: undef,$mtime)=split(/\&/,$line,12);
10155: unless (($testdir&$dirptr) ||
10156: ($file_name =~ /^\.\.?$/)) {
10157: $currsubfile{$path}{$file_name} = [$size,$mtime];
10158: }
10159: }
10160: }
10161: }
1.984 raeburn 10162: }
10163: }
10164: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10165: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10166: my $item = $path.'/'.$file;
10167: unless ($mapping{$item} eq $item) {
10168: $pathchanges{$item} = 1;
10169: }
10170: $existing{$item} = 1;
10171: $numexisting ++;
10172: } else {
10173: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10174: }
10175: }
1.1071 raeburn 10176: if ($actionurl eq '/adm/dependencies') {
10177: foreach my $path (keys(%currsubfile)) {
10178: if (ref($currsubfile{$path}) eq 'HASH') {
10179: foreach my $file (keys(%{$currsubfile{$path}})) {
10180: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10181: next if (($rem ne '') &&
10182: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10183: (ref($navmap) &&
10184: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10185: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10186: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10187: $unused{$path.'/'.$file} = 1;
10188: }
10189: }
10190: }
10191: }
10192: }
1.984 raeburn 10193: }
1.987 raeburn 10194: my %currfile;
1.1075.2.35 raeburn 10195: if (($actionurl eq '/adm/portfolio') ||
10196: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10197: my ($dirlistref,$listerror) =
10198: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10199: if (ref($dirlistref) eq 'ARRAY') {
10200: foreach my $line (@{$dirlistref}) {
10201: my ($file_name,$rest) = split(/\&/,$line,2);
10202: $currfile{$file_name} = 1;
10203: }
1.984 raeburn 10204: }
1.987 raeburn 10205: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10206: if (opendir(my $dir,$url)) {
1.987 raeburn 10207: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10208: map {$currfile{$_} = 1;} @dir_list;
10209: }
1.1075.2.11 raeburn 10210: } elsif (($actionurl eq '/adm/dependencies') ||
10211: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10212: ($args->{'context'} eq 'paste')) ||
10213: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10214: if ($env{'request.course.id'} ne '') {
10215: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10216: if ($dir ne '') {
10217: my ($dirlistref,$listerror) =
10218: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10219: if (ref($dirlistref) eq 'ARRAY') {
10220: foreach my $line (@{$dirlistref}) {
10221: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10222: $size,undef,$mtime)=split(/\&/,$line,12);
10223: unless (($testdir&$dirptr) ||
10224: ($file_name =~ /^\.\.?$/)) {
10225: $currfile{$file_name} = [$size,$mtime];
10226: }
10227: }
10228: }
10229: }
10230: }
1.984 raeburn 10231: }
10232: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10233: if (exists($currfile{$file})) {
1.987 raeburn 10234: unless ($mapping{$file} eq $file) {
10235: $pathchanges{$file} = 1;
10236: }
10237: $existing{$file} = 1;
10238: $numexisting ++;
10239: } else {
1.984 raeburn 10240: $newfiles{$file} = 1;
10241: }
10242: }
1.1071 raeburn 10243: foreach my $file (keys(%currfile)) {
10244: unless (($file eq $filename) ||
10245: ($file eq $filename.'.bak') ||
10246: ($dependencies{$file})) {
1.1075.2.11 raeburn 10247: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10248: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10249: next if (($rem ne '') &&
10250: (($env{"httpref.$rem".$file} ne '') ||
10251: (ref($navmap) &&
10252: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10253: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10254: ($navmap->getResourceByUrl($rem.$1)))))));
10255: }
1.1075.2.11 raeburn 10256: }
1.1071 raeburn 10257: $unused{$file} = 1;
10258: }
10259: }
1.1075.2.11 raeburn 10260: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10261: ($args->{'context'} eq 'paste')) {
10262: $counter = scalar(keys(%existing));
10263: $numpathchg = scalar(keys(%pathchanges));
10264: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10265: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10266: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10267: $counter = scalar(keys(%existing));
10268: $numpathchg = scalar(keys(%pathchanges));
10269: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10270: }
1.984 raeburn 10271: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10272: if ($actionurl eq '/adm/dependencies') {
10273: next if ($embed_file =~ m{^\w+://});
10274: }
1.660 raeburn 10275: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10276: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10277: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10278: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10279: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10280: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10281: }
1.1075.2.35 raeburn 10282: $upload_output .= '</td>';
1.1071 raeburn 10283: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10284: $upload_output.='<td align="right">'.
10285: '<span class="LC_info LC_fontsize_medium">'.
10286: &mt("URL points to web address").'</span>';
1.987 raeburn 10287: $numremref++;
1.660 raeburn 10288: } elsif ($args->{'error_on_invalid_names'}
10289: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10290: $upload_output.='<td align="right"><span class="LC_warning">'.
10291: &mt('Invalid characters').'</span>';
1.987 raeburn 10292: $numinvalid++;
1.660 raeburn 10293: } else {
1.1075.2.35 raeburn 10294: $upload_output .= '<td>'.
10295: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10296: $embed_file,\%mapping,
1.1071 raeburn 10297: $allfiles,$codebase,'upload');
10298: $counter ++;
10299: $numnew ++;
1.987 raeburn 10300: }
10301: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10302: }
10303: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10304: if ($actionurl eq '/adm/dependencies') {
10305: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10306: $modify_output .= &start_data_table_row().
10307: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10308: '<img src="'.&icon($embed_file).'" border="0" />'.
10309: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10310: '<td>'.$size.'</td>'.
10311: '<td>'.$mtime.'</td>'.
10312: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10313: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10314: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10315: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10316: &embedded_file_element('upload_embedded',$counter,
10317: $embed_file,\%mapping,
10318: $allfiles,$codebase,'modify').
10319: '</div></td>'.
10320: &end_data_table_row()."\n";
10321: $counter ++;
10322: } else {
10323: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10324: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10325: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10326: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10327: &Apache::loncommon::end_data_table_row()."\n";
10328: }
10329: }
10330: my $delidx = $counter;
10331: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10332: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10333: $delete_output .= &start_data_table_row().
10334: '<td><img src="'.&icon($oldfile).'" />'.
10335: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10336: '<td>'.$size.'</td>'.
10337: '<td>'.$mtime.'</td>'.
10338: '<td><label><input type="checkbox" name="del_upload_dep" '.
10339: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10340: &embedded_file_element('upload_embedded',$delidx,
10341: $oldfile,\%mapping,$allfiles,
10342: $codebase,'delete').'</td>'.
10343: &end_data_table_row()."\n";
10344: $numunused ++;
10345: $delidx ++;
1.987 raeburn 10346: }
10347: if ($upload_output) {
10348: $upload_output = &start_data_table().
10349: $upload_output.
10350: &end_data_table()."\n";
10351: }
1.1071 raeburn 10352: if ($modify_output) {
10353: $modify_output = &start_data_table().
10354: &start_data_table_header_row().
10355: '<th>'.&mt('File').'</th>'.
10356: '<th>'.&mt('Size (KB)').'</th>'.
10357: '<th>'.&mt('Modified').'</th>'.
10358: '<th>'.&mt('Upload replacement?').'</th>'.
10359: &end_data_table_header_row().
10360: $modify_output.
10361: &end_data_table()."\n";
10362: }
10363: if ($delete_output) {
10364: $delete_output = &start_data_table().
10365: &start_data_table_header_row().
10366: '<th>'.&mt('File').'</th>'.
10367: '<th>'.&mt('Size (KB)').'</th>'.
10368: '<th>'.&mt('Modified').'</th>'.
10369: '<th>'.&mt('Delete?').'</th>'.
10370: &end_data_table_header_row().
10371: $delete_output.
10372: &end_data_table()."\n";
10373: }
1.987 raeburn 10374: my $applies = 0;
10375: if ($numremref) {
10376: $applies ++;
10377: }
10378: if ($numinvalid) {
10379: $applies ++;
10380: }
10381: if ($numexisting) {
10382: $applies ++;
10383: }
1.1071 raeburn 10384: if ($counter || $numunused) {
1.987 raeburn 10385: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10386: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10387: $state.'<h3>'.$heading.'</h3>';
10388: if ($actionurl eq '/adm/dependencies') {
10389: if ($numnew) {
10390: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10391: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10392: $upload_output.'<br />'."\n";
10393: }
10394: if ($numexisting) {
10395: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10396: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10397: $modify_output.'<br />'."\n";
10398: $buttontext = &mt('Save changes');
10399: }
10400: if ($numunused) {
10401: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10402: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10403: $delete_output.'<br />'."\n";
10404: $buttontext = &mt('Save changes');
10405: }
10406: } else {
10407: $output .= $upload_output.'<br />'."\n";
10408: }
10409: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10410: $counter.'" />'."\n";
10411: if ($actionurl eq '/adm/dependencies') {
10412: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10413: $numnew.'" />'."\n";
10414: } elsif ($actionurl eq '') {
1.987 raeburn 10415: $output .= '<input type="hidden" name="phase" value="three" />';
10416: }
10417: } elsif ($applies) {
10418: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10419: if ($applies > 1) {
10420: $output .=
1.1075.2.35 raeburn 10421: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10422: if ($numremref) {
10423: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10424: }
10425: if ($numinvalid) {
10426: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10427: }
10428: if ($numexisting) {
10429: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10430: }
10431: $output .= '</ul><br />';
10432: } elsif ($numremref) {
10433: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10434: } elsif ($numinvalid) {
10435: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10436: } elsif ($numexisting) {
10437: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10438: }
10439: $output .= $upload_output.'<br />';
10440: }
10441: my ($pathchange_output,$chgcount);
1.1071 raeburn 10442: $chgcount = $counter;
1.987 raeburn 10443: if (keys(%pathchanges) > 0) {
10444: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10445: if ($counter) {
1.987 raeburn 10446: $output .= &embedded_file_element('pathchange',$chgcount,
10447: $embed_file,\%mapping,
1.1071 raeburn 10448: $allfiles,$codebase,'change');
1.987 raeburn 10449: } else {
10450: $pathchange_output .=
10451: &start_data_table_row().
10452: '<td><input type ="checkbox" name="namechange" value="'.
10453: $chgcount.'" checked="checked" /></td>'.
10454: '<td>'.$mapping{$embed_file}.'</td>'.
10455: '<td>'.$embed_file.
10456: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10457: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10458: '</td>'.&end_data_table_row();
1.660 raeburn 10459: }
1.987 raeburn 10460: $numpathchg ++;
10461: $chgcount ++;
1.660 raeburn 10462: }
10463: }
1.1075.2.35 raeburn 10464: if (($counter) || ($numunused)) {
1.987 raeburn 10465: if ($numpathchg) {
10466: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10467: $numpathchg.'" />'."\n";
10468: }
10469: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10470: ($actionurl eq '/adm/imsimport')) {
10471: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10472: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10473: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10474: } elsif ($actionurl eq '/adm/dependencies') {
10475: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10476: }
1.1075.2.35 raeburn 10477: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10478: } elsif ($numpathchg) {
10479: my %pathchange = ();
10480: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10481: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10482: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10483: }
1.987 raeburn 10484: }
1.1071 raeburn 10485: return ($output,$counter,$numpathchg);
1.987 raeburn 10486: }
10487:
1.1075.2.47 raeburn 10488: =pod
10489:
10490: =item * clean_path($name)
10491:
10492: Performs clean-up of directories, subdirectories and filename in an
10493: embedded object, referenced in an HTML file which is being uploaded
10494: to a course or portfolio, where
10495: "Upload embedded images/multimedia files if HTML file" checkbox was
10496: checked.
10497:
10498: Clean-up is similar to replacements in lonnet::clean_filename()
10499: except each / between sub-directory and next level is preserved.
10500:
10501: =cut
10502:
10503: sub clean_path {
10504: my ($embed_file) = @_;
10505: $embed_file =~s{^/+}{};
10506: my @contents;
10507: if ($embed_file =~ m{/}) {
10508: @contents = split(/\//,$embed_file);
10509: } else {
10510: @contents = ($embed_file);
10511: }
10512: my $lastidx = scalar(@contents)-1;
10513: for (my $i=0; $i<=$lastidx; $i++) {
10514: $contents[$i]=~s{\\}{/}g;
10515: $contents[$i]=~s/\s+/\_/g;
10516: $contents[$i]=~s{[^/\w\.\-]}{}g;
10517: if ($i == $lastidx) {
10518: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10519: }
10520: }
10521: if ($lastidx > 0) {
10522: return join('/',@contents);
10523: } else {
10524: return $contents[0];
10525: }
10526: }
10527:
1.987 raeburn 10528: sub embedded_file_element {
1.1071 raeburn 10529: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10530: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10531: (ref($codebase) eq 'HASH'));
10532: my $output;
1.1071 raeburn 10533: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10534: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10535: }
10536: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10537: &escape($embed_file).'" />';
10538: unless (($context eq 'upload_embedded') &&
10539: ($mapping->{$embed_file} eq $embed_file)) {
10540: $output .='
10541: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10542: }
10543: my $attrib;
10544: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10545: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10546: }
10547: $output .=
10548: "\n\t\t".
10549: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10550: $attrib.'" />';
10551: if (exists($codebase->{$mapping->{$embed_file}})) {
10552: $output .=
10553: "\n\t\t".
10554: '<input name="codebase_'.$num.'" type="hidden" value="'.
10555: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10556: }
1.987 raeburn 10557: return $output;
1.660 raeburn 10558: }
10559:
1.1071 raeburn 10560: sub get_dependency_details {
10561: my ($currfile,$currsubfile,$embed_file) = @_;
10562: my ($size,$mtime,$showsize,$showmtime);
10563: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10564: if ($embed_file =~ m{/}) {
10565: my ($path,$fname) = split(/\//,$embed_file);
10566: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10567: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10568: }
10569: } else {
10570: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10571: ($size,$mtime) = @{$currfile->{$embed_file}};
10572: }
10573: }
10574: $showsize = $size/1024.0;
10575: $showsize = sprintf("%.1f",$showsize);
10576: if ($mtime > 0) {
10577: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10578: }
10579: }
10580: return ($showsize,$showmtime);
10581: }
10582:
10583: sub ask_embedded_js {
10584: return <<"END";
10585: <script type="text/javascript"">
10586: // <![CDATA[
10587: function toggleBrowse(counter) {
10588: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10589: var fileid = document.getElementById('embedded_item_'+counter);
10590: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10591: if (chkboxid.checked == true) {
10592: uploaddivid.style.display='block';
10593: } else {
10594: uploaddivid.style.display='none';
10595: fileid.value = '';
10596: }
10597: }
10598: // ]]>
10599: </script>
10600:
10601: END
10602: }
10603:
1.661 raeburn 10604: sub upload_embedded {
10605: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10606: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10607: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10608: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10609: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10610: my $orig_uploaded_filename =
10611: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10612: foreach my $type ('orig','ref','attrib','codebase') {
10613: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10614: $env{'form.embedded_'.$type.'_'.$i} =
10615: &unescape($env{'form.embedded_'.$type.'_'.$i});
10616: }
10617: }
1.661 raeburn 10618: my ($path,$fname) =
10619: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10620: # no path, whole string is fname
10621: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10622: $fname = &Apache::lonnet::clean_filename($fname);
10623: # See if there is anything left
10624: next if ($fname eq '');
10625:
10626: # Check if file already exists as a file or directory.
10627: my ($state,$msg);
10628: if ($context eq 'portfolio') {
10629: my $port_path = $dirpath;
10630: if ($group ne '') {
10631: $port_path = "groups/$group/$port_path";
10632: }
1.987 raeburn 10633: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10634: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10635: $dir_root,$port_path,$disk_quota,
10636: $current_disk_usage,$uname,$udom);
10637: if ($state eq 'will_exceed_quota'
1.984 raeburn 10638: || $state eq 'file_locked') {
1.661 raeburn 10639: $output .= $msg;
10640: next;
10641: }
10642: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10643: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10644: if ($state eq 'exists') {
10645: $output .= $msg;
10646: next;
10647: }
10648: }
10649: # Check if extension is valid
10650: if (($fname =~ /\.(\w+)$/) &&
10651: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10652: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10653: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10654: next;
10655: } elsif (($fname =~ /\.(\w+)$/) &&
10656: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10657: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10658: next;
10659: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10660: $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 10661: next;
10662: }
10663: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10664: my $subdir = $path;
10665: $subdir =~ s{/+$}{};
1.661 raeburn 10666: if ($context eq 'portfolio') {
1.984 raeburn 10667: my $result;
10668: if ($state eq 'existingfile') {
10669: $result=
10670: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10671: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10672: } else {
1.984 raeburn 10673: $result=
10674: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10675: $dirpath.
1.1075.2.35 raeburn 10676: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10677: if ($result !~ m|^/uploaded/|) {
10678: $output .= '<span class="LC_error">'
10679: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10680: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10681: .'</span><br />';
10682: next;
10683: } else {
1.987 raeburn 10684: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10685: $path.$fname.'</span>').'<br />';
1.984 raeburn 10686: }
1.661 raeburn 10687: }
1.1075.2.35 raeburn 10688: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10689: my $extendedsubdir = $dirpath.'/'.$subdir;
10690: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10691: my $result =
1.1075.2.35 raeburn 10692: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10693: if ($result !~ m|^/uploaded/|) {
10694: $output .= '<span class="LC_error">'
10695: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10696: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10697: .'</span><br />';
10698: next;
10699: } else {
10700: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10701: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10702: if ($context eq 'syllabus') {
10703: &Apache::lonnet::make_public_indefinitely($result);
10704: }
1.987 raeburn 10705: }
1.661 raeburn 10706: } else {
10707: # Save the file
10708: my $target = $env{'form.embedded_item_'.$i};
10709: my $fullpath = $dir_root.$dirpath.'/'.$path;
10710: my $dest = $fullpath.$fname;
10711: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10712: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10713: my $count;
10714: my $filepath = $dir_root;
1.1027 raeburn 10715: foreach my $subdir (@parts) {
10716: $filepath .= "/$subdir";
10717: if (!-e $filepath) {
1.661 raeburn 10718: mkdir($filepath,0770);
10719: }
10720: }
10721: my $fh;
10722: if (!open($fh,'>'.$dest)) {
10723: &Apache::lonnet::logthis('Failed to create '.$dest);
10724: $output .= '<span class="LC_error">'.
1.1071 raeburn 10725: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10726: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10727: '</span><br />';
10728: } else {
10729: if (!print $fh $env{'form.embedded_item_'.$i}) {
10730: &Apache::lonnet::logthis('Failed to write to '.$dest);
10731: $output .= '<span class="LC_error">'.
1.1071 raeburn 10732: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10733: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10734: '</span><br />';
10735: } else {
1.987 raeburn 10736: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10737: $url.'</span>').'<br />';
10738: unless ($context eq 'testbank') {
10739: $footer .= &mt('View embedded file: [_1]',
10740: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10741: }
10742: }
10743: close($fh);
10744: }
10745: }
10746: if ($env{'form.embedded_ref_'.$i}) {
10747: $pathchange{$i} = 1;
10748: }
10749: }
10750: if ($output) {
10751: $output = '<p>'.$output.'</p>';
10752: }
10753: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10754: $returnflag = 'ok';
1.1071 raeburn 10755: my $numpathchgs = scalar(keys(%pathchange));
10756: if ($numpathchgs > 0) {
1.987 raeburn 10757: if ($context eq 'portfolio') {
10758: $output .= '<p>'.&mt('or').'</p>';
10759: } elsif ($context eq 'testbank') {
1.1071 raeburn 10760: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10761: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10762: $returnflag = 'modify_orightml';
10763: }
10764: }
1.1071 raeburn 10765: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10766: }
10767:
10768: sub modify_html_form {
10769: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10770: my $end = 0;
10771: my $modifyform;
10772: if ($context eq 'upload_embedded') {
10773: return unless (ref($pathchange) eq 'HASH');
10774: if ($env{'form.number_embedded_items'}) {
10775: $end += $env{'form.number_embedded_items'};
10776: }
10777: if ($env{'form.number_pathchange_items'}) {
10778: $end += $env{'form.number_pathchange_items'};
10779: }
10780: if ($end) {
10781: for (my $i=0; $i<$end; $i++) {
10782: if ($i < $env{'form.number_embedded_items'}) {
10783: next unless($pathchange->{$i});
10784: }
10785: $modifyform .=
10786: &start_data_table_row().
10787: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10788: 'checked="checked" /></td>'.
10789: '<td>'.$env{'form.embedded_ref_'.$i}.
10790: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10791: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10792: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10793: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10794: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10795: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10796: '<td>'.$env{'form.embedded_orig_'.$i}.
10797: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10798: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10799: &end_data_table_row();
1.1071 raeburn 10800: }
1.987 raeburn 10801: }
10802: } else {
10803: $modifyform = $pathchgtable;
10804: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10805: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10806: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10807: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10808: }
10809: }
10810: if ($modifyform) {
1.1071 raeburn 10811: if ($actionurl eq '/adm/dependencies') {
10812: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10813: }
1.987 raeburn 10814: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10815: '<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".
10816: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10817: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10818: '</ol></p>'."\n".'<p>'.
10819: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10820: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10821: &start_data_table()."\n".
10822: &start_data_table_header_row().
10823: '<th>'.&mt('Change?').'</th>'.
10824: '<th>'.&mt('Current reference').'</th>'.
10825: '<th>'.&mt('Required reference').'</th>'.
10826: &end_data_table_header_row()."\n".
10827: $modifyform.
10828: &end_data_table().'<br />'."\n".$hiddenstate.
10829: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10830: '</form>'."\n";
10831: }
10832: return;
10833: }
10834:
10835: sub modify_html_refs {
1.1075.2.35 raeburn 10836: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10837: my $container;
10838: if ($context eq 'portfolio') {
10839: $container = $env{'form.container'};
10840: } elsif ($context eq 'coursedoc') {
10841: $container = $env{'form.primaryurl'};
1.1071 raeburn 10842: } elsif ($context eq 'manage_dependencies') {
10843: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10844: $container = "/$container";
1.1075.2.35 raeburn 10845: } elsif ($context eq 'syllabus') {
10846: $container = $url;
1.987 raeburn 10847: } else {
1.1027 raeburn 10848: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10849: }
10850: my (%allfiles,%codebase,$output,$content);
10851: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10852: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10853: if (wantarray) {
10854: return ('',0,0);
10855: } else {
10856: return;
10857: }
10858: }
10859: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10860: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10861: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10862: if (wantarray) {
10863: return ('',0,0);
10864: } else {
10865: return;
10866: }
10867: }
1.987 raeburn 10868: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10869: if ($content eq '-1') {
10870: if (wantarray) {
10871: return ('',0,0);
10872: } else {
10873: return;
10874: }
10875: }
1.987 raeburn 10876: } else {
1.1071 raeburn 10877: unless ($container =~ /^\Q$dir_root\E/) {
10878: if (wantarray) {
10879: return ('',0,0);
10880: } else {
10881: return;
10882: }
10883: }
1.987 raeburn 10884: if (open(my $fh,"<$container")) {
10885: $content = join('', <$fh>);
10886: close($fh);
10887: } else {
1.1071 raeburn 10888: if (wantarray) {
10889: return ('',0,0);
10890: } else {
10891: return;
10892: }
1.987 raeburn 10893: }
10894: }
10895: my ($count,$codebasecount) = (0,0);
10896: my $mm = new File::MMagic;
10897: my $mime_type = $mm->checktype_contents($content);
10898: if ($mime_type eq 'text/html') {
10899: my $parse_result =
10900: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10901: \%codebase,\$content);
10902: if ($parse_result eq 'ok') {
10903: foreach my $i (@changes) {
10904: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10905: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10906: if ($allfiles{$ref}) {
10907: my $newname = $orig;
10908: my ($attrib_regexp,$codebase);
1.1006 raeburn 10909: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10910: if ($attrib_regexp =~ /:/) {
10911: $attrib_regexp =~ s/\:/|/g;
10912: }
10913: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10914: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10915: $count += $numchg;
1.1075.2.35 raeburn 10916: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 10917: delete($allfiles{$ref});
1.987 raeburn 10918: }
10919: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10920: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10921: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10922: $codebasecount ++;
10923: }
10924: }
10925: }
1.1075.2.35 raeburn 10926: my $skiprewrites;
1.987 raeburn 10927: if ($count || $codebasecount) {
10928: my $saveresult;
1.1071 raeburn 10929: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10930: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10931: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10932: if ($url eq $container) {
10933: my ($fname) = ($container =~ m{/([^/]+)$});
10934: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10935: $count,'<span class="LC_filename">'.
1.1071 raeburn 10936: $fname.'</span>').'</p>';
1.987 raeburn 10937: } else {
10938: $output = '<p class="LC_error">'.
10939: &mt('Error: update failed for: [_1].',
10940: '<span class="LC_filename">'.
10941: $container.'</span>').'</p>';
10942: }
1.1075.2.35 raeburn 10943: if ($context eq 'syllabus') {
10944: unless ($saveresult eq 'ok') {
10945: $skiprewrites = 1;
10946: }
10947: }
1.987 raeburn 10948: } else {
10949: if (open(my $fh,">$container")) {
10950: print $fh $content;
10951: close($fh);
10952: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10953: $count,'<span class="LC_filename">'.
10954: $container.'</span>').'</p>';
1.661 raeburn 10955: } else {
1.987 raeburn 10956: $output = '<p class="LC_error">'.
10957: &mt('Error: could not update [_1].',
10958: '<span class="LC_filename">'.
10959: $container.'</span>').'</p>';
1.661 raeburn 10960: }
10961: }
10962: }
1.1075.2.35 raeburn 10963: if (($context eq 'syllabus') && (!$skiprewrites)) {
10964: my ($actionurl,$state);
10965: $actionurl = "/public/$udom/$uname/syllabus";
10966: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10967: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10968: \%codebase,
10969: {'context' => 'rewrites',
10970: 'ignore_remote_references' => 1,});
10971: if (ref($mapping) eq 'HASH') {
10972: my $rewrites = 0;
10973: foreach my $key (keys(%{$mapping})) {
10974: next if ($key =~ m{^https?://});
10975: my $ref = $mapping->{$key};
10976: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10977: my $attrib;
10978: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10979: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10980: }
10981: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10982: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10983: $rewrites += $numchg;
10984: }
10985: }
10986: if ($rewrites) {
10987: my $saveresult;
10988: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10989: if ($url eq $container) {
10990: my ($fname) = ($container =~ m{/([^/]+)$});
10991: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10992: $count,'<span class="LC_filename">'.
10993: $fname.'</span>').'</p>';
10994: } else {
10995: $output .= '<p class="LC_error">'.
10996: &mt('Error: could not update links in [_1].',
10997: '<span class="LC_filename">'.
10998: $container.'</span>').'</p>';
10999:
11000: }
11001: }
11002: }
11003: }
1.987 raeburn 11004: } else {
11005: &logthis('Failed to parse '.$container.
11006: ' to modify references: '.$parse_result);
1.661 raeburn 11007: }
11008: }
1.1071 raeburn 11009: if (wantarray) {
11010: return ($output,$count,$codebasecount);
11011: } else {
11012: return $output;
11013: }
1.661 raeburn 11014: }
11015:
11016: sub check_for_existing {
11017: my ($path,$fname,$element) = @_;
11018: my ($state,$msg);
11019: if (-d $path.'/'.$fname) {
11020: $state = 'exists';
11021: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11022: } elsif (-e $path.'/'.$fname) {
11023: $state = 'exists';
11024: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11025: }
11026: if ($state eq 'exists') {
11027: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11028: }
11029: return ($state,$msg);
11030: }
11031:
11032: sub check_for_upload {
11033: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11034: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11035: my $filesize = length($env{'form.'.$element});
11036: if (!$filesize) {
11037: my $msg = '<span class="LC_error">'.
11038: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11039: '<span class="LC_filename">'.$fname.'</span>',
11040: $filesize).'<br />'.
1.1007 raeburn 11041: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11042: '</span>';
11043: return ('zero_bytes',$msg);
11044: }
11045: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11046: my $getpropath = 1;
1.1021 raeburn 11047: my ($dirlistref,$listerror) =
11048: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11049: my $found_file = 0;
11050: my $locked_file = 0;
1.991 raeburn 11051: my @lockers;
11052: my $navmap;
11053: if ($env{'request.course.id'}) {
11054: $navmap = Apache::lonnavmaps::navmap->new();
11055: }
1.1021 raeburn 11056: if (ref($dirlistref) eq 'ARRAY') {
11057: foreach my $line (@{$dirlistref}) {
11058: my ($file_name,$rest)=split(/\&/,$line,2);
11059: if ($file_name eq $fname){
11060: $file_name = $path.$file_name;
11061: if ($group ne '') {
11062: $file_name = $group.$file_name;
11063: }
11064: $found_file = 1;
11065: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11066: foreach my $lock (@lockers) {
11067: if (ref($lock) eq 'ARRAY') {
11068: my ($symb,$crsid) = @{$lock};
11069: if ($crsid eq $env{'request.course.id'}) {
11070: if (ref($navmap)) {
11071: my $res = $navmap->getBySymb($symb);
11072: foreach my $part (@{$res->parts()}) {
11073: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11074: unless (($slot_status == $res->RESERVED) ||
11075: ($slot_status == $res->RESERVED_LOCATION)) {
11076: $locked_file = 1;
11077: }
1.991 raeburn 11078: }
1.1021 raeburn 11079: } else {
11080: $locked_file = 1;
1.991 raeburn 11081: }
11082: } else {
11083: $locked_file = 1;
11084: }
11085: }
1.1021 raeburn 11086: }
11087: } else {
11088: my @info = split(/\&/,$rest);
11089: my $currsize = $info[6]/1000;
11090: if ($currsize < $filesize) {
11091: my $extra = $filesize - $currsize;
11092: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11093: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11094: &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 11095: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11096: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11097: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11098: return ('will_exceed_quota',$msg);
11099: }
1.984 raeburn 11100: }
11101: }
1.661 raeburn 11102: }
11103: }
11104: }
11105: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11106: my $msg = '<p class="LC_warning">'.
11107: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11108: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11109: return ('will_exceed_quota',$msg);
11110: } elsif ($found_file) {
11111: if ($locked_file) {
1.1075.2.69 raeburn 11112: my $msg = '<p class="LC_warning">';
1.661 raeburn 11113: $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 11114: $msg .= '</p>';
1.661 raeburn 11115: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11116: return ('file_locked',$msg);
11117: } else {
1.1075.2.69 raeburn 11118: my $msg = '<p class="LC_error">';
1.984 raeburn 11119: $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 11120: $msg .= '</p>';
1.984 raeburn 11121: return ('existingfile',$msg);
1.661 raeburn 11122: }
11123: }
11124: }
11125:
1.987 raeburn 11126: sub check_for_traversal {
11127: my ($path,$url,$toplevel) = @_;
11128: my @parts=split(/\//,$path);
11129: my $cleanpath;
11130: my $fullpath = $url;
11131: for (my $i=0;$i<@parts;$i++) {
11132: next if ($parts[$i] eq '.');
11133: if ($parts[$i] eq '..') {
11134: $fullpath =~ s{([^/]+/)$}{};
11135: } else {
11136: $fullpath .= $parts[$i].'/';
11137: }
11138: }
11139: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11140: $cleanpath = $1;
11141: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11142: my $curr_toprel = $1;
11143: my @parts = split(/\//,$curr_toprel);
11144: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11145: my @urlparts = split(/\//,$url_toprel);
11146: my $doubledots;
11147: my $startdiff = -1;
11148: for (my $i=0; $i<@urlparts; $i++) {
11149: if ($startdiff == -1) {
11150: unless ($urlparts[$i] eq $parts[$i]) {
11151: $startdiff = $i;
11152: $doubledots .= '../';
11153: }
11154: } else {
11155: $doubledots .= '../';
11156: }
11157: }
11158: if ($startdiff > -1) {
11159: $cleanpath = $doubledots;
11160: for (my $i=$startdiff; $i<@parts; $i++) {
11161: $cleanpath .= $parts[$i].'/';
11162: }
11163: }
11164: }
11165: $cleanpath =~ s{(/)$}{};
11166: return $cleanpath;
11167: }
1.31 albertel 11168:
1.1053 raeburn 11169: sub is_archive_file {
11170: my ($mimetype) = @_;
11171: if (($mimetype eq 'application/octet-stream') ||
11172: ($mimetype eq 'application/x-stuffit') ||
11173: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11174: return 1;
11175: }
11176: return;
11177: }
11178:
11179: sub decompress_form {
1.1065 raeburn 11180: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11181: my %lt = &Apache::lonlocal::texthash (
11182: this => 'This file is an archive file.',
1.1067 raeburn 11183: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11184: itsc => 'Its contents are as follows:',
1.1053 raeburn 11185: youm => 'You may wish to extract its contents.',
11186: extr => 'Extract contents',
1.1067 raeburn 11187: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11188: proa => 'Process automatically?',
1.1053 raeburn 11189: yes => 'Yes',
11190: no => 'No',
1.1067 raeburn 11191: fold => 'Title for folder containing movie',
11192: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11193: );
1.1065 raeburn 11194: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11195: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11196: my $info = &list_archive_contents($fileloc,\@paths);
11197: if (@paths) {
11198: foreach my $path (@paths) {
11199: $path =~ s{^/}{};
1.1067 raeburn 11200: if ($path =~ m{^([^/]+)/$}) {
11201: $topdir = $1;
11202: }
1.1065 raeburn 11203: if ($path =~ m{^([^/]+)/}) {
11204: $toplevel{$1} = $path;
11205: } else {
11206: $toplevel{$path} = $path;
11207: }
11208: }
11209: }
1.1067 raeburn 11210: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11211: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11212: "$topdir/media/",
11213: "$topdir/media/$topdir.mp4",
11214: "$topdir/media/FirstFrame.png",
11215: "$topdir/media/player.swf",
11216: "$topdir/media/swfobject.js",
11217: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11218: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11219: "$topdir/$topdir.mp4",
11220: "$topdir/$topdir\_config.xml",
11221: "$topdir/$topdir\_controller.swf",
11222: "$topdir/$topdir\_embed.css",
11223: "$topdir/$topdir\_First_Frame.png",
11224: "$topdir/$topdir\_player.html",
11225: "$topdir/$topdir\_Thumbnails.png",
11226: "$topdir/playerProductInstall.swf",
11227: "$topdir/scripts/",
11228: "$topdir/scripts/config_xml.js",
11229: "$topdir/scripts/handlebars.js",
11230: "$topdir/scripts/jquery-1.7.1.min.js",
11231: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11232: "$topdir/scripts/modernizr.js",
11233: "$topdir/scripts/player-min.js",
11234: "$topdir/scripts/swfobject.js",
11235: "$topdir/skins/",
11236: "$topdir/skins/configuration_express.xml",
11237: "$topdir/skins/express_show/",
11238: "$topdir/skins/express_show/player-min.css",
11239: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11240: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11241: "$topdir/$topdir.mp4",
11242: "$topdir/$topdir\_config.xml",
11243: "$topdir/$topdir\_controller.swf",
11244: "$topdir/$topdir\_embed.css",
11245: "$topdir/$topdir\_First_Frame.png",
11246: "$topdir/$topdir\_player.html",
11247: "$topdir/$topdir\_Thumbnails.png",
11248: "$topdir/playerProductInstall.swf",
11249: "$topdir/scripts/",
11250: "$topdir/scripts/config_xml.js",
11251: "$topdir/scripts/techsmith-smart-player.min.js",
11252: "$topdir/skins/",
11253: "$topdir/skins/configuration_express.xml",
11254: "$topdir/skins/express_show/",
11255: "$topdir/skins/express_show/spritesheet.min.css",
11256: "$topdir/skins/express_show/spritesheet.png",
11257: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11258: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11259: if (@diffs == 0) {
1.1075.2.59 raeburn 11260: $is_camtasia = 6;
11261: } else {
1.1075.2.81 raeburn 11262: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11263: if (@diffs == 0) {
11264: $is_camtasia = 8;
1.1075.2.81 raeburn 11265: } else {
11266: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11267: if (@diffs == 0) {
11268: $is_camtasia = 8;
11269: }
1.1075.2.59 raeburn 11270: }
1.1067 raeburn 11271: }
11272: }
11273: my $output;
11274: if ($is_camtasia) {
11275: $output = <<"ENDCAM";
11276: <script type="text/javascript" language="Javascript">
11277: // <![CDATA[
11278:
11279: function camtasiaToggle() {
11280: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11281: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11282: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11283: document.getElementById('camtasia_titles').style.display='block';
11284: } else {
11285: document.getElementById('camtasia_titles').style.display='none';
11286: }
11287: }
11288: }
11289: return;
11290: }
11291:
11292: // ]]>
11293: </script>
11294: <p>$lt{'camt'}</p>
11295: ENDCAM
1.1065 raeburn 11296: } else {
1.1067 raeburn 11297: $output = '<p>'.$lt{'this'};
11298: if ($info eq '') {
11299: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11300: } else {
11301: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11302: '<div><pre>'.$info.'</pre></div>';
11303: }
1.1065 raeburn 11304: }
1.1067 raeburn 11305: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11306: my $duplicates;
11307: my $num = 0;
11308: if (ref($dirlist) eq 'ARRAY') {
11309: foreach my $item (@{$dirlist}) {
11310: if (ref($item) eq 'ARRAY') {
11311: if (exists($toplevel{$item->[0]})) {
11312: $duplicates .=
11313: &start_data_table_row().
11314: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11315: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11316: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11317: 'value="1" />'.&mt('Yes').'</label>'.
11318: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11319: '<td>'.$item->[0].'</td>';
11320: if ($item->[2]) {
11321: $duplicates .= '<td>'.&mt('Directory').'</td>';
11322: } else {
11323: $duplicates .= '<td>'.&mt('File').'</td>';
11324: }
11325: $duplicates .= '<td>'.$item->[3].'</td>'.
11326: '<td>'.
11327: &Apache::lonlocal::locallocaltime($item->[4]).
11328: '</td>'.
11329: &end_data_table_row();
11330: $num ++;
11331: }
11332: }
11333: }
11334: }
11335: my $itemcount;
11336: if (@paths > 0) {
11337: $itemcount = scalar(@paths);
11338: } else {
11339: $itemcount = 1;
11340: }
1.1067 raeburn 11341: if ($is_camtasia) {
11342: $output .= $lt{'auto'}.'<br />'.
11343: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11344: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11345: $lt{'yes'}.'</label> <label>'.
11346: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11347: $lt{'no'}.'</label></span><br />'.
11348: '<div id="camtasia_titles" style="display:block">'.
11349: &Apache::lonhtmlcommon::start_pick_box().
11350: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11351: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11352: &Apache::lonhtmlcommon::row_closure().
11353: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11354: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11355: &Apache::lonhtmlcommon::row_closure(1).
11356: &Apache::lonhtmlcommon::end_pick_box().
11357: '</div>';
11358: }
1.1065 raeburn 11359: $output .=
11360: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11361: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11362: "\n";
1.1065 raeburn 11363: if ($duplicates ne '') {
11364: $output .= '<p><span class="LC_warning">'.
11365: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11366: &start_data_table().
11367: &start_data_table_header_row().
11368: '<th>'.&mt('Overwrite?').'</th>'.
11369: '<th>'.&mt('Name').'</th>'.
11370: '<th>'.&mt('Type').'</th>'.
11371: '<th>'.&mt('Size').'</th>'.
11372: '<th>'.&mt('Last modified').'</th>'.
11373: &end_data_table_header_row().
11374: $duplicates.
11375: &end_data_table().
11376: '</p>';
11377: }
1.1067 raeburn 11378: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11379: if (ref($hiddenelements) eq 'HASH') {
11380: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11381: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11382: }
11383: }
11384: $output .= <<"END";
1.1067 raeburn 11385: <br />
1.1053 raeburn 11386: <input type="submit" name="decompress" value="$lt{'extr'}" />
11387: </form>
11388: $noextract
11389: END
11390: return $output;
11391: }
11392:
1.1065 raeburn 11393: sub decompression_utility {
11394: my ($program) = @_;
11395: my @utilities = ('tar','gunzip','bunzip2','unzip');
11396: my $location;
11397: if (grep(/^\Q$program\E$/,@utilities)) {
11398: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11399: '/usr/sbin/') {
11400: if (-x $dir.$program) {
11401: $location = $dir.$program;
11402: last;
11403: }
11404: }
11405: }
11406: return $location;
11407: }
11408:
11409: sub list_archive_contents {
11410: my ($file,$pathsref) = @_;
11411: my (@cmd,$output);
11412: my $needsregexp;
11413: if ($file =~ /\.zip$/) {
11414: @cmd = (&decompression_utility('unzip'),"-l");
11415: $needsregexp = 1;
11416: } elsif (($file =~ m/\.tar\.gz$/) ||
11417: ($file =~ /\.tgz$/)) {
11418: @cmd = (&decompression_utility('tar'),"-ztf");
11419: } elsif ($file =~ /\.tar\.bz2$/) {
11420: @cmd = (&decompression_utility('tar'),"-jtf");
11421: } elsif ($file =~ m|\.tar$|) {
11422: @cmd = (&decompression_utility('tar'),"-tf");
11423: }
11424: if (@cmd) {
11425: undef($!);
11426: undef($@);
11427: if (open(my $fh,"-|", @cmd, $file)) {
11428: while (my $line = <$fh>) {
11429: $output .= $line;
11430: chomp($line);
11431: my $item;
11432: if ($needsregexp) {
11433: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11434: } else {
11435: $item = $line;
11436: }
11437: if ($item ne '') {
11438: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11439: push(@{$pathsref},$item);
11440: }
11441: }
11442: }
11443: close($fh);
11444: }
11445: }
11446: return $output;
11447: }
11448:
1.1053 raeburn 11449: sub decompress_uploaded_file {
11450: my ($file,$dir) = @_;
11451: &Apache::lonnet::appenv({'cgi.file' => $file});
11452: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11453: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11454: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11455: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11456: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11457: my $decompressed = $env{'cgi.decompressed'};
11458: &Apache::lonnet::delenv('cgi.file');
11459: &Apache::lonnet::delenv('cgi.dir');
11460: &Apache::lonnet::delenv('cgi.decompressed');
11461: return ($decompressed,$result);
11462: }
11463:
1.1055 raeburn 11464: sub process_decompression {
11465: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11466: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 11467: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 11468: $error = &mt('Filename not a supported archive file type.').
11469: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11470: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11471: } else {
11472: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11473: if ($docuhome eq 'no_host') {
11474: $error = &mt('Could not determine home server for course.');
11475: } else {
11476: my @ids=&Apache::lonnet::current_machine_ids();
11477: my $currdir = "$dir_root/$destination";
11478: if (grep(/^\Q$docuhome\E$/,@ids)) {
11479: $dir = &LONCAPA::propath($docudom,$docuname).
11480: "$dir_root/$destination";
11481: } else {
11482: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11483: "$dir_root/$docudom/$docuname/$destination";
11484: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11485: $error = &mt('Archive file not found.');
11486: }
11487: }
1.1065 raeburn 11488: my (@to_overwrite,@to_skip);
11489: if ($env{'form.archive_overwrite_total'} > 0) {
11490: my $total = $env{'form.archive_overwrite_total'};
11491: for (my $i=0; $i<$total; $i++) {
11492: if ($env{'form.archive_overwrite_'.$i} == 1) {
11493: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11494: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11495: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11496: }
11497: }
11498: }
11499: my $numskip = scalar(@to_skip);
11500: if (($numskip > 0) &&
11501: ($numskip == $env{'form.archive_itemcount'})) {
11502: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11503: } elsif ($dir eq '') {
1.1055 raeburn 11504: $error = &mt('Directory containing archive file unavailable.');
11505: } elsif (!$error) {
1.1065 raeburn 11506: my ($decompressed,$display);
11507: if ($numskip > 0) {
11508: my $tempdir = time.'_'.$$.int(rand(10000));
11509: mkdir("$dir/$tempdir",0755);
11510: system("mv $dir/$file $dir/$tempdir/$file");
11511: ($decompressed,$display) =
11512: &decompress_uploaded_file($file,"$dir/$tempdir");
11513: foreach my $item (@to_skip) {
11514: if (($item ne '') && ($item !~ /\.\./)) {
11515: if (-f "$dir/$tempdir/$item") {
11516: unlink("$dir/$tempdir/$item");
11517: } elsif (-d "$dir/$tempdir/$item") {
11518: system("rm -rf $dir/$tempdir/$item");
11519: }
11520: }
11521: }
11522: system("mv $dir/$tempdir/* $dir");
11523: rmdir("$dir/$tempdir");
11524: } else {
11525: ($decompressed,$display) =
11526: &decompress_uploaded_file($file,$dir);
11527: }
1.1055 raeburn 11528: if ($decompressed eq 'ok') {
1.1065 raeburn 11529: $output = '<p class="LC_info">'.
11530: &mt('Files extracted successfully from archive.').
11531: '</p>'."\n";
1.1055 raeburn 11532: my ($warning,$result,@contents);
11533: my ($newdirlistref,$newlisterror) =
11534: &Apache::lonnet::dirlist($currdir,$docudom,
11535: $docuname,1);
11536: my (%is_dir,%changes,@newitems);
11537: my $dirptr = 16384;
1.1065 raeburn 11538: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11539: foreach my $dir_line (@{$newdirlistref}) {
11540: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11541: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11542: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11543: push(@newitems,$item);
11544: if ($dirptr&$testdir) {
11545: $is_dir{$item} = 1;
11546: }
11547: $changes{$item} = 1;
11548: }
11549: }
11550: }
11551: if (keys(%changes) > 0) {
11552: foreach my $item (sort(@newitems)) {
11553: if ($changes{$item}) {
11554: push(@contents,$item);
11555: }
11556: }
11557: }
11558: if (@contents > 0) {
1.1067 raeburn 11559: my $wantform;
11560: unless ($env{'form.autoextract_camtasia'}) {
11561: $wantform = 1;
11562: }
1.1056 raeburn 11563: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11564: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11565: $currdir,\%is_dir,
11566: \%children,\%parent,
1.1056 raeburn 11567: \@contents,\%dirorder,
11568: \%titles,$wantform);
1.1055 raeburn 11569: if ($datatable ne '') {
11570: $output .= &archive_options_form('decompressed',$datatable,
11571: $count,$hiddenelem);
1.1065 raeburn 11572: my $startcount = 6;
1.1055 raeburn 11573: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11574: \%titles,\%children);
1.1055 raeburn 11575: }
1.1067 raeburn 11576: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11577: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11578: my %displayed;
11579: my $total = 1;
11580: $env{'form.archive_directory'} = [];
11581: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11582: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11583: $path =~ s{/$}{};
11584: my $item;
11585: if ($path ne '') {
11586: $item = "$path/$titles{$i}";
11587: } else {
11588: $item = $titles{$i};
11589: }
11590: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11591: if ($item eq $contents[0]) {
11592: push(@{$env{'form.archive_directory'}},$i);
11593: $env{'form.archive_'.$i} = 'display';
11594: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11595: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11596: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11597: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11598: $env{'form.archive_'.$i} = 'display';
11599: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11600: $displayed{'web'} = $i;
11601: } else {
1.1075.2.59 raeburn 11602: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11603: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11604: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11605: push(@{$env{'form.archive_directory'}},$i);
11606: }
11607: $env{'form.archive_'.$i} = 'dependency';
11608: }
11609: $total ++;
11610: }
11611: for (my $i=1; $i<$total; $i++) {
11612: next if ($i == $displayed{'web'});
11613: next if ($i == $displayed{'folder'});
11614: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11615: }
11616: $env{'form.phase'} = 'decompress_cleanup';
11617: $env{'form.archivedelete'} = 1;
11618: $env{'form.archive_count'} = $total-1;
11619: $output .=
11620: &process_extracted_files('coursedocs',$docudom,
11621: $docuname,$destination,
11622: $dir_root,$hiddenelem);
11623: }
1.1055 raeburn 11624: } else {
11625: $warning = &mt('No new items extracted from archive file.');
11626: }
11627: } else {
11628: $output = $display;
11629: $error = &mt('An error occurred during extraction from the archive file.');
11630: }
11631: }
11632: }
11633: }
11634: if ($error) {
11635: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11636: $error.'</p>'."\n";
11637: }
11638: if ($warning) {
11639: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11640: }
11641: return $output;
11642: }
11643:
11644: sub get_extracted {
1.1056 raeburn 11645: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11646: $titles,$wantform) = @_;
1.1055 raeburn 11647: my $count = 0;
11648: my $depth = 0;
11649: my $datatable;
1.1056 raeburn 11650: my @hierarchy;
1.1055 raeburn 11651: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11652: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11653: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11654: foreach my $item (@{$contents}) {
11655: $count ++;
1.1056 raeburn 11656: @{$dirorder->{$count}} = @hierarchy;
11657: $titles->{$count} = $item;
1.1055 raeburn 11658: &archive_hierarchy($depth,$count,$parent,$children);
11659: if ($wantform) {
11660: $datatable .= &archive_row($is_dir->{$item},$item,
11661: $currdir,$depth,$count);
11662: }
11663: if ($is_dir->{$item}) {
11664: $depth ++;
1.1056 raeburn 11665: push(@hierarchy,$count);
11666: $parent->{$depth} = $count;
1.1055 raeburn 11667: $datatable .=
11668: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11669: \$depth,\$count,\@hierarchy,$dirorder,
11670: $children,$parent,$titles,$wantform);
1.1055 raeburn 11671: $depth --;
1.1056 raeburn 11672: pop(@hierarchy);
1.1055 raeburn 11673: }
11674: }
11675: return ($count,$datatable);
11676: }
11677:
11678: sub recurse_extracted_archive {
1.1056 raeburn 11679: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11680: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11681: my $result='';
1.1056 raeburn 11682: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11683: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11684: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11685: return $result;
11686: }
11687: my $dirptr = 16384;
11688: my ($newdirlistref,$newlisterror) =
11689: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11690: if (ref($newdirlistref) eq 'ARRAY') {
11691: foreach my $dir_line (@{$newdirlistref}) {
11692: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11693: unless ($item =~ /^\.+$/) {
11694: $$count ++;
1.1056 raeburn 11695: @{$dirorder->{$$count}} = @{$hierarchy};
11696: $titles->{$$count} = $item;
1.1055 raeburn 11697: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11698:
1.1055 raeburn 11699: my $is_dir;
11700: if ($dirptr&$testdir) {
11701: $is_dir = 1;
11702: }
11703: if ($wantform) {
11704: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11705: }
11706: if ($is_dir) {
11707: $$depth ++;
1.1056 raeburn 11708: push(@{$hierarchy},$$count);
11709: $parent->{$$depth} = $$count;
1.1055 raeburn 11710: $result .=
11711: &recurse_extracted_archive("$currdir/$item",$docudom,
11712: $docuname,$depth,$count,
1.1056 raeburn 11713: $hierarchy,$dirorder,$children,
11714: $parent,$titles,$wantform);
1.1055 raeburn 11715: $$depth --;
1.1056 raeburn 11716: pop(@{$hierarchy});
1.1055 raeburn 11717: }
11718: }
11719: }
11720: }
11721: return $result;
11722: }
11723:
11724: sub archive_hierarchy {
11725: my ($depth,$count,$parent,$children) =@_;
11726: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11727: if (exists($parent->{$depth})) {
11728: $children->{$parent->{$depth}} .= $count.':';
11729: }
11730: }
11731: return;
11732: }
11733:
11734: sub archive_row {
11735: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11736: my ($name) = ($item =~ m{([^/]+)$});
11737: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11738: 'display' => 'Add as file',
1.1055 raeburn 11739: 'dependency' => 'Include as dependency',
11740: 'discard' => 'Discard',
11741: );
11742: if ($is_dir) {
1.1059 raeburn 11743: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11744: }
1.1056 raeburn 11745: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11746: my $offset = 0;
1.1055 raeburn 11747: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11748: $offset ++;
1.1065 raeburn 11749: if ($action ne 'display') {
11750: $offset ++;
11751: }
1.1055 raeburn 11752: $output .= '<td><span class="LC_nobreak">'.
11753: '<label><input type="radio" name="archive_'.$count.
11754: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11755: my $text = $choices{$action};
11756: if ($is_dir) {
11757: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11758: if ($action eq 'display') {
1.1059 raeburn 11759: $text = &mt('Add as folder');
1.1055 raeburn 11760: }
1.1056 raeburn 11761: } else {
11762: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11763:
11764: }
11765: $output .= ' /> '.$choices{$action}.'</label></span>';
11766: if ($action eq 'dependency') {
11767: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11768: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11769: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11770: '<option value=""></option>'."\n".
11771: '</select>'."\n".
11772: '</div>';
1.1059 raeburn 11773: } elsif ($action eq 'display') {
11774: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11775: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11776: '</div>';
1.1055 raeburn 11777: }
1.1056 raeburn 11778: $output .= '</td>';
1.1055 raeburn 11779: }
11780: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11781: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11782: for (my $i=0; $i<$depth; $i++) {
11783: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11784: }
11785: if ($is_dir) {
11786: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11787: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11788: } else {
11789: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11790: }
11791: $output .= ' '.$name.'</td>'."\n".
11792: &end_data_table_row();
11793: return $output;
11794: }
11795:
11796: sub archive_options_form {
1.1065 raeburn 11797: my ($form,$display,$count,$hiddenelem) = @_;
11798: my %lt = &Apache::lonlocal::texthash(
11799: perm => 'Permanently remove archive file?',
11800: hows => 'How should each extracted item be incorporated in the course?',
11801: cont => 'Content actions for all',
11802: addf => 'Add as folder/file',
11803: incd => 'Include as dependency for a displayed file',
11804: disc => 'Discard',
11805: no => 'No',
11806: yes => 'Yes',
11807: save => 'Save',
11808: );
11809: my $output = <<"END";
11810: <form name="$form" method="post" action="">
11811: <p><span class="LC_nobreak">$lt{'perm'}
11812: <label>
11813: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11814: </label>
11815:
11816: <label>
11817: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11818: </span>
11819: </p>
11820: <input type="hidden" name="phase" value="decompress_cleanup" />
11821: <br />$lt{'hows'}
11822: <div class="LC_columnSection">
11823: <fieldset>
11824: <legend>$lt{'cont'}</legend>
11825: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11826: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11827: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11828: </fieldset>
11829: </div>
11830: END
11831: return $output.
1.1055 raeburn 11832: &start_data_table()."\n".
1.1065 raeburn 11833: $display."\n".
1.1055 raeburn 11834: &end_data_table()."\n".
11835: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11836: $hiddenelem.
1.1065 raeburn 11837: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11838: '</form>';
11839: }
11840:
11841: sub archive_javascript {
1.1056 raeburn 11842: my ($startcount,$numitems,$titles,$children) = @_;
11843: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11844: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11845: my $scripttag = <<START;
11846: <script type="text/javascript">
11847: // <![CDATA[
11848:
11849: function checkAll(form,prefix) {
11850: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11851: for (var i=0; i < form.elements.length; i++) {
11852: var id = form.elements[i].id;
11853: if ((id != '') && (id != undefined)) {
11854: if (idstr.test(id)) {
11855: if (form.elements[i].type == 'radio') {
11856: form.elements[i].checked = true;
1.1056 raeburn 11857: var nostart = i-$startcount;
1.1059 raeburn 11858: var offset = nostart%7;
11859: var count = (nostart-offset)/7;
1.1056 raeburn 11860: dependencyCheck(form,count,offset);
1.1055 raeburn 11861: }
11862: }
11863: }
11864: }
11865: }
11866:
11867: function propagateCheck(form,count) {
11868: if (count > 0) {
1.1059 raeburn 11869: var startelement = $startcount + ((count-1) * 7);
11870: for (var j=1; j<6; j++) {
11871: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11872: var item = startelement + j;
11873: if (form.elements[item].type == 'radio') {
11874: if (form.elements[item].checked) {
11875: containerCheck(form,count,j);
11876: break;
11877: }
1.1055 raeburn 11878: }
11879: }
11880: }
11881: }
11882: }
11883:
11884: numitems = $numitems
1.1056 raeburn 11885: var titles = new Array(numitems);
11886: var parents = new Array(numitems);
1.1055 raeburn 11887: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11888: parents[i] = new Array;
1.1055 raeburn 11889: }
1.1059 raeburn 11890: var maintitle = '$maintitle';
1.1055 raeburn 11891:
11892: START
11893:
1.1056 raeburn 11894: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11895: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11896: for (my $i=0; $i<@contents; $i ++) {
11897: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11898: }
11899: }
11900:
1.1056 raeburn 11901: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11902: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11903: }
11904:
1.1055 raeburn 11905: $scripttag .= <<END;
11906:
11907: function containerCheck(form,count,offset) {
11908: if (count > 0) {
1.1056 raeburn 11909: dependencyCheck(form,count,offset);
1.1059 raeburn 11910: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11911: form.elements[item].checked = true;
11912: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11913: if (parents[count].length > 0) {
11914: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11915: containerCheck(form,parents[count][j],offset);
11916: }
11917: }
11918: }
11919: }
11920: }
11921:
11922: function dependencyCheck(form,count,offset) {
11923: if (count > 0) {
1.1059 raeburn 11924: var chosen = (offset+$startcount)+7*(count-1);
11925: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11926: var currtype = form.elements[depitem].type;
11927: if (form.elements[chosen].value == 'dependency') {
11928: document.getElementById('arc_depon_'+count).style.display='block';
11929: form.elements[depitem].options.length = 0;
11930: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 11931: for (var i=1; i<=numitems; i++) {
11932: if (i == count) {
11933: continue;
11934: }
1.1059 raeburn 11935: var startelement = $startcount + (i-1) * 7;
11936: for (var j=1; j<6; j++) {
11937: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11938: var item = startelement + j;
11939: if (form.elements[item].type == 'radio') {
11940: if (form.elements[item].checked) {
11941: if (form.elements[item].value == 'display') {
11942: var n = form.elements[depitem].options.length;
11943: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11944: }
11945: }
11946: }
11947: }
11948: }
11949: }
11950: } else {
11951: document.getElementById('arc_depon_'+count).style.display='none';
11952: form.elements[depitem].options.length = 0;
11953: form.elements[depitem].options[0] = new Option('Select','',true,true);
11954: }
1.1059 raeburn 11955: titleCheck(form,count,offset);
1.1056 raeburn 11956: }
11957: }
11958:
11959: function propagateSelect(form,count,offset) {
11960: if (count > 0) {
1.1065 raeburn 11961: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11962: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11963: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11964: if (parents[count].length > 0) {
11965: for (var j=0; j<parents[count].length; j++) {
11966: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11967: }
11968: }
11969: }
11970: }
11971: }
1.1056 raeburn 11972:
11973: function containerSelect(form,count,offset,picked) {
11974: if (count > 0) {
1.1065 raeburn 11975: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11976: if (form.elements[item].type == 'radio') {
11977: if (form.elements[item].value == 'dependency') {
11978: if (form.elements[item+1].type == 'select-one') {
11979: for (var i=0; i<form.elements[item+1].options.length; i++) {
11980: if (form.elements[item+1].options[i].value == picked) {
11981: form.elements[item+1].selectedIndex = i;
11982: break;
11983: }
11984: }
11985: }
11986: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11987: if (parents[count].length > 0) {
11988: for (var j=0; j<parents[count].length; j++) {
11989: containerSelect(form,parents[count][j],offset,picked);
11990: }
11991: }
11992: }
11993: }
11994: }
11995: }
11996: }
11997:
1.1059 raeburn 11998: function titleCheck(form,count,offset) {
11999: if (count > 0) {
12000: var chosen = (offset+$startcount)+7*(count-1);
12001: var depitem = $startcount + ((count-1) * 7) + 2;
12002: var currtype = form.elements[depitem].type;
12003: if (form.elements[chosen].value == 'display') {
12004: document.getElementById('arc_title_'+count).style.display='block';
12005: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12006: document.getElementById('archive_title_'+count).value=maintitle;
12007: }
12008: } else {
12009: document.getElementById('arc_title_'+count).style.display='none';
12010: if (currtype == 'text') {
12011: document.getElementById('archive_title_'+count).value='';
12012: }
12013: }
12014: }
12015: return;
12016: }
12017:
1.1055 raeburn 12018: // ]]>
12019: </script>
12020: END
12021: return $scripttag;
12022: }
12023:
12024: sub process_extracted_files {
1.1067 raeburn 12025: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12026: my $numitems = $env{'form.archive_count'};
12027: return unless ($numitems);
12028: my @ids=&Apache::lonnet::current_machine_ids();
12029: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12030: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12031: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12032: if (grep(/^\Q$docuhome\E$/,@ids)) {
12033: $prefix = &LONCAPA::propath($docudom,$docuname);
12034: $pathtocheck = "$dir_root/$destination";
12035: $dir = $dir_root;
12036: $ishome = 1;
12037: } else {
12038: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12039: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12040: $dir = "$dir_root/$docudom/$docuname";
12041: }
12042: my $currdir = "$dir_root/$destination";
12043: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12044: if ($env{'form.folderpath'}) {
12045: my @items = split('&',$env{'form.folderpath'});
12046: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12047: if ($env{'form.folderpath'} =~ /\:1$/) {
12048: $containers{'0'}='page';
12049: } else {
12050: $containers{'0'}='sequence';
12051: }
1.1055 raeburn 12052: }
12053: my @archdirs = &get_env_multiple('form.archive_directory');
12054: if ($numitems) {
12055: for (my $i=1; $i<=$numitems; $i++) {
12056: my $path = $env{'form.archive_content_'.$i};
12057: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12058: my $item = $1;
12059: $toplevelitems{$item} = $i;
12060: if (grep(/^\Q$i\E$/,@archdirs)) {
12061: $is_dir{$item} = 1;
12062: }
12063: }
12064: }
12065: }
1.1067 raeburn 12066: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12067: if (keys(%toplevelitems) > 0) {
12068: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12069: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12070: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12071: }
1.1066 raeburn 12072: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12073: if ($numitems) {
12074: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12075: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12076: my $path = $env{'form.archive_content_'.$i};
12077: if ($path =~ /^\Q$pathtocheck\E/) {
12078: if ($env{'form.archive_'.$i} eq 'discard') {
12079: if ($prefix ne '' && $path ne '') {
12080: if (-e $prefix.$path) {
1.1066 raeburn 12081: if ((@archdirs > 0) &&
12082: (grep(/^\Q$i\E$/,@archdirs))) {
12083: $todeletedir{$prefix.$path} = 1;
12084: } else {
12085: $todelete{$prefix.$path} = 1;
12086: }
1.1055 raeburn 12087: }
12088: }
12089: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12090: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12091: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12092: $docstitle = $env{'form.archive_title_'.$i};
12093: if ($docstitle eq '') {
12094: $docstitle = $title;
12095: }
1.1055 raeburn 12096: $outer = 0;
1.1056 raeburn 12097: if (ref($dirorder{$i}) eq 'ARRAY') {
12098: if (@{$dirorder{$i}} > 0) {
12099: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12100: if ($env{'form.archive_'.$item} eq 'display') {
12101: $outer = $item;
12102: last;
12103: }
12104: }
12105: }
12106: }
12107: my ($errtext,$fatal) =
12108: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12109: '/'.$folders{$outer}.'.'.
12110: $containers{$outer});
12111: next if ($fatal);
12112: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12113: if ($context eq 'coursedocs') {
1.1056 raeburn 12114: $mapinner{$i} = time;
1.1055 raeburn 12115: $folders{$i} = 'default_'.$mapinner{$i};
12116: $containers{$i} = 'sequence';
12117: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12118: $folders{$i}.'.'.$containers{$i};
12119: my $newidx = &LONCAPA::map::getresidx();
12120: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12121: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12122: push(@LONCAPA::map::order,$newidx);
12123: my ($outtext,$errtext) =
12124: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12125: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12126: '.'.$containers{$outer},1,1);
1.1056 raeburn 12127: $newseqid{$i} = $newidx;
1.1067 raeburn 12128: unless ($errtext) {
12129: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12130: }
1.1055 raeburn 12131: }
12132: } else {
12133: if ($context eq 'coursedocs') {
12134: my $newidx=&LONCAPA::map::getresidx();
12135: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12136: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12137: $title;
12138: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12139: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12140: }
12141: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12142: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12143: }
12144: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12145: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12146: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12147: unless ($ishome) {
12148: my $fetch = "$newdest{$i}/$title";
12149: $fetch =~ s/^\Q$prefix$dir\E//;
12150: $prompttofetch{$fetch} = 1;
12151: }
1.1055 raeburn 12152: }
12153: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12154: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12155: push(@LONCAPA::map::order, $newidx);
12156: my ($outtext,$errtext)=
12157: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12158: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12159: '.'.$containers{$outer},1,1);
1.1067 raeburn 12160: unless ($errtext) {
12161: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12162: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12163: }
12164: }
1.1055 raeburn 12165: }
12166: }
1.1075.2.11 raeburn 12167: }
12168: } else {
12169: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12170: }
12171: }
12172: for (my $i=1; $i<=$numitems; $i++) {
12173: next unless ($env{'form.archive_'.$i} eq 'dependency');
12174: my $path = $env{'form.archive_content_'.$i};
12175: if ($path =~ /^\Q$pathtocheck\E/) {
12176: my ($title) = ($path =~ m{/([^/]+)$});
12177: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12178: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12179: if (ref($dirorder{$i}) eq 'ARRAY') {
12180: my ($itemidx,$fullpath,$relpath);
12181: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12182: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12183: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12184: if ($dirorder{$i}->[$j] eq $container) {
12185: $itemidx = $j;
1.1056 raeburn 12186: }
12187: }
1.1075.2.11 raeburn 12188: }
12189: if ($itemidx eq '') {
12190: $itemidx = 0;
12191: }
12192: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12193: if ($mapinner{$referrer{$i}}) {
12194: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12195: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12196: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12197: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12198: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12199: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12200: if (!-e $fullpath) {
12201: mkdir($fullpath,0755);
1.1056 raeburn 12202: }
12203: }
1.1075.2.11 raeburn 12204: } else {
12205: last;
1.1056 raeburn 12206: }
1.1075.2.11 raeburn 12207: }
12208: }
12209: } elsif ($newdest{$referrer{$i}}) {
12210: $fullpath = $newdest{$referrer{$i}};
12211: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12212: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12213: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12214: last;
12215: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12216: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12217: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12218: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12219: if (!-e $fullpath) {
12220: mkdir($fullpath,0755);
1.1056 raeburn 12221: }
12222: }
1.1075.2.11 raeburn 12223: } else {
12224: last;
1.1056 raeburn 12225: }
1.1075.2.11 raeburn 12226: }
12227: }
12228: if ($fullpath ne '') {
12229: if (-e "$prefix$path") {
12230: system("mv $prefix$path $fullpath/$title");
12231: }
12232: if (-e "$fullpath/$title") {
12233: my $showpath;
12234: if ($relpath ne '') {
12235: $showpath = "$relpath/$title";
12236: } else {
12237: $showpath = "/$title";
1.1056 raeburn 12238: }
1.1075.2.11 raeburn 12239: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12240: }
12241: unless ($ishome) {
12242: my $fetch = "$fullpath/$title";
12243: $fetch =~ s/^\Q$prefix$dir\E//;
12244: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12245: }
12246: }
12247: }
1.1075.2.11 raeburn 12248: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12249: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12250: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12251: }
12252: } else {
1.1075.2.11 raeburn 12253: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12254: }
12255: }
12256: if (keys(%todelete)) {
12257: foreach my $key (keys(%todelete)) {
12258: unlink($key);
1.1066 raeburn 12259: }
12260: }
12261: if (keys(%todeletedir)) {
12262: foreach my $key (keys(%todeletedir)) {
12263: rmdir($key);
12264: }
12265: }
12266: foreach my $dir (sort(keys(%is_dir))) {
12267: if (($pathtocheck ne '') && ($dir ne '')) {
12268: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12269: }
12270: }
1.1067 raeburn 12271: if ($result ne '') {
12272: $output .= '<ul>'."\n".
12273: $result."\n".
12274: '</ul>';
12275: }
12276: unless ($ishome) {
12277: my $replicationfail;
12278: foreach my $item (keys(%prompttofetch)) {
12279: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12280: unless ($fetchresult eq 'ok') {
12281: $replicationfail .= '<li>'.$item.'</li>'."\n";
12282: }
12283: }
12284: if ($replicationfail) {
12285: $output .= '<p class="LC_error">'.
12286: &mt('Course home server failed to retrieve:').'<ul>'.
12287: $replicationfail.
12288: '</ul></p>';
12289: }
12290: }
1.1055 raeburn 12291: } else {
12292: $warning = &mt('No items found in archive.');
12293: }
12294: if ($error) {
12295: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12296: $error.'</p>'."\n";
12297: }
12298: if ($warning) {
12299: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12300: }
12301: return $output;
12302: }
12303:
1.1066 raeburn 12304: sub cleanup_empty_dirs {
12305: my ($path) = @_;
12306: if (($path ne '') && (-d $path)) {
12307: if (opendir(my $dirh,$path)) {
12308: my @dircontents = grep(!/^\./,readdir($dirh));
12309: my $numitems = 0;
12310: foreach my $item (@dircontents) {
12311: if (-d "$path/$item") {
1.1075.2.28 raeburn 12312: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12313: if (-e "$path/$item") {
12314: $numitems ++;
12315: }
12316: } else {
12317: $numitems ++;
12318: }
12319: }
12320: if ($numitems == 0) {
12321: rmdir($path);
12322: }
12323: closedir($dirh);
12324: }
12325: }
12326: return;
12327: }
12328:
1.41 ng 12329: =pod
1.45 matthew 12330:
1.1075.2.56 raeburn 12331: =item * &get_folder_hierarchy()
1.1068 raeburn 12332:
12333: Provides hierarchy of names of folders/sub-folders containing the current
12334: item,
12335:
12336: Inputs: 3
12337: - $navmap - navmaps object
12338:
12339: - $map - url for map (either the trigger itself, or map containing
12340: the resource, which is the trigger).
12341:
12342: - $showitem - 1 => show title for map itself; 0 => do not show.
12343:
12344: Outputs: 1 @pathitems - array of folder/subfolder names.
12345:
12346: =cut
12347:
12348: sub get_folder_hierarchy {
12349: my ($navmap,$map,$showitem) = @_;
12350: my @pathitems;
12351: if (ref($navmap)) {
12352: my $mapres = $navmap->getResourceByUrl($map);
12353: if (ref($mapres)) {
12354: my $pcslist = $mapres->map_hierarchy();
12355: if ($pcslist ne '') {
12356: my @pcs = split(/,/,$pcslist);
12357: foreach my $pc (@pcs) {
12358: if ($pc == 1) {
1.1075.2.38 raeburn 12359: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12360: } else {
12361: my $res = $navmap->getByMapPc($pc);
12362: if (ref($res)) {
12363: my $title = $res->compTitle();
12364: $title =~ s/\W+/_/g;
12365: if ($title ne '') {
12366: push(@pathitems,$title);
12367: }
12368: }
12369: }
12370: }
12371: }
1.1071 raeburn 12372: if ($showitem) {
12373: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12374: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12375: } else {
12376: my $maptitle = $mapres->compTitle();
12377: $maptitle =~ s/\W+/_/g;
12378: if ($maptitle ne '') {
12379: push(@pathitems,$maptitle);
12380: }
1.1068 raeburn 12381: }
12382: }
12383: }
12384: }
12385: return @pathitems;
12386: }
12387:
12388: =pod
12389:
1.1015 raeburn 12390: =item * &get_turnedin_filepath()
12391:
12392: Determines path in a user's portfolio file for storage of files uploaded
12393: to a specific essayresponse or dropbox item.
12394:
12395: Inputs: 3 required + 1 optional.
12396: $symb is symb for resource, $uname and $udom are for current user (required).
12397: $caller is optional (can be "submission", if routine is called when storing
12398: an upoaded file when "Submit Answer" button was pressed).
12399:
12400: Returns array containing $path and $multiresp.
12401: $path is path in portfolio. $multiresp is 1 if this resource contains more
12402: than one file upload item. Callers of routine should append partid as a
12403: subdirectory to $path in cases where $multiresp is 1.
12404:
12405: Called by: homework/essayresponse.pm and homework/structuretags.pm
12406:
12407: =cut
12408:
12409: sub get_turnedin_filepath {
12410: my ($symb,$uname,$udom,$caller) = @_;
12411: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12412: my $turnindir;
12413: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12414: $turnindir = $userhash{'turnindir'};
12415: my ($path,$multiresp);
12416: if ($turnindir eq '') {
12417: if ($caller eq 'submission') {
12418: $turnindir = &mt('turned in');
12419: $turnindir =~ s/\W+/_/g;
12420: my %newhash = (
12421: 'turnindir' => $turnindir,
12422: );
12423: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12424: }
12425: }
12426: if ($turnindir ne '') {
12427: $path = '/'.$turnindir.'/';
12428: my ($multipart,$turnin,@pathitems);
12429: my $navmap = Apache::lonnavmaps::navmap->new();
12430: if (defined($navmap)) {
12431: my $mapres = $navmap->getResourceByUrl($map);
12432: if (ref($mapres)) {
12433: my $pcslist = $mapres->map_hierarchy();
12434: if ($pcslist ne '') {
12435: foreach my $pc (split(/,/,$pcslist)) {
12436: my $res = $navmap->getByMapPc($pc);
12437: if (ref($res)) {
12438: my $title = $res->compTitle();
12439: $title =~ s/\W+/_/g;
12440: if ($title ne '') {
1.1075.2.48 raeburn 12441: if (($pc > 1) && (length($title) > 12)) {
12442: $title = substr($title,0,12);
12443: }
1.1015 raeburn 12444: push(@pathitems,$title);
12445: }
12446: }
12447: }
12448: }
12449: my $maptitle = $mapres->compTitle();
12450: $maptitle =~ s/\W+/_/g;
12451: if ($maptitle ne '') {
1.1075.2.48 raeburn 12452: if (length($maptitle) > 12) {
12453: $maptitle = substr($maptitle,0,12);
12454: }
1.1015 raeburn 12455: push(@pathitems,$maptitle);
12456: }
12457: unless ($env{'request.state'} eq 'construct') {
12458: my $res = $navmap->getBySymb($symb);
12459: if (ref($res)) {
12460: my $partlist = $res->parts();
12461: my $totaluploads = 0;
12462: if (ref($partlist) eq 'ARRAY') {
12463: foreach my $part (@{$partlist}) {
12464: my @types = $res->responseType($part);
12465: my @ids = $res->responseIds($part);
12466: for (my $i=0; $i < scalar(@ids); $i++) {
12467: if ($types[$i] eq 'essay') {
12468: my $partid = $part.'_'.$ids[$i];
12469: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12470: $totaluploads ++;
12471: }
12472: }
12473: }
12474: }
12475: if ($totaluploads > 1) {
12476: $multiresp = 1;
12477: }
12478: }
12479: }
12480: }
12481: } else {
12482: return;
12483: }
12484: } else {
12485: return;
12486: }
12487: my $restitle=&Apache::lonnet::gettitle($symb);
12488: $restitle =~ s/\W+/_/g;
12489: if ($restitle eq '') {
12490: $restitle = ($resurl =~ m{/[^/]+$});
12491: if ($restitle eq '') {
12492: $restitle = time;
12493: }
12494: }
1.1075.2.48 raeburn 12495: if (length($restitle) > 12) {
12496: $restitle = substr($restitle,0,12);
12497: }
1.1015 raeburn 12498: push(@pathitems,$restitle);
12499: $path .= join('/',@pathitems);
12500: }
12501: return ($path,$multiresp);
12502: }
12503:
12504: =pod
12505:
1.464 albertel 12506: =back
1.41 ng 12507:
1.112 bowersj2 12508: =head1 CSV Upload/Handling functions
1.38 albertel 12509:
1.41 ng 12510: =over 4
12511:
1.648 raeburn 12512: =item * &upfile_store($r)
1.41 ng 12513:
12514: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12515: needs $env{'form.upfile'}
1.41 ng 12516: returns $datatoken to be put into hidden field
12517:
12518: =cut
1.31 albertel 12519:
12520: sub upfile_store {
12521: my $r=shift;
1.258 albertel 12522: $env{'form.upfile'}=~s/\r/\n/gs;
12523: $env{'form.upfile'}=~s/\f/\n/gs;
12524: $env{'form.upfile'}=~s/\n+/\n/gs;
12525: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12526:
1.258 albertel 12527: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12528: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12529: {
1.158 raeburn 12530: my $datafile = $r->dir_config('lonDaemons').
12531: '/tmp/'.$datatoken.'.tmp';
12532: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12533: print $fh $env{'form.upfile'};
1.158 raeburn 12534: close($fh);
12535: }
1.31 albertel 12536: }
12537: return $datatoken;
12538: }
12539:
1.56 matthew 12540: =pod
12541:
1.648 raeburn 12542: =item * &load_tmp_file($r)
1.41 ng 12543:
12544: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12545: needs $env{'form.datatoken'},
12546: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12547:
12548: =cut
1.31 albertel 12549:
12550: sub load_tmp_file {
12551: my $r=shift;
12552: my @studentdata=();
12553: {
1.158 raeburn 12554: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12555: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12556: if ( open(my $fh,"<$studentfile") ) {
12557: @studentdata=<$fh>;
12558: close($fh);
12559: }
1.31 albertel 12560: }
1.258 albertel 12561: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12562: }
12563:
1.56 matthew 12564: =pod
12565:
1.648 raeburn 12566: =item * &upfile_record_sep()
1.41 ng 12567:
12568: Separate uploaded file into records
12569: returns array of records,
1.258 albertel 12570: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12571:
12572: =cut
1.31 albertel 12573:
12574: sub upfile_record_sep {
1.258 albertel 12575: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12576: } else {
1.248 albertel 12577: my @records;
1.258 albertel 12578: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12579: if ($line=~/^\s*$/) { next; }
12580: push(@records,$line);
12581: }
12582: return @records;
1.31 albertel 12583: }
12584: }
12585:
1.56 matthew 12586: =pod
12587:
1.648 raeburn 12588: =item * &record_sep($record)
1.41 ng 12589:
1.258 albertel 12590: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12591:
12592: =cut
12593:
1.263 www 12594: sub takeleft {
12595: my $index=shift;
12596: return substr('0000'.$index,-4,4);
12597: }
12598:
1.31 albertel 12599: sub record_sep {
12600: my $record=shift;
12601: my %components=();
1.258 albertel 12602: if ($env{'form.upfiletype'} eq 'xml') {
12603: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12604: my $i=0;
1.356 albertel 12605: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12606: $field=~s/^(\"|\')//;
12607: $field=~s/(\"|\')$//;
1.263 www 12608: $components{&takeleft($i)}=$field;
1.31 albertel 12609: $i++;
12610: }
1.258 albertel 12611: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12612: my $i=0;
1.356 albertel 12613: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12614: $field=~s/^(\"|\')//;
12615: $field=~s/(\"|\')$//;
1.263 www 12616: $components{&takeleft($i)}=$field;
1.31 albertel 12617: $i++;
12618: }
12619: } else {
1.561 www 12620: my $separator=',';
1.480 banghart 12621: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12622: $separator=';';
1.480 banghart 12623: }
1.31 albertel 12624: my $i=0;
1.561 www 12625: # the character we are looking for to indicate the end of a quote or a record
12626: my $looking_for=$separator;
12627: # do not add the characters to the fields
12628: my $ignore=0;
12629: # we just encountered a separator (or the beginning of the record)
12630: my $just_found_separator=1;
12631: # store the field we are working on here
12632: my $field='';
12633: # work our way through all characters in record
12634: foreach my $character ($record=~/(.)/g) {
12635: if ($character eq $looking_for) {
12636: if ($character ne $separator) {
12637: # Found the end of a quote, again looking for separator
12638: $looking_for=$separator;
12639: $ignore=1;
12640: } else {
12641: # Found a separator, store away what we got
12642: $components{&takeleft($i)}=$field;
12643: $i++;
12644: $just_found_separator=1;
12645: $ignore=0;
12646: $field='';
12647: }
12648: next;
12649: }
12650: # single or double quotation marks after a separator indicate beginning of a quote
12651: # we are now looking for the end of the quote and need to ignore separators
12652: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12653: $looking_for=$character;
12654: next;
12655: }
12656: # ignore would be true after we reached the end of a quote
12657: if ($ignore) { next; }
12658: if (($just_found_separator) && ($character=~/\s/)) { next; }
12659: $field.=$character;
12660: $just_found_separator=0;
1.31 albertel 12661: }
1.561 www 12662: # catch the very last entry, since we never encountered the separator
12663: $components{&takeleft($i)}=$field;
1.31 albertel 12664: }
12665: return %components;
12666: }
12667:
1.144 matthew 12668: ######################################################
12669: ######################################################
12670:
1.56 matthew 12671: =pod
12672:
1.648 raeburn 12673: =item * &upfile_select_html()
1.41 ng 12674:
1.144 matthew 12675: Return HTML code to select a file from the users machine and specify
12676: the file type.
1.41 ng 12677:
12678: =cut
12679:
1.144 matthew 12680: ######################################################
12681: ######################################################
1.31 albertel 12682: sub upfile_select_html {
1.144 matthew 12683: my %Types = (
12684: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12685: semisv => &mt('Semicolon separated values'),
1.144 matthew 12686: space => &mt('Space separated'),
12687: tab => &mt('Tabulator separated'),
12688: # xml => &mt('HTML/XML'),
12689: );
12690: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12691: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12692: foreach my $type (sort(keys(%Types))) {
12693: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12694: }
12695: $Str .= "</select>\n";
12696: return $Str;
1.31 albertel 12697: }
12698:
1.301 albertel 12699: sub get_samples {
12700: my ($records,$toget) = @_;
12701: my @samples=({});
12702: my $got=0;
12703: foreach my $rec (@$records) {
12704: my %temp = &record_sep($rec);
12705: if (! grep(/\S/, values(%temp))) { next; }
12706: if (%temp) {
12707: $samples[$got]=\%temp;
12708: $got++;
12709: if ($got == $toget) { last; }
12710: }
12711: }
12712: return \@samples;
12713: }
12714:
1.144 matthew 12715: ######################################################
12716: ######################################################
12717:
1.56 matthew 12718: =pod
12719:
1.648 raeburn 12720: =item * &csv_print_samples($r,$records)
1.41 ng 12721:
12722: Prints a table of sample values from each column uploaded $r is an
12723: Apache Request ref, $records is an arrayref from
12724: &Apache::loncommon::upfile_record_sep
12725:
12726: =cut
12727:
1.144 matthew 12728: ######################################################
12729: ######################################################
1.31 albertel 12730: sub csv_print_samples {
12731: my ($r,$records) = @_;
1.662 bisitz 12732: my $samples = &get_samples($records,5);
1.301 albertel 12733:
1.594 raeburn 12734: $r->print(&mt('Samples').'<br />'.&start_data_table().
12735: &start_data_table_header_row());
1.356 albertel 12736: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12737: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12738: $r->print(&end_data_table_header_row());
1.301 albertel 12739: foreach my $hash (@$samples) {
1.594 raeburn 12740: $r->print(&start_data_table_row());
1.356 albertel 12741: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12742: $r->print('<td>');
1.356 albertel 12743: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12744: $r->print('</td>');
12745: }
1.594 raeburn 12746: $r->print(&end_data_table_row());
1.31 albertel 12747: }
1.594 raeburn 12748: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12749: }
12750:
1.144 matthew 12751: ######################################################
12752: ######################################################
12753:
1.56 matthew 12754: =pod
12755:
1.648 raeburn 12756: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12757:
12758: Prints a table to create associations between values and table columns.
1.144 matthew 12759:
1.41 ng 12760: $r is an Apache Request ref,
12761: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12762: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12763:
12764: =cut
12765:
1.144 matthew 12766: ######################################################
12767: ######################################################
1.31 albertel 12768: sub csv_print_select_table {
12769: my ($r,$records,$d) = @_;
1.301 albertel 12770: my $i=0;
12771: my $samples = &get_samples($records,1);
1.144 matthew 12772: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12773: &start_data_table().&start_data_table_header_row().
1.144 matthew 12774: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12775: '<th>'.&mt('Column').'</th>'.
12776: &end_data_table_header_row()."\n");
1.356 albertel 12777: foreach my $array_ref (@$d) {
12778: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12779: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12780:
1.875 bisitz 12781: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12782: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12783: $r->print('<option value="none"></option>');
1.356 albertel 12784: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12785: $r->print('<option value="'.$sample.'"'.
12786: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12787: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12788: }
1.594 raeburn 12789: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12790: $i++;
12791: }
1.594 raeburn 12792: $r->print(&end_data_table());
1.31 albertel 12793: $i--;
12794: return $i;
12795: }
1.56 matthew 12796:
1.144 matthew 12797: ######################################################
12798: ######################################################
12799:
1.56 matthew 12800: =pod
1.31 albertel 12801:
1.648 raeburn 12802: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12803:
12804: Prints a table of sample values from the upload and can make associate samples to internal names.
12805:
12806: $r is an Apache Request ref,
12807: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12808: $d is an array of 2 element arrays (internal name, displayed name)
12809:
12810: =cut
12811:
1.144 matthew 12812: ######################################################
12813: ######################################################
1.31 albertel 12814: sub csv_samples_select_table {
12815: my ($r,$records,$d) = @_;
12816: my $i=0;
1.144 matthew 12817: #
1.662 bisitz 12818: my $max_samples = 5;
12819: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12820: $r->print(&start_data_table().
12821: &start_data_table_header_row().'<th>'.
12822: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12823: &end_data_table_header_row());
1.301 albertel 12824:
12825: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12826: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12827: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12828: foreach my $option (@$d) {
12829: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12830: $r->print('<option value="'.$value.'"'.
1.253 albertel 12831: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12832: $display.'</option>');
1.31 albertel 12833: }
12834: $r->print('</select></td><td>');
1.662 bisitz 12835: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12836: if (defined($samples->[$line]{$key})) {
12837: $r->print($samples->[$line]{$key}."<br />\n");
12838: }
12839: }
1.594 raeburn 12840: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12841: $i++;
12842: }
1.594 raeburn 12843: $r->print(&end_data_table());
1.31 albertel 12844: $i--;
12845: return($i);
1.115 matthew 12846: }
12847:
1.144 matthew 12848: ######################################################
12849: ######################################################
12850:
1.115 matthew 12851: =pod
12852:
1.648 raeburn 12853: =item * &clean_excel_name($name)
1.115 matthew 12854:
12855: Returns a replacement for $name which does not contain any illegal characters.
12856:
12857: =cut
12858:
1.144 matthew 12859: ######################################################
12860: ######################################################
1.115 matthew 12861: sub clean_excel_name {
12862: my ($name) = @_;
12863: $name =~ s/[:\*\?\/\\]//g;
12864: if (length($name) > 31) {
12865: $name = substr($name,0,31);
12866: }
12867: return $name;
1.25 albertel 12868: }
1.84 albertel 12869:
1.85 albertel 12870: =pod
12871:
1.648 raeburn 12872: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12873:
12874: Returns either 1 or undef
12875:
12876: 1 if the part is to be hidden, undef if it is to be shown
12877:
12878: Arguments are:
12879:
12880: $id the id of the part to be checked
12881: $symb, optional the symb of the resource to check
12882: $udom, optional the domain of the user to check for
12883: $uname, optional the username of the user to check for
12884:
12885: =cut
1.84 albertel 12886:
12887: sub check_if_partid_hidden {
12888: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12889: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12890: $symb,$udom,$uname);
1.141 albertel 12891: my $truth=1;
12892: #if the string starts with !, then the list is the list to show not hide
12893: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12894: my @hiddenlist=split(/,/,$hiddenparts);
12895: foreach my $checkid (@hiddenlist) {
1.141 albertel 12896: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12897: }
1.141 albertel 12898: return !$truth;
1.84 albertel 12899: }
1.127 matthew 12900:
1.138 matthew 12901:
12902: ############################################################
12903: ############################################################
12904:
12905: =pod
12906:
1.157 matthew 12907: =back
12908:
1.138 matthew 12909: =head1 cgi-bin script and graphing routines
12910:
1.157 matthew 12911: =over 4
12912:
1.648 raeburn 12913: =item * &get_cgi_id()
1.138 matthew 12914:
12915: Inputs: none
12916:
12917: Returns an id which can be used to pass environment variables
12918: to various cgi-bin scripts. These environment variables will
12919: be removed from the users environment after a given time by
12920: the routine &Apache::lonnet::transfer_profile_to_env.
12921:
12922: =cut
12923:
12924: ############################################################
12925: ############################################################
1.152 albertel 12926: my $uniq=0;
1.136 matthew 12927: sub get_cgi_id {
1.154 albertel 12928: $uniq=($uniq+1)%100000;
1.280 albertel 12929: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12930: }
12931:
1.127 matthew 12932: ############################################################
12933: ############################################################
12934:
12935: =pod
12936:
1.648 raeburn 12937: =item * &DrawBarGraph()
1.127 matthew 12938:
1.138 matthew 12939: Facilitates the plotting of data in a (stacked) bar graph.
12940: Puts plot definition data into the users environment in order for
12941: graph.png to plot it. Returns an <img> tag for the plot.
12942: The bars on the plot are labeled '1','2',...,'n'.
12943:
12944: Inputs:
12945:
12946: =over 4
12947:
12948: =item $Title: string, the title of the plot
12949:
12950: =item $xlabel: string, text describing the X-axis of the plot
12951:
12952: =item $ylabel: string, text describing the Y-axis of the plot
12953:
12954: =item $Max: scalar, the maximum Y value to use in the plot
12955: If $Max is < any data point, the graph will not be rendered.
12956:
1.140 matthew 12957: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12958: they are plotted. If undefined, default values will be used.
12959:
1.178 matthew 12960: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12961:
1.138 matthew 12962: =item @Values: An array of array references. Each array reference holds data
12963: to be plotted in a stacked bar chart.
12964:
1.239 matthew 12965: =item If the final element of @Values is a hash reference the key/value
12966: pairs will be added to the graph definition.
12967:
1.138 matthew 12968: =back
12969:
12970: Returns:
12971:
12972: An <img> tag which references graph.png and the appropriate identifying
12973: information for the plot.
12974:
1.127 matthew 12975: =cut
12976:
12977: ############################################################
12978: ############################################################
1.134 matthew 12979: sub DrawBarGraph {
1.178 matthew 12980: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12981: #
12982: if (! defined($colors)) {
12983: $colors = ['#33ff00',
12984: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12985: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12986: ];
12987: }
1.228 matthew 12988: my $extra_settings = {};
12989: if (ref($Values[-1]) eq 'HASH') {
12990: $extra_settings = pop(@Values);
12991: }
1.127 matthew 12992: #
1.136 matthew 12993: my $identifier = &get_cgi_id();
12994: my $id = 'cgi.'.$identifier;
1.129 matthew 12995: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12996: return '';
12997: }
1.225 matthew 12998: #
12999: my @Labels;
13000: if (defined($labels)) {
13001: @Labels = @$labels;
13002: } else {
13003: for (my $i=0;$i<@{$Values[0]};$i++) {
13004: push (@Labels,$i+1);
13005: }
13006: }
13007: #
1.129 matthew 13008: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13009: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13010: my %ValuesHash;
13011: my $NumSets=1;
13012: foreach my $array (@Values) {
13013: next if (! ref($array));
1.136 matthew 13014: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13015: join(',',@$array);
1.129 matthew 13016: }
1.127 matthew 13017: #
1.136 matthew 13018: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13019: if ($NumBars < 3) {
13020: $width = 120+$NumBars*32;
1.220 matthew 13021: $xskip = 1;
1.225 matthew 13022: $bar_width = 30;
13023: } elsif ($NumBars < 5) {
13024: $width = 120+$NumBars*20;
13025: $xskip = 1;
13026: $bar_width = 20;
1.220 matthew 13027: } elsif ($NumBars < 10) {
1.136 matthew 13028: $width = 120+$NumBars*15;
13029: $xskip = 1;
13030: $bar_width = 15;
13031: } elsif ($NumBars <= 25) {
13032: $width = 120+$NumBars*11;
13033: $xskip = 5;
13034: $bar_width = 8;
13035: } elsif ($NumBars <= 50) {
13036: $width = 120+$NumBars*8;
13037: $xskip = 5;
13038: $bar_width = 4;
13039: } else {
13040: $width = 120+$NumBars*8;
13041: $xskip = 5;
13042: $bar_width = 4;
13043: }
13044: #
1.137 matthew 13045: $Max = 1 if ($Max < 1);
13046: if ( int($Max) < $Max ) {
13047: $Max++;
13048: $Max = int($Max);
13049: }
1.127 matthew 13050: $Title = '' if (! defined($Title));
13051: $xlabel = '' if (! defined($xlabel));
13052: $ylabel = '' if (! defined($ylabel));
1.369 www 13053: $ValuesHash{$id.'.title'} = &escape($Title);
13054: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13055: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13056: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13057: $ValuesHash{$id.'.NumBars'} = $NumBars;
13058: $ValuesHash{$id.'.NumSets'} = $NumSets;
13059: $ValuesHash{$id.'.PlotType'} = 'bar';
13060: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13061: $ValuesHash{$id.'.height'} = $height;
13062: $ValuesHash{$id.'.width'} = $width;
13063: $ValuesHash{$id.'.xskip'} = $xskip;
13064: $ValuesHash{$id.'.bar_width'} = $bar_width;
13065: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13066: #
1.228 matthew 13067: # Deal with other parameters
13068: while (my ($key,$value) = each(%$extra_settings)) {
13069: $ValuesHash{$id.'.'.$key} = $value;
13070: }
13071: #
1.646 raeburn 13072: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13073: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13074: }
13075:
13076: ############################################################
13077: ############################################################
13078:
13079: =pod
13080:
1.648 raeburn 13081: =item * &DrawXYGraph()
1.137 matthew 13082:
1.138 matthew 13083: Facilitates the plotting of data in an XY graph.
13084: Puts plot definition data into the users environment in order for
13085: graph.png to plot it. Returns an <img> tag for the plot.
13086:
13087: Inputs:
13088:
13089: =over 4
13090:
13091: =item $Title: string, the title of the plot
13092:
13093: =item $xlabel: string, text describing the X-axis of the plot
13094:
13095: =item $ylabel: string, text describing the Y-axis of the plot
13096:
13097: =item $Max: scalar, the maximum Y value to use in the plot
13098: If $Max is < any data point, the graph will not be rendered.
13099:
13100: =item $colors: Array ref containing the hex color codes for the data to be
13101: plotted in. If undefined, default values will be used.
13102:
13103: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13104:
13105: =item $Ydata: Array ref containing Array refs.
1.185 www 13106: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13107:
13108: =item %Values: hash indicating or overriding any default values which are
13109: passed to graph.png.
13110: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13111:
13112: =back
13113:
13114: Returns:
13115:
13116: An <img> tag which references graph.png and the appropriate identifying
13117: information for the plot.
13118:
1.137 matthew 13119: =cut
13120:
13121: ############################################################
13122: ############################################################
13123: sub DrawXYGraph {
13124: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13125: #
13126: # Create the identifier for the graph
13127: my $identifier = &get_cgi_id();
13128: my $id = 'cgi.'.$identifier;
13129: #
13130: $Title = '' if (! defined($Title));
13131: $xlabel = '' if (! defined($xlabel));
13132: $ylabel = '' if (! defined($ylabel));
13133: my %ValuesHash =
13134: (
1.369 www 13135: $id.'.title' => &escape($Title),
13136: $id.'.xlabel' => &escape($xlabel),
13137: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13138: $id.'.y_max_value'=> $Max,
13139: $id.'.labels' => join(',',@$Xlabels),
13140: $id.'.PlotType' => 'XY',
13141: );
13142: #
13143: if (defined($colors) && ref($colors) eq 'ARRAY') {
13144: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13145: }
13146: #
13147: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13148: return '';
13149: }
13150: my $NumSets=1;
1.138 matthew 13151: foreach my $array (@{$Ydata}){
1.137 matthew 13152: next if (! ref($array));
13153: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13154: }
1.138 matthew 13155: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13156: #
13157: # Deal with other parameters
13158: while (my ($key,$value) = each(%Values)) {
13159: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13160: }
13161: #
1.646 raeburn 13162: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13163: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13164: }
13165:
13166: ############################################################
13167: ############################################################
13168:
13169: =pod
13170:
1.648 raeburn 13171: =item * &DrawXYYGraph()
1.138 matthew 13172:
13173: Facilitates the plotting of data in an XY graph with two Y axes.
13174: Puts plot definition data into the users environment in order for
13175: graph.png to plot it. Returns an <img> tag for the plot.
13176:
13177: Inputs:
13178:
13179: =over 4
13180:
13181: =item $Title: string, the title of the plot
13182:
13183: =item $xlabel: string, text describing the X-axis of the plot
13184:
13185: =item $ylabel: string, text describing the Y-axis of the plot
13186:
13187: =item $colors: Array ref containing the hex color codes for the data to be
13188: plotted in. If undefined, default values will be used.
13189:
13190: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13191:
13192: =item $Ydata1: The first data set
13193:
13194: =item $Min1: The minimum value of the left Y-axis
13195:
13196: =item $Max1: The maximum value of the left Y-axis
13197:
13198: =item $Ydata2: The second data set
13199:
13200: =item $Min2: The minimum value of the right Y-axis
13201:
13202: =item $Max2: The maximum value of the left Y-axis
13203:
13204: =item %Values: hash indicating or overriding any default values which are
13205: passed to graph.png.
13206: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13207:
13208: =back
13209:
13210: Returns:
13211:
13212: An <img> tag which references graph.png and the appropriate identifying
13213: information for the plot.
1.136 matthew 13214:
13215: =cut
13216:
13217: ############################################################
13218: ############################################################
1.137 matthew 13219: sub DrawXYYGraph {
13220: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13221: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13222: #
13223: # Create the identifier for the graph
13224: my $identifier = &get_cgi_id();
13225: my $id = 'cgi.'.$identifier;
13226: #
13227: $Title = '' if (! defined($Title));
13228: $xlabel = '' if (! defined($xlabel));
13229: $ylabel = '' if (! defined($ylabel));
13230: my %ValuesHash =
13231: (
1.369 www 13232: $id.'.title' => &escape($Title),
13233: $id.'.xlabel' => &escape($xlabel),
13234: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13235: $id.'.labels' => join(',',@$Xlabels),
13236: $id.'.PlotType' => 'XY',
13237: $id.'.NumSets' => 2,
1.137 matthew 13238: $id.'.two_axes' => 1,
13239: $id.'.y1_max_value' => $Max1,
13240: $id.'.y1_min_value' => $Min1,
13241: $id.'.y2_max_value' => $Max2,
13242: $id.'.y2_min_value' => $Min2,
1.136 matthew 13243: );
13244: #
1.137 matthew 13245: if (defined($colors) && ref($colors) eq 'ARRAY') {
13246: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13247: }
13248: #
13249: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13250: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13251: return '';
13252: }
13253: my $NumSets=1;
1.137 matthew 13254: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13255: next if (! ref($array));
13256: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13257: }
13258: #
13259: # Deal with other parameters
13260: while (my ($key,$value) = each(%Values)) {
13261: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13262: }
13263: #
1.646 raeburn 13264: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13265: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13266: }
13267:
13268: ############################################################
13269: ############################################################
13270:
13271: =pod
13272:
1.157 matthew 13273: =back
13274:
1.139 matthew 13275: =head1 Statistics helper routines?
13276:
13277: Bad place for them but what the hell.
13278:
1.157 matthew 13279: =over 4
13280:
1.648 raeburn 13281: =item * &chartlink()
1.139 matthew 13282:
13283: Returns a link to the chart for a specific student.
13284:
13285: Inputs:
13286:
13287: =over 4
13288:
13289: =item $linktext: The text of the link
13290:
13291: =item $sname: The students username
13292:
13293: =item $sdomain: The students domain
13294:
13295: =back
13296:
1.157 matthew 13297: =back
13298:
1.139 matthew 13299: =cut
13300:
13301: ############################################################
13302: ############################################################
13303: sub chartlink {
13304: my ($linktext, $sname, $sdomain) = @_;
13305: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13306: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13307: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13308: '">'.$linktext.'</a>';
1.153 matthew 13309: }
13310:
13311: #######################################################
13312: #######################################################
13313:
13314: =pod
13315:
13316: =head1 Course Environment Routines
1.157 matthew 13317:
13318: =over 4
1.153 matthew 13319:
1.648 raeburn 13320: =item * &restore_course_settings()
1.153 matthew 13321:
1.648 raeburn 13322: =item * &store_course_settings()
1.153 matthew 13323:
13324: Restores/Store indicated form parameters from the course environment.
13325: Will not overwrite existing values of the form parameters.
13326:
13327: Inputs:
13328: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13329:
13330: a hash ref describing the data to be stored. For example:
13331:
13332: %Save_Parameters = ('Status' => 'scalar',
13333: 'chartoutputmode' => 'scalar',
13334: 'chartoutputdata' => 'scalar',
13335: 'Section' => 'array',
1.373 raeburn 13336: 'Group' => 'array',
1.153 matthew 13337: 'StudentData' => 'array',
13338: 'Maps' => 'array');
13339:
13340: Returns: both routines return nothing
13341:
1.631 raeburn 13342: =back
13343:
1.153 matthew 13344: =cut
13345:
13346: #######################################################
13347: #######################################################
13348: sub store_course_settings {
1.496 albertel 13349: return &store_settings($env{'request.course.id'},@_);
13350: }
13351:
13352: sub store_settings {
1.153 matthew 13353: # save to the environment
13354: # appenv the same items, just to be safe
1.300 albertel 13355: my $udom = $env{'user.domain'};
13356: my $uname = $env{'user.name'};
1.496 albertel 13357: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13358: my %SaveHash;
13359: my %AppHash;
13360: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13361: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13362: my $envname = 'environment.'.$basename;
1.258 albertel 13363: if (exists($env{'form.'.$setting})) {
1.153 matthew 13364: # Save this value away
13365: if ($type eq 'scalar' &&
1.258 albertel 13366: (! exists($env{$envname}) ||
13367: $env{$envname} ne $env{'form.'.$setting})) {
13368: $SaveHash{$basename} = $env{'form.'.$setting};
13369: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13370: } elsif ($type eq 'array') {
13371: my $stored_form;
1.258 albertel 13372: if (ref($env{'form.'.$setting})) {
1.153 matthew 13373: $stored_form = join(',',
13374: map {
1.369 www 13375: &escape($_);
1.258 albertel 13376: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13377: } else {
13378: $stored_form =
1.369 www 13379: &escape($env{'form.'.$setting});
1.153 matthew 13380: }
13381: # Determine if the array contents are the same.
1.258 albertel 13382: if ($stored_form ne $env{$envname}) {
1.153 matthew 13383: $SaveHash{$basename} = $stored_form;
13384: $AppHash{$envname} = $stored_form;
13385: }
13386: }
13387: }
13388: }
13389: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13390: $udom,$uname);
1.153 matthew 13391: if ($put_result !~ /^(ok|delayed)/) {
13392: &Apache::lonnet::logthis('unable to save form parameters, '.
13393: 'got error:'.$put_result);
13394: }
13395: # Make sure these settings stick around in this session, too
1.646 raeburn 13396: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13397: return;
13398: }
13399:
13400: sub restore_course_settings {
1.499 albertel 13401: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13402: }
13403:
13404: sub restore_settings {
13405: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13406: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13407: next if (exists($env{'form.'.$setting}));
1.496 albertel 13408: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13409: '.'.$setting;
1.258 albertel 13410: if (exists($env{$envname})) {
1.153 matthew 13411: if ($type eq 'scalar') {
1.258 albertel 13412: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13413: } elsif ($type eq 'array') {
1.258 albertel 13414: $env{'form.'.$setting} = [
1.153 matthew 13415: map {
1.369 www 13416: &unescape($_);
1.258 albertel 13417: } split(',',$env{$envname})
1.153 matthew 13418: ];
13419: }
13420: }
13421: }
1.127 matthew 13422: }
13423:
1.618 raeburn 13424: #######################################################
13425: #######################################################
13426:
13427: =pod
13428:
13429: =head1 Domain E-mail Routines
13430:
13431: =over 4
13432:
1.648 raeburn 13433: =item * &build_recipient_list()
1.618 raeburn 13434:
1.1075.2.44 raeburn 13435: Build recipient lists for following types of e-mail:
1.766 raeburn 13436: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13437: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13438: module change checking, student/employee ID conflict checks, as
13439: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13440: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13441:
13442: Inputs:
1.1075.2.44 raeburn 13443: defmail (scalar - email address of default recipient),
13444: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13445: requestsmail, updatesmail, or idconflictsmail).
13446:
1.619 raeburn 13447: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13448:
13449: origmail (scalar - email address of recipient from loncapa.conf,
13450: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13451:
1.655 raeburn 13452: Returns: comma separated list of addresses to which to send e-mail.
13453:
13454: =back
1.618 raeburn 13455:
13456: =cut
13457:
13458: ############################################################
13459: ############################################################
13460: sub build_recipient_list {
1.619 raeburn 13461: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13462: my @recipients;
13463: my $otheremails;
13464: my %domconfig =
13465: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13466: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13467: if (exists($domconfig{'contacts'}{$mailing})) {
13468: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13469: my @contacts = ('adminemail','supportemail');
13470: foreach my $item (@contacts) {
13471: if ($domconfig{'contacts'}{$mailing}{$item}) {
13472: my $addr = $domconfig{'contacts'}{$item};
13473: if (!grep(/^\Q$addr\E$/,@recipients)) {
13474: push(@recipients,$addr);
13475: }
1.619 raeburn 13476: }
1.766 raeburn 13477: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13478: }
13479: }
1.766 raeburn 13480: } elsif ($origmail ne '') {
13481: push(@recipients,$origmail);
1.618 raeburn 13482: }
1.619 raeburn 13483: } elsif ($origmail ne '') {
13484: push(@recipients,$origmail);
1.618 raeburn 13485: }
1.688 raeburn 13486: if (defined($defmail)) {
13487: if ($defmail ne '') {
13488: push(@recipients,$defmail);
13489: }
1.618 raeburn 13490: }
13491: if ($otheremails) {
1.619 raeburn 13492: my @others;
13493: if ($otheremails =~ /,/) {
13494: @others = split(/,/,$otheremails);
1.618 raeburn 13495: } else {
1.619 raeburn 13496: push(@others,$otheremails);
13497: }
13498: foreach my $addr (@others) {
13499: if (!grep(/^\Q$addr\E$/,@recipients)) {
13500: push(@recipients,$addr);
13501: }
1.618 raeburn 13502: }
13503: }
1.619 raeburn 13504: my $recipientlist = join(',',@recipients);
1.618 raeburn 13505: return $recipientlist;
13506: }
13507:
1.127 matthew 13508: ############################################################
13509: ############################################################
1.154 albertel 13510:
1.655 raeburn 13511: =pod
13512:
13513: =head1 Course Catalog Routines
13514:
13515: =over 4
13516:
13517: =item * &gather_categories()
13518:
13519: Converts category definitions - keys of categories hash stored in
13520: coursecategories in configuration.db on the primary library server in a
13521: domain - to an array. Also generates javascript and idx hash used to
13522: generate Domain Coordinator interface for editing Course Categories.
13523:
13524: Inputs:
1.663 raeburn 13525:
1.655 raeburn 13526: categories (reference to hash of category definitions).
1.663 raeburn 13527:
1.655 raeburn 13528: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13529: categories and subcategories).
1.663 raeburn 13530:
1.655 raeburn 13531: idx (reference to hash of counters used in Domain Coordinator interface for
13532: editing Course Categories).
1.663 raeburn 13533:
1.655 raeburn 13534: jsarray (reference to array of categories used to create Javascript arrays for
13535: Domain Coordinator interface for editing Course Categories).
13536:
13537: Returns: nothing
13538:
13539: Side effects: populates cats, idx and jsarray.
13540:
13541: =cut
13542:
13543: sub gather_categories {
13544: my ($categories,$cats,$idx,$jsarray) = @_;
13545: my %counters;
13546: my $num = 0;
13547: foreach my $item (keys(%{$categories})) {
13548: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13549: if ($container eq '' && $depth == 0) {
13550: $cats->[$depth][$categories->{$item}] = $cat;
13551: } else {
13552: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13553: }
13554: my ($escitem,$tail) = split(/:/,$item,2);
13555: if ($counters{$tail} eq '') {
13556: $counters{$tail} = $num;
13557: $num ++;
13558: }
13559: if (ref($idx) eq 'HASH') {
13560: $idx->{$item} = $counters{$tail};
13561: }
13562: if (ref($jsarray) eq 'ARRAY') {
13563: push(@{$jsarray->[$counters{$tail}]},$item);
13564: }
13565: }
13566: return;
13567: }
13568:
13569: =pod
13570:
13571: =item * &extract_categories()
13572:
13573: Used to generate breadcrumb trails for course categories.
13574:
13575: Inputs:
1.663 raeburn 13576:
1.655 raeburn 13577: categories (reference to hash of category definitions).
1.663 raeburn 13578:
1.655 raeburn 13579: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13580: categories and subcategories).
1.663 raeburn 13581:
1.655 raeburn 13582: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13583:
1.655 raeburn 13584: allitems (reference to hash - key is category key
13585: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13586:
1.655 raeburn 13587: idx (reference to hash of counters used in Domain Coordinator interface for
13588: editing Course Categories).
1.663 raeburn 13589:
1.655 raeburn 13590: jsarray (reference to array of categories used to create Javascript arrays for
13591: Domain Coordinator interface for editing Course Categories).
13592:
1.665 raeburn 13593: subcats (reference to hash of arrays containing all subcategories within each
13594: category, -recursive)
13595:
1.655 raeburn 13596: Returns: nothing
13597:
13598: Side effects: populates trails and allitems hash references.
13599:
13600: =cut
13601:
13602: sub extract_categories {
1.665 raeburn 13603: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13604: if (ref($categories) eq 'HASH') {
13605: &gather_categories($categories,$cats,$idx,$jsarray);
13606: if (ref($cats->[0]) eq 'ARRAY') {
13607: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13608: my $name = $cats->[0][$i];
13609: my $item = &escape($name).'::0';
13610: my $trailstr;
13611: if ($name eq 'instcode') {
13612: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13613: } elsif ($name eq 'communities') {
13614: $trailstr = &mt('Communities');
1.655 raeburn 13615: } else {
13616: $trailstr = $name;
13617: }
13618: if ($allitems->{$item} eq '') {
13619: push(@{$trails},$trailstr);
13620: $allitems->{$item} = scalar(@{$trails})-1;
13621: }
13622: my @parents = ($name);
13623: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13624: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13625: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13626: if (ref($subcats) eq 'HASH') {
13627: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13628: }
13629: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13630: }
13631: } else {
13632: if (ref($subcats) eq 'HASH') {
13633: $subcats->{$item} = [];
1.655 raeburn 13634: }
13635: }
13636: }
13637: }
13638: }
13639: return;
13640: }
13641:
13642: =pod
13643:
1.1075.2.56 raeburn 13644: =item * &recurse_categories()
1.655 raeburn 13645:
13646: Recursively used to generate breadcrumb trails for course categories.
13647:
13648: Inputs:
1.663 raeburn 13649:
1.655 raeburn 13650: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13651: categories and subcategories).
1.663 raeburn 13652:
1.655 raeburn 13653: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13654:
13655: category (current course category, for which breadcrumb trail is being generated).
13656:
13657: trails (reference to array of breadcrumb trails for each category).
13658:
1.655 raeburn 13659: allitems (reference to hash - key is category key
13660: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13661:
1.655 raeburn 13662: parents (array containing containers directories for current category,
13663: back to top level).
13664:
13665: Returns: nothing
13666:
13667: Side effects: populates trails and allitems hash references
13668:
13669: =cut
13670:
13671: sub recurse_categories {
1.665 raeburn 13672: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13673: my $shallower = $depth - 1;
13674: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13675: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13676: my $name = $cats->[$depth]{$category}[$k];
13677: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13678: my $trailstr = join(' -> ',(@{$parents},$category));
13679: if ($allitems->{$item} eq '') {
13680: push(@{$trails},$trailstr);
13681: $allitems->{$item} = scalar(@{$trails})-1;
13682: }
13683: my $deeper = $depth+1;
13684: push(@{$parents},$category);
1.665 raeburn 13685: if (ref($subcats) eq 'HASH') {
13686: my $subcat = &escape($name).':'.$category.':'.$depth;
13687: for (my $j=@{$parents}; $j>=0; $j--) {
13688: my $higher;
13689: if ($j > 0) {
13690: $higher = &escape($parents->[$j]).':'.
13691: &escape($parents->[$j-1]).':'.$j;
13692: } else {
13693: $higher = &escape($parents->[$j]).'::'.$j;
13694: }
13695: push(@{$subcats->{$higher}},$subcat);
13696: }
13697: }
13698: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13699: $subcats);
1.655 raeburn 13700: pop(@{$parents});
13701: }
13702: } else {
13703: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13704: my $trailstr = join(' -> ',(@{$parents},$category));
13705: if ($allitems->{$item} eq '') {
13706: push(@{$trails},$trailstr);
13707: $allitems->{$item} = scalar(@{$trails})-1;
13708: }
13709: }
13710: return;
13711: }
13712:
1.663 raeburn 13713: =pod
13714:
1.1075.2.56 raeburn 13715: =item * &assign_categories_table()
1.663 raeburn 13716:
13717: Create a datatable for display of hierarchical categories in a domain,
13718: with checkboxes to allow a course to be categorized.
13719:
13720: Inputs:
13721:
13722: cathash - reference to hash of categories defined for the domain (from
13723: configuration.db)
13724:
13725: currcat - scalar with an & separated list of categories assigned to a course.
13726:
1.919 raeburn 13727: type - scalar contains course type (Course or Community).
13728:
1.663 raeburn 13729: Returns: $output (markup to be displayed)
13730:
13731: =cut
13732:
13733: sub assign_categories_table {
1.919 raeburn 13734: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13735: my $output;
13736: if (ref($cathash) eq 'HASH') {
13737: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13738: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13739: $maxdepth = scalar(@cats);
13740: if (@cats > 0) {
13741: my $itemcount = 0;
13742: if (ref($cats[0]) eq 'ARRAY') {
13743: my @currcategories;
13744: if ($currcat ne '') {
13745: @currcategories = split('&',$currcat);
13746: }
1.919 raeburn 13747: my $table;
1.663 raeburn 13748: for (my $i=0; $i<@{$cats[0]}; $i++) {
13749: my $parent = $cats[0][$i];
1.919 raeburn 13750: next if ($parent eq 'instcode');
13751: if ($type eq 'Community') {
13752: next unless ($parent eq 'communities');
13753: } else {
13754: next if ($parent eq 'communities');
13755: }
1.663 raeburn 13756: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13757: my $item = &escape($parent).'::0';
13758: my $checked = '';
13759: if (@currcategories > 0) {
13760: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13761: $checked = ' checked="checked"';
1.663 raeburn 13762: }
13763: }
1.919 raeburn 13764: my $parent_title = $parent;
13765: if ($parent eq 'communities') {
13766: $parent_title = &mt('Communities');
13767: }
13768: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13769: '<input type="checkbox" name="usecategory" value="'.
13770: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13771: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13772: my $depth = 1;
13773: push(@path,$parent);
1.919 raeburn 13774: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13775: pop(@path);
1.919 raeburn 13776: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13777: $itemcount ++;
13778: }
1.919 raeburn 13779: if ($itemcount) {
13780: $output = &Apache::loncommon::start_data_table().
13781: $table.
13782: &Apache::loncommon::end_data_table();
13783: }
1.663 raeburn 13784: }
13785: }
13786: }
13787: return $output;
13788: }
13789:
13790: =pod
13791:
1.1075.2.56 raeburn 13792: =item * &assign_category_rows()
1.663 raeburn 13793:
13794: Create a datatable row for display of nested categories in a domain,
13795: with checkboxes to allow a course to be categorized,called recursively.
13796:
13797: Inputs:
13798:
13799: itemcount - track row number for alternating colors
13800:
13801: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13802: categories and subcategories.
13803:
13804: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13805:
13806: parent - parent of current category item
13807:
13808: path - Array containing all categories back up through the hierarchy from the
13809: current category to the top level.
13810:
13811: currcategories - reference to array of current categories assigned to the course
13812:
13813: Returns: $output (markup to be displayed).
13814:
13815: =cut
13816:
13817: sub assign_category_rows {
13818: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13819: my ($text,$name,$item,$chgstr);
13820: if (ref($cats) eq 'ARRAY') {
13821: my $maxdepth = scalar(@{$cats});
13822: if (ref($cats->[$depth]) eq 'HASH') {
13823: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13824: my $numchildren = @{$cats->[$depth]{$parent}};
13825: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13826: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13827: for (my $j=0; $j<$numchildren; $j++) {
13828: $name = $cats->[$depth]{$parent}[$j];
13829: $item = &escape($name).':'.&escape($parent).':'.$depth;
13830: my $deeper = $depth+1;
13831: my $checked = '';
13832: if (ref($currcategories) eq 'ARRAY') {
13833: if (@{$currcategories} > 0) {
13834: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13835: $checked = ' checked="checked"';
1.663 raeburn 13836: }
13837: }
13838: }
1.664 raeburn 13839: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13840: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13841: $item.'"'.$checked.' />'.$name.'</label></span>'.
13842: '<input type="hidden" name="catname" value="'.$name.'" />'.
13843: '</td><td>';
1.663 raeburn 13844: if (ref($path) eq 'ARRAY') {
13845: push(@{$path},$name);
13846: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13847: pop(@{$path});
13848: }
13849: $text .= '</td></tr>';
13850: }
13851: $text .= '</table></td>';
13852: }
13853: }
13854: }
13855: return $text;
13856: }
13857:
1.1075.2.69 raeburn 13858: =pod
13859:
13860: =back
13861:
13862: =cut
13863:
1.655 raeburn 13864: ############################################################
13865: ############################################################
13866:
13867:
1.443 albertel 13868: sub commit_customrole {
1.664 raeburn 13869: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13870: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13871: ($start?', '.&mt('starting').' '.localtime($start):'').
13872: ($end?', ending '.localtime($end):'').': <b>'.
13873: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13874: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13875: '</b><br />';
13876: return $output;
13877: }
13878:
13879: sub commit_standardrole {
1.1075.2.31 raeburn 13880: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13881: my ($output,$logmsg,$linefeed);
13882: if ($context eq 'auto') {
13883: $linefeed = "\n";
13884: } else {
13885: $linefeed = "<br />\n";
13886: }
1.443 albertel 13887: if ($three eq 'st') {
1.541 raeburn 13888: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 13889: $one,$two,$sec,$context,$credits);
1.541 raeburn 13890: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13891: ($result eq 'unknown_course') || ($result eq 'refused')) {
13892: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13893: } else {
1.541 raeburn 13894: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13895: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13896: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13897: if ($context eq 'auto') {
13898: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13899: } else {
13900: $output .= '<b>'.$result.'</b>'.$linefeed.
13901: &mt('Add to classlist').': <b>ok</b>';
13902: }
13903: $output .= $linefeed;
1.443 albertel 13904: }
13905: } else {
13906: $output = &mt('Assigning').' '.$three.' in '.$url.
13907: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13908: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13909: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13910: if ($context eq 'auto') {
13911: $output .= $result.$linefeed;
13912: } else {
13913: $output .= '<b>'.$result.'</b>'.$linefeed;
13914: }
1.443 albertel 13915: }
13916: return $output;
13917: }
13918:
13919: sub commit_studentrole {
1.1075.2.31 raeburn 13920: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13921: $credits) = @_;
1.626 raeburn 13922: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13923: if ($context eq 'auto') {
13924: $linefeed = "\n";
13925: } else {
13926: $linefeed = '<br />'."\n";
13927: }
1.443 albertel 13928: if (defined($one) && defined($two)) {
13929: my $cid=$one.'_'.$two;
13930: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13931: my $secchange = 0;
13932: my $expire_role_result;
13933: my $modify_section_result;
1.628 raeburn 13934: if ($oldsec ne '-1') {
13935: if ($oldsec ne $sec) {
1.443 albertel 13936: $secchange = 1;
1.628 raeburn 13937: my $now = time;
1.443 albertel 13938: my $uurl='/'.$cid;
13939: $uurl=~s/\_/\//g;
13940: if ($oldsec) {
13941: $uurl.='/'.$oldsec;
13942: }
1.626 raeburn 13943: $oldsecurl = $uurl;
1.628 raeburn 13944: $expire_role_result =
1.652 raeburn 13945: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13946: if ($env{'request.course.sec'} ne '') {
13947: if ($expire_role_result eq 'refused') {
13948: my @roles = ('st');
13949: my @statuses = ('previous');
13950: my @roledoms = ($one);
13951: my $withsec = 1;
13952: my %roleshash =
13953: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13954: \@statuses,\@roles,\@roledoms,$withsec);
13955: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13956: my ($oldstart,$oldend) =
13957: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13958: if ($oldend > 0 && $oldend <= $now) {
13959: $expire_role_result = 'ok';
13960: }
13961: }
13962: }
13963: }
1.443 albertel 13964: $result = $expire_role_result;
13965: }
13966: }
13967: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 13968: $modify_section_result =
13969: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13970: undef,undef,undef,$sec,
13971: $end,$start,'','',$cid,
13972: '',$context,$credits);
1.443 albertel 13973: if ($modify_section_result =~ /^ok/) {
13974: if ($secchange == 1) {
1.628 raeburn 13975: if ($sec eq '') {
13976: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13977: } else {
13978: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13979: }
1.443 albertel 13980: } elsif ($oldsec eq '-1') {
1.628 raeburn 13981: if ($sec eq '') {
13982: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13983: } else {
13984: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13985: }
1.443 albertel 13986: } else {
1.628 raeburn 13987: if ($sec eq '') {
13988: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13989: } else {
13990: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13991: }
1.443 albertel 13992: }
13993: } else {
1.628 raeburn 13994: if ($secchange) {
13995: $$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;
13996: } else {
13997: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13998: }
1.443 albertel 13999: }
14000: $result = $modify_section_result;
14001: } elsif ($secchange == 1) {
1.628 raeburn 14002: if ($oldsec eq '') {
1.1075.2.20 raeburn 14003: $$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 14004: } else {
14005: $$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;
14006: }
1.626 raeburn 14007: if ($expire_role_result eq 'refused') {
14008: my $newsecurl = '/'.$cid;
14009: $newsecurl =~ s/\_/\//g;
14010: if ($sec ne '') {
14011: $newsecurl.='/'.$sec;
14012: }
14013: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14014: if ($sec eq '') {
14015: $$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;
14016: } else {
14017: $$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;
14018: }
14019: }
14020: }
1.443 albertel 14021: }
14022: } else {
1.626 raeburn 14023: $$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 14024: $result = "error: incomplete course id\n";
14025: }
14026: return $result;
14027: }
14028:
1.1075.2.25 raeburn 14029: sub show_role_extent {
14030: my ($scope,$context,$role) = @_;
14031: $scope =~ s{^/}{};
14032: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14033: push(@courseroles,'co');
14034: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14035: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14036: $scope =~ s{/}{_};
14037: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14038: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14039: my ($audom,$auname) = split(/\//,$scope);
14040: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14041: &Apache::loncommon::plainname($auname,$audom).'</span>');
14042: } else {
14043: $scope =~ s{/$}{};
14044: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14045: &Apache::lonnet::domain($scope,'description').'</span>');
14046: }
14047: }
14048:
1.443 albertel 14049: ############################################################
14050: ############################################################
14051:
1.566 albertel 14052: sub check_clone {
1.578 raeburn 14053: my ($args,$linefeed) = @_;
1.566 albertel 14054: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14055: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14056: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14057: my $clonemsg;
14058: my $can_clone = 0;
1.944 raeburn 14059: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14060: if ($lctype ne 'community') {
14061: $lctype = 'course';
14062: }
1.566 albertel 14063: if ($clonehome eq 'no_host') {
1.944 raeburn 14064: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14065: $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'});
14066: } else {
14067: $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'});
14068: }
1.566 albertel 14069: } else {
14070: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14071: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14072: if ($clonedesc{'type'} ne 'Community') {
14073: $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'});
14074: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14075: }
14076: }
1.882 raeburn 14077: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14078: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14079: $can_clone = 1;
14080: } else {
14081: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14082: $args->{'clonedomain'},$args->{'clonecourse'});
14083: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14084: if (grep(/^\*$/,@cloners)) {
14085: $can_clone = 1;
14086: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14087: $can_clone = 1;
14088: } else {
1.908 raeburn 14089: my $ccrole = 'cc';
1.944 raeburn 14090: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14091: $ccrole = 'co';
14092: }
1.578 raeburn 14093: my %roleshash =
14094: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14095: $args->{'ccdomain'},
1.908 raeburn 14096: 'userroles',['active'],[$ccrole],
1.578 raeburn 14097: [$args->{'clonedomain'}]);
1.908 raeburn 14098: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14099: $can_clone = 1;
14100: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14101: $can_clone = 1;
14102: } else {
1.944 raeburn 14103: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14104: $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'});
14105: } else {
14106: $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'});
14107: }
1.578 raeburn 14108: }
1.566 albertel 14109: }
1.578 raeburn 14110: }
1.566 albertel 14111: }
14112: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14113: }
14114:
1.444 albertel 14115: sub construct_course {
1.1075.2.59 raeburn 14116: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14117: my $outcome;
1.541 raeburn 14118: my $linefeed = '<br />'."\n";
14119: if ($context eq 'auto') {
14120: $linefeed = "\n";
14121: }
1.566 albertel 14122:
14123: #
14124: # Are we cloning?
14125: #
14126: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14127: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14128: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14129: if ($context ne 'auto') {
1.578 raeburn 14130: if ($clonemsg ne '') {
14131: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14132: }
1.566 albertel 14133: }
14134: $outcome .= $clonemsg.$linefeed;
14135:
14136: if (!$can_clone) {
14137: return (0,$outcome);
14138: }
14139: }
14140:
1.444 albertel 14141: #
14142: # Open course
14143: #
14144: my $crstype = lc($args->{'crstype'});
14145: my %cenv=();
14146: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14147: $args->{'cdescr'},
14148: $args->{'curl'},
14149: $args->{'course_home'},
14150: $args->{'nonstandard'},
14151: $args->{'crscode'},
14152: $args->{'ccuname'}.':'.
14153: $args->{'ccdomain'},
1.882 raeburn 14154: $args->{'crstype'},
1.885 raeburn 14155: $cnum,$context,$category);
1.444 albertel 14156:
14157: # Note: The testing routines depend on this being output; see
14158: # Utils::Course. This needs to at least be output as a comment
14159: # if anyone ever decides to not show this, and Utils::Course::new
14160: # will need to be suitably modified.
1.541 raeburn 14161: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14162: if ($$courseid =~ /^error:/) {
14163: return (0,$outcome);
14164: }
14165:
1.444 albertel 14166: #
14167: # Check if created correctly
14168: #
1.479 albertel 14169: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14170: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14171: if ($crsuhome eq 'no_host') {
14172: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14173: return (0,$outcome);
14174: }
1.541 raeburn 14175: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14176:
1.444 albertel 14177: #
1.566 albertel 14178: # Do the cloning
14179: #
14180: if ($can_clone && $cloneid) {
14181: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14182: if ($context ne 'auto') {
14183: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14184: }
14185: $outcome .= $clonemsg.$linefeed;
14186: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14187: # Copy all files
1.637 www 14188: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14189: # Restore URL
1.566 albertel 14190: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14191: # Restore title
1.566 albertel 14192: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14193: # Restore creation date, creator and creation context.
14194: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14195: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14196: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14197: # Mark as cloned
1.566 albertel 14198: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14199: # Need to clone grading mode
14200: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14201: $cenv{'grading'}=$newenv{'grading'};
14202: # Do not clone these environment entries
14203: &Apache::lonnet::del('environment',
14204: ['default_enrollment_start_date',
14205: 'default_enrollment_end_date',
14206: 'question.email',
14207: 'policy.email',
14208: 'comment.email',
14209: 'pch.users.denied',
1.725 raeburn 14210: 'plc.users.denied',
14211: 'hidefromcat',
1.1075.2.36 raeburn 14212: 'checkforpriv',
1.1075.2.59 raeburn 14213: 'categories',
14214: 'internal.uniquecode'],
1.638 www 14215: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14216: if ($args->{'textbook'}) {
14217: $cenv{'internal.textbook'} = $args->{'textbook'};
14218: }
1.444 albertel 14219: }
1.566 albertel 14220:
1.444 albertel 14221: #
14222: # Set environment (will override cloned, if existing)
14223: #
14224: my @sections = ();
14225: my @xlists = ();
14226: if ($args->{'crstype'}) {
14227: $cenv{'type'}=$args->{'crstype'};
14228: }
14229: if ($args->{'crsid'}) {
14230: $cenv{'courseid'}=$args->{'crsid'};
14231: }
14232: if ($args->{'crscode'}) {
14233: $cenv{'internal.coursecode'}=$args->{'crscode'};
14234: }
14235: if ($args->{'crsquota'} ne '') {
14236: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14237: } else {
14238: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14239: }
14240: if ($args->{'ccuname'}) {
14241: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14242: ':'.$args->{'ccdomain'};
14243: } else {
14244: $cenv{'internal.courseowner'} = $args->{'curruser'};
14245: }
1.1075.2.31 raeburn 14246: if ($args->{'defaultcredits'}) {
14247: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14248: }
1.444 albertel 14249: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14250: if ($args->{'crssections'}) {
14251: $cenv{'internal.sectionnums'} = '';
14252: if ($args->{'crssections'} =~ m/,/) {
14253: @sections = split/,/,$args->{'crssections'};
14254: } else {
14255: $sections[0] = $args->{'crssections'};
14256: }
14257: if (@sections > 0) {
14258: foreach my $item (@sections) {
14259: my ($sec,$gp) = split/:/,$item;
14260: my $class = $args->{'crscode'}.$sec;
14261: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14262: $cenv{'internal.sectionnums'} .= $item.',';
14263: unless ($addcheck eq 'ok') {
14264: push @badclasses, $class;
14265: }
14266: }
14267: $cenv{'internal.sectionnums'} =~ s/,$//;
14268: }
14269: }
14270: # do not hide course coordinator from staff listing,
14271: # even if privileged
14272: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14273: # add course coordinator's domain to domains to check for privileged users
14274: # if different to course domain
14275: if ($$crsudom ne $args->{'ccdomain'}) {
14276: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14277: }
1.444 albertel 14278: # add crosslistings
14279: if ($args->{'crsxlist'}) {
14280: $cenv{'internal.crosslistings'}='';
14281: if ($args->{'crsxlist'} =~ m/,/) {
14282: @xlists = split/,/,$args->{'crsxlist'};
14283: } else {
14284: $xlists[0] = $args->{'crsxlist'};
14285: }
14286: if (@xlists > 0) {
14287: foreach my $item (@xlists) {
14288: my ($xl,$gp) = split/:/,$item;
14289: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14290: $cenv{'internal.crosslistings'} .= $item.',';
14291: unless ($addcheck eq 'ok') {
14292: push @badclasses, $xl;
14293: }
14294: }
14295: $cenv{'internal.crosslistings'} =~ s/,$//;
14296: }
14297: }
14298: if ($args->{'autoadds'}) {
14299: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14300: }
14301: if ($args->{'autodrops'}) {
14302: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14303: }
14304: # check for notification of enrollment changes
14305: my @notified = ();
14306: if ($args->{'notify_owner'}) {
14307: if ($args->{'ccuname'} ne '') {
14308: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14309: }
14310: }
14311: if ($args->{'notify_dc'}) {
14312: if ($uname ne '') {
1.630 raeburn 14313: push(@notified,$uname.':'.$udom);
1.444 albertel 14314: }
14315: }
14316: if (@notified > 0) {
14317: my $notifylist;
14318: if (@notified > 1) {
14319: $notifylist = join(',',@notified);
14320: } else {
14321: $notifylist = $notified[0];
14322: }
14323: $cenv{'internal.notifylist'} = $notifylist;
14324: }
14325: if (@badclasses > 0) {
14326: my %lt=&Apache::lonlocal::texthash(
14327: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
14328: 'dnhr' => 'does not have rights to access enrollment in these classes',
14329: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14330: );
1.541 raeburn 14331: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14332: ' ('.$lt{'adby'}.')';
14333: if ($context eq 'auto') {
14334: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14335: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14336: foreach my $item (@badclasses) {
14337: if ($context eq 'auto') {
14338: $outcome .= " - $item\n";
14339: } else {
14340: $outcome .= "<li>$item</li>\n";
14341: }
14342: }
14343: if ($context eq 'auto') {
14344: $outcome .= $linefeed;
14345: } else {
1.566 albertel 14346: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14347: }
14348: }
1.444 albertel 14349: }
14350: if ($args->{'no_end_date'}) {
14351: $args->{'endaccess'} = 0;
14352: }
14353: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14354: $cenv{'internal.autoend'}=$args->{'enrollend'};
14355: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14356: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14357: if ($args->{'showphotos'}) {
14358: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14359: }
14360: $cenv{'internal.authtype'} = $args->{'authtype'};
14361: $cenv{'internal.autharg'} = $args->{'autharg'};
14362: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14363: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14364: 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');
14365: if ($context eq 'auto') {
14366: $outcome .= $krb_msg;
14367: } else {
1.566 albertel 14368: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14369: }
14370: $outcome .= $linefeed;
1.444 albertel 14371: }
14372: }
14373: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14374: if ($args->{'setpolicy'}) {
14375: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14376: }
14377: if ($args->{'setcontent'}) {
14378: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14379: }
14380: }
14381: if ($args->{'reshome'}) {
14382: $cenv{'reshome'}=$args->{'reshome'}.'/';
14383: $cenv{'reshome'}=~s/\/+$/\//;
14384: }
14385: #
14386: # course has keyed access
14387: #
14388: if ($args->{'setkeys'}) {
14389: $cenv{'keyaccess'}='yes';
14390: }
14391: # if specified, key authority is not course, but user
14392: # only active if keyaccess is yes
14393: if ($args->{'keyauth'}) {
1.487 albertel 14394: my ($user,$domain) = split(':',$args->{'keyauth'});
14395: $user = &LONCAPA::clean_username($user);
14396: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14397: if ($user ne '' && $domain ne '') {
1.487 albertel 14398: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14399: }
14400: }
14401:
1.1075.2.59 raeburn 14402: #
14403: # generate and store uniquecode (available to course requester), if course should have one.
14404: #
14405: if ($args->{'uniquecode'}) {
14406: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14407: if ($code) {
14408: $cenv{'internal.uniquecode'} = $code;
14409: my %crsinfo =
14410: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14411: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14412: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14413: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14414: }
14415: if (ref($coderef)) {
14416: $$coderef = $code;
14417: }
14418: }
14419: }
14420:
1.444 albertel 14421: if ($args->{'disresdis'}) {
14422: $cenv{'pch.roles.denied'}='st';
14423: }
14424: if ($args->{'disablechat'}) {
14425: $cenv{'plc.roles.denied'}='st';
14426: }
14427:
14428: # Record we've not yet viewed the Course Initialization Helper for this
14429: # course
14430: $cenv{'course.helper.not.run'} = 1;
14431: #
14432: # Use new Randomseed
14433: #
14434: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14435: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14436: #
14437: # The encryption code and receipt prefix for this course
14438: #
14439: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14440: $cenv{'internal.encpref'}=100+int(9*rand(99));
14441: #
14442: # By default, use standard grading
14443: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14444:
1.541 raeburn 14445: $outcome .= $linefeed.&mt('Setting environment').': '.
14446: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14447: #
14448: # Open all assignments
14449: #
14450: if ($args->{'openall'}) {
14451: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14452: my %storecontent = ($storeunder => time,
14453: $storeunder.'.type' => 'date_start');
14454:
14455: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14456: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14457: }
14458: #
14459: # Set first page
14460: #
14461: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14462: || ($cloneid)) {
1.445 albertel 14463: use LONCAPA::map;
1.444 albertel 14464: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14465:
14466: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14467: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14468:
1.444 albertel 14469: $outcome .= ($fatal?$errtext:'read ok').' - ';
14470: my $title; my $url;
14471: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14472: $title=&mt('Syllabus');
1.444 albertel 14473: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14474: } else {
1.963 raeburn 14475: $title=&mt('Table of Contents');
1.444 albertel 14476: $url='/adm/navmaps';
14477: }
1.445 albertel 14478:
14479: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14480: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14481:
14482: if ($errtext) { $fatal=2; }
1.541 raeburn 14483: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14484: }
1.566 albertel 14485:
14486: return (1,$outcome);
1.444 albertel 14487: }
14488:
1.1075.2.59 raeburn 14489: sub make_unique_code {
14490: my ($cdom,$cnum) = @_;
14491: # get lock on uniquecodes db
14492: my $lockhash = {
14493: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14494: ':'.$env{'user.domain'},
14495: };
14496: my $tries = 0;
14497: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14498: my ($code,$error);
14499:
14500: while (($gotlock ne 'ok') && ($tries<3)) {
14501: $tries ++;
14502: sleep 1;
14503: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14504: }
14505: if ($gotlock eq 'ok') {
14506: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14507: my $gotcode;
14508: my $attempts = 0;
14509: while ((!$gotcode) && ($attempts < 100)) {
14510: $code = &generate_code();
14511: if (!exists($currcodes{$code})) {
14512: $gotcode = 1;
14513: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14514: $error = 'nostore';
14515: }
14516: }
14517: $attempts ++;
14518: }
14519: my @del_lock = ($cnum."\0".'uniquecodes');
14520: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14521: } else {
14522: $error = 'nolock';
14523: }
14524: return ($code,$error);
14525: }
14526:
14527: sub generate_code {
14528: my $code;
14529: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14530: for (my $i=0; $i<6; $i++) {
14531: my $lettnum = int (rand 2);
14532: my $item = '';
14533: if ($lettnum) {
14534: $item = $letts[int( rand(18) )];
14535: } else {
14536: $item = 1+int( rand(8) );
14537: }
14538: $code .= $item;
14539: }
14540: return $code;
14541: }
14542:
1.444 albertel 14543: ############################################################
14544: ############################################################
14545:
1.953 droeschl 14546: #SD
14547: # only Community and Course, or anything else?
1.378 raeburn 14548: sub course_type {
14549: my ($cid) = @_;
14550: if (!defined($cid)) {
14551: $cid = $env{'request.course.id'};
14552: }
1.404 albertel 14553: if (defined($env{'course.'.$cid.'.type'})) {
14554: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14555: } else {
14556: return 'Course';
1.377 raeburn 14557: }
14558: }
1.156 albertel 14559:
1.406 raeburn 14560: sub group_term {
14561: my $crstype = &course_type();
14562: my %names = (
14563: 'Course' => 'group',
1.865 raeburn 14564: 'Community' => 'group',
1.406 raeburn 14565: );
14566: return $names{$crstype};
14567: }
14568:
1.902 raeburn 14569: sub course_types {
1.1075.2.59 raeburn 14570: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14571: my %typename = (
14572: official => 'Official course',
14573: unofficial => 'Unofficial course',
14574: community => 'Community',
1.1075.2.59 raeburn 14575: textbook => 'Textbook course',
1.902 raeburn 14576: );
14577: return (\@types,\%typename);
14578: }
14579:
1.156 albertel 14580: sub icon {
14581: my ($file)=@_;
1.505 albertel 14582: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14583: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14584: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14585: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14586: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14587: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14588: $curfext.".gif") {
14589: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14590: $curfext.".gif";
14591: }
14592: }
1.249 albertel 14593: return &lonhttpdurl($iconname);
1.154 albertel 14594: }
1.84 albertel 14595:
1.575 albertel 14596: sub lonhttpdurl {
1.692 www 14597: #
14598: # Had been used for "small fry" static images on separate port 8080.
14599: # Modify here if lightweight http functionality desired again.
14600: # Currently eliminated due to increasing firewall issues.
14601: #
1.575 albertel 14602: my ($url)=@_;
1.692 www 14603: return $url;
1.215 albertel 14604: }
14605:
1.213 albertel 14606: sub connection_aborted {
14607: my ($r)=@_;
14608: $r->print(" ");$r->rflush();
14609: my $c = $r->connection;
14610: return $c->aborted();
14611: }
14612:
1.221 foxr 14613: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14614: # strings as 'strings'.
14615: sub escape_single {
1.221 foxr 14616: my ($input) = @_;
1.223 albertel 14617: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14618: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14619: return $input;
14620: }
1.223 albertel 14621:
1.222 foxr 14622: # Same as escape_single, but escape's "'s This
14623: # can be used for "strings"
14624: sub escape_double {
14625: my ($input) = @_;
14626: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14627: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14628: return $input;
14629: }
1.223 albertel 14630:
1.222 foxr 14631: # Escapes the last element of a full URL.
14632: sub escape_url {
14633: my ($url) = @_;
1.238 raeburn 14634: my @urlslices = split(/\//, $url,-1);
1.369 www 14635: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 14636: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14637: }
1.462 albertel 14638:
1.820 raeburn 14639: sub compare_arrays {
14640: my ($arrayref1,$arrayref2) = @_;
14641: my (@difference,%count);
14642: @difference = ();
14643: %count = ();
14644: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14645: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14646: foreach my $element (keys(%count)) {
14647: if ($count{$element} == 1) {
14648: push(@difference,$element);
14649: }
14650: }
14651: }
14652: return @difference;
14653: }
14654:
1.817 bisitz 14655: # -------------------------------------------------------- Initialize user login
1.462 albertel 14656: sub init_user_environment {
1.463 albertel 14657: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14658: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14659:
14660: my $public=($username eq 'public' && $domain eq 'public');
14661:
14662: # See if old ID present, if so, remove
14663:
1.1062 raeburn 14664: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14665: my $now=time;
14666:
14667: if ($public) {
14668: my $max_public=100;
14669: my $oldest;
14670: my $oldest_time=0;
14671: for(my $next=1;$next<=$max_public;$next++) {
14672: if (-e $lonids."/publicuser_$next.id") {
14673: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14674: if ($mtime<$oldest_time || !$oldest_time) {
14675: $oldest_time=$mtime;
14676: $oldest=$next;
14677: }
14678: } else {
14679: $cookie="publicuser_$next";
14680: last;
14681: }
14682: }
14683: if (!$cookie) { $cookie="publicuser_$oldest"; }
14684: } else {
1.463 albertel 14685: # if this isn't a robot, kill any existing non-robot sessions
14686: if (!$args->{'robot'}) {
14687: opendir(DIR,$lonids);
14688: while ($filename=readdir(DIR)) {
14689: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14690: unlink($lonids.'/'.$filename);
14691: }
1.462 albertel 14692: }
1.463 albertel 14693: closedir(DIR);
1.1075.2.84 raeburn 14694: # If there is a undeleted lockfile for the user's paste buffer remove it.
14695: my $namespace = 'nohist_courseeditor';
14696: my $lockingkey = 'paste'."\0".'locked_num';
14697: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
14698: $domain,$username);
14699: if (exists($lockhash{$lockingkey})) {
14700: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
14701: unless ($delresult eq 'ok') {
14702: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
14703: }
14704: }
1.462 albertel 14705: }
14706: # Give them a new cookie
1.463 albertel 14707: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14708: : $now.$$.int(rand(10000)));
1.463 albertel 14709: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14710:
14711: # Initialize roles
14712:
1.1062 raeburn 14713: ($userroles,$firstaccenv,$timerintenv) =
14714: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14715: }
14716: # ------------------------------------ Check browser type and MathML capability
14717:
1.1075.2.77 raeburn 14718: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14719: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14720:
14721: # ------------------------------------------------------------- Get environment
14722:
14723: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14724: my ($tmp) = keys(%userenv);
14725: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14726: } else {
14727: undef(%userenv);
14728: }
14729: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14730: $form->{'interface'}=$userenv{'interface'};
14731: }
14732: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14733:
14734: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14735: foreach my $option ('interface','localpath','localres') {
14736: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14737: }
14738: # --------------------------------------------------------- Write first profile
14739:
14740: {
14741: my %initial_env =
14742: ("user.name" => $username,
14743: "user.domain" => $domain,
14744: "user.home" => $authhost,
14745: "browser.type" => $clientbrowser,
14746: "browser.version" => $clientversion,
14747: "browser.mathml" => $clientmathml,
14748: "browser.unicode" => $clientunicode,
14749: "browser.os" => $clientos,
1.1075.2.42 raeburn 14750: "browser.mobile" => $clientmobile,
14751: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 14752: "browser.osversion" => $clientosversion,
1.462 albertel 14753: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14754: "request.course.fn" => '',
14755: "request.course.uri" => '',
14756: "request.course.sec" => '',
14757: "request.role" => 'cm',
14758: "request.role.adv" => $env{'user.adv'},
14759: "request.host" => $ENV{'REMOTE_ADDR'},);
14760:
14761: if ($form->{'localpath'}) {
14762: $initial_env{"browser.localpath"} = $form->{'localpath'};
14763: $initial_env{"browser.localres"} = $form->{'localres'};
14764: }
14765:
14766: if ($form->{'interface'}) {
14767: $form->{'interface'}=~s/\W//gs;
14768: $initial_env{"browser.interface"} = $form->{'interface'};
14769: $env{'browser.interface'}=$form->{'interface'};
14770: }
14771:
1.1075.2.54 raeburn 14772: if ($form->{'iptoken'}) {
14773: my $lonhost = $r->dir_config('lonHostID');
14774: $initial_env{"user.noloadbalance"} = $lonhost;
14775: $env{'user.noloadbalance'} = $lonhost;
14776: }
14777:
1.981 raeburn 14778: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14779: my %domdef;
14780: unless ($domain eq 'public') {
14781: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14782: }
1.980 raeburn 14783:
1.1075.2.7 raeburn 14784: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14785: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14786: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14787: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14788: }
14789:
1.1075.2.59 raeburn 14790: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14791: $userenv{'canrequest.'.$crstype} =
14792: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14793: 'reload','requestcourses',
14794: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14795: }
14796:
1.1075.2.14 raeburn 14797: $userenv{'canrequest.author'} =
14798: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14799: 'reload','requestauthor',
14800: \%userenv,\%domdef,\%is_adv);
14801: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14802: $domain,$username);
14803: my $reqstatus = $reqauthor{'author_status'};
14804: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14805: if (ref($reqauthor{'author'}) eq 'HASH') {
14806: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14807: $reqauthor{'author'}{'timestamp'};
14808: }
14809: }
14810:
1.462 albertel 14811: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14812:
1.462 albertel 14813: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14814: &GDBM_WRCREAT(),0640)) {
14815: &_add_to_env(\%disk_env,\%initial_env);
14816: &_add_to_env(\%disk_env,\%userenv,'environment.');
14817: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14818: if (ref($firstaccenv) eq 'HASH') {
14819: &_add_to_env(\%disk_env,$firstaccenv);
14820: }
14821: if (ref($timerintenv) eq 'HASH') {
14822: &_add_to_env(\%disk_env,$timerintenv);
14823: }
1.463 albertel 14824: if (ref($args->{'extra_env'})) {
14825: &_add_to_env(\%disk_env,$args->{'extra_env'});
14826: }
1.462 albertel 14827: untie(%disk_env);
14828: } else {
1.705 tempelho 14829: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14830: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14831: return 'error: '.$!;
14832: }
14833: }
14834: $env{'request.role'}='cm';
14835: $env{'request.role.adv'}=$env{'user.adv'};
14836: $env{'browser.type'}=$clientbrowser;
14837:
14838: return $cookie;
14839:
14840: }
14841:
14842: sub _add_to_env {
14843: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14844: if (ref($env_data) eq 'HASH') {
14845: while (my ($key,$value) = each(%$env_data)) {
14846: $idf->{$prefix.$key} = $value;
14847: $env{$prefix.$key} = $value;
14848: }
1.462 albertel 14849: }
14850: }
14851:
1.685 tempelho 14852: # --- Get the symbolic name of a problem and the url
14853: sub get_symb {
14854: my ($request,$silent) = @_;
1.726 raeburn 14855: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14856: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14857: if ($symb eq '') {
14858: if (!$silent) {
1.1071 raeburn 14859: if (ref($request)) {
14860: $request->print("Unable to handle ambiguous references:$url:.");
14861: }
1.685 tempelho 14862: return ();
14863: }
14864: }
14865: &Apache::lonenc::check_decrypt(\$symb);
14866: return ($symb);
14867: }
14868:
14869: # --------------------------------------------------------------Get annotation
14870:
14871: sub get_annotation {
14872: my ($symb,$enc) = @_;
14873:
14874: my $key = $symb;
14875: if (!$enc) {
14876: $key =
14877: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14878: }
14879: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14880: return $annotation{$key};
14881: }
14882:
14883: sub clean_symb {
1.731 raeburn 14884: my ($symb,$delete_enc) = @_;
1.685 tempelho 14885:
14886: &Apache::lonenc::check_decrypt(\$symb);
14887: my $enc = $env{'request.enc'};
1.731 raeburn 14888: if ($delete_enc) {
1.730 raeburn 14889: delete($env{'request.enc'});
14890: }
1.685 tempelho 14891:
14892: return ($symb,$enc);
14893: }
1.462 albertel 14894:
1.1075.2.69 raeburn 14895: ############################################################
14896: ############################################################
14897:
14898: =pod
14899:
14900: =head1 Routines for building display used to search for courses
14901:
14902:
14903: =over 4
14904:
14905: =item * &build_filters()
14906:
14907: Create markup for a table used to set filters to use when selecting
14908: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14909: and quotacheck.pl
14910:
14911:
14912: Inputs:
14913:
14914: filterlist - anonymous array of fields to include as potential filters
14915:
14916: crstype - course type
14917:
14918: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14919: to pop-open a course selector (will contain "extra element").
14920:
14921: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14922:
14923: filter - anonymous hash of criteria and their values
14924:
14925: action - form action
14926:
14927: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14928:
14929: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
14930:
14931: cloneruname - username of owner of new course who wants to clone
14932:
14933: clonerudom - domain of owner of new course who wants to clone
14934:
14935: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14936:
14937: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14938:
14939: codedom - domain
14940:
14941: formname - value of form element named "form".
14942:
14943: fixeddom - domain, if fixed.
14944:
14945: prevphase - value to assign to form element named "phase" when going back to the previous screen
14946:
14947: cnameelement - name of form element in form on opener page which will receive title of selected course
14948:
14949: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14950:
14951: cdomelement - name of form element in form on opener page which will receive domain of selected course
14952:
14953: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14954:
14955: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14956:
14957: clonewarning - warning message about missing information for intended course owner when DC creates a course
14958:
14959:
14960: Returns: $output - HTML for display of search criteria, and hidden form elements.
14961:
14962:
14963: Side Effects: None
14964:
14965: =cut
14966:
14967: # ---------------------------------------------- search for courses based on last activity etc.
14968:
14969: sub build_filters {
14970: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14971: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14972: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14973: $cnameelement,$cnumelement,$cdomelement,$setroles,
14974: $clonetext,$clonewarning) = @_;
14975: my ($list,$jscript);
14976: my $onchange = 'javascript:updateFilters(this)';
14977: my ($domainselectform,$sincefilterform,$createdfilterform,
14978: $ownerdomselectform,$persondomselectform,$instcodeform,
14979: $typeselectform,$instcodetitle);
14980: if ($formname eq '') {
14981: $formname = $caller;
14982: }
14983: foreach my $item (@{$filterlist}) {
14984: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
14985: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
14986: if ($item eq 'domainfilter') {
14987: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
14988: } elsif ($item eq 'coursefilter') {
14989: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
14990: } elsif ($item eq 'ownerfilter') {
14991: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14992: } elsif ($item eq 'ownerdomfilter') {
14993: $filter->{'ownerdomfilter'} =
14994: &LONCAPA::clean_domain($filter->{$item});
14995: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
14996: 'ownerdomfilter',1);
14997: } elsif ($item eq 'personfilter') {
14998: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14999: } elsif ($item eq 'persondomfilter') {
15000: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15001: 'persondomfilter',1);
15002: } else {
15003: $filter->{$item} =~ s/\W//g;
15004: }
15005: if (!$filter->{$item}) {
15006: $filter->{$item} = '';
15007: }
15008: }
15009: if ($item eq 'domainfilter') {
15010: my $allow_blank = 1;
15011: if ($formname eq 'portform') {
15012: $allow_blank=0;
15013: } elsif ($formname eq 'studentform') {
15014: $allow_blank=0;
15015: }
15016: if ($fixeddom) {
15017: $domainselectform = '<input type="hidden" name="domainfilter"'.
15018: ' value="'.$codedom.'" />'.
15019: &Apache::lonnet::domain($codedom,'description');
15020: } else {
15021: $domainselectform = &select_dom_form($filter->{$item},
15022: 'domainfilter',
15023: $allow_blank,'',$onchange);
15024: }
15025: } else {
15026: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15027: }
15028: }
15029:
15030: # last course activity filter and selection
15031: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15032:
15033: # course created filter and selection
15034: if (exists($filter->{'createdfilter'})) {
15035: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15036: }
15037:
15038: my %lt = &Apache::lonlocal::texthash(
15039: 'cac' => "$crstype Activity",
15040: 'ccr' => "$crstype Created",
15041: 'cde' => "$crstype Title",
15042: 'cdo' => "$crstype Domain",
15043: 'ins' => 'Institutional Code',
15044: 'inc' => 'Institutional Categorization',
15045: 'cow' => "$crstype Owner/Co-owner",
15046: 'cop' => "$crstype Personnel Includes",
15047: 'cog' => 'Type',
15048: );
15049:
15050: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15051: my $typeval = 'Course';
15052: if ($crstype eq 'Community') {
15053: $typeval = 'Community';
15054: }
15055: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15056: } else {
15057: $typeselectform = '<select name="type" size="1"';
15058: if ($onchange) {
15059: $typeselectform .= ' onchange="'.$onchange.'"';
15060: }
15061: $typeselectform .= '>'."\n";
15062: foreach my $posstype ('Course','Community') {
15063: $typeselectform.='<option value="'.$posstype.'"'.
15064: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15065: }
15066: $typeselectform.="</select>";
15067: }
15068:
15069: my ($cloneableonlyform,$cloneabletitle);
15070: if (exists($filter->{'cloneableonly'})) {
15071: my $cloneableon = '';
15072: my $cloneableoff = ' checked="checked"';
15073: if ($filter->{'cloneableonly'}) {
15074: $cloneableon = $cloneableoff;
15075: $cloneableoff = '';
15076: }
15077: $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>';
15078: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 15079: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 15080: } else {
15081: $cloneabletitle = &mt('Cloneable by you');
15082: }
15083: }
15084: my $officialjs;
15085: if ($crstype eq 'Course') {
15086: if (exists($filter->{'instcodefilter'})) {
15087: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15088: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15089: if ($codedom) {
15090: $officialjs = 1;
15091: ($instcodeform,$jscript,$$numtitlesref) =
15092: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15093: $officialjs,$codetitlesref);
15094: if ($jscript) {
15095: $jscript = '<script type="text/javascript">'."\n".
15096: '// <![CDATA['."\n".
15097: $jscript."\n".
15098: '// ]]>'."\n".
15099: '</script>'."\n";
15100: }
15101: }
15102: if ($instcodeform eq '') {
15103: $instcodeform =
15104: '<input type="text" name="instcodefilter" size="10" value="'.
15105: $list->{'instcodefilter'}.'" />';
15106: $instcodetitle = $lt{'ins'};
15107: } else {
15108: $instcodetitle = $lt{'inc'};
15109: }
15110: if ($fixeddom) {
15111: $instcodetitle .= '<br />('.$codedom.')';
15112: }
15113: }
15114: }
15115: my $output = qq|
15116: <form method="post" name="filterpicker" action="$action">
15117: <input type="hidden" name="form" value="$formname" />
15118: |;
15119: if ($formname eq 'modifycourse') {
15120: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15121: '<input type="hidden" name="prevphase" value="'.
15122: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 15123: } elsif ($formname eq 'quotacheck') {
15124: $output .= qq|
15125: <input type="hidden" name="sortby" value="" />
15126: <input type="hidden" name="sortorder" value="" />
15127: |;
15128: } else {
1.1075.2.69 raeburn 15129: my $name_input;
15130: if ($cnameelement ne '') {
15131: $name_input = '<input type="hidden" name="cnameelement" value="'.
15132: $cnameelement.'" />';
15133: }
15134: $output .= qq|
15135: <input type="hidden" name="cnumelement" value="$cnumelement" />
15136: <input type="hidden" name="cdomelement" value="$cdomelement" />
15137: $name_input
15138: $roleelement
15139: $multelement
15140: $typeelement
15141: |;
15142: if ($formname eq 'portform') {
15143: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15144: }
15145: }
15146: if ($fixeddom) {
15147: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15148: }
15149: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15150: if ($sincefilterform) {
15151: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15152: .$sincefilterform
15153: .&Apache::lonhtmlcommon::row_closure();
15154: }
15155: if ($createdfilterform) {
15156: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15157: .$createdfilterform
15158: .&Apache::lonhtmlcommon::row_closure();
15159: }
15160: if ($domainselectform) {
15161: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15162: .$domainselectform
15163: .&Apache::lonhtmlcommon::row_closure();
15164: }
15165: if ($typeselectform) {
15166: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15167: $output .= $typeselectform;
15168: } else {
15169: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15170: .$typeselectform
15171: .&Apache::lonhtmlcommon::row_closure();
15172: }
15173: }
15174: if ($instcodeform) {
15175: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15176: .$instcodeform
15177: .&Apache::lonhtmlcommon::row_closure();
15178: }
15179: if (exists($filter->{'ownerfilter'})) {
15180: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15181: '<table><tr><td>'.&mt('Username').'<br />'.
15182: '<input type="text" name="ownerfilter" size="20" value="'.
15183: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15184: $ownerdomselectform.'</td></tr></table>'.
15185: &Apache::lonhtmlcommon::row_closure();
15186: }
15187: if (exists($filter->{'personfilter'})) {
15188: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15189: '<table><tr><td>'.&mt('Username').'<br />'.
15190: '<input type="text" name="personfilter" size="20" value="'.
15191: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15192: $persondomselectform.'</td></tr></table>'.
15193: &Apache::lonhtmlcommon::row_closure();
15194: }
15195: if (exists($filter->{'coursefilter'})) {
15196: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15197: .'<input type="text" name="coursefilter" size="25" value="'
15198: .$list->{'coursefilter'}.'" />'
15199: .&Apache::lonhtmlcommon::row_closure();
15200: }
15201: if ($cloneableonlyform) {
15202: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15203: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15204: }
15205: if (exists($filter->{'descriptfilter'})) {
15206: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15207: .'<input type="text" name="descriptfilter" size="40" value="'
15208: .$list->{'descriptfilter'}.'" />'
15209: .&Apache::lonhtmlcommon::row_closure(1);
15210: }
15211: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15212: '<input type="hidden" name="updater" value="" />'."\n".
15213: '<input type="submit" name="gosearch" value="'.
15214: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15215: return $jscript.$clonewarning.$output;
15216: }
15217:
15218: =pod
15219:
15220: =item * &timebased_select_form()
15221:
15222: Create markup for a dropdown list used to select a time-based
15223: filter e.g., Course Activity, Course Created, when searching for courses
15224: or communities
15225:
15226: Inputs:
15227:
15228: item - name of form element (sincefilter or createdfilter)
15229:
15230: filter - anonymous hash of criteria and their values
15231:
15232: Returns: HTML for a select box contained a blank, then six time selections,
15233: with value set in incoming form variables currently selected.
15234:
15235: Side Effects: None
15236:
15237: =cut
15238:
15239: sub timebased_select_form {
15240: my ($item,$filter) = @_;
15241: if (ref($filter) eq 'HASH') {
15242: $filter->{$item} =~ s/[^\d-]//g;
15243: if (!$filter->{$item}) { $filter->{$item}=-1; }
15244: return &select_form(
15245: $filter->{$item},
15246: $item,
15247: { '-1' => '',
15248: '86400' => &mt('today'),
15249: '604800' => &mt('last week'),
15250: '2592000' => &mt('last month'),
15251: '7776000' => &mt('last three months'),
15252: '15552000' => &mt('last six months'),
15253: '31104000' => &mt('last year'),
15254: 'select_form_order' =>
15255: ['-1','86400','604800','2592000','7776000',
15256: '15552000','31104000']});
15257: }
15258: }
15259:
15260: =pod
15261:
15262: =item * &js_changer()
15263:
15264: Create script tag containing Javascript used to submit course search form
15265: when course type or domain is changed, and also to hide 'Searching ...' on
15266: page load completion for page showing search result.
15267:
15268: Inputs: None
15269:
15270: Returns: markup containing updateFilters() and hideSearching() javascript functions.
15271:
15272: Side Effects: None
15273:
15274: =cut
15275:
15276: sub js_changer {
15277: return <<ENDJS;
15278: <script type="text/javascript">
15279: // <![CDATA[
15280: function updateFilters(caller) {
15281: if (typeof(caller) != "undefined") {
15282: document.filterpicker.updater.value = caller.name;
15283: }
15284: document.filterpicker.submit();
15285: }
15286:
15287: function hideSearching() {
15288: if (document.getElementById('searching')) {
15289: document.getElementById('searching').style.display = 'none';
15290: }
15291: return;
15292: }
15293:
15294: // ]]>
15295: </script>
15296:
15297: ENDJS
15298: }
15299:
15300: =pod
15301:
15302: =item * &search_courses()
15303:
15304: Process selected filters form course search form and pass to lonnet::courseiddump
15305: to retrieve a hash for which keys are courseIDs which match the selected filters.
15306:
15307: Inputs:
15308:
15309: dom - domain being searched
15310:
15311: type - course type ('Course' or 'Community' or '.' if any).
15312:
15313: filter - anonymous hash of criteria and their values
15314:
15315: numtitles - for institutional codes - number of categories
15316:
15317: cloneruname - optional username of new course owner
15318:
15319: clonerudom - optional domain of new course owner
15320:
15321: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15322: (used when DC is using course creation form)
15323:
15324: codetitles - reference to array of titles of components in institutional codes (official courses).
15325:
15326:
15327: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15328:
15329:
15330: Side Effects: None
15331:
15332: =cut
15333:
15334:
15335: sub search_courses {
15336: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15337: my (%courses,%showcourses,$cloner);
15338: if (($filter->{'ownerfilter'} ne '') ||
15339: ($filter->{'ownerdomfilter'} ne '')) {
15340: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15341: $filter->{'ownerdomfilter'};
15342: }
15343: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15344: if (!$filter->{$item}) {
15345: $filter->{$item}='.';
15346: }
15347: }
15348: my $now = time;
15349: my $timefilter =
15350: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15351: my ($createdbefore,$createdafter);
15352: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15353: $createdbefore = $now;
15354: $createdafter = $now-$filter->{'createdfilter'};
15355: }
15356: my ($instcodefilter,$regexpok);
15357: if ($numtitles) {
15358: if ($env{'form.official'} eq 'on') {
15359: $instcodefilter =
15360: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15361: $regexpok = 1;
15362: } elsif ($env{'form.official'} eq 'off') {
15363: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15364: unless ($instcodefilter eq '') {
15365: $regexpok = -1;
15366: }
15367: }
15368: } else {
15369: $instcodefilter = $filter->{'instcodefilter'};
15370: }
15371: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15372: if ($type eq '') { $type = '.'; }
15373:
15374: if (($clonerudom ne '') && ($cloneruname ne '')) {
15375: $cloner = $cloneruname.':'.$clonerudom;
15376: }
15377: %courses = &Apache::lonnet::courseiddump($dom,
15378: $filter->{'descriptfilter'},
15379: $timefilter,
15380: $instcodefilter,
15381: $filter->{'combownerfilter'},
15382: $filter->{'coursefilter'},
15383: undef,undef,$type,$regexpok,undef,undef,
15384: undef,undef,$cloner,$env{'form.cc_clone'},
15385: $filter->{'cloneableonly'},
15386: $createdbefore,$createdafter,undef,
15387: $domcloner);
15388: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15389: my $ccrole;
15390: if ($type eq 'Community') {
15391: $ccrole = 'co';
15392: } else {
15393: $ccrole = 'cc';
15394: }
15395: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15396: $filter->{'persondomfilter'},
15397: 'userroles',undef,
15398: [$ccrole,'in','ad','ep','ta','cr'],
15399: $dom);
15400: foreach my $role (keys(%rolehash)) {
15401: my ($cnum,$cdom,$courserole) = split(':',$role);
15402: my $cid = $cdom.'_'.$cnum;
15403: if (exists($courses{$cid})) {
15404: if (ref($courses{$cid}) eq 'HASH') {
15405: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15406: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15407: push (@{$courses{$cid}{roles}},$courserole);
15408: }
15409: } else {
15410: $courses{$cid}{roles} = [$courserole];
15411: }
15412: $showcourses{$cid} = $courses{$cid};
15413: }
15414: }
15415: }
15416: %courses = %showcourses;
15417: }
15418: return %courses;
15419: }
15420:
15421: =pod
15422:
15423: =back
15424:
1.1075.2.88 raeburn 15425: =head1 Routines for version requirements for current course.
15426:
15427: =over 4
15428:
15429: =item * &check_release_required()
15430:
15431: Compares required LON-CAPA version with version on server, and
15432: if required version is newer looks for a server with the required version.
15433:
15434: Looks first at servers in user's owen domain; if none suitable, looks at
15435: servers in course's domain are permitted to host sessions for user's domain.
15436:
15437: Inputs:
15438:
15439: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15440:
15441: $courseid - Course ID of current course
15442:
15443: $rolecode - User's current role in course (for switchserver query string).
15444:
15445: $required - LON-CAPA version needed by course (format: Major.Minor).
15446:
15447:
15448: Returns:
15449:
15450: $switchserver - query string tp append to /adm/switchserver call (if
15451: current server's LON-CAPA version is too old.
15452:
15453: $warning - Message is displayed if no suitable server could be found.
15454:
15455: =cut
15456:
15457: sub check_release_required {
15458: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15459: my ($switchserver,$warning);
15460: if ($required ne '') {
15461: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15462: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15463: if ($reqdmajor ne '' && $reqdminor ne '') {
15464: my $otherserver;
15465: if (($major eq '' && $minor eq '') ||
15466: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15467: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15468: my $switchlcrev =
15469: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15470: $userdomserver);
15471: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15472: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15473: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15474: my $cdom = $env{'course.'.$courseid.'.domain'};
15475: if ($cdom ne $env{'user.domain'}) {
15476: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15477: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15478: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15479: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15480: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15481: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15482: my $canhost =
15483: &Apache::lonnet::can_host_session($env{'user.domain'},
15484: $coursedomserver,
15485: $remoterev,
15486: $udomdefaults{'remotesessions'},
15487: $defdomdefaults{'hostedsessions'});
15488:
15489: if ($canhost) {
15490: $otherserver = $coursedomserver;
15491: } else {
15492: $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.");
15493: }
15494: } else {
15495: $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).");
15496: }
15497: } else {
15498: $otherserver = $userdomserver;
15499: }
15500: }
15501: if ($otherserver ne '') {
15502: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15503: }
15504: }
15505: }
15506: return ($switchserver,$warning);
15507: }
15508:
15509: =pod
15510:
15511: =item * &check_release_result()
15512:
15513: Inputs:
15514:
15515: $switchwarning - Warning message if no suitable server found to host session.
15516:
15517: $switchserver - query string to append to /adm/switchserver containing lonHostID
15518: and current role.
15519:
15520: Returns: HTML to display with information about requirement to switch server.
15521: Either displaying warning with link to Roles/Courses screen or
15522: display link to switchserver.
15523:
1.1075.2.69 raeburn 15524: =cut
15525:
1.1075.2.88 raeburn 15526: sub check_release_result {
15527: my ($switchwarning,$switchserver) = @_;
15528: my $output = &start_page('Selected course unavailable on this server').
15529: '<p class="LC_warning">';
15530: if ($switchwarning) {
15531: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15532: if (&show_course()) {
15533: $output .= &mt('Display courses');
15534: } else {
15535: $output .= &mt('Display roles');
15536: }
15537: $output .= '</a>';
15538: } elsif ($switchserver) {
15539: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15540: '<br />'.
15541: '<a href="/adm/switchserver?'.$switchserver.'">'.
15542: &mt('Switch Server').
15543: '</a>';
15544: }
15545: $output .= '</p>'.&end_page();
15546: return $output;
15547: }
15548:
15549: =pod
15550:
15551: =item * &needs_coursereinit()
15552:
15553: Determine if course contents stored for user's session needs to be
15554: refreshed, because content has changed since "Big Hash" last tied.
15555:
15556: Check for change is made if time last checked is more than 10 minutes ago
15557: (by default).
15558:
15559: Inputs:
15560:
15561: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15562:
15563: $interval (optional) - Time which may elapse (in s) between last check for content
15564: change in current course. (default: 600 s).
15565:
15566: Returns: an array; first element is:
15567:
15568: =over 4
15569:
15570: 'switch' - if content updates mean user's session
15571: needs to be switched to a server running a newer LON-CAPA version
15572:
15573: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15574: on current server hosting user's session
15575:
15576: '' - if no action required.
15577:
15578: =back
15579:
15580: If first item element is 'switch':
15581:
15582: second item is $switchwarning - Warning message if no suitable server found to host session.
15583:
15584: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15585: and current role.
15586:
15587: otherwise: no other elements returned.
15588:
15589: =back
15590:
15591: =cut
15592:
15593: sub needs_coursereinit {
15594: my ($loncaparev,$interval) = @_;
15595: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15596: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15597: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15598: my $now = time;
15599: if ($interval eq '') {
15600: $interval = 600;
15601: }
15602: if (($now-$env{'request.course.timechecked'})>$interval) {
15603: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15604: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15605: if ($lastchange > $env{'request.course.tied'}) {
15606: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15607: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15608: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15609: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15610: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15611: $curr_reqd_hash{'internal.releaserequired'}});
15612: my ($switchserver,$switchwarning) =
15613: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15614: $curr_reqd_hash{'internal.releaserequired'});
15615: if ($switchwarning ne '' || $switchserver ne '') {
15616: return ('switch',$switchwarning,$switchserver);
15617: }
15618: }
15619: }
15620: return ('update');
15621: }
15622: }
15623: return ();
15624: }
1.1075.2.69 raeburn 15625:
1.1075.2.11 raeburn 15626: sub update_content_constraints {
15627: my ($cdom,$cnum,$chome,$cid) = @_;
15628: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15629: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15630: my %checkresponsetypes;
15631: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15632: my ($item,$name,$value) = split(/:/,$key);
15633: if ($item eq 'resourcetag') {
15634: if ($name eq 'responsetype') {
15635: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15636: }
15637: }
15638: }
15639: my $navmap = Apache::lonnavmaps::navmap->new();
15640: if (defined($navmap)) {
15641: my %allresponses;
15642: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15643: my %responses = $res->responseTypes();
15644: foreach my $key (keys(%responses)) {
15645: next unless(exists($checkresponsetypes{$key}));
15646: $allresponses{$key} += $responses{$key};
15647: }
15648: }
15649: foreach my $key (keys(%allresponses)) {
15650: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15651: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15652: ($reqdmajor,$reqdminor) = ($major,$minor);
15653: }
15654: }
15655: undef($navmap);
15656: }
15657: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15658: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15659: }
15660: return;
15661: }
15662:
1.1075.2.27 raeburn 15663: sub allmaps_incourse {
15664: my ($cdom,$cnum,$chome,$cid) = @_;
15665: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15666: $cid = $env{'request.course.id'};
15667: $cdom = $env{'course.'.$cid.'.domain'};
15668: $cnum = $env{'course.'.$cid.'.num'};
15669: $chome = $env{'course.'.$cid.'.home'};
15670: }
15671: my %allmaps = ();
15672: my $lastchange =
15673: &Apache::lonnet::get_coursechange($cdom,$cnum);
15674: if ($lastchange > $env{'request.course.tied'}) {
15675: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15676: unless ($ferr) {
15677: &update_content_constraints($cdom,$cnum,$chome,$cid);
15678: }
15679: }
15680: my $navmap = Apache::lonnavmaps::navmap->new();
15681: if (defined($navmap)) {
15682: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15683: $allmaps{$res->src()} = 1;
15684: }
15685: }
15686: return \%allmaps;
15687: }
15688:
1.1075.2.11 raeburn 15689: sub parse_supplemental_title {
15690: my ($title) = @_;
15691:
15692: my ($foldertitle,$renametitle);
15693: if ($title =~ /&&&/) {
15694: $title = &HTML::Entites::decode($title);
15695: }
15696: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15697: $renametitle=$4;
15698: my ($time,$uname,$udom) = ($1,$2,$3);
15699: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15700: my $name = &plainname($uname,$udom);
15701: $name = &HTML::Entities::encode($name,'"<>&\'');
15702: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15703: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15704: $name.': <br />'.$foldertitle;
15705: }
15706: if (wantarray) {
15707: return ($title,$foldertitle,$renametitle);
15708: }
15709: return $title;
15710: }
15711:
1.1075.2.43 raeburn 15712: sub recurse_supplemental {
15713: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15714: if ($suppmap) {
15715: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15716: if ($fatal) {
15717: $errors ++;
15718: } else {
15719: if ($#LONCAPA::map::resources > 0) {
15720: foreach my $res (@LONCAPA::map::resources) {
15721: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15722: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 15723: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15724: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 15725: } else {
15726: $numfiles ++;
15727: }
15728: }
15729: }
15730: }
15731: }
15732: }
15733: return ($numfiles,$errors);
15734: }
15735:
1.1075.2.18 raeburn 15736: sub symb_to_docspath {
15737: my ($symb) = @_;
15738: return unless ($symb);
15739: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15740: if ($resurl=~/\.(sequence|page)$/) {
15741: $mapurl=$resurl;
15742: } elsif ($resurl eq 'adm/navmaps') {
15743: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15744: }
15745: my $mapresobj;
15746: my $navmap = Apache::lonnavmaps::navmap->new();
15747: if (ref($navmap)) {
15748: $mapresobj = $navmap->getResourceByUrl($mapurl);
15749: }
15750: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15751: my $type=$2;
15752: my $path;
15753: if (ref($mapresobj)) {
15754: my $pcslist = $mapresobj->map_hierarchy();
15755: if ($pcslist ne '') {
15756: foreach my $pc (split(/,/,$pcslist)) {
15757: next if ($pc <= 1);
15758: my $res = $navmap->getByMapPc($pc);
15759: if (ref($res)) {
15760: my $thisurl = $res->src();
15761: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15762: my $thistitle = $res->title();
15763: $path .= '&'.
15764: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 15765: &escape($thistitle).
1.1075.2.18 raeburn 15766: ':'.$res->randompick().
15767: ':'.$res->randomout().
15768: ':'.$res->encrypted().
15769: ':'.$res->randomorder().
15770: ':'.$res->is_page();
15771: }
15772: }
15773: }
15774: $path =~ s/^\&//;
15775: my $maptitle = $mapresobj->title();
15776: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15777: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15778: }
15779: $path .= (($path ne '')? '&' : '').
15780: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15781: &escape($maptitle).
1.1075.2.18 raeburn 15782: ':'.$mapresobj->randompick().
15783: ':'.$mapresobj->randomout().
15784: ':'.$mapresobj->encrypted().
15785: ':'.$mapresobj->randomorder().
15786: ':'.$mapresobj->is_page();
15787: } else {
15788: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15789: my $ispage = (($type eq 'page')? 1 : '');
15790: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15791: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15792: }
15793: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15794: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 15795: }
15796: unless ($mapurl eq 'default') {
15797: $path = 'default&'.
1.1075.2.46 raeburn 15798: &escape('Main Content').
1.1075.2.18 raeburn 15799: ':::::&'.$path;
15800: }
15801: return $path;
15802: }
15803:
1.1075.2.14 raeburn 15804: sub captcha_display {
15805: my ($context,$lonhost) = @_;
15806: my ($output,$error);
15807: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
15808: if ($captcha eq 'original') {
15809: $output = &create_captcha();
15810: unless ($output) {
15811: $error = 'captcha';
15812: }
15813: } elsif ($captcha eq 'recaptcha') {
15814: $output = &create_recaptcha($pubkey);
15815: unless ($output) {
15816: $error = 'recaptcha';
15817: }
15818: }
1.1075.2.66 raeburn 15819: return ($output,$error,$captcha);
1.1075.2.14 raeburn 15820: }
15821:
15822: sub captcha_response {
15823: my ($context,$lonhost) = @_;
15824: my ($captcha_chk,$captcha_error);
15825: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
15826: if ($captcha eq 'original') {
15827: ($captcha_chk,$captcha_error) = &check_captcha();
15828: } elsif ($captcha eq 'recaptcha') {
15829: $captcha_chk = &check_recaptcha($privkey);
15830: } else {
15831: $captcha_chk = 1;
15832: }
15833: return ($captcha_chk,$captcha_error);
15834: }
15835:
15836: sub get_captcha_config {
15837: my ($context,$lonhost) = @_;
15838: my ($captcha,$pubkey,$privkey,$hashtocheck);
15839: my $hostname = &Apache::lonnet::hostname($lonhost);
15840: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15841: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15842: if ($context eq 'usercreation') {
15843: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15844: if (ref($domconfig{$context}) eq 'HASH') {
15845: $hashtocheck = $domconfig{$context}{'cancreate'};
15846: if (ref($hashtocheck) eq 'HASH') {
15847: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15848: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15849: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15850: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15851: }
15852: if ($privkey && $pubkey) {
15853: $captcha = 'recaptcha';
15854: } else {
15855: $captcha = 'original';
15856: }
15857: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15858: $captcha = 'original';
15859: }
15860: }
15861: } else {
15862: $captcha = 'captcha';
15863: }
15864: } elsif ($context eq 'login') {
15865: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15866: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15867: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15868: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
15869: if ($privkey && $pubkey) {
15870: $captcha = 'recaptcha';
15871: } else {
15872: $captcha = 'original';
15873: }
15874: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15875: $captcha = 'original';
15876: }
15877: }
15878: return ($captcha,$pubkey,$privkey);
15879: }
15880:
15881: sub create_captcha {
15882: my %captcha_params = &captcha_settings();
15883: my ($output,$maxtries,$tries) = ('',10,0);
15884: while ($tries < $maxtries) {
15885: $tries ++;
15886: my $captcha = Authen::Captcha->new (
15887: output_folder => $captcha_params{'output_dir'},
15888: data_folder => $captcha_params{'db_dir'},
15889: );
15890: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15891:
15892: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15893: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15894: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 15895: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15896: '<br />'.
15897: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 15898: last;
15899: }
15900: }
15901: return $output;
15902: }
15903:
15904: sub captcha_settings {
15905: my %captcha_params = (
15906: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15907: www_output_dir => "/captchaspool",
15908: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15909: numchars => '5',
15910: );
15911: return %captcha_params;
15912: }
15913:
15914: sub check_captcha {
15915: my ($captcha_chk,$captcha_error);
15916: my $code = $env{'form.code'};
15917: my $md5sum = $env{'form.crypt'};
15918: my %captcha_params = &captcha_settings();
15919: my $captcha = Authen::Captcha->new(
15920: output_folder => $captcha_params{'output_dir'},
15921: data_folder => $captcha_params{'db_dir'},
15922: );
1.1075.2.26 raeburn 15923: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 15924: my %captcha_hash = (
15925: 0 => 'Code not checked (file error)',
15926: -1 => 'Failed: code expired',
15927: -2 => 'Failed: invalid code (not in database)',
15928: -3 => 'Failed: invalid code (code does not match crypt)',
15929: );
15930: if ($captcha_chk != 1) {
15931: $captcha_error = $captcha_hash{$captcha_chk}
15932: }
15933: return ($captcha_chk,$captcha_error);
15934: }
15935:
15936: sub create_recaptcha {
15937: my ($pubkey) = @_;
1.1075.2.51 raeburn 15938: my $use_ssl;
15939: if ($ENV{'SERVER_PORT'} == 443) {
15940: $use_ssl = 1;
15941: }
1.1075.2.14 raeburn 15942: my $captcha = Captcha::reCAPTCHA->new;
15943: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 15944: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14 raeburn 15945: &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 15946: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 15947: '<br /><br />';
15948: }
15949:
15950: sub check_recaptcha {
15951: my ($privkey) = @_;
15952: my $captcha_chk;
15953: my $captcha = Captcha::reCAPTCHA->new;
15954: my $captcha_result =
15955: $captcha->check_answer(
15956: $privkey,
15957: $ENV{'REMOTE_ADDR'},
15958: $env{'form.recaptcha_challenge_field'},
15959: $env{'form.recaptcha_response_field'},
15960: );
15961: if ($captcha_result->{is_valid}) {
15962: $captcha_chk = 1;
15963: }
15964: return $captcha_chk;
15965: }
15966:
1.1075.2.64 raeburn 15967: sub emailusername_info {
1.1075.2.67 raeburn 15968: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64 raeburn 15969: my %titles = &Apache::lonlocal::texthash (
15970: lastname => 'Last Name',
15971: firstname => 'First Name',
15972: institution => 'School/college/university',
15973: location => "School's city, state/province, country",
15974: web => "School's web address",
15975: officialemail => 'E-mail address at institution (if different)',
15976: );
15977: return (\@fields,\%titles);
15978: }
15979:
1.1075.2.56 raeburn 15980: sub cleanup_html {
15981: my ($incoming) = @_;
15982: my $outgoing;
15983: if ($incoming ne '') {
15984: $outgoing = $incoming;
15985: $outgoing =~ s/;/;/g;
15986: $outgoing =~ s/\#/#/g;
15987: $outgoing =~ s/\&/&/g;
15988: $outgoing =~ s/</</g;
15989: $outgoing =~ s/>/>/g;
15990: $outgoing =~ s/\(/(/g;
15991: $outgoing =~ s/\)/)/g;
15992: $outgoing =~ s/"/"/g;
15993: $outgoing =~ s/'/'/g;
15994: $outgoing =~ s/\$/$/g;
15995: $outgoing =~ s{/}{/}g;
15996: $outgoing =~ s/=/=/g;
15997: $outgoing =~ s/\\/\/g
15998: }
15999: return $outgoing;
16000: }
16001:
1.1075.2.74 raeburn 16002: # Checks for critical messages and returns a redirect url if one exists.
16003: # $interval indicates how often to check for messages.
16004: sub critical_redirect {
16005: my ($interval) = @_;
16006: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16007: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16008: $env{'user.name'});
16009: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
16010: my $redirecturl;
16011: if ($what[0]) {
16012: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16013: $redirecturl='/adm/email?critical=display';
16014: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16015: return (1, $url);
16016: }
16017: }
16018: }
16019: return ();
16020: }
16021:
1.1075.2.64 raeburn 16022: # Use:
16023: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16024: #
16025: ##################################################
16026: # password associated functions #
16027: ##################################################
16028: sub des_keys {
16029: # Make a new key for DES encryption.
16030: # Each key has two parts which are returned separately.
16031: # Please note: Each key must be passed through the &hex function
16032: # before it is output to the web browser. The hex versions cannot
16033: # be used to decrypt.
16034: my @hexstr=('0','1','2','3','4','5','6','7',
16035: '8','9','a','b','c','d','e','f');
16036: my $lkey='';
16037: for (0..7) {
16038: $lkey.=$hexstr[rand(15)];
16039: }
16040: my $ukey='';
16041: for (0..7) {
16042: $ukey.=$hexstr[rand(15)];
16043: }
16044: return ($lkey,$ukey);
16045: }
16046:
16047: sub des_decrypt {
16048: my ($key,$cyphertext) = @_;
16049: my $keybin=pack("H16",$key);
16050: my $cypher;
16051: if ($Crypt::DES::VERSION>=2.03) {
16052: $cypher=new Crypt::DES $keybin;
16053: } else {
16054: $cypher=new DES $keybin;
16055: }
16056: my $plaintext=
16057: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16058: $plaintext.=
16059: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16060: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16061: return $plaintext;
16062: }
16063:
1.112 bowersj2 16064: 1;
16065: __END__;
1.41 ng 16066:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>