Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.31
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.31! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.30 2013/01/28 15:52:51 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.479 albertel 72: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 73: use DateTime::TimeZone;
1.687 raeburn 74: use DateTime::Locale::Catalog;
1.1075.2.14 raeburn 75: use Authen::Captcha;
76: use Captcha::reCAPTCHA;
1.117 www 77:
1.517 raeburn 78: # ---------------------------------------------- Designs
79: use vars qw(%defaultdesign);
80:
1.22 www 81: my $readit;
82:
1.517 raeburn 83:
1.157 matthew 84: ##
85: ## Global Variables
86: ##
1.46 matthew 87:
1.643 foxr 88:
89: # ----------------------------------------------- SSI with retries:
90: #
91:
92: =pod
93:
1.648 raeburn 94: =head1 Server Side include with retries:
1.643 foxr 95:
96: =over 4
97:
1.648 raeburn 98: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 99:
100: Performs an ssi with some number of retries. Retries continue either
101: until the result is ok or until the retry count supplied by the
102: caller is exhausted.
103:
104: Inputs:
1.648 raeburn 105:
106: =over 4
107:
1.643 foxr 108: resource - Identifies the resource to insert.
1.648 raeburn 109:
1.643 foxr 110: retries - Count of the number of retries allowed.
1.648 raeburn 111:
1.643 foxr 112: form - Hash that identifies the rendering options.
113:
1.648 raeburn 114: =back
115:
116: Returns:
117:
118: =over 4
119:
1.643 foxr 120: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 121:
1.643 foxr 122: response - The response from the last attempt (which may or may not have been successful.
123:
1.648 raeburn 124: =back
125:
126: =back
127:
1.643 foxr 128: =cut
129:
130: sub ssi_with_retries {
131: my ($resource, $retries, %form) = @_;
132:
133:
134: my $ok = 0; # True if we got a good response.
135: my $content;
136: my $response;
137:
138: # Try to get the ssi done. within the retries count:
139:
140: do {
141: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
142: $ok = $response->is_success;
1.650 www 143: if (!$ok) {
144: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
145: }
1.643 foxr 146: $retries--;
147: } while (!$ok && ($retries > 0));
148:
149: if (!$ok) {
150: $content = ''; # On error return an empty content.
151: }
152: return ($content, $response);
153:
154: }
155:
156:
157:
1.20 www 158: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 159: my %language;
1.124 www 160: my %supported_language;
1.1048 foxr 161: my %latex_language; # For choosing hyphenation in <transl..>
162: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 163: my %cprtag;
1.192 taceyjo1 164: my %scprtag;
1.351 www 165: my %fe; my %fd; my %fm;
1.41 ng 166: my %category_extensions;
1.12 harris41 167:
1.46 matthew 168: # ---------------------------------------------- Thesaurus variables
1.144 matthew 169: #
170: # %Keywords:
171: # A hash used by &keyword to determine if a word is considered a keyword.
172: # $thesaurus_db_file
173: # Scalar containing the full path to the thesaurus database.
1.46 matthew 174:
175: my %Keywords;
176: my $thesaurus_db_file;
177:
1.144 matthew 178: #
179: # Initialize values from language.tab, copyright.tab, filetypes.tab,
180: # thesaurus.tab, and filecategories.tab.
181: #
1.18 www 182: BEGIN {
1.46 matthew 183: # Variable initialization
184: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
185: #
1.22 www 186: unless ($readit) {
1.12 harris41 187: # ------------------------------------------------------------------- languages
188: {
1.158 raeburn 189: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
190: '/language.tab';
191: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 192: while (my $line = <$fh>) {
193: next if ($line=~/^\#/);
194: chomp($line);
1.1048 foxr 195: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 196: $language{$key}=$val.' - '.$enc;
197: if ($sup) {
198: $supported_language{$key}=$sup;
199: }
1.1048 foxr 200: if ($latex) {
201: $latex_language_bykey{$key} = $latex;
202: $latex_language{$two} = $latex;
203: }
1.158 raeburn 204: }
205: close($fh);
206: }
1.12 harris41 207: }
208: # ------------------------------------------------------------------ copyrights
209: {
1.158 raeburn 210: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
211: '/copyright.tab';
212: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 213: while (my $line = <$fh>) {
214: next if ($line=~/^\#/);
215: chomp($line);
216: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 217: $cprtag{$key}=$val;
218: }
219: close($fh);
220: }
1.12 harris41 221: }
1.351 www 222: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 223: {
224: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
225: '/source_copyright.tab';
226: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 227: while (my $line = <$fh>) {
228: next if ($line =~ /^\#/);
229: chomp($line);
230: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 231: $scprtag{$key}=$val;
232: }
233: close($fh);
234: }
235: }
1.63 www 236:
1.517 raeburn 237: # -------------------------------------------------------------- default domain designs
1.63 www 238: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 239: my $designfile = $designdir.'/default.tab';
240: if ( open (my $fh,"<$designfile") ) {
241: while (my $line = <$fh>) {
242: next if ($line =~ /^\#/);
243: chomp($line);
244: my ($key,$val)=(split(/\=/,$line));
245: if ($val) { $defaultdesign{$key}=$val; }
246: }
247: close($fh);
1.63 www 248: }
249:
1.15 harris41 250: # ------------------------------------------------------------- file categories
251: {
1.158 raeburn 252: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
253: '/filecategories.tab';
254: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 255: while (my $line = <$fh>) {
256: next if ($line =~ /^\#/);
257: chomp($line);
258: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 259: push @{$category_extensions{lc($category)}},$extension;
260: }
261: close($fh);
262: }
263:
1.15 harris41 264: }
1.12 harris41 265: # ------------------------------------------------------------------ file types
266: {
1.158 raeburn 267: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
268: '/filetypes.tab';
269: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 270: while (my $line = <$fh>) {
271: next if ($line =~ /^\#/);
272: chomp($line);
273: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 274: if ($descr ne '') {
275: $fe{$ending}=lc($emb);
276: $fd{$ending}=$descr;
1.351 www 277: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 278: }
279: }
280: close($fh);
281: }
1.12 harris41 282: }
1.22 www 283: &Apache::lonnet::logthis(
1.705 tempelho 284: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 285: $readit=1;
1.46 matthew 286: } # end of unless($readit)
1.32 matthew 287:
288: }
1.112 bowersj2 289:
1.42 matthew 290: ###############################################################
291: ## HTML and Javascript Helper Functions ##
292: ###############################################################
293:
294: =pod
295:
1.112 bowersj2 296: =head1 HTML and Javascript Functions
1.42 matthew 297:
1.112 bowersj2 298: =over 4
299:
1.648 raeburn 300: =item * &browser_and_searcher_javascript()
1.112 bowersj2 301:
302: X<browsing, javascript>X<searching, javascript>Returns a string
303: containing javascript with two functions, C<openbrowser> and
304: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
305: tags.
1.42 matthew 306:
1.648 raeburn 307: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 308:
309: inputs: formname, elementname, only, omit
310:
311: formname and elementname indicate the name of the html form and name of
312: the element that the results of the browsing selection are to be placed in.
313:
314: Specifying 'only' will restrict the browser to displaying only files
1.185 www 315: with the given extension. Can be a comma separated list.
1.42 matthew 316:
317: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 318: with the given extension. Can be a comma separated list.
1.42 matthew 319:
1.648 raeburn 320: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 321:
322: Inputs: formname, elementname
323:
324: formname and elementname specify the name of the html form and the name
325: of the element the selection from the search results will be placed in.
1.542 raeburn 326:
1.42 matthew 327: =cut
328:
329: sub browser_and_searcher_javascript {
1.199 albertel 330: my ($mode)=@_;
331: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 332: my $resurl=&escape_single(&lastresurl());
1.42 matthew 333: return <<END;
1.219 albertel 334: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 335: var editbrowser = null;
1.135 albertel 336: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 337: var url = '$resurl/?';
1.42 matthew 338: if (editbrowser == null) {
339: url += 'launch=1&';
340: }
341: url += 'catalogmode=interactive&';
1.199 albertel 342: url += 'mode=$mode&';
1.611 albertel 343: url += 'inhibitmenu=yes&';
1.42 matthew 344: url += 'form=' + formname + '&';
345: if (only != null) {
346: url += 'only=' + only + '&';
1.217 albertel 347: } else {
348: url += 'only=&';
349: }
1.42 matthew 350: if (omit != null) {
351: url += 'omit=' + omit + '&';
1.217 albertel 352: } else {
353: url += 'omit=&';
354: }
1.135 albertel 355: if (titleelement != null) {
356: url += 'titleelement=' + titleelement + '&';
1.217 albertel 357: } else {
358: url += 'titleelement=&';
359: }
1.42 matthew 360: url += 'element=' + elementname + '';
361: var title = 'Browser';
1.435 albertel 362: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 363: options += ',width=700,height=600';
364: editbrowser = open(url,title,options,'1');
365: editbrowser.focus();
366: }
367: var editsearcher;
1.135 albertel 368: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 369: var url = '/adm/searchcat?';
370: if (editsearcher == null) {
371: url += 'launch=1&';
372: }
373: url += 'catalogmode=interactive&';
1.199 albertel 374: url += 'mode=$mode&';
1.42 matthew 375: url += 'form=' + formname + '&';
1.135 albertel 376: if (titleelement != null) {
377: url += 'titleelement=' + titleelement + '&';
1.217 albertel 378: } else {
379: url += 'titleelement=&';
380: }
1.42 matthew 381: url += 'element=' + elementname + '';
382: var title = 'Search';
1.435 albertel 383: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 384: options += ',width=700,height=600';
385: editsearcher = open(url,title,options,'1');
386: editsearcher.focus();
387: }
1.219 albertel 388: // END LON-CAPA Internal -->
1.42 matthew 389: END
1.170 www 390: }
391:
392: sub lastresurl {
1.258 albertel 393: if ($env{'environment.lastresurl'}) {
394: return $env{'environment.lastresurl'}
1.170 www 395: } else {
396: return '/res';
397: }
398: }
399:
400: sub storeresurl {
401: my $resurl=&Apache::lonnet::clutter(shift);
402: unless ($resurl=~/^\/res/) { return 0; }
403: $resurl=~s/\/$//;
404: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 405: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 406: return 1;
1.42 matthew 407: }
408:
1.74 www 409: sub studentbrowser_javascript {
1.111 www 410: unless (
1.258 albertel 411: (($env{'request.course.id'}) &&
1.302 albertel 412: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
413: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
414: '/'.$env{'request.course.sec'})
415: ))
1.258 albertel 416: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 417: ) { return ''; }
1.74 www 418: return (<<'ENDSTDBRW');
1.776 bisitz 419: <script type="text/javascript" language="Javascript">
1.824 bisitz 420: // <![CDATA[
1.74 www 421: var stdeditbrowser;
1.999 www 422: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 423: var url = '/adm/pickstudent?';
424: var filter;
1.558 albertel 425: if (!ignorefilter) {
426: eval('filter=document.'+formname+'.'+uname+'.value;');
427: }
1.74 www 428: if (filter != null) {
429: if (filter != '') {
430: url += 'filter='+filter+'&';
431: }
432: }
433: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 434: '&udomelement='+udom+
435: '&clicker='+clicker;
1.111 www 436: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 437: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 438: var title = 'Student_Browser';
1.74 www 439: var options = 'scrollbars=1,resizable=1,menubar=0';
440: options += ',width=700,height=600';
441: stdeditbrowser = open(url,title,options,'1');
442: stdeditbrowser.focus();
443: }
1.824 bisitz 444: // ]]>
1.74 www 445: </script>
446: ENDSTDBRW
447: }
1.42 matthew 448:
1.1003 www 449: sub resourcebrowser_javascript {
450: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 451: return (<<'ENDRESBRW');
1.1003 www 452: <script type="text/javascript" language="Javascript">
453: // <![CDATA[
454: var reseditbrowser;
1.1004 www 455: function openresbrowser(formname,reslink) {
1.1005 www 456: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 457: var title = 'Resource_Browser';
458: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 459: options += ',width=700,height=500';
1.1004 www 460: reseditbrowser = open(url,title,options,'1');
461: reseditbrowser.focus();
1.1003 www 462: }
463: // ]]>
464: </script>
1.1004 www 465: ENDRESBRW
1.1003 www 466: }
467:
1.74 www 468: sub selectstudent_link {
1.999 www 469: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
470: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
471: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
472: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 473: if ($env{'request.course.id'}) {
1.302 albertel 474: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
475: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
476: '/'.$env{'request.course.sec'})) {
1.111 www 477: return '';
478: }
1.999 www 479: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 480: if ($courseadvonly) {
481: $callargs .= ",'',1,1";
482: }
483: return '<span class="LC_nobreak">'.
484: '<a href="javascript:openstdbrowser('.$callargs.');">'.
485: &mt('Select User').'</a></span>';
1.74 www 486: }
1.258 albertel 487: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 488: $callargs .= ",'',1";
1.793 raeburn 489: return '<span class="LC_nobreak">'.
490: '<a href="javascript:openstdbrowser('.$callargs.');">'.
491: &mt('Select User').'</a></span>';
1.111 www 492: }
493: return '';
1.91 www 494: }
495:
1.1004 www 496: sub selectresource_link {
497: my ($form,$reslink,$arg)=@_;
498:
499: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
500: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
501: unless ($env{'request.course.id'}) { return $arg; }
502: return '<span class="LC_nobreak">'.
503: '<a href="javascript:openresbrowser('.$callargs.');">'.
504: $arg.'</a></span>';
505: }
506:
507:
508:
1.653 raeburn 509: sub authorbrowser_javascript {
510: return <<"ENDAUTHORBRW";
1.776 bisitz 511: <script type="text/javascript" language="JavaScript">
1.824 bisitz 512: // <![CDATA[
1.653 raeburn 513: var stdeditbrowser;
514:
515: function openauthorbrowser(formname,udom) {
516: var url = '/adm/pickauthor?';
517: url += 'form='+formname+'&roledom='+udom;
518: var title = 'Author_Browser';
519: var options = 'scrollbars=1,resizable=1,menubar=0';
520: options += ',width=700,height=600';
521: stdeditbrowser = open(url,title,options,'1');
522: stdeditbrowser.focus();
523: }
524:
1.824 bisitz 525: // ]]>
1.653 raeburn 526: </script>
527: ENDAUTHORBRW
528: }
529:
1.91 www 530: sub coursebrowser_javascript {
1.1075.2.31! raeburn 531: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
! 532: $credits_element) = @_;
1.932 raeburn 533: my $wintitle = 'Course_Browser';
1.931 raeburn 534: if ($crstype eq 'Community') {
1.932 raeburn 535: $wintitle = 'Community_Browser';
1.909 raeburn 536: }
1.876 raeburn 537: my $id_functions = &javascript_index_functions();
538: my $output = '
1.776 bisitz 539: <script type="text/javascript" language="JavaScript">
1.824 bisitz 540: // <![CDATA[
1.468 raeburn 541: var stdeditbrowser;'."\n";
1.876 raeburn 542:
543: $output .= <<"ENDSTDBRW";
1.909 raeburn 544: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 545: var url = '/adm/pickcourse?';
1.895 raeburn 546: var formid = getFormIdByName(formname);
1.876 raeburn 547: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 548: if (domainfilter != null) {
549: if (domainfilter != '') {
550: url += 'domainfilter='+domainfilter+'&';
551: }
552: }
1.91 www 553: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 554: '&cdomelement='+udom+
555: '&cnameelement='+desc;
1.468 raeburn 556: if (extra_element !=null && extra_element != '') {
1.594 raeburn 557: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 558: url += '&roleelement='+extra_element;
559: if (domainfilter == null || domainfilter == '') {
560: url += '&domainfilter='+extra_element;
561: }
1.234 raeburn 562: }
1.468 raeburn 563: else {
564: if (formname == 'portform') {
565: url += '&setroles='+extra_element;
1.800 raeburn 566: } else {
567: if (formname == 'rules') {
568: url += '&fixeddom='+extra_element;
569: }
1.468 raeburn 570: }
571: }
1.230 raeburn 572: }
1.909 raeburn 573: if (type != null && type != '') {
574: url += '&type='+type;
575: }
576: if (type_elem != null && type_elem != '') {
577: url += '&typeelement='+type_elem;
578: }
1.872 raeburn 579: if (formname == 'ccrs') {
580: var ownername = document.forms[formid].ccuname.value;
581: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
582: url += '&cloner='+ownername+':'+ownerdom;
583: }
1.293 raeburn 584: if (multflag !=null && multflag != '') {
585: url += '&multiple='+multflag;
586: }
1.909 raeburn 587: var title = '$wintitle';
1.91 www 588: var options = 'scrollbars=1,resizable=1,menubar=0';
589: options += ',width=700,height=600';
590: stdeditbrowser = open(url,title,options,'1');
591: stdeditbrowser.focus();
592: }
1.876 raeburn 593: $id_functions
594: ENDSTDBRW
1.1075.2.31! raeburn 595: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
! 596: $output .= &setsec_javascript($sec_element,$formname,$role_element,
! 597: $credits_element);
1.876 raeburn 598: }
599: $output .= '
600: // ]]>
601: </script>';
602: return $output;
603: }
604:
605: sub javascript_index_functions {
606: return <<"ENDJS";
607:
608: function getFormIdByName(formname) {
609: for (var i=0;i<document.forms.length;i++) {
610: if (document.forms[i].name == formname) {
611: return i;
612: }
613: }
614: return -1;
615: }
616:
617: function getIndexByName(formid,item) {
618: for (var i=0;i<document.forms[formid].elements.length;i++) {
619: if (document.forms[formid].elements[i].name == item) {
620: return i;
621: }
622: }
623: return -1;
624: }
1.468 raeburn 625:
1.876 raeburn 626: function getDomainFromSelectbox(formname,udom) {
627: var userdom;
628: var formid = getFormIdByName(formname);
629: if (formid > -1) {
630: var domid = getIndexByName(formid,udom);
631: if (domid > -1) {
632: if (document.forms[formid].elements[domid].type == 'select-one') {
633: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
634: }
635: if (document.forms[formid].elements[domid].type == 'hidden') {
636: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 637: }
638: }
639: }
1.876 raeburn 640: return userdom;
641: }
642:
643: ENDJS
1.468 raeburn 644:
1.876 raeburn 645: }
646:
1.1017 raeburn 647: sub javascript_array_indexof {
1.1018 raeburn 648: return <<ENDJS;
1.1017 raeburn 649: <script type="text/javascript" language="JavaScript">
650: // <![CDATA[
651:
652: if (!Array.prototype.indexOf) {
653: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
654: "use strict";
655: if (this === void 0 || this === null) {
656: throw new TypeError();
657: }
658: var t = Object(this);
659: var len = t.length >>> 0;
660: if (len === 0) {
661: return -1;
662: }
663: var n = 0;
664: if (arguments.length > 0) {
665: n = Number(arguments[1]);
666: if (n !== n) { // shortcut for verifying if it's NaN
667: n = 0;
668: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
669: n = (n > 0 || -1) * Math.floor(Math.abs(n));
670: }
671: }
672: if (n >= len) {
673: return -1;
674: }
675: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
676: for (; k < len; k++) {
677: if (k in t && t[k] === searchElement) {
678: return k;
679: }
680: }
681: return -1;
682: }
683: }
684:
685: // ]]>
686: </script>
687:
688: ENDJS
689:
690: }
691:
1.876 raeburn 692: sub userbrowser_javascript {
693: my $id_functions = &javascript_index_functions();
694: return <<"ENDUSERBRW";
695:
1.888 raeburn 696: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 697: var url = '/adm/pickuser?';
698: var userdom = getDomainFromSelectbox(formname,udom);
699: if (userdom != null) {
700: if (userdom != '') {
701: url += 'srchdom='+userdom+'&';
702: }
703: }
704: url += 'form=' + formname + '&unameelement='+uname+
705: '&udomelement='+udom+
706: '&ulastelement='+ulast+
707: '&ufirstelement='+ufirst+
708: '&uemailelement='+uemail+
1.881 raeburn 709: '&hideudomelement='+hideudom+
710: '&coursedom='+crsdom;
1.888 raeburn 711: if ((caller != null) && (caller != undefined)) {
712: url += '&caller='+caller;
713: }
1.876 raeburn 714: var title = 'User_Browser';
715: var options = 'scrollbars=1,resizable=1,menubar=0';
716: options += ',width=700,height=600';
717: var stdeditbrowser = open(url,title,options,'1');
718: stdeditbrowser.focus();
719: }
720:
1.888 raeburn 721: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 722: var formid = getFormIdByName(formname);
723: if (formid > -1) {
1.888 raeburn 724: var unameid = getIndexByName(formid,uname);
1.876 raeburn 725: var domid = getIndexByName(formid,udom);
726: var hidedomid = getIndexByName(formid,origdom);
727: if (hidedomid > -1) {
728: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 729: var unameval = document.forms[formid].elements[unameid].value;
730: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
731: if (domid > -1) {
732: var slct = document.forms[formid].elements[domid];
733: if (slct.type == 'select-one') {
734: var i;
735: for (i=0;i<slct.length;i++) {
736: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
737: }
738: }
739: if (slct.type == 'hidden') {
740: slct.value = fixeddom;
1.876 raeburn 741: }
742: }
1.468 raeburn 743: }
744: }
745: }
1.876 raeburn 746: return;
747: }
748:
749: $id_functions
750: ENDUSERBRW
1.468 raeburn 751: }
752:
753: sub setsec_javascript {
1.1075.2.31! raeburn 754: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 755: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
756: $communityrolestr);
757: if ($role_element ne '') {
758: my @allroles = ('st','ta','ep','in','ad');
759: foreach my $crstype ('Course','Community') {
760: if ($crstype eq 'Community') {
761: foreach my $role (@allroles) {
762: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
763: }
764: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
765: } else {
766: foreach my $role (@allroles) {
767: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
768: }
769: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
770: }
771: }
772: $rolestr = '"'.join('","',@allroles).'"';
773: $courserolestr = '"'.join('","',@courserolenames).'"';
774: $communityrolestr = '"'.join('","',@communityrolenames).'"';
775: }
1.468 raeburn 776: my $setsections = qq|
777: function setSect(sectionlist) {
1.629 raeburn 778: var sectionsArray = new Array();
779: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
780: sectionsArray = sectionlist.split(",");
781: }
1.468 raeburn 782: var numSections = sectionsArray.length;
783: document.$formname.$sec_element.length = 0;
784: if (numSections == 0) {
785: document.$formname.$sec_element.multiple=false;
786: document.$formname.$sec_element.size=1;
787: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
788: } else {
789: if (numSections == 1) {
790: document.$formname.$sec_element.multiple=false;
791: document.$formname.$sec_element.size=1;
792: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
793: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
794: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
795: } else {
796: for (var i=0; i<numSections; i++) {
797: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
798: }
799: document.$formname.$sec_element.multiple=true
800: if (numSections < 3) {
801: document.$formname.$sec_element.size=numSections;
802: } else {
803: document.$formname.$sec_element.size=3;
804: }
805: document.$formname.$sec_element.options[0].selected = false
806: }
807: }
1.91 www 808: }
1.905 raeburn 809:
810: function setRole(crstype) {
1.468 raeburn 811: |;
1.905 raeburn 812: if ($role_element eq '') {
813: $setsections .= ' return;
814: }
815: ';
816: } else {
817: $setsections .= qq|
818: var elementLength = document.$formname.$role_element.length;
819: var allroles = Array($rolestr);
820: var courserolenames = Array($courserolestr);
821: var communityrolenames = Array($communityrolestr);
822: if (elementLength != undefined) {
823: if (document.$formname.$role_element.options[5].value == 'cc') {
824: if (crstype == 'Course') {
825: return;
826: } else {
827: allroles[5] = 'co';
828: for (var i=0; i<6; i++) {
829: document.$formname.$role_element.options[i].value = allroles[i];
830: document.$formname.$role_element.options[i].text = communityrolenames[i];
831: }
832: }
833: } else {
834: if (crstype == 'Community') {
835: return;
836: } else {
837: allroles[5] = 'cc';
838: for (var i=0; i<6; i++) {
839: document.$formname.$role_element.options[i].value = allroles[i];
840: document.$formname.$role_element.options[i].text = courserolenames[i];
841: }
842: }
843: }
844: }
845: return;
846: }
847: |;
848: }
1.1075.2.31! raeburn 849: if ($credits_element) {
! 850: $setsections .= qq|
! 851: function setCredits(defaultcredits) {
! 852: document.$formname.$credits_element.value = defaultcredits;
! 853: return;
! 854: }
! 855: |;
! 856: }
1.468 raeburn 857: return $setsections;
858: }
859:
1.91 www 860: sub selectcourse_link {
1.909 raeburn 861: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
862: $typeelement) = @_;
863: my $type = $selecttype;
1.871 raeburn 864: my $linktext = &mt('Select Course');
865: if ($selecttype eq 'Community') {
1.909 raeburn 866: $linktext = &mt('Select Community');
1.906 raeburn 867: } elsif ($selecttype eq 'Course/Community') {
868: $linktext = &mt('Select Course/Community');
1.909 raeburn 869: $type = '';
1.1019 raeburn 870: } elsif ($selecttype eq 'Select') {
871: $linktext = &mt('Select');
872: $type = '';
1.871 raeburn 873: }
1.787 bisitz 874: return '<span class="LC_nobreak">'
875: ."<a href='"
876: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
877: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 878: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 879: ."'>".$linktext.'</a>'
1.787 bisitz 880: .'</span>';
1.74 www 881: }
1.42 matthew 882:
1.653 raeburn 883: sub selectauthor_link {
884: my ($form,$udom)=@_;
885: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
886: &mt('Select Author').'</a>';
887: }
888:
1.876 raeburn 889: sub selectuser_link {
1.881 raeburn 890: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 891: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 892: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 893: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 894: ');">'.$linktext.'</a>';
1.876 raeburn 895: }
896:
1.273 raeburn 897: sub check_uncheck_jscript {
898: my $jscript = <<"ENDSCRT";
899: function checkAll(field) {
900: if (field.length > 0) {
901: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 902: if (!field[i].disabled) {
903: field[i].checked = true;
904: }
1.273 raeburn 905: }
906: } else {
1.1075.2.14 raeburn 907: if (!field.disabled) {
908: field.checked = true;
909: }
1.273 raeburn 910: }
911: }
912:
913: function uncheckAll(field) {
914: if (field.length > 0) {
915: for (i = 0; i < field.length; i++) {
916: field[i].checked = false ;
1.543 albertel 917: }
918: } else {
1.273 raeburn 919: field.checked = false ;
920: }
921: }
922: ENDSCRT
923: return $jscript;
924: }
925:
1.656 www 926: sub select_timezone {
1.659 raeburn 927: my ($name,$selected,$onchange,$includeempty)=@_;
928: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
929: if ($includeempty) {
930: $output .= '<option value=""';
931: if (($selected eq '') || ($selected eq 'local')) {
932: $output .= ' selected="selected" ';
933: }
934: $output .= '> </option>';
935: }
1.657 raeburn 936: my @timezones = DateTime::TimeZone->all_names;
937: foreach my $tzone (@timezones) {
938: $output.= '<option value="'.$tzone.'"';
939: if ($tzone eq $selected) {
940: $output.=' selected="selected"';
941: }
942: $output.=">$tzone</option>\n";
1.656 www 943: }
944: $output.="</select>";
945: return $output;
946: }
1.273 raeburn 947:
1.687 raeburn 948: sub select_datelocale {
949: my ($name,$selected,$onchange,$includeempty)=@_;
950: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
951: if ($includeempty) {
952: $output .= '<option value=""';
953: if ($selected eq '') {
954: $output .= ' selected="selected" ';
955: }
956: $output .= '> </option>';
957: }
958: my (@possibles,%locale_names);
959: my @locales = DateTime::Locale::Catalog::Locales;
960: foreach my $locale (@locales) {
961: if (ref($locale) eq 'HASH') {
962: my $id = $locale->{'id'};
963: if ($id ne '') {
964: my $en_terr = $locale->{'en_territory'};
965: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 966: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 967: if (grep(/^en$/,@languages) || !@languages) {
968: if ($en_terr ne '') {
969: $locale_names{$id} = '('.$en_terr.')';
970: } elsif ($native_terr ne '') {
971: $locale_names{$id} = $native_terr;
972: }
973: } else {
974: if ($native_terr ne '') {
975: $locale_names{$id} = $native_terr.' ';
976: } elsif ($en_terr ne '') {
977: $locale_names{$id} = '('.$en_terr.')';
978: }
979: }
980: push (@possibles,$id);
981: }
982: }
983: }
984: foreach my $item (sort(@possibles)) {
985: $output.= '<option value="'.$item.'"';
986: if ($item eq $selected) {
987: $output.=' selected="selected"';
988: }
989: $output.=">$item";
990: if ($locale_names{$item} ne '') {
991: $output.=" $locale_names{$item}</option>\n";
992: }
993: $output.="</option>\n";
994: }
995: $output.="</select>";
996: return $output;
997: }
998:
1.792 raeburn 999: sub select_language {
1000: my ($name,$selected,$includeempty) = @_;
1001: my %langchoices;
1002: if ($includeempty) {
1.1075.2.29 raeburn 1003: %langchoices = ('' => &mt('No language preference'));
1.792 raeburn 1004: }
1005: foreach my $id (&languageids()) {
1006: my $code = &supportedlanguagecode($id);
1007: if ($code) {
1008: $langchoices{$code} = &plainlanguagedescription($id);
1009: }
1010: }
1.970 raeburn 1011: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1012: }
1013:
1.42 matthew 1014: =pod
1.36 matthew 1015:
1.648 raeburn 1016: =item * &linked_select_forms(...)
1.36 matthew 1017:
1018: linked_select_forms returns a string containing a <script></script> block
1019: and html for two <select> menus. The select menus will be linked in that
1020: changing the value of the first menu will result in new values being placed
1021: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1022: order unless a defined order is provided.
1.36 matthew 1023:
1024: linked_select_forms takes the following ordered inputs:
1025:
1026: =over 4
1027:
1.112 bowersj2 1028: =item * $formname, the name of the <form> tag
1.36 matthew 1029:
1.112 bowersj2 1030: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1031:
1.112 bowersj2 1032: =item * $firstdefault, the default value for the first menu
1.36 matthew 1033:
1.112 bowersj2 1034: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1035:
1.112 bowersj2 1036: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1037:
1.112 bowersj2 1038: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1039:
1.609 raeburn 1040: =item * $menuorder, the order of values in the first menu
1041:
1.1075.2.31! raeburn 1042: =item * $onchangefirst, additional javascript call to execute for an onchange
! 1043: event for the first <select> tag
! 1044:
! 1045: =item * $onchangesecond, additional javascript call to execute for an onchange
! 1046: event for the second <select> tag
! 1047:
1.41 ng 1048: =back
1049:
1.36 matthew 1050: Below is an example of such a hash. Only the 'text', 'default', and
1051: 'select2' keys must appear as stated. keys(%menu) are the possible
1052: values for the first select menu. The text that coincides with the
1.41 ng 1053: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1054: and text for the second menu are given in the hash pointed to by
1055: $menu{$choice1}->{'select2'}.
1056:
1.112 bowersj2 1057: my %menu = ( A1 => { text =>"Choice A1" ,
1058: default => "B3",
1059: select2 => {
1060: B1 => "Choice B1",
1061: B2 => "Choice B2",
1062: B3 => "Choice B3",
1063: B4 => "Choice B4"
1.609 raeburn 1064: },
1065: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1066: },
1067: A2 => { text =>"Choice A2" ,
1068: default => "C2",
1069: select2 => {
1070: C1 => "Choice C1",
1071: C2 => "Choice C2",
1072: C3 => "Choice C3"
1.609 raeburn 1073: },
1074: order => ['C2','C1','C3'],
1.112 bowersj2 1075: },
1076: A3 => { text =>"Choice A3" ,
1077: default => "D6",
1078: select2 => {
1079: D1 => "Choice D1",
1080: D2 => "Choice D2",
1081: D3 => "Choice D3",
1082: D4 => "Choice D4",
1083: D5 => "Choice D5",
1084: D6 => "Choice D6",
1085: D7 => "Choice D7"
1.609 raeburn 1086: },
1087: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1088: }
1089: );
1.36 matthew 1090:
1091: =cut
1092:
1093: sub linked_select_forms {
1094: my ($formname,
1095: $middletext,
1096: $firstdefault,
1097: $firstselectname,
1098: $secondselectname,
1.609 raeburn 1099: $hashref,
1100: $menuorder,
1.1075.2.31! raeburn 1101: $onchangefirst,
! 1102: $onchangesecond
1.36 matthew 1103: ) = @_;
1104: my $second = "document.$formname.$secondselectname";
1105: my $first = "document.$formname.$firstselectname";
1106: # output the javascript to do the changing
1107: my $result = '';
1.776 bisitz 1108: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1109: $result.="// <![CDATA[\n";
1.36 matthew 1110: $result.="var select2data = new Object();\n";
1111: $" = '","';
1112: my $debug = '';
1113: foreach my $s1 (sort(keys(%$hashref))) {
1114: $result.="select2data.d_$s1 = new Object();\n";
1115: $result.="select2data.d_$s1.def = new String('".
1116: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1117: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1118: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1119: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1120: @s2values = @{$hashref->{$s1}->{'order'}};
1121: }
1.36 matthew 1122: $result.="\"@s2values\");\n";
1123: $result.="select2data.d_$s1.texts = new Array(";
1124: my @s2texts;
1125: foreach my $value (@s2values) {
1126: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1127: }
1128: $result.="\"@s2texts\");\n";
1129: }
1130: $"=' ';
1131: $result.= <<"END";
1132:
1133: function select1_changed() {
1134: // Determine new choice
1135: var newvalue = "d_" + $first.value;
1136: // update select2
1137: var values = select2data[newvalue].values;
1138: var texts = select2data[newvalue].texts;
1139: var select2def = select2data[newvalue].def;
1140: var i;
1141: // out with the old
1142: for (i = 0; i < $second.options.length; i++) {
1143: $second.options[i] = null;
1144: }
1145: // in with the nuclear
1146: for (i=0;i<values.length; i++) {
1147: $second.options[i] = new Option(values[i]);
1.143 matthew 1148: $second.options[i].value = values[i];
1.36 matthew 1149: $second.options[i].text = texts[i];
1150: if (values[i] == select2def) {
1151: $second.options[i].selected = true;
1152: }
1153: }
1154: }
1.824 bisitz 1155: // ]]>
1.36 matthew 1156: </script>
1157: END
1158: # output the initial values for the selection lists
1.1075.2.31! raeburn 1159: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1160: my @order = sort(keys(%{$hashref}));
1161: if (ref($menuorder) eq 'ARRAY') {
1162: @order = @{$menuorder};
1163: }
1164: foreach my $value (@order) {
1.36 matthew 1165: $result.=" <option value=\"$value\" ";
1.253 albertel 1166: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1167: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1168: }
1169: $result .= "</select>\n";
1170: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1171: $result .= $middletext;
1.1075.2.31! raeburn 1172: $result .= "<select size=\"1\" name=\"$secondselectname\"";
! 1173: if ($onchangesecond) {
! 1174: $result .= ' onchange="'.$onchangesecond.'"';
! 1175: }
! 1176: $result .= ">\n";
1.36 matthew 1177: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1178:
1179: my @secondorder = sort(keys(%select2));
1180: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1181: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1182: }
1183: foreach my $value (@secondorder) {
1.36 matthew 1184: $result.=" <option value=\"$value\" ";
1.253 albertel 1185: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1186: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1187: }
1188: $result .= "</select>\n";
1189: # return $debug;
1190: return $result;
1191: } # end of sub linked_select_forms {
1192:
1.45 matthew 1193: =pod
1.44 bowersj2 1194:
1.973 raeburn 1195: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1196:
1.112 bowersj2 1197: Returns a string corresponding to an HTML link to the given help
1198: $topic, where $topic corresponds to the name of a .tex file in
1199: /home/httpd/html/adm/help/tex, with underscores replaced by
1200: spaces.
1201:
1202: $text will optionally be linked to the same topic, allowing you to
1203: link text in addition to the graphic. If you do not want to link
1204: text, but wish to specify one of the later parameters, pass an
1205: empty string.
1206:
1207: $stayOnPage is a value that will be interpreted as a boolean. If true,
1208: the link will not open a new window. If false, the link will open
1209: a new window using Javascript. (Default is false.)
1210:
1211: $width and $height are optional numerical parameters that will
1212: override the width and height of the popped up window, which may
1.973 raeburn 1213: be useful for certain help topics with big pictures included.
1214:
1215: $imgid is the id of the img tag used for the help icon. This may be
1216: used in a javascript call to switch the image src. See
1217: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1218:
1219: =cut
1220:
1221: sub help_open_topic {
1.973 raeburn 1222: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1223: $text = "" if (not defined $text);
1.44 bowersj2 1224: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1225: $width = 500 if (not defined $width);
1.44 bowersj2 1226: $height = 400 if (not defined $height);
1227: my $filename = $topic;
1228: $filename =~ s/ /_/g;
1229:
1.48 bowersj2 1230: my $template = "";
1231: my $link;
1.572 banghart 1232:
1.159 www 1233: $topic=~s/\W/\_/g;
1.44 bowersj2 1234:
1.572 banghart 1235: if (!$stayOnPage) {
1.1033 www 1236: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1237: } elsif ($stayOnPage eq 'popup') {
1238: $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 1239: } else {
1.48 bowersj2 1240: $link = "/adm/help/${filename}.hlp";
1241: }
1242:
1243: # Add the text
1.755 neumanie 1244: if ($text ne "") {
1.763 bisitz 1245: $template.='<span class="LC_help_open_topic">'
1246: .'<a target="_top" href="'.$link.'">'
1247: .$text.'</a>';
1.48 bowersj2 1248: }
1249:
1.763 bisitz 1250: # (Always) Add the graphic
1.179 matthew 1251: my $title = &mt('Online Help');
1.667 raeburn 1252: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1253: if ($imgid ne '') {
1254: $imgid = ' id="'.$imgid.'"';
1255: }
1.763 bisitz 1256: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1257: .'<img src="'.$helpicon.'" border="0"'
1258: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1259: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1260: .' /></a>';
1261: if ($text ne "") {
1262: $template.='</span>';
1263: }
1.44 bowersj2 1264: return $template;
1265:
1.106 bowersj2 1266: }
1267:
1268: # This is a quicky function for Latex cheatsheet editing, since it
1269: # appears in at least four places
1270: sub helpLatexCheatsheet {
1.1037 www 1271: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1272: my $out;
1.106 bowersj2 1273: my $addOther = '';
1.732 raeburn 1274: if ($topic) {
1.1037 www 1275: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1276: }
1277: $out = '<span>' # Start cheatsheet
1278: .$addOther
1279: .'<span>'
1.1037 www 1280: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1281: .'</span> <span>'
1.1037 www 1282: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1283: .'</span>';
1.732 raeburn 1284: unless ($not_author) {
1.763 bisitz 1285: $out .= ' <span>'
1.1037 www 1286: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763 bisitz 1287: .'</span>';
1.732 raeburn 1288: }
1.763 bisitz 1289: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1290: return $out;
1.172 www 1291: }
1292:
1.430 albertel 1293: sub general_help {
1294: my $helptopic='Student_Intro';
1295: if ($env{'request.role'}=~/^(ca|au)/) {
1296: $helptopic='Authoring_Intro';
1.907 raeburn 1297: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1298: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1299: } elsif ($env{'request.role'}=~/^dc/) {
1300: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1301: }
1302: return $helptopic;
1303: }
1304:
1305: sub update_help_link {
1306: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1307: my $origurl = $ENV{'REQUEST_URI'};
1308: $origurl=~s|^/~|/priv/|;
1309: my $timestamp = time;
1310: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1311: $$datum = &escape($$datum);
1312: }
1313:
1314: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1315: my $output .= <<"ENDOUTPUT";
1316: <script type="text/javascript">
1.824 bisitz 1317: // <![CDATA[
1.430 albertel 1318: banner_link = '$banner_link';
1.824 bisitz 1319: // ]]>
1.430 albertel 1320: </script>
1321: ENDOUTPUT
1322: return $output;
1323: }
1324:
1325: # now just updates the help link and generates a blue icon
1.193 raeburn 1326: sub help_open_menu {
1.430 albertel 1327: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1328: = @_;
1.949 droeschl 1329: $stayOnPage = 1;
1.430 albertel 1330: my $output;
1331: if ($component_help) {
1332: if (!$text) {
1333: $output=&help_open_topic($component_help,undef,$stayOnPage,
1334: $width,$height);
1335: } else {
1336: my $help_text;
1337: $help_text=&unescape($topic);
1338: $output='<table><tr><td>'.
1339: &help_open_topic($component_help,$help_text,$stayOnPage,
1340: $width,$height).'</td></tr></table>';
1341: }
1342: }
1343: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1344: return $output.$banner_link;
1345: }
1346:
1347: sub top_nav_help {
1348: my ($text) = @_;
1.436 albertel 1349: $text = &mt($text);
1.949 droeschl 1350: my $stay_on_page = 1;
1351:
1.572 banghart 1352: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1353: : "javascript:helpMenu('open')";
1.572 banghart 1354: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1355:
1.201 raeburn 1356: my $title = &mt('Get help');
1.436 albertel 1357:
1358: return <<"END";
1359: $banner_link
1360: <a href="$link" title="$title">$text</a>
1361: END
1362: }
1363:
1364: sub help_menu_js {
1365: my ($text) = @_;
1.949 droeschl 1366: my $stayOnPage = 1;
1.436 albertel 1367: my $width = 620;
1368: my $height = 600;
1.430 albertel 1369: my $helptopic=&general_help();
1370: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1371: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1372: my $start_page =
1373: &Apache::loncommon::start_page('Help Menu', undef,
1374: {'frameset' => 1,
1375: 'js_ready' => 1,
1376: 'add_entries' => {
1377: 'border' => '0',
1.579 raeburn 1378: 'rows' => "110,*",},});
1.331 albertel 1379: my $end_page =
1380: &Apache::loncommon::end_page({'frameset' => 1,
1381: 'js_ready' => 1,});
1382:
1.436 albertel 1383: my $template .= <<"ENDTEMPLATE";
1384: <script type="text/javascript">
1.877 bisitz 1385: // <![CDATA[
1.253 albertel 1386: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1387: var banner_link = '';
1.243 raeburn 1388: function helpMenu(target) {
1389: var caller = this;
1390: if (target == 'open') {
1391: var newWindow = null;
1392: try {
1.262 albertel 1393: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1394: }
1395: catch(error) {
1396: writeHelp(caller);
1397: return;
1398: }
1399: if (newWindow) {
1400: caller = newWindow;
1401: }
1.193 raeburn 1402: }
1.243 raeburn 1403: writeHelp(caller);
1404: return;
1405: }
1406: function writeHelp(caller) {
1.1072 raeburn 1407: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
1.243 raeburn 1408: caller.document.close()
1409: caller.focus()
1.193 raeburn 1410: }
1.877 bisitz 1411: // END LON-CAPA Internal -->
1.253 albertel 1412: // ]]>
1.436 albertel 1413: </script>
1.193 raeburn 1414: ENDTEMPLATE
1415: return $template;
1416: }
1417:
1.172 www 1418: sub help_open_bug {
1419: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1420: unless ($env{'user.adv'}) { return ''; }
1.172 www 1421: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1422: $text = "" if (not defined $text);
1423: $stayOnPage=1;
1.184 albertel 1424: $width = 600 if (not defined $width);
1425: $height = 600 if (not defined $height);
1.172 www 1426:
1427: $topic=~s/\W+/\+/g;
1428: my $link='';
1429: my $template='';
1.379 albertel 1430: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1431: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1432: if (!$stayOnPage)
1433: {
1434: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1435: }
1436: else
1437: {
1438: $link = $url;
1439: }
1440: # Add the text
1441: if ($text ne "")
1442: {
1443: $template .=
1444: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1445: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1446: }
1447:
1448: # Add the graphic
1.179 matthew 1449: my $title = &mt('Report a Bug');
1.215 albertel 1450: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1451: $template .= <<"ENDTEMPLATE";
1.436 albertel 1452: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1453: ENDTEMPLATE
1454: if ($text ne '') { $template.='</td></tr></table>' };
1455: return $template;
1456:
1457: }
1458:
1459: sub help_open_faq {
1460: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1461: unless ($env{'user.adv'}) { return ''; }
1.172 www 1462: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1463: $text = "" if (not defined $text);
1464: $stayOnPage=1;
1465: $width = 350 if (not defined $width);
1466: $height = 400 if (not defined $height);
1467:
1468: $topic=~s/\W+/\+/g;
1469: my $link='';
1470: my $template='';
1471: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1472: if (!$stayOnPage)
1473: {
1474: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1475: }
1476: else
1477: {
1478: $link = $url;
1479: }
1480:
1481: # Add the text
1482: if ($text ne "")
1483: {
1484: $template .=
1.173 www 1485: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1486: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1487: }
1488:
1489: # Add the graphic
1.179 matthew 1490: my $title = &mt('View the FAQ');
1.215 albertel 1491: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1492: $template .= <<"ENDTEMPLATE";
1.436 albertel 1493: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1494: ENDTEMPLATE
1495: if ($text ne '') { $template.='</td></tr></table>' };
1496: return $template;
1497:
1.44 bowersj2 1498: }
1.37 matthew 1499:
1.180 matthew 1500: ###############################################################
1501: ###############################################################
1502:
1.45 matthew 1503: =pod
1504:
1.648 raeburn 1505: =item * &change_content_javascript():
1.256 matthew 1506:
1507: This and the next function allow you to create small sections of an
1508: otherwise static HTML page that you can update on the fly with
1509: Javascript, even in Netscape 4.
1510:
1511: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1512: must be written to the HTML page once. It will prove the Javascript
1513: function "change(name, content)". Calling the change function with the
1514: name of the section
1515: you want to update, matching the name passed to C<changable_area>, and
1516: the new content you want to put in there, will put the content into
1517: that area.
1518:
1519: B<Note>: Netscape 4 only reserves enough space for the changable area
1520: to contain room for the original contents. You need to "make space"
1521: for whatever changes you wish to make, and be B<sure> to check your
1522: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1523: it's adequate for updating a one-line status display, but little more.
1524: This script will set the space to 100% width, so you only need to
1525: worry about height in Netscape 4.
1526:
1527: Modern browsers are much less limiting, and if you can commit to the
1528: user not using Netscape 4, this feature may be used freely with
1529: pretty much any HTML.
1530:
1531: =cut
1532:
1533: sub change_content_javascript {
1534: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1535: if ($env{'browser.type'} eq 'netscape' &&
1536: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1537: return (<<NETSCAPE4);
1538: function change(name, content) {
1539: doc = document.layers[name+"___escape"].layers[0].document;
1540: doc.open();
1541: doc.write(content);
1542: doc.close();
1543: }
1544: NETSCAPE4
1545: } else {
1546: # Otherwise, we need to use semi-standards-compliant code
1547: # (technically, "innerHTML" isn't standard but the equivalent
1548: # is really scary, and every useful browser supports it
1549: return (<<DOMBASED);
1550: function change(name, content) {
1551: element = document.getElementById(name);
1552: element.innerHTML = content;
1553: }
1554: DOMBASED
1555: }
1556: }
1557:
1558: =pod
1559:
1.648 raeburn 1560: =item * &changable_area($name,$origContent):
1.256 matthew 1561:
1562: This provides a "changable area" that can be modified on the fly via
1563: the Javascript code provided in C<change_content_javascript>. $name is
1564: the name you will use to reference the area later; do not repeat the
1565: same name on a given HTML page more then once. $origContent is what
1566: the area will originally contain, which can be left blank.
1567:
1568: =cut
1569:
1570: sub changable_area {
1571: my ($name, $origContent) = @_;
1572:
1.258 albertel 1573: if ($env{'browser.type'} eq 'netscape' &&
1574: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1575: # If this is netscape 4, we need to use the Layer tag
1576: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1577: } else {
1578: return "<span id='$name'>$origContent</span>";
1579: }
1580: }
1581:
1582: =pod
1583:
1.648 raeburn 1584: =item * &viewport_geometry_js
1.590 raeburn 1585:
1586: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1587:
1588: =cut
1589:
1590:
1591: sub viewport_geometry_js {
1592: return <<"GEOMETRY";
1593: var Geometry = {};
1594: function init_geometry() {
1595: if (Geometry.init) { return };
1596: Geometry.init=1;
1597: if (window.innerHeight) {
1598: Geometry.getViewportHeight = function() { return window.innerHeight; };
1599: Geometry.getViewportWidth = function() { return window.innerWidth; };
1600: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1601: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1602: }
1603: else if (document.documentElement && document.documentElement.clientHeight) {
1604: Geometry.getViewportHeight =
1605: function() { return document.documentElement.clientHeight; };
1606: Geometry.getViewportWidth =
1607: function() { return document.documentElement.clientWidth; };
1608:
1609: Geometry.getHorizontalScroll =
1610: function() { return document.documentElement.scrollLeft; };
1611: Geometry.getVerticalScroll =
1612: function() { return document.documentElement.scrollTop; };
1613: }
1614: else if (document.body.clientHeight) {
1615: Geometry.getViewportHeight =
1616: function() { return document.body.clientHeight; };
1617: Geometry.getViewportWidth =
1618: function() { return document.body.clientWidth; };
1619: Geometry.getHorizontalScroll =
1620: function() { return document.body.scrollLeft; };
1621: Geometry.getVerticalScroll =
1622: function() { return document.body.scrollTop; };
1623: }
1624: }
1625:
1626: GEOMETRY
1627: }
1628:
1629: =pod
1630:
1.648 raeburn 1631: =item * &viewport_size_js()
1.590 raeburn 1632:
1633: 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.
1634:
1635: =cut
1636:
1637: sub viewport_size_js {
1638: my $geometry = &viewport_geometry_js();
1639: return <<"DIMS";
1640:
1641: $geometry
1642:
1643: function getViewportDims(width,height) {
1644: init_geometry();
1645: width.value = Geometry.getViewportWidth();
1646: height.value = Geometry.getViewportHeight();
1647: return;
1648: }
1649:
1650: DIMS
1651: }
1652:
1653: =pod
1654:
1.648 raeburn 1655: =item * &resize_textarea_js()
1.565 albertel 1656:
1657: emits the needed javascript to resize a textarea to be as big as possible
1658:
1659: creates a function resize_textrea that takes two IDs first should be
1660: the id of the element to resize, second should be the id of a div that
1661: surrounds everything that comes after the textarea, this routine needs
1662: to be attached to the <body> for the onload and onresize events.
1663:
1.648 raeburn 1664: =back
1.565 albertel 1665:
1666: =cut
1667:
1668: sub resize_textarea_js {
1.590 raeburn 1669: my $geometry = &viewport_geometry_js();
1.565 albertel 1670: return <<"RESIZE";
1671: <script type="text/javascript">
1.824 bisitz 1672: // <![CDATA[
1.590 raeburn 1673: $geometry
1.565 albertel 1674:
1.588 albertel 1675: function getX(element) {
1676: var x = 0;
1677: while (element) {
1678: x += element.offsetLeft;
1679: element = element.offsetParent;
1680: }
1681: return x;
1682: }
1683: function getY(element) {
1684: var y = 0;
1685: while (element) {
1686: y += element.offsetTop;
1687: element = element.offsetParent;
1688: }
1689: return y;
1690: }
1691:
1692:
1.565 albertel 1693: function resize_textarea(textarea_id,bottom_id) {
1694: init_geometry();
1695: var textarea = document.getElementById(textarea_id);
1696: //alert(textarea);
1697:
1.588 albertel 1698: var textarea_top = getY(textarea);
1.565 albertel 1699: var textarea_height = textarea.offsetHeight;
1700: var bottom = document.getElementById(bottom_id);
1.588 albertel 1701: var bottom_top = getY(bottom);
1.565 albertel 1702: var bottom_height = bottom.offsetHeight;
1703: var window_height = Geometry.getViewportHeight();
1.588 albertel 1704: var fudge = 23;
1.565 albertel 1705: var new_height = window_height-fudge-textarea_top-bottom_height;
1706: if (new_height < 300) {
1707: new_height = 300;
1708: }
1709: textarea.style.height=new_height+'px';
1710: }
1.824 bisitz 1711: // ]]>
1.565 albertel 1712: </script>
1713: RESIZE
1714:
1715: }
1716:
1717: =pod
1718:
1.256 matthew 1719: =head1 Excel and CSV file utility routines
1720:
1721: =over 4
1722:
1723: =cut
1724:
1725: ###############################################################
1726: ###############################################################
1727:
1728: =pod
1729:
1.648 raeburn 1730: =item * &csv_translate($text)
1.37 matthew 1731:
1.185 www 1732: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1733: format.
1734:
1735: =cut
1736:
1.180 matthew 1737: ###############################################################
1738: ###############################################################
1.37 matthew 1739: sub csv_translate {
1740: my $text = shift;
1741: $text =~ s/\"/\"\"/g;
1.209 albertel 1742: $text =~ s/\n/ /g;
1.37 matthew 1743: return $text;
1744: }
1.180 matthew 1745:
1746: ###############################################################
1747: ###############################################################
1748:
1749: =pod
1750:
1.648 raeburn 1751: =item * &define_excel_formats()
1.180 matthew 1752:
1753: Define some commonly used Excel cell formats.
1754:
1755: Currently supported formats:
1756:
1757: =over 4
1758:
1759: =item header
1760:
1761: =item bold
1762:
1763: =item h1
1764:
1765: =item h2
1766:
1767: =item h3
1768:
1.256 matthew 1769: =item h4
1770:
1771: =item i
1772:
1.180 matthew 1773: =item date
1774:
1775: =back
1776:
1777: Inputs: $workbook
1778:
1779: Returns: $format, a hash reference.
1780:
1.1057 foxr 1781:
1.180 matthew 1782: =cut
1783:
1784: ###############################################################
1785: ###############################################################
1786: sub define_excel_formats {
1787: my ($workbook) = @_;
1788: my $format;
1789: $format->{'header'} = $workbook->add_format(bold => 1,
1790: bottom => 1,
1791: align => 'center');
1792: $format->{'bold'} = $workbook->add_format(bold=>1);
1793: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1794: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1795: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1796: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1797: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1798: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1799: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1800: return $format;
1801: }
1802:
1803: ###############################################################
1804: ###############################################################
1.113 bowersj2 1805:
1806: =pod
1807:
1.648 raeburn 1808: =item * &create_workbook()
1.255 matthew 1809:
1810: Create an Excel worksheet. If it fails, output message on the
1811: request object and return undefs.
1812:
1813: Inputs: Apache request object
1814:
1815: Returns (undef) on failure,
1816: Excel worksheet object, scalar with filename, and formats
1817: from &Apache::loncommon::define_excel_formats on success
1818:
1819: =cut
1820:
1821: ###############################################################
1822: ###############################################################
1823: sub create_workbook {
1824: my ($r) = @_;
1825: #
1826: # Create the excel spreadsheet
1827: my $filename = '/prtspool/'.
1.258 albertel 1828: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1829: time.'_'.rand(1000000000).'.xls';
1830: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1831: if (! defined($workbook)) {
1832: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1833: $r->print(
1834: '<p class="LC_error">'
1835: .&mt('Problems occurred in creating the new Excel file.')
1836: .' '.&mt('This error has been logged.')
1837: .' '.&mt('Please alert your LON-CAPA administrator.')
1838: .'</p>'
1839: );
1.255 matthew 1840: return (undef);
1841: }
1842: #
1.1014 foxr 1843: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1844: #
1845: my $format = &Apache::loncommon::define_excel_formats($workbook);
1846: return ($workbook,$filename,$format);
1847: }
1848:
1849: ###############################################################
1850: ###############################################################
1851:
1852: =pod
1853:
1.648 raeburn 1854: =item * &create_text_file()
1.113 bowersj2 1855:
1.542 raeburn 1856: Create a file to write to and eventually make available to the user.
1.256 matthew 1857: If file creation fails, outputs an error message on the request object and
1858: return undefs.
1.113 bowersj2 1859:
1.256 matthew 1860: Inputs: Apache request object, and file suffix
1.113 bowersj2 1861:
1.256 matthew 1862: Returns (undef) on failure,
1863: Filehandle and filename on success.
1.113 bowersj2 1864:
1865: =cut
1866:
1.256 matthew 1867: ###############################################################
1868: ###############################################################
1869: sub create_text_file {
1870: my ($r,$suffix) = @_;
1871: if (! defined($suffix)) { $suffix = 'txt'; };
1872: my $fh;
1873: my $filename = '/prtspool/'.
1.258 albertel 1874: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1875: time.'_'.rand(1000000000).'.'.$suffix;
1876: $fh = Apache::File->new('>/home/httpd'.$filename);
1877: if (! defined($fh)) {
1878: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1879: $r->print(
1880: '<p class="LC_error">'
1881: .&mt('Problems occurred in creating the output file.')
1882: .' '.&mt('This error has been logged.')
1883: .' '.&mt('Please alert your LON-CAPA administrator.')
1884: .'</p>'
1885: );
1.113 bowersj2 1886: }
1.256 matthew 1887: return ($fh,$filename)
1.113 bowersj2 1888: }
1889:
1890:
1.256 matthew 1891: =pod
1.113 bowersj2 1892:
1893: =back
1894:
1895: =cut
1.37 matthew 1896:
1897: ###############################################################
1.33 matthew 1898: ## Home server <option> list generating code ##
1899: ###############################################################
1.35 matthew 1900:
1.169 www 1901: # ------------------------------------------
1902:
1903: sub domain_select {
1904: my ($name,$value,$multiple)=@_;
1905: my %domains=map {
1.514 albertel 1906: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1907: } &Apache::lonnet::all_domains();
1.169 www 1908: if ($multiple) {
1909: $domains{''}=&mt('Any domain');
1.550 albertel 1910: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1911: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1912: } else {
1.550 albertel 1913: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1914: return &select_form($name,$value,\%domains);
1.169 www 1915: }
1916: }
1917:
1.282 albertel 1918: #-------------------------------------------
1919:
1920: =pod
1921:
1.519 raeburn 1922: =head1 Routines for form select boxes
1923:
1924: =over 4
1925:
1.648 raeburn 1926: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1927:
1928: Returns a string containing a <select> element int multiple mode
1929:
1930:
1931: Args:
1932: $name - name of the <select> element
1.506 raeburn 1933: $value - scalar or array ref of values that should already be selected
1.282 albertel 1934: $size - number of rows long the select element is
1.283 albertel 1935: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1936: (shown text should already have been &mt())
1.506 raeburn 1937: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1938:
1.282 albertel 1939: =cut
1940:
1941: #-------------------------------------------
1.169 www 1942: sub multiple_select_form {
1.284 albertel 1943: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1944: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1945: my $output='';
1.191 matthew 1946: if (! defined($size)) {
1947: $size = 4;
1.283 albertel 1948: if (scalar(keys(%$hash))<4) {
1949: $size = scalar(keys(%$hash));
1.191 matthew 1950: }
1951: }
1.734 bisitz 1952: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1953: my @order;
1.506 raeburn 1954: if (ref($order) eq 'ARRAY') {
1955: @order = @{$order};
1956: } else {
1957: @order = sort(keys(%$hash));
1.501 banghart 1958: }
1959: if (exists($$hash{'select_form_order'})) {
1960: @order = @{$$hash{'select_form_order'}};
1961: }
1962:
1.284 albertel 1963: foreach my $key (@order) {
1.356 albertel 1964: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1965: $output.='selected="selected" ' if ($selected{$key});
1966: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1967: }
1968: $output.="</select>\n";
1969: return $output;
1970: }
1971:
1.88 www 1972: #-------------------------------------------
1973:
1974: =pod
1975:
1.970 raeburn 1976: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 1977:
1978: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 1979: allow a user to select options from a ref to a hash containing:
1980: option_name => displayed text. An optional $onchange can include
1981: a javascript onchange item, e.g., onchange="this.form.submit();"
1982:
1.88 www 1983: See lonrights.pm for an example invocation and use.
1984:
1985: =cut
1986:
1987: #-------------------------------------------
1988: sub select_form {
1.970 raeburn 1989: my ($def,$name,$hashref,$onchange) = @_;
1990: return unless (ref($hashref) eq 'HASH');
1991: if ($onchange) {
1992: $onchange = ' onchange="'.$onchange.'"';
1993: }
1994: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 1995: my @keys;
1.970 raeburn 1996: if (exists($hashref->{'select_form_order'})) {
1997: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 1998: } else {
1.970 raeburn 1999: @keys=sort(keys(%{$hashref}));
1.128 albertel 2000: }
1.356 albertel 2001: foreach my $key (@keys) {
2002: $selectform.=
2003: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2004: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2005: ">".$hashref->{$key}."</option>\n";
1.88 www 2006: }
2007: $selectform.="</select>";
2008: return $selectform;
2009: }
2010:
1.475 www 2011: # For display filters
2012:
2013: sub display_filter {
1.1074 raeburn 2014: my ($context) = @_;
1.475 www 2015: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2016: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2017: my $phraseinput = 'hidden';
2018: my $includeinput = 'hidden';
2019: my ($checked,$includetypestext);
2020: if ($env{'form.displayfilter'} eq 'containing') {
2021: $phraseinput = 'text';
2022: if ($context eq 'parmslog') {
2023: $includeinput = 'checkbox';
2024: if ($env{'form.includetypes'}) {
2025: $checked = ' checked="checked"';
2026: }
2027: $includetypestext = &mt('Include parameter types');
2028: }
2029: } else {
2030: $includetypestext = ' ';
2031: }
2032: my ($additional,$secondid,$thirdid);
2033: if ($context eq 'parmslog') {
2034: $additional =
2035: '<label><input type="'.$includeinput.'" name="includetypes"'.
2036: $checked.' name="includetypes" value="1" id="includetypes" />'.
2037: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2038: '</label>';
2039: $secondid = 'includetypes';
2040: $thirdid = 'includetypestext';
2041: }
2042: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2043: '$secondid','$thirdid')";
2044: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2045: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2046: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2047: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2048: &mt('Filter: [_1]',
1.477 www 2049: &select_form($env{'form.displayfilter'},
2050: 'displayfilter',
1.970 raeburn 2051: {'currentfolder' => 'Current folder/page',
1.477 www 2052: 'containing' => 'Containing phrase',
1.1074 raeburn 2053: 'none' => 'None'},$onchange)).' '.
2054: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2055: &HTML::Entities::encode($env{'form.containingphrase'}).
2056: '" />'.$additional;
2057: }
2058:
2059: sub display_filter_js {
2060: my $includetext = &mt('Include parameter types');
2061: return <<"ENDJS";
2062:
2063: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2064: var firstType = 'hidden';
2065: if (setter.options[setter.selectedIndex].value == 'containing') {
2066: firstType = 'text';
2067: }
2068: firstObject = document.getElementById(firstid);
2069: if (typeof(firstObject) == 'object') {
2070: if (firstObject.type != firstType) {
2071: changeInputType(firstObject,firstType);
2072: }
2073: }
2074: if (context == 'parmslog') {
2075: var secondType = 'hidden';
2076: if (firstType == 'text') {
2077: secondType = 'checkbox';
2078: }
2079: secondObject = document.getElementById(secondid);
2080: if (typeof(secondObject) == 'object') {
2081: if (secondObject.type != secondType) {
2082: changeInputType(secondObject,secondType);
2083: }
2084: }
2085: var textItem = document.getElementById(thirdid);
2086: var currtext = textItem.innerHTML;
2087: var newtext;
2088: if (firstType == 'text') {
2089: newtext = '$includetext';
2090: } else {
2091: newtext = ' ';
2092: }
2093: if (currtext != newtext) {
2094: textItem.innerHTML = newtext;
2095: }
2096: }
2097: return;
2098: }
2099:
2100: function changeInputType(oldObject,newType) {
2101: var newObject = document.createElement('input');
2102: newObject.type = newType;
2103: if (oldObject.size) {
2104: newObject.size = oldObject.size;
2105: }
2106: if (oldObject.value) {
2107: newObject.value = oldObject.value;
2108: }
2109: if (oldObject.name) {
2110: newObject.name = oldObject.name;
2111: }
2112: if (oldObject.id) {
2113: newObject.id = oldObject.id;
2114: }
2115: oldObject.parentNode.replaceChild(newObject,oldObject);
2116: return;
2117: }
2118:
2119: ENDJS
1.475 www 2120: }
2121:
1.167 www 2122: sub gradeleveldescription {
2123: my $gradelevel=shift;
2124: my %gradelevels=(0 => 'Not specified',
2125: 1 => 'Grade 1',
2126: 2 => 'Grade 2',
2127: 3 => 'Grade 3',
2128: 4 => 'Grade 4',
2129: 5 => 'Grade 5',
2130: 6 => 'Grade 6',
2131: 7 => 'Grade 7',
2132: 8 => 'Grade 8',
2133: 9 => 'Grade 9',
2134: 10 => 'Grade 10',
2135: 11 => 'Grade 11',
2136: 12 => 'Grade 12',
2137: 13 => 'Grade 13',
2138: 14 => '100 Level',
2139: 15 => '200 Level',
2140: 16 => '300 Level',
2141: 17 => '400 Level',
2142: 18 => 'Graduate Level');
2143: return &mt($gradelevels{$gradelevel});
2144: }
2145:
1.163 www 2146: sub select_level_form {
2147: my ($deflevel,$name)=@_;
2148: unless ($deflevel) { $deflevel=0; }
1.167 www 2149: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2150: for (my $i=0; $i<=18; $i++) {
2151: $selectform.="<option value=\"$i\" ".
1.253 albertel 2152: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2153: ">".&gradeleveldescription($i)."</option>\n";
2154: }
2155: $selectform.="</select>";
2156: return $selectform;
1.163 www 2157: }
1.167 www 2158:
1.35 matthew 2159: #-------------------------------------------
2160:
1.45 matthew 2161: =pod
2162:
1.910 raeburn 2163: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35 matthew 2164:
2165: Returns a string containing a <select name='$name' size='1'> form to
2166: allow a user to select the domain to preform an operation in.
2167: See loncreateuser.pm for an example invocation and use.
2168:
1.90 www 2169: If the $includeempty flag is set, it also includes an empty choice ("no domain
2170: selected");
2171:
1.743 raeburn 2172: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2173:
1.910 raeburn 2174: 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.
2175:
2176: The optional $incdoms is a reference to an array of domains which will be the only available options.
1.563 raeburn 2177:
1.35 matthew 2178: =cut
2179:
2180: #-------------------------------------------
1.34 matthew 2181: sub select_dom_form {
1.910 raeburn 2182: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872 raeburn 2183: if ($onchange) {
1.874 raeburn 2184: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2185: }
1.910 raeburn 2186: my @domains;
2187: if (ref($incdoms) eq 'ARRAY') {
2188: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2189: } else {
2190: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2191: }
1.90 www 2192: if ($includeempty) { @domains=('',@domains); }
1.743 raeburn 2193: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2194: foreach my $dom (@domains) {
2195: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2196: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2197: if ($showdomdesc) {
2198: if ($dom ne '') {
2199: my $domdesc = &Apache::lonnet::domain($dom,'description');
2200: if ($domdesc ne '') {
2201: $selectdomain .= ' ('.$domdesc.')';
2202: }
2203: }
2204: }
2205: $selectdomain .= "</option>\n";
1.34 matthew 2206: }
2207: $selectdomain.="</select>";
2208: return $selectdomain;
2209: }
2210:
1.35 matthew 2211: #-------------------------------------------
2212:
1.45 matthew 2213: =pod
2214:
1.648 raeburn 2215: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2216:
1.586 raeburn 2217: input: 4 arguments (two required, two optional) -
2218: $domain - domain of new user
2219: $name - name of form element
2220: $default - Value of 'default' causes a default item to be first
2221: option, and selected by default.
2222: $hide - Value of 'hide' causes hiding of the name of the server,
2223: if 1 server found, or default, if 0 found.
1.594 raeburn 2224: output: returns 2 items:
1.586 raeburn 2225: (a) form element which contains either:
2226: (i) <select name="$name">
2227: <option value="$hostid1">$hostid $servers{$hostid}</option>
2228: <option value="$hostid2">$hostid $servers{$hostid}</option>
2229: </select>
2230: form item if there are multiple library servers in $domain, or
2231: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2232: if there is only one library server in $domain.
2233:
2234: (b) number of library servers found.
2235:
2236: See loncreateuser.pm for example of use.
1.35 matthew 2237:
2238: =cut
2239:
2240: #-------------------------------------------
1.586 raeburn 2241: sub home_server_form_item {
2242: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2243: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2244: my $result;
2245: my $numlib = keys(%servers);
2246: if ($numlib > 1) {
2247: $result .= '<select name="'.$name.'" />'."\n";
2248: if ($default) {
1.804 bisitz 2249: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2250: '</option>'."\n";
2251: }
2252: foreach my $hostid (sort(keys(%servers))) {
2253: $result.= '<option value="'.$hostid.'">'.
2254: $hostid.' '.$servers{$hostid}."</option>\n";
2255: }
2256: $result .= '</select>'."\n";
2257: } elsif ($numlib == 1) {
2258: my $hostid;
2259: foreach my $item (keys(%servers)) {
2260: $hostid = $item;
2261: }
2262: $result .= '<input type="hidden" name="'.$name.'" value="'.
2263: $hostid.'" />';
2264: if (!$hide) {
2265: $result .= $hostid.' '.$servers{$hostid};
2266: }
2267: $result .= "\n";
2268: } elsif ($default) {
2269: $result .= '<input type="hidden" name="'.$name.
2270: '" value="default" />';
2271: if (!$hide) {
2272: $result .= &mt('default');
2273: }
2274: $result .= "\n";
1.33 matthew 2275: }
1.586 raeburn 2276: return ($result,$numlib);
1.33 matthew 2277: }
1.112 bowersj2 2278:
2279: =pod
2280:
1.534 albertel 2281: =back
2282:
1.112 bowersj2 2283: =cut
1.87 matthew 2284:
2285: ###############################################################
1.112 bowersj2 2286: ## Decoding User Agent ##
1.87 matthew 2287: ###############################################################
2288:
2289: =pod
2290:
1.112 bowersj2 2291: =head1 Decoding the User Agent
2292:
2293: =over 4
2294:
2295: =item * &decode_user_agent()
1.87 matthew 2296:
2297: Inputs: $r
2298:
2299: Outputs:
2300:
2301: =over 4
2302:
1.112 bowersj2 2303: =item * $httpbrowser
1.87 matthew 2304:
1.112 bowersj2 2305: =item * $clientbrowser
1.87 matthew 2306:
1.112 bowersj2 2307: =item * $clientversion
1.87 matthew 2308:
1.112 bowersj2 2309: =item * $clientmathml
1.87 matthew 2310:
1.112 bowersj2 2311: =item * $clientunicode
1.87 matthew 2312:
1.112 bowersj2 2313: =item * $clientos
1.87 matthew 2314:
2315: =back
2316:
1.157 matthew 2317: =back
2318:
1.87 matthew 2319: =cut
2320:
2321: ###############################################################
2322: ###############################################################
2323: sub decode_user_agent {
1.247 albertel 2324: my ($r)=@_;
1.87 matthew 2325: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2326: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2327: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2328: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2329: my $clientbrowser='unknown';
2330: my $clientversion='0';
2331: my $clientmathml='';
2332: my $clientunicode='0';
2333: for (my $i=0;$i<=$#browsertype;$i++) {
2334: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2335: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2336: $clientbrowser=$bname;
2337: $httpbrowser=~/$vreg/i;
2338: $clientversion=$1;
2339: $clientmathml=($clientversion>=$minv);
2340: $clientunicode=($clientversion>=$univ);
2341: }
2342: }
2343: my $clientos='unknown';
2344: if (($httpbrowser=~/linux/i) ||
2345: ($httpbrowser=~/unix/i) ||
2346: ($httpbrowser=~/ux/i) ||
2347: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2348: if (($httpbrowser=~/vax/i) ||
2349: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2350: if ($httpbrowser=~/next/i) { $clientos='next'; }
2351: if (($httpbrowser=~/mac/i) ||
2352: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2353: if ($httpbrowser=~/win/i) { $clientos='win'; }
2354: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2355: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2356: $clientunicode,$clientos,);
2357: }
2358:
1.32 matthew 2359: ###############################################################
2360: ## Authentication changing form generation subroutines ##
2361: ###############################################################
2362: ##
2363: ## All of the authform_xxxxxxx subroutines take their inputs in a
2364: ## hash, and have reasonable default values.
2365: ##
2366: ## formname = the name given in the <form> tag.
1.35 matthew 2367: #-------------------------------------------
2368:
1.45 matthew 2369: =pod
2370:
1.112 bowersj2 2371: =head1 Authentication Routines
2372:
2373: =over 4
2374:
1.648 raeburn 2375: =item * &authform_xxxxxx()
1.35 matthew 2376:
2377: The authform_xxxxxx subroutines provide javascript and html forms which
2378: handle some of the conveniences required for authentication forms.
2379: This is not an optimal method, but it works.
2380:
2381: =over 4
2382:
1.112 bowersj2 2383: =item * authform_header
1.35 matthew 2384:
1.112 bowersj2 2385: =item * authform_authorwarning
1.35 matthew 2386:
1.112 bowersj2 2387: =item * authform_nochange
1.35 matthew 2388:
1.112 bowersj2 2389: =item * authform_kerberos
1.35 matthew 2390:
1.112 bowersj2 2391: =item * authform_internal
1.35 matthew 2392:
1.112 bowersj2 2393: =item * authform_filesystem
1.35 matthew 2394:
2395: =back
2396:
1.648 raeburn 2397: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2398:
1.35 matthew 2399: =cut
2400:
2401: #-------------------------------------------
1.32 matthew 2402: sub authform_header{
2403: my %in = (
2404: formname => 'cu',
1.80 albertel 2405: kerb_def_dom => '',
1.32 matthew 2406: @_,
2407: );
2408: $in{'formname'} = 'document.' . $in{'formname'};
2409: my $result='';
1.80 albertel 2410:
2411: #---------------------------------------------- Code for upper case translation
2412: my $Javascript_toUpperCase;
2413: unless ($in{kerb_def_dom}) {
2414: $Javascript_toUpperCase =<<"END";
2415: switch (choice) {
2416: case 'krb': currentform.elements[choicearg].value =
2417: currentform.elements[choicearg].value.toUpperCase();
2418: break;
2419: default:
2420: }
2421: END
2422: } else {
2423: $Javascript_toUpperCase = "";
2424: }
2425:
1.165 raeburn 2426: my $radioval = "'nochange'";
1.591 raeburn 2427: if (defined($in{'curr_authtype'})) {
2428: if ($in{'curr_authtype'} ne '') {
2429: $radioval = "'".$in{'curr_authtype'}."arg'";
2430: }
1.174 matthew 2431: }
1.165 raeburn 2432: my $argfield = 'null';
1.591 raeburn 2433: if (defined($in{'mode'})) {
1.165 raeburn 2434: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2435: if (defined($in{'curr_autharg'})) {
2436: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2437: $argfield = "'$in{'curr_autharg'}'";
2438: }
2439: }
2440: }
2441: }
2442:
1.32 matthew 2443: $result.=<<"END";
2444: var current = new Object();
1.165 raeburn 2445: current.radiovalue = $radioval;
2446: current.argfield = $argfield;
1.32 matthew 2447:
2448: function changed_radio(choice,currentform) {
2449: var choicearg = choice + 'arg';
2450: // If a radio button in changed, we need to change the argfield
2451: if (current.radiovalue != choice) {
2452: current.radiovalue = choice;
2453: if (current.argfield != null) {
2454: currentform.elements[current.argfield].value = '';
2455: }
2456: if (choice == 'nochange') {
2457: current.argfield = null;
2458: } else {
2459: current.argfield = choicearg;
2460: switch(choice) {
2461: case 'krb':
2462: currentform.elements[current.argfield].value =
2463: "$in{'kerb_def_dom'}";
2464: break;
2465: default:
2466: break;
2467: }
2468: }
2469: }
2470: return;
2471: }
1.22 www 2472:
1.32 matthew 2473: function changed_text(choice,currentform) {
2474: var choicearg = choice + 'arg';
2475: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2476: $Javascript_toUpperCase
1.32 matthew 2477: // clear old field
2478: if ((current.argfield != choicearg) && (current.argfield != null)) {
2479: currentform.elements[current.argfield].value = '';
2480: }
2481: current.argfield = choicearg;
2482: }
2483: set_auth_radio_buttons(choice,currentform);
2484: return;
1.20 www 2485: }
1.32 matthew 2486:
2487: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2488: var numauthchoices = currentform.login.length;
2489: if (typeof numauthchoices == "undefined") {
2490: return;
2491: }
1.32 matthew 2492: var i=0;
1.986 raeburn 2493: while (i < numauthchoices) {
1.32 matthew 2494: if (currentform.login[i].value == newvalue) { break; }
2495: i++;
2496: }
1.986 raeburn 2497: if (i == numauthchoices) {
1.32 matthew 2498: return;
2499: }
2500: current.radiovalue = newvalue;
2501: currentform.login[i].checked = true;
2502: return;
2503: }
2504: END
2505: return $result;
2506: }
2507:
1.1075.2.20 raeburn 2508: sub authform_authorwarning {
1.32 matthew 2509: my $result='';
1.144 matthew 2510: $result='<i>'.
2511: &mt('As a general rule, only authors or co-authors should be '.
2512: 'filesystem authenticated '.
2513: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2514: return $result;
2515: }
2516:
1.1075.2.20 raeburn 2517: sub authform_nochange {
1.32 matthew 2518: my %in = (
2519: formname => 'document.cu',
2520: kerb_def_dom => 'MSU.EDU',
2521: @_,
2522: );
1.1075.2.20 raeburn 2523: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2524: my $result;
1.1075.2.20 raeburn 2525: if (!$authnum) {
2526: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2527: } else {
2528: $result = '<label>'.&mt('[_1] Do not change login data',
2529: '<input type="radio" name="login" value="nochange" '.
2530: 'checked="checked" onclick="'.
1.281 albertel 2531: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2532: '</label>';
1.586 raeburn 2533: }
1.32 matthew 2534: return $result;
2535: }
2536:
1.591 raeburn 2537: sub authform_kerberos {
1.32 matthew 2538: my %in = (
2539: formname => 'document.cu',
2540: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2541: kerb_def_auth => 'krb4',
1.32 matthew 2542: @_,
2543: );
1.586 raeburn 2544: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2545: $autharg,$jscall);
1.1075.2.20 raeburn 2546: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2547: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2548: $check5 = ' checked="checked"';
1.80 albertel 2549: } else {
1.772 bisitz 2550: $check4 = ' checked="checked"';
1.80 albertel 2551: }
1.165 raeburn 2552: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2553: if (defined($in{'curr_authtype'})) {
2554: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2555: $krbcheck = ' checked="checked"';
1.623 raeburn 2556: if (defined($in{'mode'})) {
2557: if ($in{'mode'} eq 'modifyuser') {
2558: $krbcheck = '';
2559: }
2560: }
1.591 raeburn 2561: if (defined($in{'curr_kerb_ver'})) {
2562: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2563: $check5 = ' checked="checked"';
1.591 raeburn 2564: $check4 = '';
2565: } else {
1.772 bisitz 2566: $check4 = ' checked="checked"';
1.591 raeburn 2567: $check5 = '';
2568: }
1.586 raeburn 2569: }
1.591 raeburn 2570: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2571: $krbarg = $in{'curr_autharg'};
2572: }
1.586 raeburn 2573: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2574: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2575: $result =
2576: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2577: $in{'curr_autharg'},$krbver);
2578: } else {
2579: $result =
2580: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2581: }
2582: return $result;
2583: }
2584: }
2585: } else {
2586: if ($authnum == 1) {
1.784 bisitz 2587: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2588: }
2589: }
1.586 raeburn 2590: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2591: return;
1.587 raeburn 2592: } elsif ($authtype eq '') {
1.591 raeburn 2593: if (defined($in{'mode'})) {
1.587 raeburn 2594: if ($in{'mode'} eq 'modifycourse') {
2595: if ($authnum == 1) {
1.1075.2.20 raeburn 2596: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2597: }
2598: }
2599: }
1.586 raeburn 2600: }
2601: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2602: if ($authtype eq '') {
2603: $authtype = '<input type="radio" name="login" value="krb" '.
2604: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2605: $krbcheck.' />';
2606: }
2607: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2608: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2609: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2610: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2611: $in{'curr_authtype'} eq 'krb4')) {
2612: $result .= &mt
1.144 matthew 2613: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2614: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2615: '<label>'.$authtype,
1.281 albertel 2616: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2617: 'value="'.$krbarg.'" '.
1.144 matthew 2618: 'onchange="'.$jscall.'" />',
1.281 albertel 2619: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2620: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2621: '</label>');
1.586 raeburn 2622: } elsif ($can_assign{'krb4'}) {
2623: $result .= &mt
2624: ('[_1] Kerberos authenticated with domain [_2] '.
2625: '[_3] Version 4 [_4]',
2626: '<label>'.$authtype,
2627: '</label><input type="text" size="10" name="krbarg" '.
2628: 'value="'.$krbarg.'" '.
2629: 'onchange="'.$jscall.'" />',
2630: '<label><input type="hidden" name="krbver" value="4" />',
2631: '</label>');
2632: } elsif ($can_assign{'krb5'}) {
2633: $result .= &mt
2634: ('[_1] Kerberos authenticated with domain [_2] '.
2635: '[_3] Version 5 [_4]',
2636: '<label>'.$authtype,
2637: '</label><input type="text" size="10" name="krbarg" '.
2638: 'value="'.$krbarg.'" '.
2639: 'onchange="'.$jscall.'" />',
2640: '<label><input type="hidden" name="krbver" value="5" />',
2641: '</label>');
2642: }
1.32 matthew 2643: return $result;
2644: }
2645:
1.1075.2.20 raeburn 2646: sub authform_internal {
1.586 raeburn 2647: my %in = (
1.32 matthew 2648: formname => 'document.cu',
2649: kerb_def_dom => 'MSU.EDU',
2650: @_,
2651: );
1.586 raeburn 2652: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2653: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2654: if (defined($in{'curr_authtype'})) {
2655: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2656: if ($can_assign{'int'}) {
1.772 bisitz 2657: $intcheck = 'checked="checked" ';
1.623 raeburn 2658: if (defined($in{'mode'})) {
2659: if ($in{'mode'} eq 'modifyuser') {
2660: $intcheck = '';
2661: }
2662: }
1.591 raeburn 2663: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2664: $intarg = $in{'curr_autharg'};
2665: }
2666: } else {
2667: $result = &mt('Currently internally authenticated.');
2668: return $result;
1.165 raeburn 2669: }
2670: }
1.586 raeburn 2671: } else {
2672: if ($authnum == 1) {
1.784 bisitz 2673: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2674: }
2675: }
2676: if (!$can_assign{'int'}) {
2677: return;
1.587 raeburn 2678: } elsif ($authtype eq '') {
1.591 raeburn 2679: if (defined($in{'mode'})) {
1.587 raeburn 2680: if ($in{'mode'} eq 'modifycourse') {
2681: if ($authnum == 1) {
1.1075.2.20 raeburn 2682: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2683: }
2684: }
2685: }
1.165 raeburn 2686: }
1.586 raeburn 2687: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2688: if ($authtype eq '') {
2689: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2690: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2691: }
1.605 bisitz 2692: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2693: $intarg.'" onchange="'.$jscall.'" />';
2694: $result = &mt
1.144 matthew 2695: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2696: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2697: $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 2698: return $result;
2699: }
2700:
1.1075.2.20 raeburn 2701: sub authform_local {
1.32 matthew 2702: my %in = (
2703: formname => 'document.cu',
2704: kerb_def_dom => 'MSU.EDU',
2705: @_,
2706: );
1.586 raeburn 2707: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2708: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2709: if (defined($in{'curr_authtype'})) {
2710: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2711: if ($can_assign{'loc'}) {
1.772 bisitz 2712: $loccheck = 'checked="checked" ';
1.623 raeburn 2713: if (defined($in{'mode'})) {
2714: if ($in{'mode'} eq 'modifyuser') {
2715: $loccheck = '';
2716: }
2717: }
1.591 raeburn 2718: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2719: $locarg = $in{'curr_autharg'};
2720: }
2721: } else {
2722: $result = &mt('Currently using local (institutional) authentication.');
2723: return $result;
1.165 raeburn 2724: }
2725: }
1.586 raeburn 2726: } else {
2727: if ($authnum == 1) {
1.784 bisitz 2728: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2729: }
2730: }
2731: if (!$can_assign{'loc'}) {
2732: return;
1.587 raeburn 2733: } elsif ($authtype eq '') {
1.591 raeburn 2734: if (defined($in{'mode'})) {
1.587 raeburn 2735: if ($in{'mode'} eq 'modifycourse') {
2736: if ($authnum == 1) {
1.1075.2.20 raeburn 2737: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2738: }
2739: }
2740: }
1.165 raeburn 2741: }
1.586 raeburn 2742: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2743: if ($authtype eq '') {
2744: $authtype = '<input type="radio" name="login" value="loc" '.
2745: $loccheck.' onchange="'.$jscall.'" onclick="'.
2746: $jscall.'" />';
2747: }
2748: $autharg = '<input type="text" size="10" name="locarg" value="'.
2749: $locarg.'" onchange="'.$jscall.'" />';
2750: $result = &mt('[_1] Local Authentication with argument [_2]',
2751: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2752: return $result;
2753: }
2754:
1.1075.2.20 raeburn 2755: sub authform_filesystem {
1.32 matthew 2756: my %in = (
2757: formname => 'document.cu',
2758: kerb_def_dom => 'MSU.EDU',
2759: @_,
2760: );
1.586 raeburn 2761: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2762: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2763: if (defined($in{'curr_authtype'})) {
2764: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2765: if ($can_assign{'fsys'}) {
1.772 bisitz 2766: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2767: if (defined($in{'mode'})) {
2768: if ($in{'mode'} eq 'modifyuser') {
2769: $fsyscheck = '';
2770: }
2771: }
1.586 raeburn 2772: } else {
2773: $result = &mt('Currently Filesystem Authenticated.');
2774: return $result;
2775: }
2776: }
2777: } else {
2778: if ($authnum == 1) {
1.784 bisitz 2779: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2780: }
2781: }
2782: if (!$can_assign{'fsys'}) {
2783: return;
1.587 raeburn 2784: } elsif ($authtype eq '') {
1.591 raeburn 2785: if (defined($in{'mode'})) {
1.587 raeburn 2786: if ($in{'mode'} eq 'modifycourse') {
2787: if ($authnum == 1) {
1.1075.2.20 raeburn 2788: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2789: }
2790: }
2791: }
1.586 raeburn 2792: }
2793: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2794: if ($authtype eq '') {
2795: $authtype = '<input type="radio" name="login" value="fsys" '.
2796: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2797: $jscall.'" />';
2798: }
2799: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2800: ' onchange="'.$jscall.'" />';
2801: $result = &mt
1.144 matthew 2802: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2803: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2804: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2805: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2806: 'onchange="'.$jscall.'" />');
1.32 matthew 2807: return $result;
2808: }
2809:
1.586 raeburn 2810: sub get_assignable_auth {
2811: my ($dom) = @_;
2812: if ($dom eq '') {
2813: $dom = $env{'request.role.domain'};
2814: }
2815: my %can_assign = (
2816: krb4 => 1,
2817: krb5 => 1,
2818: int => 1,
2819: loc => 1,
2820: );
2821: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2822: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2823: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2824: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2825: my $context;
2826: if ($env{'request.role'} =~ /^au/) {
2827: $context = 'author';
2828: } elsif ($env{'request.role'} =~ /^dc/) {
2829: $context = 'domain';
2830: } elsif ($env{'request.course.id'}) {
2831: $context = 'course';
2832: }
2833: if ($context) {
2834: if (ref($authhash->{$context}) eq 'HASH') {
2835: %can_assign = %{$authhash->{$context}};
2836: }
2837: }
2838: }
2839: }
2840: my $authnum = 0;
2841: foreach my $key (keys(%can_assign)) {
2842: if ($can_assign{$key}) {
2843: $authnum ++;
2844: }
2845: }
2846: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2847: $authnum --;
2848: }
2849: return ($authnum,%can_assign);
2850: }
2851:
1.80 albertel 2852: ###############################################################
2853: ## Get Kerberos Defaults for Domain ##
2854: ###############################################################
2855: ##
2856: ## Returns default kerberos version and an associated argument
2857: ## as listed in file domain.tab. If not listed, provides
2858: ## appropriate default domain and kerberos version.
2859: ##
2860: #-------------------------------------------
2861:
2862: =pod
2863:
1.648 raeburn 2864: =item * &get_kerberos_defaults()
1.80 albertel 2865:
2866: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2867: version and domain. If not found, it defaults to version 4 and the
2868: domain of the server.
1.80 albertel 2869:
1.648 raeburn 2870: =over 4
2871:
1.80 albertel 2872: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2873:
1.648 raeburn 2874: =back
2875:
2876: =back
2877:
1.80 albertel 2878: =cut
2879:
2880: #-------------------------------------------
2881: sub get_kerberos_defaults {
2882: my $domain=shift;
1.641 raeburn 2883: my ($krbdef,$krbdefdom);
2884: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2885: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2886: $krbdef = $domdefaults{'auth_def'};
2887: $krbdefdom = $domdefaults{'auth_arg_def'};
2888: } else {
1.80 albertel 2889: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2890: my $krbdefdom=$1;
2891: $krbdefdom=~tr/a-z/A-Z/;
2892: $krbdef = "krb4";
2893: }
2894: return ($krbdef,$krbdefdom);
2895: }
1.112 bowersj2 2896:
1.32 matthew 2897:
1.46 matthew 2898: ###############################################################
2899: ## Thesaurus Functions ##
2900: ###############################################################
1.20 www 2901:
1.46 matthew 2902: =pod
1.20 www 2903:
1.112 bowersj2 2904: =head1 Thesaurus Functions
2905:
2906: =over 4
2907:
1.648 raeburn 2908: =item * &initialize_keywords()
1.46 matthew 2909:
2910: Initializes the package variable %Keywords if it is empty. Uses the
2911: package variable $thesaurus_db_file.
2912:
2913: =cut
2914:
2915: ###################################################
2916:
2917: sub initialize_keywords {
2918: return 1 if (scalar keys(%Keywords));
2919: # If we are here, %Keywords is empty, so fill it up
2920: # Make sure the file we need exists...
2921: if (! -e $thesaurus_db_file) {
2922: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2923: " failed because it does not exist");
2924: return 0;
2925: }
2926: # Set up the hash as a database
2927: my %thesaurus_db;
2928: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2929: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2930: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2931: $thesaurus_db_file);
2932: return 0;
2933: }
2934: # Get the average number of appearances of a word.
2935: my $avecount = $thesaurus_db{'average.count'};
2936: # Put keywords (those that appear > average) into %Keywords
2937: while (my ($word,$data)=each (%thesaurus_db)) {
2938: my ($count,undef) = split /:/,$data;
2939: $Keywords{$word}++ if ($count > $avecount);
2940: }
2941: untie %thesaurus_db;
2942: # Remove special values from %Keywords.
1.356 albertel 2943: foreach my $value ('total.count','average.count') {
2944: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2945: }
1.46 matthew 2946: return 1;
2947: }
2948:
2949: ###################################################
2950:
2951: =pod
2952:
1.648 raeburn 2953: =item * &keyword($word)
1.46 matthew 2954:
2955: Returns true if $word is a keyword. A keyword is a word that appears more
2956: than the average number of times in the thesaurus database. Calls
2957: &initialize_keywords
2958:
2959: =cut
2960:
2961: ###################################################
1.20 www 2962:
2963: sub keyword {
1.46 matthew 2964: return if (!&initialize_keywords());
2965: my $word=lc(shift());
2966: $word=~s/\W//g;
2967: return exists($Keywords{$word});
1.20 www 2968: }
1.46 matthew 2969:
2970: ###############################################################
2971:
2972: =pod
1.20 www 2973:
1.648 raeburn 2974: =item * &get_related_words()
1.46 matthew 2975:
1.160 matthew 2976: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2977: an array of words. If the keyword is not in the thesaurus, an empty array
2978: will be returned. The order of the words returned is determined by the
2979: database which holds them.
2980:
2981: Uses global $thesaurus_db_file.
2982:
1.1057 foxr 2983:
1.46 matthew 2984: =cut
2985:
2986: ###############################################################
2987: sub get_related_words {
2988: my $keyword = shift;
2989: my %thesaurus_db;
2990: if (! -e $thesaurus_db_file) {
2991: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2992: "failed because the file does not exist");
2993: return ();
2994: }
2995: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2996: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2997: return ();
2998: }
2999: my @Words=();
1.429 www 3000: my $count=0;
1.46 matthew 3001: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3002: # The first element is the number of times
3003: # the word appears. We do not need it now.
1.429 www 3004: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3005: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3006: my $threshold=$mostfrequentcount/10;
3007: foreach my $possibleword (@RelatedWords) {
3008: my ($word,$wordcount)=split(/\,/,$possibleword);
3009: if ($wordcount>$threshold) {
3010: push(@Words,$word);
3011: $count++;
3012: if ($count>10) { last; }
3013: }
1.20 www 3014: }
3015: }
1.46 matthew 3016: untie %thesaurus_db;
3017: return @Words;
1.14 harris41 3018: }
1.46 matthew 3019:
1.112 bowersj2 3020: =pod
3021:
3022: =back
3023:
3024: =cut
1.61 www 3025:
3026: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3027: =pod
3028:
1.112 bowersj2 3029: =head1 User Name Functions
3030:
3031: =over 4
3032:
1.648 raeburn 3033: =item * &plainname($uname,$udom,$first)
1.81 albertel 3034:
1.112 bowersj2 3035: Takes a users logon name and returns it as a string in
1.226 albertel 3036: "first middle last generation" form
3037: if $first is set to 'lastname' then it returns it as
3038: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3039:
3040: =cut
1.61 www 3041:
1.295 www 3042:
1.81 albertel 3043: ###############################################################
1.61 www 3044: sub plainname {
1.226 albertel 3045: my ($uname,$udom,$first)=@_;
1.537 albertel 3046: return if (!defined($uname) || !defined($udom));
1.295 www 3047: my %names=&getnames($uname,$udom);
1.226 albertel 3048: my $name=&Apache::lonnet::format_name($names{'firstname'},
3049: $names{'middlename'},
3050: $names{'lastname'},
3051: $names{'generation'},$first);
3052: $name=~s/^\s+//;
1.62 www 3053: $name=~s/\s+$//;
3054: $name=~s/\s+/ /g;
1.353 albertel 3055: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3056: return $name;
1.61 www 3057: }
1.66 www 3058:
3059: # -------------------------------------------------------------------- Nickname
1.81 albertel 3060: =pod
3061:
1.648 raeburn 3062: =item * &nickname($uname,$udom)
1.81 albertel 3063:
3064: Gets a users name and returns it as a string as
3065:
3066: ""nickname""
1.66 www 3067:
1.81 albertel 3068: if the user has a nickname or
3069:
3070: "first middle last generation"
3071:
3072: if the user does not
3073:
3074: =cut
1.66 www 3075:
3076: sub nickname {
3077: my ($uname,$udom)=@_;
1.537 albertel 3078: return if (!defined($uname) || !defined($udom));
1.295 www 3079: my %names=&getnames($uname,$udom);
1.68 albertel 3080: my $name=$names{'nickname'};
1.66 www 3081: if ($name) {
3082: $name='"'.$name.'"';
3083: } else {
3084: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3085: $names{'lastname'}.' '.$names{'generation'};
3086: $name=~s/\s+$//;
3087: $name=~s/\s+/ /g;
3088: }
3089: return $name;
3090: }
3091:
1.295 www 3092: sub getnames {
3093: my ($uname,$udom)=@_;
1.537 albertel 3094: return if (!defined($uname) || !defined($udom));
1.433 albertel 3095: if ($udom eq 'public' && $uname eq 'public') {
3096: return ('lastname' => &mt('Public'));
3097: }
1.295 www 3098: my $id=$uname.':'.$udom;
3099: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3100: if ($cached) {
3101: return %{$names};
3102: } else {
3103: my %loadnames=&Apache::lonnet::get('environment',
3104: ['firstname','middlename','lastname','generation','nickname'],
3105: $udom,$uname);
3106: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3107: return %loadnames;
3108: }
3109: }
1.61 www 3110:
1.542 raeburn 3111: # -------------------------------------------------------------------- getemails
1.648 raeburn 3112:
1.542 raeburn 3113: =pod
3114:
1.648 raeburn 3115: =item * &getemails($uname,$udom)
1.542 raeburn 3116:
3117: Gets a user's email information and returns it as a hash with keys:
3118: notification, critnotification, permanentemail
3119:
3120: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3121: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3122:
1.648 raeburn 3123:
1.542 raeburn 3124: =cut
3125:
1.648 raeburn 3126:
1.466 albertel 3127: sub getemails {
3128: my ($uname,$udom)=@_;
3129: if ($udom eq 'public' && $uname eq 'public') {
3130: return;
3131: }
1.467 www 3132: if (!$udom) { $udom=$env{'user.domain'}; }
3133: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3134: my $id=$uname.':'.$udom;
3135: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3136: if ($cached) {
3137: return %{$names};
3138: } else {
3139: my %loadnames=&Apache::lonnet::get('environment',
3140: ['notification','critnotification',
3141: 'permanentemail'],
3142: $udom,$uname);
3143: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3144: return %loadnames;
3145: }
3146: }
3147:
1.551 albertel 3148: sub flush_email_cache {
3149: my ($uname,$udom)=@_;
3150: if (!$udom) { $udom =$env{'user.domain'}; }
3151: if (!$uname) { $uname=$env{'user.name'}; }
3152: return if ($udom eq 'public' && $uname eq 'public');
3153: my $id=$uname.':'.$udom;
3154: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3155: }
3156:
1.728 raeburn 3157: # -------------------------------------------------------------------- getlangs
3158:
3159: =pod
3160:
3161: =item * &getlangs($uname,$udom)
3162:
3163: Gets a user's language preference and returns it as a hash with key:
3164: language.
3165:
3166: =cut
3167:
3168:
3169: sub getlangs {
3170: my ($uname,$udom) = @_;
3171: if (!$udom) { $udom =$env{'user.domain'}; }
3172: if (!$uname) { $uname=$env{'user.name'}; }
3173: my $id=$uname.':'.$udom;
3174: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3175: if ($cached) {
3176: return %{$langs};
3177: } else {
3178: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3179: $udom,$uname);
3180: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3181: return %loadlangs;
3182: }
3183: }
3184:
3185: sub flush_langs_cache {
3186: my ($uname,$udom)=@_;
3187: if (!$udom) { $udom =$env{'user.domain'}; }
3188: if (!$uname) { $uname=$env{'user.name'}; }
3189: return if ($udom eq 'public' && $uname eq 'public');
3190: my $id=$uname.':'.$udom;
3191: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3192: }
3193:
1.61 www 3194: # ------------------------------------------------------------------ Screenname
1.81 albertel 3195:
3196: =pod
3197:
1.648 raeburn 3198: =item * &screenname($uname,$udom)
1.81 albertel 3199:
3200: Gets a users screenname and returns it as a string
3201:
3202: =cut
1.61 www 3203:
3204: sub screenname {
3205: my ($uname,$udom)=@_;
1.258 albertel 3206: if ($uname eq $env{'user.name'} &&
3207: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3208: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3209: return $names{'screenname'};
1.62 www 3210: }
3211:
1.212 albertel 3212:
1.802 bisitz 3213: # ------------------------------------------------------------- Confirm Wrapper
3214: =pod
3215:
3216: =item confirmwrapper
3217:
3218: Wrap messages about completion of operation in box
3219:
3220: =cut
3221:
3222: sub confirmwrapper {
3223: my ($message)=@_;
3224: if ($message) {
3225: return "\n".'<div class="LC_confirm_box">'."\n"
3226: .$message."\n"
3227: .'</div>'."\n";
3228: } else {
3229: return $message;
3230: }
3231: }
3232:
1.62 www 3233: # ------------------------------------------------------------- Message Wrapper
3234:
3235: sub messagewrapper {
1.369 www 3236: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3237: return
1.441 albertel 3238: '<a href="/adm/email?compose=individual&'.
3239: 'recname='.$username.'&recdom='.$domain.
3240: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3241: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3242: }
1.802 bisitz 3243:
1.74 www 3244: # --------------------------------------------------------------- Notes Wrapper
3245:
3246: sub noteswrapper {
3247: my ($link,$un,$do)=@_;
3248: return
1.896 amueller 3249: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3250: }
1.802 bisitz 3251:
1.62 www 3252: # ------------------------------------------------------------- Aboutme Wrapper
3253:
3254: sub aboutmewrapper {
1.1070 raeburn 3255: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3256: if (!defined($username) && !defined($domain)) {
3257: return;
3258: }
1.1075.2.15 raeburn 3259: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3260: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3261: }
3262:
3263: # ------------------------------------------------------------ Syllabus Wrapper
3264:
3265: sub syllabuswrapper {
1.707 bisitz 3266: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3267: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3268: }
1.14 harris41 3269:
1.802 bisitz 3270: # -----------------------------------------------------------------------------
3271:
1.208 matthew 3272: sub track_student_link {
1.887 raeburn 3273: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3274: my $link ="/adm/trackstudent?";
1.208 matthew 3275: my $title = 'View recent activity';
3276: if (defined($sname) && $sname !~ /^\s*$/ &&
3277: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3278: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3279: $title .= ' of this student';
1.268 albertel 3280: }
1.208 matthew 3281: if (defined($target) && $target !~ /^\s*$/) {
3282: $target = qq{target="$target"};
3283: } else {
3284: $target = '';
3285: }
1.268 albertel 3286: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3287: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3288: $title = &mt($title);
3289: $linktext = &mt($linktext);
1.448 albertel 3290: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3291: &help_open_topic('View_recent_activity');
1.208 matthew 3292: }
3293:
1.781 raeburn 3294: sub slot_reservations_link {
3295: my ($linktext,$sname,$sdom,$target) = @_;
3296: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3297: my $title = 'View slot reservation history';
3298: if (defined($sname) && $sname !~ /^\s*$/ &&
3299: defined($sdom) && $sdom !~ /^\s*$/) {
3300: $link .= "&uname=$sname&udom=$sdom";
3301: $title .= ' of this student';
3302: }
3303: if (defined($target) && $target !~ /^\s*$/) {
3304: $target = qq{target="$target"};
3305: } else {
3306: $target = '';
3307: }
3308: $title = &mt($title);
3309: $linktext = &mt($linktext);
3310: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3311: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3312:
3313: }
3314:
1.508 www 3315: # ===================================================== Display a student photo
3316:
3317:
1.509 albertel 3318: sub student_image_tag {
1.508 www 3319: my ($domain,$user)=@_;
3320: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3321: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3322: return '<img src="'.$imgsrc.'" align="right" />';
3323: } else {
3324: return '';
3325: }
3326: }
3327:
1.112 bowersj2 3328: =pod
3329:
3330: =back
3331:
3332: =head1 Access .tab File Data
3333:
3334: =over 4
3335:
1.648 raeburn 3336: =item * &languageids()
1.112 bowersj2 3337:
3338: returns list of all language ids
3339:
3340: =cut
3341:
1.14 harris41 3342: sub languageids {
1.16 harris41 3343: return sort(keys(%language));
1.14 harris41 3344: }
3345:
1.112 bowersj2 3346: =pod
3347:
1.648 raeburn 3348: =item * &languagedescription()
1.112 bowersj2 3349:
3350: returns description of a specified language id
3351:
3352: =cut
3353:
1.14 harris41 3354: sub languagedescription {
1.125 www 3355: my $code=shift;
3356: return ($supported_language{$code}?'* ':'').
3357: $language{$code}.
1.126 www 3358: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3359: }
3360:
1.1048 foxr 3361: =pod
3362:
3363: =item * &plainlanguagedescription
3364:
3365: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3366: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3367:
3368: =cut
3369:
1.145 www 3370: sub plainlanguagedescription {
3371: my $code=shift;
3372: return $language{$code};
3373: }
3374:
1.1048 foxr 3375: =pod
3376:
3377: =item * &supportedlanguagecode
3378:
3379: Returns the supported language code (e.g. sptutf maps to pt) given a language
3380: code.
3381:
3382: =cut
3383:
1.145 www 3384: sub supportedlanguagecode {
3385: my $code=shift;
3386: return $supported_language{$code};
1.97 www 3387: }
3388:
1.112 bowersj2 3389: =pod
3390:
1.1048 foxr 3391: =item * &latexlanguage()
3392:
3393: Given a language key code returns the correspondnig language to use
3394: to select the correct hyphenation on LaTeX printouts. This is undef if there
3395: is no supported hyphenation for the language code.
3396:
3397: =cut
3398:
3399: sub latexlanguage {
3400: my $code = shift;
3401: return $latex_language{$code};
3402: }
3403:
3404: =pod
3405:
3406: =item * &latexhyphenation()
3407:
3408: Same as above but what's supplied is the language as it might be stored
3409: in the metadata.
3410:
3411: =cut
3412:
3413: sub latexhyphenation {
3414: my $key = shift;
3415: return $latex_language_bykey{$key};
3416: }
3417:
3418: =pod
3419:
1.648 raeburn 3420: =item * ©rightids()
1.112 bowersj2 3421:
3422: returns list of all copyrights
3423:
3424: =cut
3425:
3426: sub copyrightids {
3427: return sort(keys(%cprtag));
3428: }
3429:
3430: =pod
3431:
1.648 raeburn 3432: =item * ©rightdescription()
1.112 bowersj2 3433:
3434: returns description of a specified copyright id
3435:
3436: =cut
3437:
3438: sub copyrightdescription {
1.166 www 3439: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3440: }
1.197 matthew 3441:
3442: =pod
3443:
1.648 raeburn 3444: =item * &source_copyrightids()
1.192 taceyjo1 3445:
3446: returns list of all source copyrights
3447:
3448: =cut
3449:
3450: sub source_copyrightids {
3451: return sort(keys(%scprtag));
3452: }
3453:
3454: =pod
3455:
1.648 raeburn 3456: =item * &source_copyrightdescription()
1.192 taceyjo1 3457:
3458: returns description of a specified source copyright id
3459:
3460: =cut
3461:
3462: sub source_copyrightdescription {
3463: return &mt($scprtag{shift(@_)});
3464: }
1.112 bowersj2 3465:
3466: =pod
3467:
1.648 raeburn 3468: =item * &filecategories()
1.112 bowersj2 3469:
3470: returns list of all file categories
3471:
3472: =cut
3473:
3474: sub filecategories {
3475: return sort(keys(%category_extensions));
3476: }
3477:
3478: =pod
3479:
1.648 raeburn 3480: =item * &filecategorytypes()
1.112 bowersj2 3481:
3482: returns list of file types belonging to a given file
3483: category
3484:
3485: =cut
3486:
3487: sub filecategorytypes {
1.356 albertel 3488: my ($cat) = @_;
3489: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3490: }
3491:
3492: =pod
3493:
1.648 raeburn 3494: =item * &fileembstyle()
1.112 bowersj2 3495:
3496: returns embedding style for a specified file type
3497:
3498: =cut
3499:
3500: sub fileembstyle {
3501: return $fe{lc(shift(@_))};
1.169 www 3502: }
3503:
1.351 www 3504: sub filemimetype {
3505: return $fm{lc(shift(@_))};
3506: }
3507:
1.169 www 3508:
3509: sub filecategoryselect {
3510: my ($name,$value)=@_;
1.189 matthew 3511: return &select_form($value,$name,
1.970 raeburn 3512: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3513: }
3514:
3515: =pod
3516:
1.648 raeburn 3517: =item * &filedescription()
1.112 bowersj2 3518:
3519: returns description for a specified file type
3520:
3521: =cut
3522:
3523: sub filedescription {
1.188 matthew 3524: my $file_description = $fd{lc(shift())};
3525: $file_description =~ s:([\[\]]):~$1:g;
3526: return &mt($file_description);
1.112 bowersj2 3527: }
3528:
3529: =pod
3530:
1.648 raeburn 3531: =item * &filedescriptionex()
1.112 bowersj2 3532:
3533: returns description for a specified file type with
3534: extra formatting
3535:
3536: =cut
3537:
3538: sub filedescriptionex {
3539: my $ex=shift;
1.188 matthew 3540: my $file_description = $fd{lc($ex)};
3541: $file_description =~ s:([\[\]]):~$1:g;
3542: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3543: }
3544:
3545: # End of .tab access
3546: =pod
3547:
3548: =back
3549:
3550: =cut
3551:
3552: # ------------------------------------------------------------------ File Types
3553: sub fileextensions {
3554: return sort(keys(%fe));
3555: }
3556:
1.97 www 3557: # ----------------------------------------------------------- Display Languages
3558: # returns a hash with all desired display languages
3559: #
3560:
3561: sub display_languages {
3562: my %languages=();
1.695 raeburn 3563: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3564: $languages{$lang}=1;
1.97 www 3565: }
3566: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3567: if ($env{'form.displaylanguage'}) {
1.356 albertel 3568: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3569: $languages{$lang}=1;
1.97 www 3570: }
3571: }
3572: return %languages;
1.14 harris41 3573: }
3574:
1.582 albertel 3575: sub languages {
3576: my ($possible_langs) = @_;
1.695 raeburn 3577: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3578: if (!ref($possible_langs)) {
3579: if( wantarray ) {
3580: return @preferred_langs;
3581: } else {
3582: return $preferred_langs[0];
3583: }
3584: }
3585: my %possibilities = map { $_ => 1 } (@$possible_langs);
3586: my @preferred_possibilities;
3587: foreach my $preferred_lang (@preferred_langs) {
3588: if (exists($possibilities{$preferred_lang})) {
3589: push(@preferred_possibilities, $preferred_lang);
3590: }
3591: }
3592: if( wantarray ) {
3593: return @preferred_possibilities;
3594: }
3595: return $preferred_possibilities[0];
3596: }
3597:
1.742 raeburn 3598: sub user_lang {
3599: my ($touname,$toudom,$fromcid) = @_;
3600: my @userlangs;
3601: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3602: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3603: $env{'course.'.$fromcid.'.languages'}));
3604: } else {
3605: my %langhash = &getlangs($touname,$toudom);
3606: if ($langhash{'languages'} ne '') {
3607: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3608: } else {
3609: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3610: if ($domdefs{'lang_def'} ne '') {
3611: @userlangs = ($domdefs{'lang_def'});
3612: }
3613: }
3614: }
3615: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3616: my $user_lh = Apache::localize->get_handle(@languages);
3617: return $user_lh;
3618: }
3619:
3620:
1.112 bowersj2 3621: ###############################################################
3622: ## Student Answer Attempts ##
3623: ###############################################################
3624:
3625: =pod
3626:
3627: =head1 Alternate Problem Views
3628:
3629: =over 4
3630:
1.648 raeburn 3631: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3632: $getattempt, $regexp, $gradesub)
3633:
3634: Return string with previous attempt on problem. Arguments:
3635:
3636: =over 4
3637:
3638: =item * $symb: Problem, including path
3639:
3640: =item * $username: username of the desired student
3641:
3642: =item * $domain: domain of the desired student
1.14 harris41 3643:
1.112 bowersj2 3644: =item * $course: Course ID
1.14 harris41 3645:
1.112 bowersj2 3646: =item * $getattempt: Leave blank for all attempts, otherwise put
3647: something
1.14 harris41 3648:
1.112 bowersj2 3649: =item * $regexp: if string matches this regexp, the string will be
3650: sent to $gradesub
1.14 harris41 3651:
1.112 bowersj2 3652: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3653:
1.112 bowersj2 3654: =back
1.14 harris41 3655:
1.112 bowersj2 3656: The output string is a table containing all desired attempts, if any.
1.16 harris41 3657:
1.112 bowersj2 3658: =cut
1.1 albertel 3659:
3660: sub get_previous_attempt {
1.43 ng 3661: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3662: my $prevattempts='';
1.43 ng 3663: no strict 'refs';
1.1 albertel 3664: if ($symb) {
1.3 albertel 3665: my (%returnhash)=
3666: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3667: if ($returnhash{'version'}) {
3668: my %lasthash=();
3669: my $version;
3670: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3671: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3672: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3673: }
1.1 albertel 3674: }
1.596 albertel 3675: $prevattempts=&start_data_table().&start_data_table_header_row();
3676: $prevattempts.='<th>'.&mt('History').'</th>';
1.978 raeburn 3677: my (%typeparts,%lasthidden);
1.945 raeburn 3678: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3679: foreach my $key (sort(keys(%lasthash))) {
3680: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3681: if ($#parts > 0) {
1.31 albertel 3682: my $data=$parts[-1];
1.989 raeburn 3683: next if ($data eq 'foilorder');
1.31 albertel 3684: pop(@parts);
1.1010 www 3685: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3686: if ($data eq 'type') {
3687: unless ($showsurv) {
3688: my $id = join(',',@parts);
3689: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3690: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3691: $lasthidden{$ign.'.'.$id} = 1;
3692: }
1.945 raeburn 3693: }
1.1010 www 3694: }
1.31 albertel 3695: } else {
1.41 ng 3696: if ($#parts == 0) {
3697: $prevattempts.='<th>'.$parts[0].'</th>';
3698: } else {
3699: $prevattempts.='<th>'.$ign.'</th>';
3700: }
1.31 albertel 3701: }
1.16 harris41 3702: }
1.596 albertel 3703: $prevattempts.=&end_data_table_header_row();
1.40 ng 3704: if ($getattempt eq '') {
3705: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945 raeburn 3706: my @hidden;
3707: if (%typeparts) {
3708: foreach my $id (keys(%typeparts)) {
3709: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
3710: push(@hidden,$id);
3711: }
3712: }
3713: }
3714: $prevattempts.=&start_data_table_row().
3715: '<td>'.&mt('Transaction [_1]',$version).'</td>';
3716: if (@hidden) {
3717: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3718: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3719: my $hide;
3720: foreach my $id (@hidden) {
3721: if ($key =~ /^\Q$id\E/) {
3722: $hide = 1;
3723: last;
3724: }
3725: }
3726: if ($hide) {
3727: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3728: if (($data eq 'award') || ($data eq 'awarddetail')) {
3729: my $value = &format_previous_attempt_value($key,
3730: $returnhash{$version.':'.$key});
3731: $prevattempts.='<td>'.$value.' </td>';
3732: } else {
3733: $prevattempts.='<td> </td>';
3734: }
3735: } else {
3736: if ($key =~ /\./) {
3737: my $value = &format_previous_attempt_value($key,
3738: $returnhash{$version.':'.$key});
3739: $prevattempts.='<td>'.$value.' </td>';
3740: } else {
3741: $prevattempts.='<td> </td>';
3742: }
3743: }
3744: }
3745: } else {
3746: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3747: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3748: my $value = &format_previous_attempt_value($key,
3749: $returnhash{$version.':'.$key});
3750: $prevattempts.='<td>'.$value.' </td>';
3751: }
3752: }
3753: $prevattempts.=&end_data_table_row();
1.40 ng 3754: }
1.1 albertel 3755: }
1.945 raeburn 3756: my @currhidden = keys(%lasthidden);
1.596 albertel 3757: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3758: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3759: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3760: if (%typeparts) {
3761: my $hidden;
3762: foreach my $id (@currhidden) {
3763: if ($key =~ /^\Q$id\E/) {
3764: $hidden = 1;
3765: last;
3766: }
3767: }
3768: if ($hidden) {
3769: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3770: if (($data eq 'award') || ($data eq 'awarddetail')) {
3771: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3772: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3773: $value = &$gradesub($value);
3774: }
3775: $prevattempts.='<td>'.$value.' </td>';
3776: } else {
3777: $prevattempts.='<td> </td>';
3778: }
3779: } else {
3780: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3781: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3782: $value = &$gradesub($value);
3783: }
3784: $prevattempts.='<td>'.$value.' </td>';
3785: }
3786: } else {
3787: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3788: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3789: $value = &$gradesub($value);
3790: }
3791: $prevattempts.='<td>'.$value.' </td>';
3792: }
1.16 harris41 3793: }
1.596 albertel 3794: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3795: } else {
1.596 albertel 3796: $prevattempts=
3797: &start_data_table().&start_data_table_row().
3798: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3799: &end_data_table_row().&end_data_table();
1.1 albertel 3800: }
3801: } else {
1.596 albertel 3802: $prevattempts=
3803: &start_data_table().&start_data_table_row().
3804: '<td>'.&mt('No data.').'</td>'.
3805: &end_data_table_row().&end_data_table();
1.1 albertel 3806: }
1.10 albertel 3807: }
3808:
1.581 albertel 3809: sub format_previous_attempt_value {
3810: my ($key,$value) = @_;
1.1011 www 3811: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3812: $value = &Apache::lonlocal::locallocaltime($value);
3813: } elsif (ref($value) eq 'ARRAY') {
3814: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3815: } elsif ($key =~ /answerstring$/) {
3816: my %answers = &Apache::lonnet::str2hash($value);
3817: my @anskeys = sort(keys(%answers));
3818: if (@anskeys == 1) {
3819: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3820: if ($answer =~ m{\0}) {
3821: $answer =~ s{\0}{,}g;
1.988 raeburn 3822: }
3823: my $tag_internal_answer_name = 'INTERNAL';
3824: if ($anskeys[0] eq $tag_internal_answer_name) {
3825: $value = $answer;
3826: } else {
3827: $value = $anskeys[0].'='.$answer;
3828: }
3829: } else {
3830: foreach my $ans (@anskeys) {
3831: my $answer = $answers{$ans};
1.1001 raeburn 3832: if ($answer =~ m{\0}) {
3833: $answer =~ s{\0}{,}g;
1.988 raeburn 3834: }
3835: $value .= $ans.'='.$answer.'<br />';;
3836: }
3837: }
1.581 albertel 3838: } else {
3839: $value = &unescape($value);
3840: }
3841: return $value;
3842: }
3843:
3844:
1.107 albertel 3845: sub relative_to_absolute {
3846: my ($url,$output)=@_;
3847: my $parser=HTML::TokeParser->new(\$output);
3848: my $token;
3849: my $thisdir=$url;
3850: my @rlinks=();
3851: while ($token=$parser->get_token) {
3852: if ($token->[0] eq 'S') {
3853: if ($token->[1] eq 'a') {
3854: if ($token->[2]->{'href'}) {
3855: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3856: }
3857: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3858: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3859: } elsif ($token->[1] eq 'base') {
3860: $thisdir=$token->[2]->{'href'};
3861: }
3862: }
3863: }
3864: $thisdir=~s-/[^/]*$--;
1.356 albertel 3865: foreach my $link (@rlinks) {
1.726 raeburn 3866: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3867: ($link=~/^\//) ||
3868: ($link=~/^javascript:/i) ||
3869: ($link=~/^mailto:/i) ||
3870: ($link=~/^\#/)) {
3871: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3872: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3873: }
3874: }
3875: # -------------------------------------------------- Deal with Applet codebases
3876: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3877: return $output;
3878: }
3879:
1.112 bowersj2 3880: =pod
3881:
1.648 raeburn 3882: =item * &get_student_view()
1.112 bowersj2 3883:
3884: show a snapshot of what student was looking at
3885:
3886: =cut
3887:
1.10 albertel 3888: sub get_student_view {
1.186 albertel 3889: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3890: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3891: my (%form);
1.10 albertel 3892: my @elements=('symb','courseid','domain','username');
3893: foreach my $element (@elements) {
1.186 albertel 3894: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3895: }
1.186 albertel 3896: if (defined($moreenv)) {
3897: %form=(%form,%{$moreenv});
3898: }
1.236 albertel 3899: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3900: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3901: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3902: $userview=~s/\<body[^\>]*\>//gi;
3903: $userview=~s/\<\/body\>//gi;
3904: $userview=~s/\<html\>//gi;
3905: $userview=~s/\<\/html\>//gi;
3906: $userview=~s/\<head\>//gi;
3907: $userview=~s/\<\/head\>//gi;
3908: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3909: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3910: if (wantarray) {
3911: return ($userview,$response);
3912: } else {
3913: return $userview;
3914: }
3915: }
3916:
3917: sub get_student_view_with_retries {
3918: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3919:
3920: my $ok = 0; # True if we got a good response.
3921: my $content;
3922: my $response;
3923:
3924: # Try to get the student_view done. within the retries count:
3925:
3926: do {
3927: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3928: $ok = $response->is_success;
3929: if (!$ok) {
3930: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3931: }
3932: $retries--;
3933: } while (!$ok && ($retries > 0));
3934:
3935: if (!$ok) {
3936: $content = ''; # On error return an empty content.
3937: }
1.651 www 3938: if (wantarray) {
3939: return ($content, $response);
3940: } else {
3941: return $content;
3942: }
1.11 albertel 3943: }
3944:
1.112 bowersj2 3945: =pod
3946:
1.648 raeburn 3947: =item * &get_student_answers()
1.112 bowersj2 3948:
3949: show a snapshot of how student was answering problem
3950:
3951: =cut
3952:
1.11 albertel 3953: sub get_student_answers {
1.100 sakharuk 3954: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3955: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3956: my (%moreenv);
1.11 albertel 3957: my @elements=('symb','courseid','domain','username');
3958: foreach my $element (@elements) {
1.186 albertel 3959: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3960: }
1.186 albertel 3961: $moreenv{'grade_target'}='answer';
3962: %moreenv=(%form,%moreenv);
1.497 raeburn 3963: $feedurl = &Apache::lonnet::clutter($feedurl);
3964: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3965: return $userview;
1.1 albertel 3966: }
1.116 albertel 3967:
3968: =pod
3969:
3970: =item * &submlink()
3971:
1.242 albertel 3972: Inputs: $text $uname $udom $symb $target
1.116 albertel 3973:
3974: Returns: A link to grades.pm such as to see the SUBM view of a student
3975:
3976: =cut
3977:
3978: ###############################################
3979: sub submlink {
1.242 albertel 3980: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3981: if (!($uname && $udom)) {
3982: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3983: &Apache::lonnet::whichuser($symb);
1.116 albertel 3984: if (!$symb) { $symb=$cursymb; }
3985: }
1.254 matthew 3986: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3987: $symb=&escape($symb);
1.960 bisitz 3988: if ($target) { $target=" target=\"$target\""; }
3989: return
3990: '<a href="/adm/grades?command=submission'.
3991: '&symb='.$symb.
3992: '&student='.$uname.
3993: '&userdom='.$udom.'"'.
3994: $target.'>'.$text.'</a>';
1.242 albertel 3995: }
3996: ##############################################
3997:
3998: =pod
3999:
4000: =item * &pgrdlink()
4001:
4002: Inputs: $text $uname $udom $symb $target
4003:
4004: Returns: A link to grades.pm such as to see the PGRD view of a student
4005:
4006: =cut
4007:
4008: ###############################################
4009: sub pgrdlink {
4010: my $link=&submlink(@_);
4011: $link=~s/(&command=submission)/$1&showgrading=yes/;
4012: return $link;
4013: }
4014: ##############################################
4015:
4016: =pod
4017:
4018: =item * &pprmlink()
4019:
4020: Inputs: $text $uname $udom $symb $target
4021:
4022: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4023: student and a specific resource
1.242 albertel 4024:
4025: =cut
4026:
4027: ###############################################
4028: sub pprmlink {
4029: my ($text,$uname,$udom,$symb,$target)=@_;
4030: if (!($uname && $udom)) {
4031: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4032: &Apache::lonnet::whichuser($symb);
1.242 albertel 4033: if (!$symb) { $symb=$cursymb; }
4034: }
1.254 matthew 4035: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4036: $symb=&escape($symb);
1.242 albertel 4037: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4038: return '<a href="/adm/parmset?command=set&'.
4039: 'symb='.$symb.'&uname='.$uname.
4040: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4041: }
4042: ##############################################
1.37 matthew 4043:
1.112 bowersj2 4044: =pod
4045:
4046: =back
4047:
4048: =cut
4049:
1.37 matthew 4050: ###############################################
1.51 www 4051:
4052:
4053: sub timehash {
1.687 raeburn 4054: my ($thistime) = @_;
4055: my $timezone = &Apache::lonlocal::gettimezone();
4056: my $dt = DateTime->from_epoch(epoch => $thistime)
4057: ->set_time_zone($timezone);
4058: my $wday = $dt->day_of_week();
4059: if ($wday == 7) { $wday = 0; }
4060: return ( 'second' => $dt->second(),
4061: 'minute' => $dt->minute(),
4062: 'hour' => $dt->hour(),
4063: 'day' => $dt->day_of_month(),
4064: 'month' => $dt->month(),
4065: 'year' => $dt->year(),
4066: 'weekday' => $wday,
4067: 'dayyear' => $dt->day_of_year(),
4068: 'dlsav' => $dt->is_dst() );
1.51 www 4069: }
4070:
1.370 www 4071: sub utc_string {
4072: my ($date)=@_;
1.371 www 4073: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4074: }
4075:
1.51 www 4076: sub maketime {
4077: my %th=@_;
1.687 raeburn 4078: my ($epoch_time,$timezone,$dt);
4079: $timezone = &Apache::lonlocal::gettimezone();
4080: eval {
4081: $dt = DateTime->new( year => $th{'year'},
4082: month => $th{'month'},
4083: day => $th{'day'},
4084: hour => $th{'hour'},
4085: minute => $th{'minute'},
4086: second => $th{'second'},
4087: time_zone => $timezone,
4088: );
4089: };
4090: if (!$@) {
4091: $epoch_time = $dt->epoch;
4092: if ($epoch_time) {
4093: return $epoch_time;
4094: }
4095: }
1.51 www 4096: return POSIX::mktime(
4097: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4098: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4099: }
4100:
4101: #########################################
1.51 www 4102:
4103: sub findallcourses {
1.482 raeburn 4104: my ($roles,$uname,$udom) = @_;
1.355 albertel 4105: my %roles;
4106: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4107: my %courses;
1.51 www 4108: my $now=time;
1.482 raeburn 4109: if (!defined($uname)) {
4110: $uname = $env{'user.name'};
4111: }
4112: if (!defined($udom)) {
4113: $udom = $env{'user.domain'};
4114: }
4115: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4116: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4117: if (!%roles) {
4118: %roles = (
4119: cc => 1,
1.907 raeburn 4120: co => 1,
1.482 raeburn 4121: in => 1,
4122: ep => 1,
4123: ta => 1,
4124: cr => 1,
4125: st => 1,
4126: );
4127: }
4128: foreach my $entry (keys(%roleshash)) {
4129: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4130: if ($trole =~ /^cr/) {
4131: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4132: } else {
4133: next if (!exists($roles{$trole}));
4134: }
4135: if ($tend) {
4136: next if ($tend < $now);
4137: }
4138: if ($tstart) {
4139: next if ($tstart > $now);
4140: }
1.1058 raeburn 4141: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4142: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4143: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4144: if ($secpart eq '') {
4145: ($cnum,$role) = split(/_/,$cnumpart);
4146: $sec = 'none';
1.1058 raeburn 4147: $value .= $cnum.'/';
1.482 raeburn 4148: } else {
4149: $cnum = $cnumpart;
4150: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4151: $value .= $cnum.'/'.$sec;
4152: }
4153: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4154: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4155: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4156: }
4157: } else {
4158: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4159: }
1.482 raeburn 4160: }
4161: } else {
4162: foreach my $key (keys(%env)) {
1.483 albertel 4163: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4164: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4165: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4166: next if ($role eq 'ca' || $role eq 'aa');
4167: next if (%roles && !exists($roles{$role}));
4168: my ($starttime,$endtime)=split(/\./,$env{$key});
4169: my $active=1;
4170: if ($starttime) {
4171: if ($now<$starttime) { $active=0; }
4172: }
4173: if ($endtime) {
4174: if ($now>$endtime) { $active=0; }
4175: }
4176: if ($active) {
1.1058 raeburn 4177: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4178: if ($sec eq '') {
4179: $sec = 'none';
1.1058 raeburn 4180: } else {
4181: $value .= $sec;
4182: }
4183: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4184: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4185: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4186: }
4187: } else {
4188: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4189: }
1.474 raeburn 4190: }
4191: }
1.51 www 4192: }
4193: }
1.474 raeburn 4194: return %courses;
1.51 www 4195: }
1.37 matthew 4196:
1.54 www 4197: ###############################################
1.474 raeburn 4198:
4199: sub blockcheck {
1.1062 raeburn 4200: my ($setters,$activity,$uname,$udom,$url) = @_;
1.490 raeburn 4201:
4202: if (!defined($udom)) {
4203: $udom = $env{'user.domain'};
4204: }
4205: if (!defined($uname)) {
4206: $uname = $env{'user.name'};
4207: }
4208:
4209: # If uname and udom are for a course, check for blocks in the course.
4210:
4211: if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062 raeburn 4212: my ($startblock,$endblock,$triggerblock) =
4213: &get_blocks($setters,$activity,$udom,$uname,$url);
4214: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4215: }
1.474 raeburn 4216:
1.502 raeburn 4217: my $startblock = 0;
4218: my $endblock = 0;
1.1062 raeburn 4219: my $triggerblock = '';
1.482 raeburn 4220: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4221:
1.490 raeburn 4222: # If uname is for a user, and activity is course-specific, i.e.,
4223: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4224:
1.490 raeburn 4225: if (($activity eq 'boards' || $activity eq 'chat' ||
4226: $activity eq 'groups') && ($env{'request.course.id'})) {
4227: foreach my $key (keys(%live_courses)) {
4228: if ($key ne $env{'request.course.id'}) {
4229: delete($live_courses{$key});
4230: }
4231: }
4232: }
4233:
4234: my $otheruser = 0;
4235: my %own_courses;
4236: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4237: # Resource belongs to user other than current user.
4238: $otheruser = 1;
4239: # Gather courses for current user
4240: %own_courses =
4241: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4242: }
4243:
4244: # Gather active course roles - course coordinator, instructor,
4245: # exam proctor, ta, student, or custom role.
1.474 raeburn 4246:
4247: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4248: my ($cdom,$cnum);
4249: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4250: $cdom = $env{'course.'.$course.'.domain'};
4251: $cnum = $env{'course.'.$course.'.num'};
4252: } else {
1.490 raeburn 4253: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4254: }
4255: my $no_ownblock = 0;
4256: my $no_userblock = 0;
1.533 raeburn 4257: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4258: # Check if current user has 'evb' priv for this
4259: if (defined($own_courses{$course})) {
4260: foreach my $sec (keys(%{$own_courses{$course}})) {
4261: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4262: if ($sec ne 'none') {
4263: $checkrole .= '/'.$sec;
4264: }
4265: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4266: $no_ownblock = 1;
4267: last;
4268: }
4269: }
4270: }
4271: # if they have 'evb' priv and are currently not playing student
4272: next if (($no_ownblock) &&
4273: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4274: }
1.474 raeburn 4275: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4276: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4277: if ($sec ne 'none') {
1.482 raeburn 4278: $checkrole .= '/'.$sec;
1.474 raeburn 4279: }
1.490 raeburn 4280: if ($otheruser) {
4281: # Resource belongs to user other than current user.
4282: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4283: my (%allroles,%userroles);
4284: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4285: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4286: my ($trole,$tdom,$tnum,$tsec);
4287: if ($entry =~ /^cr/) {
4288: ($trole,$tdom,$tnum,$tsec) =
4289: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4290: } else {
4291: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4292: }
4293: my ($spec,$area,$trest);
4294: $area = '/'.$tdom.'/'.$tnum;
4295: $trest = $tnum;
4296: if ($tsec ne '') {
4297: $area .= '/'.$tsec;
4298: $trest .= '/'.$tsec;
4299: }
4300: $spec = $trole.'.'.$area;
4301: if ($trole =~ /^cr/) {
4302: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4303: $tdom,$spec,$trest,$area);
4304: } else {
4305: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4306: $tdom,$spec,$trest,$area);
4307: }
4308: }
4309: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4310: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4311: if ($1) {
4312: $no_userblock = 1;
4313: last;
4314: }
1.486 raeburn 4315: }
4316: }
1.490 raeburn 4317: } else {
4318: # Resource belongs to current user
4319: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4320: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4321: $no_ownblock = 1;
4322: last;
4323: }
1.474 raeburn 4324: }
4325: }
4326: # if they have the evb priv and are currently not playing student
1.482 raeburn 4327: next if (($no_ownblock) &&
1.491 albertel 4328: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4329: next if ($no_userblock);
1.474 raeburn 4330:
1.866 kalberla 4331: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4332: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4333:
1.1062 raeburn 4334: my ($start,$end,$trigger) =
4335: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4336: if (($start != 0) &&
4337: (($startblock == 0) || ($startblock > $start))) {
4338: $startblock = $start;
1.1062 raeburn 4339: if ($trigger ne '') {
4340: $triggerblock = $trigger;
4341: }
1.502 raeburn 4342: }
4343: if (($end != 0) &&
4344: (($endblock == 0) || ($endblock < $end))) {
4345: $endblock = $end;
1.1062 raeburn 4346: if ($trigger ne '') {
4347: $triggerblock = $trigger;
4348: }
1.502 raeburn 4349: }
1.490 raeburn 4350: }
1.1062 raeburn 4351: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4352: }
4353:
4354: sub get_blocks {
1.1062 raeburn 4355: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4356: my $startblock = 0;
4357: my $endblock = 0;
1.1062 raeburn 4358: my $triggerblock = '';
1.490 raeburn 4359: my $course = $cdom.'_'.$cnum;
4360: $setters->{$course} = {};
4361: $setters->{$course}{'staff'} = [];
4362: $setters->{$course}{'times'} = [];
1.1062 raeburn 4363: $setters->{$course}{'triggers'} = [];
4364: my (@blockers,%triggered);
4365: my $now = time;
4366: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4367: if ($activity eq 'docs') {
4368: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4369: foreach my $block (@blockers) {
4370: if ($block =~ /^firstaccess____(.+)$/) {
4371: my $item = $1;
4372: my $type = 'map';
4373: my $timersymb = $item;
4374: if ($item eq 'course') {
4375: $type = 'course';
4376: } elsif ($item =~ /___\d+___/) {
4377: $type = 'resource';
4378: } else {
4379: $timersymb = &Apache::lonnet::symbread($item);
4380: }
4381: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4382: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4383: $triggered{$block} = {
4384: start => $start,
4385: end => $end,
4386: type => $type,
4387: };
4388: }
4389: }
4390: } else {
4391: foreach my $block (keys(%commblocks)) {
4392: if ($block =~ m/^(\d+)____(\d+)$/) {
4393: my ($start,$end) = ($1,$2);
4394: if ($start <= time && $end >= time) {
4395: if (ref($commblocks{$block}) eq 'HASH') {
4396: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4397: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4398: unless(grep(/^\Q$block\E$/,@blockers)) {
4399: push(@blockers,$block);
4400: }
4401: }
4402: }
4403: }
4404: }
4405: } elsif ($block =~ /^firstaccess____(.+)$/) {
4406: my $item = $1;
4407: my $timersymb = $item;
4408: my $type = 'map';
4409: if ($item eq 'course') {
4410: $type = 'course';
4411: } elsif ($item =~ /___\d+___/) {
4412: $type = 'resource';
4413: } else {
4414: $timersymb = &Apache::lonnet::symbread($item);
4415: }
4416: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4417: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4418: if ($start && $end) {
4419: if (($start <= time) && ($end >= time)) {
4420: unless (grep(/^\Q$block\E$/,@blockers)) {
4421: push(@blockers,$block);
4422: $triggered{$block} = {
4423: start => $start,
4424: end => $end,
4425: type => $type,
4426: };
4427: }
4428: }
1.490 raeburn 4429: }
1.1062 raeburn 4430: }
4431: }
4432: }
4433: foreach my $blocker (@blockers) {
4434: my ($staff_name,$staff_dom,$title,$blocks) =
4435: &parse_block_record($commblocks{$blocker});
4436: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4437: my ($start,$end,$triggertype);
4438: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4439: ($start,$end) = ($1,$2);
4440: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4441: $start = $triggered{$blocker}{'start'};
4442: $end = $triggered{$blocker}{'end'};
4443: $triggertype = $triggered{$blocker}{'type'};
4444: }
4445: if ($start) {
4446: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4447: if ($triggertype) {
4448: push(@{$$setters{$course}{'triggers'}},$triggertype);
4449: } else {
4450: push(@{$$setters{$course}{'triggers'}},0);
4451: }
4452: if ( ($startblock == 0) || ($startblock > $start) ) {
4453: $startblock = $start;
4454: if ($triggertype) {
4455: $triggerblock = $blocker;
1.474 raeburn 4456: }
4457: }
1.1062 raeburn 4458: if ( ($endblock == 0) || ($endblock < $end) ) {
4459: $endblock = $end;
4460: if ($triggertype) {
4461: $triggerblock = $blocker;
4462: }
4463: }
1.474 raeburn 4464: }
4465: }
1.1062 raeburn 4466: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4467: }
4468:
4469: sub parse_block_record {
4470: my ($record) = @_;
4471: my ($setuname,$setudom,$title,$blocks);
4472: if (ref($record) eq 'HASH') {
4473: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4474: $title = &unescape($record->{'event'});
4475: $blocks = $record->{'blocks'};
4476: } else {
4477: my @data = split(/:/,$record,3);
4478: if (scalar(@data) eq 2) {
4479: $title = $data[1];
4480: ($setuname,$setudom) = split(/@/,$data[0]);
4481: } else {
4482: ($setuname,$setudom,$title) = @data;
4483: }
4484: $blocks = { 'com' => 'on' };
4485: }
4486: return ($setuname,$setudom,$title,$blocks);
4487: }
4488:
1.854 kalberla 4489: sub blocking_status {
1.1062 raeburn 4490: my ($activity,$uname,$udom,$url) = @_;
1.1061 raeburn 4491: my %setters;
1.890 droeschl 4492:
1.1061 raeburn 4493: # check for active blocking
1.1062 raeburn 4494: my ($startblock,$endblock,$triggerblock) =
4495: &blockcheck(\%setters,$activity,$uname,$udom,$url);
4496: my $blocked = 0;
4497: if ($startblock && $endblock) {
4498: $blocked = 1;
4499: }
1.890 droeschl 4500:
1.1061 raeburn 4501: # caller just wants to know whether a block is active
4502: if (!wantarray) { return $blocked; }
4503:
4504: # build a link to a popup window containing the details
4505: my $querystring = "?activity=$activity";
4506: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4507: if ($activity eq 'port') {
4508: $querystring .= "&udom=$udom" if $udom;
4509: $querystring .= "&uname=$uname" if $uname;
4510: } elsif ($activity eq 'docs') {
4511: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4512: }
1.1061 raeburn 4513:
4514: my $output .= <<'END_MYBLOCK';
4515: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4516: var options = "width=" + w + ",height=" + h + ",";
4517: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4518: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4519: var newWin = window.open(url, wdwName, options);
4520: newWin.focus();
4521: }
1.890 droeschl 4522: END_MYBLOCK
1.854 kalberla 4523:
1.1061 raeburn 4524: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4525:
1.1061 raeburn 4526: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4527: my $text = &mt('Communication Blocked');
4528: if ($activity eq 'docs') {
4529: $text = &mt('Content Access Blocked');
1.1063 raeburn 4530: } elsif ($activity eq 'printout') {
4531: $text = &mt('Printing Blocked');
1.1062 raeburn 4532: }
1.1061 raeburn 4533: $output .= <<"END_BLOCK";
1.867 kalberla 4534: <div class='LC_comblock'>
1.869 kalberla 4535: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4536: title='$text'>
4537: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4538: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4539: title='$text'>$text</a>
1.867 kalberla 4540: </div>
4541:
4542: END_BLOCK
1.474 raeburn 4543:
1.1061 raeburn 4544: return ($blocked, $output);
1.854 kalberla 4545: }
1.490 raeburn 4546:
1.60 matthew 4547: ###############################################
4548:
1.682 raeburn 4549: sub check_ip_acc {
4550: my ($acc)=@_;
4551: &Apache::lonxml::debug("acc is $acc");
4552: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4553: return 1;
4554: }
4555: my $allowed=0;
4556: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4557:
4558: my $name;
4559: foreach my $pattern (split(',',$acc)) {
4560: $pattern =~ s/^\s*//;
4561: $pattern =~ s/\s*$//;
4562: if ($pattern =~ /\*$/) {
4563: #35.8.*
4564: $pattern=~s/\*//;
4565: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4566: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4567: #35.8.3.[34-56]
4568: my $low=$2;
4569: my $high=$3;
4570: $pattern=$1;
4571: if ($ip =~ /^\Q$pattern\E/) {
4572: my $last=(split(/\./,$ip))[3];
4573: if ($last <=$high && $last >=$low) { $allowed=1; }
4574: }
4575: } elsif ($pattern =~ /^\*/) {
4576: #*.msu.edu
4577: $pattern=~s/\*//;
4578: if (!defined($name)) {
4579: use Socket;
4580: my $netaddr=inet_aton($ip);
4581: ($name)=gethostbyaddr($netaddr,AF_INET);
4582: }
4583: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4584: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4585: #127.0.0.1
4586: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4587: } else {
4588: #some.name.com
4589: if (!defined($name)) {
4590: use Socket;
4591: my $netaddr=inet_aton($ip);
4592: ($name)=gethostbyaddr($netaddr,AF_INET);
4593: }
4594: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4595: }
4596: if ($allowed) { last; }
4597: }
4598: return $allowed;
4599: }
4600:
4601: ###############################################
4602:
1.60 matthew 4603: =pod
4604:
1.112 bowersj2 4605: =head1 Domain Template Functions
4606:
4607: =over 4
4608:
4609: =item * &determinedomain()
1.60 matthew 4610:
4611: Inputs: $domain (usually will be undef)
4612:
1.63 www 4613: Returns: Determines which domain should be used for designs
1.60 matthew 4614:
4615: =cut
1.54 www 4616:
1.60 matthew 4617: ###############################################
1.63 www 4618: sub determinedomain {
4619: my $domain=shift;
1.531 albertel 4620: if (! $domain) {
1.60 matthew 4621: # Determine domain if we have not been given one
1.893 raeburn 4622: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4623: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4624: if ($env{'request.role.domain'}) {
4625: $domain=$env{'request.role.domain'};
1.60 matthew 4626: }
4627: }
1.63 www 4628: return $domain;
4629: }
4630: ###############################################
1.517 raeburn 4631:
1.518 albertel 4632: sub devalidate_domconfig_cache {
4633: my ($udom)=@_;
4634: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4635: }
4636:
4637: # ---------------------- Get domain configuration for a domain
4638: sub get_domainconf {
4639: my ($udom) = @_;
4640: my $cachetime=1800;
4641: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4642: if (defined($cached)) { return %{$result}; }
4643:
4644: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4645: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4646: my (%designhash,%legacy);
1.518 albertel 4647: if (keys(%domconfig) > 0) {
4648: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4649: if (keys(%{$domconfig{'login'}})) {
4650: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4651: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4652: if ($key eq 'loginvia') {
4653: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4654: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4655: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4656: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4657: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4658: $designhash{$udom.'.login.loginvia'} = $server;
4659: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4660:
4661: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4662: } else {
1.1013 raeburn 4663: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4664: }
4665: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4666: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4667: }
1.946 raeburn 4668: }
4669: }
4670: }
4671: }
4672: } else {
4673: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4674: $designhash{$udom.'.login.'.$key.'_'.$img} =
4675: $domconfig{'login'}{$key}{$img};
4676: }
1.699 raeburn 4677: }
4678: } else {
4679: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4680: }
1.632 raeburn 4681: }
4682: } else {
4683: $legacy{'login'} = 1;
1.518 albertel 4684: }
1.632 raeburn 4685: } else {
4686: $legacy{'login'} = 1;
1.518 albertel 4687: }
4688: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4689: if (keys(%{$domconfig{'rolecolors'}})) {
4690: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4691: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4692: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4693: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4694: }
1.518 albertel 4695: }
4696: }
1.632 raeburn 4697: } else {
4698: $legacy{'rolecolors'} = 1;
1.518 albertel 4699: }
1.632 raeburn 4700: } else {
4701: $legacy{'rolecolors'} = 1;
1.518 albertel 4702: }
1.948 raeburn 4703: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4704: if ($domconfig{'autoenroll'}{'co-owners'}) {
4705: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4706: }
4707: }
1.632 raeburn 4708: if (keys(%legacy) > 0) {
4709: my %legacyhash = &get_legacy_domconf($udom);
4710: foreach my $item (keys(%legacyhash)) {
4711: if ($item =~ /^\Q$udom\E\.login/) {
4712: if ($legacy{'login'}) {
4713: $designhash{$item} = $legacyhash{$item};
4714: }
4715: } else {
4716: if ($legacy{'rolecolors'}) {
4717: $designhash{$item} = $legacyhash{$item};
4718: }
1.518 albertel 4719: }
4720: }
4721: }
1.632 raeburn 4722: } else {
4723: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4724: }
4725: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4726: $cachetime);
4727: return %designhash;
4728: }
4729:
1.632 raeburn 4730: sub get_legacy_domconf {
4731: my ($udom) = @_;
4732: my %legacyhash;
4733: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4734: my $designfile = $designdir.'/'.$udom.'.tab';
4735: if (-e $designfile) {
4736: if ( open (my $fh,"<$designfile") ) {
4737: while (my $line = <$fh>) {
4738: next if ($line =~ /^\#/);
4739: chomp($line);
4740: my ($key,$val)=(split(/\=/,$line));
4741: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4742: }
4743: close($fh);
4744: }
4745: }
1.1026 raeburn 4746: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4747: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4748: }
4749: return %legacyhash;
4750: }
4751:
1.63 www 4752: =pod
4753:
1.112 bowersj2 4754: =item * &domainlogo()
1.63 www 4755:
4756: Inputs: $domain (usually will be undef)
4757:
4758: Returns: A link to a domain logo, if the domain logo exists.
4759: If the domain logo does not exist, a description of the domain.
4760:
4761: =cut
1.112 bowersj2 4762:
1.63 www 4763: ###############################################
4764: sub domainlogo {
1.517 raeburn 4765: my $domain = &determinedomain(shift);
1.518 albertel 4766: my %designhash = &get_domainconf($domain);
1.517 raeburn 4767: # See if there is a logo
4768: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4769: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4770: if ($imgsrc =~ m{^/(adm|res)/}) {
4771: if ($imgsrc =~ m{^/res/}) {
4772: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4773: &Apache::lonnet::repcopy($local_name);
4774: }
4775: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4776: }
4777: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4778: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4779: return &Apache::lonnet::domain($domain,'description');
1.59 www 4780: } else {
1.60 matthew 4781: return '';
1.59 www 4782: }
4783: }
1.63 www 4784: ##############################################
4785:
4786: =pod
4787:
1.112 bowersj2 4788: =item * &designparm()
1.63 www 4789:
4790: Inputs: $which parameter; $domain (usually will be undef)
4791:
4792: Returns: value of designparamter $which
4793:
4794: =cut
1.112 bowersj2 4795:
1.397 albertel 4796:
1.400 albertel 4797: ##############################################
1.397 albertel 4798: sub designparm {
4799: my ($which,$domain)=@_;
4800: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4801: return $env{'environment.color.'.$which};
1.96 www 4802: }
1.63 www 4803: $domain=&determinedomain($domain);
1.1016 raeburn 4804: my %domdesign;
4805: unless ($domain eq 'public') {
4806: %domdesign = &get_domainconf($domain);
4807: }
1.520 raeburn 4808: my $output;
1.517 raeburn 4809: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4810: $output = $domdesign{$domain.'.'.$which};
1.63 www 4811: } else {
1.520 raeburn 4812: $output = $defaultdesign{$which};
4813: }
4814: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4815: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4816: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4817: if ($output =~ m{^/res/}) {
4818: my $local_name = &Apache::lonnet::filelocation('',$output);
4819: &Apache::lonnet::repcopy($local_name);
4820: }
1.520 raeburn 4821: $output = &lonhttpdurl($output);
4822: }
1.63 www 4823: }
1.520 raeburn 4824: return $output;
1.63 www 4825: }
1.59 www 4826:
1.822 bisitz 4827: ##############################################
4828: =pod
4829:
1.832 bisitz 4830: =item * &authorspace()
4831:
1.1028 raeburn 4832: Inputs: $url (usually will be undef).
1.832 bisitz 4833:
1.1028 raeburn 4834: Returns: Path to Construction Space containing the resource or
4835: directory being viewed (or for which action is being taken).
4836: If $url is provided, and begins /priv/<domain>/<uname>
4837: the path will be that portion of the $context argument.
4838: Otherwise the path will be for the author space of the current
4839: user when the current role is author, or for that of the
4840: co-author/assistant co-author space when the current role
4841: is co-author or assistant co-author.
1.832 bisitz 4842:
4843: =cut
4844:
4845: sub authorspace {
1.1028 raeburn 4846: my ($url) = @_;
4847: if ($url ne '') {
4848: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4849: return $1;
4850: }
4851: }
1.832 bisitz 4852: my $caname = '';
1.1024 www 4853: my $cadom = '';
1.1028 raeburn 4854: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4855: ($cadom,$caname) =
1.832 bisitz 4856: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4857: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4858: $caname = $env{'user.name'};
1.1024 www 4859: $cadom = $env{'user.domain'};
1.832 bisitz 4860: }
1.1028 raeburn 4861: if (($caname ne '') && ($cadom ne '')) {
4862: return "/priv/$cadom/$caname/";
4863: }
4864: return;
1.832 bisitz 4865: }
4866:
4867: ##############################################
4868: =pod
4869:
1.822 bisitz 4870: =item * &head_subbox()
4871:
4872: Inputs: $content (contains HTML code with page functions, etc.)
4873:
4874: Returns: HTML div with $content
4875: To be included in page header
4876:
4877: =cut
4878:
4879: sub head_subbox {
4880: my ($content)=@_;
4881: my $output =
1.993 raeburn 4882: '<div class="LC_head_subbox">'
1.822 bisitz 4883: .$content
4884: .'</div>'
4885: }
4886:
4887: ##############################################
4888: =pod
4889:
4890: =item * &CSTR_pageheader()
4891:
1.1026 raeburn 4892: Input: (optional) filename from which breadcrumb trail is built.
4893: In most cases no input as needed, as $env{'request.filename'}
4894: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 4895:
4896: Returns: HTML div with CSTR path and recent box
4897: To be included on Construction Space pages
4898:
4899: =cut
4900:
4901: sub CSTR_pageheader {
1.1026 raeburn 4902: my ($trailfile) = @_;
4903: if ($trailfile eq '') {
4904: $trailfile = $env{'request.filename'};
4905: }
4906:
4907: # this is for resources; directories have customtitle, and crumbs
4908: # and select recent are created in lonpubdir.pm
4909:
4910: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 4911: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 4912: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 4913: my $formaction = "/priv/$udom/$uname/$thisdisfn";
4914: $formaction =~ s{/+}{/}g;
1.822 bisitz 4915:
4916: my $parentpath = '';
4917: my $lastitem = '';
4918: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4919: $parentpath = $1;
4920: $lastitem = $2;
4921: } else {
4922: $lastitem = $thisdisfn;
4923: }
1.921 bisitz 4924:
4925: my $output =
1.822 bisitz 4926: '<div>'
4927: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
4928: .'<b>'.&mt('Construction Space:').'</b> '
4929: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 4930: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 4931: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 4932:
4933: if ($lastitem) {
4934: $output .=
4935: '<span class="LC_filename">'
4936: .$lastitem
4937: .'</span>';
4938: }
4939: $output .=
4940: '<br />'
1.822 bisitz 4941: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
4942: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4943: .'</form>'
4944: .&Apache::lonmenu::constspaceform()
4945: .'</div>';
1.921 bisitz 4946:
4947: return $output;
1.822 bisitz 4948: }
4949:
1.60 matthew 4950: ###############################################
4951: ###############################################
4952:
4953: =pod
4954:
1.112 bowersj2 4955: =back
4956:
1.549 albertel 4957: =head1 HTML Helpers
1.112 bowersj2 4958:
4959: =over 4
4960:
4961: =item * &bodytag()
1.60 matthew 4962:
4963: Returns a uniform header for LON-CAPA web pages.
4964:
4965: Inputs:
4966:
1.112 bowersj2 4967: =over 4
4968:
4969: =item * $title, A title to be displayed on the page.
4970:
4971: =item * $function, the current role (can be undef).
4972:
4973: =item * $addentries, extra parameters for the <body> tag.
4974:
4975: =item * $bodyonly, if defined, only return the <body> tag.
4976:
4977: =item * $domain, if defined, force a given domain.
4978:
4979: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4980: text interface only)
1.60 matthew 4981:
1.814 bisitz 4982: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
4983: navigational links
1.317 albertel 4984:
1.338 albertel 4985: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4986:
1.1075.2.12 raeburn 4987: =item * $no_inline_link, if true and in remote mode, don't show the
4988: 'Switch To Inline Menu' link
4989:
1.460 albertel 4990: =item * $args, optional argument valid values are
4991: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4992: inherit_jsmath -> when creating popup window in a page,
4993: should it have jsmath forced on by the
4994: current page
1.460 albertel 4995:
1.1075.2.15 raeburn 4996: =item * $advtoolsref, optional argument, ref to an array containing
4997: inlineremote items to be added in "Functions" menu below
4998: breadcrumbs.
4999:
1.112 bowersj2 5000: =back
5001:
1.60 matthew 5002: Returns: A uniform header for LON-CAPA web pages.
5003: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5004: If $bodyonly is undef or zero, an html string containing a <body> tag and
5005: other decorations will be returned.
5006:
5007: =cut
5008:
1.54 www 5009: sub bodytag {
1.831 bisitz 5010: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5011: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5012:
1.954 raeburn 5013: my $public;
5014: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5015: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5016: $public = 1;
5017: }
1.460 albertel 5018: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 5019:
1.183 matthew 5020: $function = &get_users_function() if (!$function);
1.339 albertel 5021: my $img = &designparm($function.'.img',$domain);
5022: my $font = &designparm($function.'.font',$domain);
5023: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5024:
1.803 bisitz 5025: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5026: 'bgcolor' => $pgbg,
1.339 albertel 5027: 'text' => $font,
5028: 'alink' => &designparm($function.'.alink',$domain),
5029: 'vlink' => &designparm($function.'.vlink',$domain),
5030: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5031: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5032:
1.63 www 5033: # role and realm
1.378 raeburn 5034: my ($role,$realm) = split(/\./,$env{'request.role'},2);
5035: if ($role eq 'ca') {
1.479 albertel 5036: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5037: $realm = &plainname($rname,$rdom);
1.378 raeburn 5038: }
1.55 www 5039: # realm
1.258 albertel 5040: if ($env{'request.course.id'}) {
1.378 raeburn 5041: if ($env{'request.role'} !~ /^cr/) {
5042: $role = &Apache::lonnet::plaintext($role,&course_type());
5043: }
1.898 raeburn 5044: if ($env{'request.course.sec'}) {
5045: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5046: }
1.359 albertel 5047: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5048: } else {
5049: $role = &Apache::lonnet::plaintext($role);
1.54 www 5050: }
1.433 albertel 5051:
1.359 albertel 5052: if (!$realm) { $realm=' '; }
1.330 albertel 5053:
1.438 albertel 5054: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5055:
1.101 www 5056: # construct main body tag
1.359 albertel 5057: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5058: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5059:
1.530 albertel 5060: if ($bodyonly) {
1.60 matthew 5061: return $bodytag;
1.798 tempelho 5062: }
1.359 albertel 5063:
1.410 albertel 5064: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954 raeburn 5065: if ($public) {
1.433 albertel 5066: undef($role);
1.434 albertel 5067: } else {
1.1070 raeburn 5068: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5069: undef,'LC_menubuttons_link');
1.433 albertel 5070: }
1.359 albertel 5071:
1.762 bisitz 5072: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5073: #
5074: # Extra info if you are the DC
5075: my $dc_info = '';
5076: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5077: $env{'course.'.$env{'request.course.id'}.
5078: '.domain'}.'/'})) {
5079: my $cid = $env{'request.course.id'};
1.917 raeburn 5080: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5081: $dc_info =~ s/\s+$//;
1.359 albertel 5082: }
5083:
1.898 raeburn 5084: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5085: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5086:
1.1075.2.13 raeburn 5087: if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
5088: return $bodytag;
5089: }
1.903 droeschl 5090:
1.1075.2.13 raeburn 5091: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5092:
1.1075.2.21 raeburn 5093: my $funclist;
5094: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
5095: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n".
5096: Apache::lonmenu::serverform();
5097: my $forbodytag;
5098: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5099: $forcereg,$args->{'group'},
5100: $args->{'bread_crumbs'},
5101: $advtoolsref,'',\$forbodytag);
5102: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5103: $funclist = $forbodytag;
5104: }
5105: } else {
1.903 droeschl 5106:
5107: # if ($env{'request.state'} eq 'construct') {
5108: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5109: # }
5110:
1.359 albertel 5111:
1.1075.2.2 raeburn 5112:
1.916 droeschl 5113: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5114: if ($dc_info) {
5115: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5116: }
1.1075.2.22 raeburn 5117: $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
5118: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5119: return $bodytag;
5120: }
1.894 droeschl 5121:
1.927 raeburn 5122: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
5123: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
5124: }
1.916 droeschl 5125:
1.903 droeschl 5126: $bodytag .= Apache::lonhtmlcommon::scripttag(
5127: Apache::lonmenu::utilityfunctions(), 'start');
1.816 bisitz 5128:
1.903 droeschl 5129: $bodytag .= Apache::lonmenu::primary_menu();
1.852 droeschl 5130:
1.917 raeburn 5131: if ($dc_info) {
5132: $dc_info = &dc_courseid_toggle($dc_info);
5133: }
5134: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5135:
1.903 droeschl 5136: #don't show menus for public users
1.954 raeburn 5137: if (!$public){
1.903 droeschl 5138: $bodytag .= Apache::lonmenu::secondary_menu();
5139: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5140: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5141: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5142: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5143: $args->{'bread_crumbs'});
5144: } elsif ($forcereg) {
1.1075.2.22 raeburn 5145: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5146: $args->{'group'});
1.1075.2.15 raeburn 5147: } else {
1.1075.2.21 raeburn 5148: my $forbodytag;
5149: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5150: $forcereg,$args->{'group'},
5151: $args->{'bread_crumbs'},
5152: $advtoolsref,'',\$forbodytag);
5153: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5154: $bodytag .= $forbodytag;
5155: }
1.920 raeburn 5156: }
1.903 droeschl 5157: }else{
5158: # this is to seperate menu from content when there's no secondary
5159: # menu. Especially needed for public accessible ressources.
5160: $bodytag .= '<hr style="clear:both" />';
5161: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5162: }
1.903 droeschl 5163:
1.235 raeburn 5164: return $bodytag;
1.1075.2.12 raeburn 5165: }
5166:
5167: #
5168: # Top frame rendering, Remote is up
5169: #
5170:
5171: my $imgsrc = $img;
5172: if ($img =~ /^\/adm/) {
5173: $imgsrc = &lonhttpdurl($img);
5174: }
5175: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5176:
5177: # Explicit link to get inline menu
5178: my $menu= ($no_inline_link?''
5179: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5180:
5181: if ($dc_info) {
5182: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5183: }
5184:
5185: unless ($env{'form.inhibitmenu'}) {
5186: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
5187: <ol class="LC_primary_menu LC_right">
5188: <li>$menu</li>
5189: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5190: }
1.1075.2.13 raeburn 5191: if ($env{'request.state'} eq 'construct') {
5192: if (!$public){
5193: if ($env{'request.state'} eq 'construct') {
5194: $funclist = &Apache::lonhtmlcommon::scripttag(
5195: &Apache::lonmenu::utilityfunctions(), 'start').
5196: &Apache::lonhtmlcommon::scripttag('','end').
5197: &Apache::lonmenu::innerregister($forcereg,
5198: $args->{'bread_crumbs'});
5199: }
5200: }
5201: }
1.1075.2.21 raeburn 5202: return $bodytag."\n".$funclist;
1.182 matthew 5203: }
5204:
1.917 raeburn 5205: sub dc_courseid_toggle {
5206: my ($dc_info) = @_;
1.980 raeburn 5207: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5208: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5209: &mt('(More ...)').'</a></span>'.
5210: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5211: }
5212:
1.330 albertel 5213: sub make_attr_string {
5214: my ($register,$attr_ref) = @_;
5215:
5216: if ($attr_ref && !ref($attr_ref)) {
5217: die("addentries Must be a hash ref ".
5218: join(':',caller(1))." ".
5219: join(':',caller(0))." ");
5220: }
5221:
5222: if ($register) {
1.339 albertel 5223: my ($on_load,$on_unload);
5224: foreach my $key (keys(%{$attr_ref})) {
5225: if (lc($key) eq 'onload') {
5226: $on_load.=$attr_ref->{$key}.';';
5227: delete($attr_ref->{$key});
5228:
5229: } elsif (lc($key) eq 'onunload') {
5230: $on_unload.=$attr_ref->{$key}.';';
5231: delete($attr_ref->{$key});
5232: }
5233: }
1.1075.2.12 raeburn 5234: if ($env{'environment.remote'} eq 'on') {
5235: $attr_ref->{'onload'} =
5236: &Apache::lonmenu::loadevents(). $on_load;
5237: $attr_ref->{'onunload'}=
5238: &Apache::lonmenu::unloadevents().$on_unload;
5239: } else {
5240: $attr_ref->{'onload'} = $on_load;
5241: $attr_ref->{'onunload'}= $on_unload;
5242: }
1.330 albertel 5243: }
1.339 albertel 5244:
1.330 albertel 5245: my $attr_string;
5246: foreach my $attr (keys(%$attr_ref)) {
5247: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5248: }
5249: return $attr_string;
5250: }
5251:
5252:
1.182 matthew 5253: ###############################################
1.251 albertel 5254: ###############################################
5255:
5256: =pod
5257:
5258: =item * &endbodytag()
5259:
5260: Returns a uniform footer for LON-CAPA web pages.
5261:
1.635 raeburn 5262: Inputs: 1 - optional reference to an args hash
5263: If in the hash, key for noredirectlink has a value which evaluates to true,
5264: a 'Continue' link is not displayed if the page contains an
5265: internal redirect in the <head></head> section,
5266: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5267:
5268: =cut
5269:
5270: sub endbodytag {
1.635 raeburn 5271: my ($args) = @_;
1.1075.2.6 raeburn 5272: my $endbodytag;
5273: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5274: $endbodytag='</body>';
5275: }
1.269 albertel 5276: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5277: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5278: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5279: $endbodytag=
5280: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5281: &mt('Continue').'</a>'.
5282: $endbodytag;
5283: }
1.315 albertel 5284: }
1.251 albertel 5285: return $endbodytag;
5286: }
5287:
1.352 albertel 5288: =pod
5289:
5290: =item * &standard_css()
5291:
5292: Returns a style sheet
5293:
5294: Inputs: (all optional)
5295: domain -> force to color decorate a page for a specific
5296: domain
5297: function -> force usage of a specific rolish color scheme
5298: bgcolor -> override the default page bgcolor
5299:
5300: =cut
5301:
1.343 albertel 5302: sub standard_css {
1.345 albertel 5303: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5304: $function = &get_users_function() if (!$function);
5305: my $img = &designparm($function.'.img', $domain);
5306: my $tabbg = &designparm($function.'.tabbg', $domain);
5307: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5308: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5309: #second colour for later usage
1.345 albertel 5310: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5311: my $pgbg_or_bgcolor =
5312: $bgcolor ||
1.352 albertel 5313: &designparm($function.'.pgbg', $domain);
1.382 albertel 5314: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5315: my $alink = &designparm($function.'.alink', $domain);
5316: my $vlink = &designparm($function.'.vlink', $domain);
5317: my $link = &designparm($function.'.link', $domain);
5318:
1.602 albertel 5319: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5320: my $mono = 'monospace';
1.850 bisitz 5321: my $data_table_head = $sidebg;
5322: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5323: my $data_table_dark = '#E0E0E0';
1.470 banghart 5324: my $data_table_darker = '#CCCCCC';
1.349 albertel 5325: my $data_table_highlight = '#FFFF00';
1.352 albertel 5326: my $mail_new = '#FFBB77';
5327: my $mail_new_hover = '#DD9955';
5328: my $mail_read = '#BBBB77';
5329: my $mail_read_hover = '#999944';
5330: my $mail_replied = '#AAAA88';
5331: my $mail_replied_hover = '#888855';
5332: my $mail_other = '#99BBBB';
5333: my $mail_other_hover = '#669999';
1.391 albertel 5334: my $table_header = '#DDDDDD';
1.489 raeburn 5335: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5336: my $lg_border_color = '#C8C8C8';
1.952 onken 5337: my $button_hover = '#BF2317';
1.392 albertel 5338:
1.608 albertel 5339: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5340: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5341: : '0 3px 0 4px';
1.448 albertel 5342:
1.523 albertel 5343:
1.343 albertel 5344: return <<END;
1.947 droeschl 5345:
5346: /* needed for iframe to allow 100% height in FF */
5347: body, html {
5348: margin: 0;
5349: padding: 0 0.5%;
5350: height: 99%; /* to avoid scrollbars */
5351: }
5352:
1.795 www 5353: body {
1.911 bisitz 5354: font-family: $sans;
5355: line-height:130%;
5356: font-size:0.83em;
5357: color:$font;
1.795 www 5358: }
5359:
1.959 onken 5360: a:focus,
5361: a:focus img {
1.795 www 5362: color: red;
5363: }
1.698 harmsja 5364:
1.911 bisitz 5365: form, .inline {
5366: display: inline;
1.795 www 5367: }
1.721 harmsja 5368:
1.795 www 5369: .LC_right {
1.911 bisitz 5370: text-align:right;
1.795 www 5371: }
5372:
5373: .LC_middle {
1.911 bisitz 5374: vertical-align:middle;
1.795 www 5375: }
1.721 harmsja 5376:
1.911 bisitz 5377: .LC_400Box {
5378: width:400px;
5379: }
1.721 harmsja 5380:
1.947 droeschl 5381: .LC_iframecontainer {
5382: width: 98%;
5383: margin: 0;
5384: position: fixed;
5385: top: 8.5em;
5386: bottom: 0;
5387: }
5388:
5389: .LC_iframecontainer iframe{
5390: border: none;
5391: width: 100%;
5392: height: 100%;
5393: }
5394:
1.778 bisitz 5395: .LC_filename {
5396: font-family: $mono;
5397: white-space:pre;
1.921 bisitz 5398: font-size: 120%;
1.778 bisitz 5399: }
5400:
5401: .LC_fileicon {
5402: border: none;
5403: height: 1.3em;
5404: vertical-align: text-bottom;
5405: margin-right: 0.3em;
5406: text-decoration:none;
5407: }
5408:
1.1008 www 5409: .LC_setting {
5410: text-decoration:underline;
5411: }
5412:
1.350 albertel 5413: .LC_error {
5414: color: red;
5415: }
1.795 www 5416:
1.1075.2.15 raeburn 5417: .LC_warning {
5418: color: darkorange;
5419: }
5420:
1.457 albertel 5421: .LC_diff_removed {
1.733 bisitz 5422: color: red;
1.394 albertel 5423: }
1.532 albertel 5424:
5425: .LC_info,
1.457 albertel 5426: .LC_success,
5427: .LC_diff_added {
1.350 albertel 5428: color: green;
5429: }
1.795 www 5430:
1.802 bisitz 5431: div.LC_confirm_box {
5432: background-color: #FAFAFA;
5433: border: 1px solid $lg_border_color;
5434: margin-right: 0;
5435: padding: 5px;
5436: }
5437:
5438: div.LC_confirm_box .LC_error img,
5439: div.LC_confirm_box .LC_success img {
5440: vertical-align: middle;
5441: }
5442:
1.440 albertel 5443: .LC_icon {
1.771 droeschl 5444: border: none;
1.790 droeschl 5445: vertical-align: middle;
1.771 droeschl 5446: }
5447:
1.543 albertel 5448: .LC_docs_spacer {
5449: width: 25px;
5450: height: 1px;
1.771 droeschl 5451: border: none;
1.543 albertel 5452: }
1.346 albertel 5453:
1.532 albertel 5454: .LC_internal_info {
1.735 bisitz 5455: color: #999999;
1.532 albertel 5456: }
5457:
1.794 www 5458: .LC_discussion {
1.1050 www 5459: background: $data_table_dark;
1.911 bisitz 5460: border: 1px solid black;
5461: margin: 2px;
1.794 www 5462: }
5463:
5464: .LC_disc_action_left {
1.1050 www 5465: background: $sidebg;
1.911 bisitz 5466: text-align: left;
1.1050 www 5467: padding: 4px;
5468: margin: 2px;
1.794 www 5469: }
5470:
5471: .LC_disc_action_right {
1.1050 www 5472: background: $sidebg;
1.911 bisitz 5473: text-align: right;
1.1050 www 5474: padding: 4px;
5475: margin: 2px;
1.794 www 5476: }
5477:
5478: .LC_disc_new_item {
1.911 bisitz 5479: background: white;
5480: border: 2px solid red;
1.1050 www 5481: margin: 4px;
5482: padding: 4px;
1.794 www 5483: }
5484:
5485: .LC_disc_old_item {
1.911 bisitz 5486: background: white;
1.1050 www 5487: margin: 4px;
5488: padding: 4px;
1.794 www 5489: }
5490:
1.458 albertel 5491: table.LC_pastsubmission {
5492: border: 1px solid black;
5493: margin: 2px;
5494: }
5495:
1.924 bisitz 5496: table#LC_menubuttons {
1.345 albertel 5497: width: 100%;
5498: background: $pgbg;
1.392 albertel 5499: border: 2px;
1.402 albertel 5500: border-collapse: separate;
1.803 bisitz 5501: padding: 0;
1.345 albertel 5502: }
1.392 albertel 5503:
1.801 tempelho 5504: table#LC_title_bar a {
5505: color: $fontmenu;
5506: }
1.836 bisitz 5507:
1.807 droeschl 5508: table#LC_title_bar {
1.819 tempelho 5509: clear: both;
1.836 bisitz 5510: display: none;
1.807 droeschl 5511: }
5512:
1.795 www 5513: table#LC_title_bar,
1.933 droeschl 5514: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5515: table#LC_title_bar.LC_with_remote {
1.359 albertel 5516: width: 100%;
1.392 albertel 5517: border-color: $pgbg;
5518: border-style: solid;
5519: border-width: $border;
1.379 albertel 5520: background: $pgbg;
1.801 tempelho 5521: color: $fontmenu;
1.392 albertel 5522: border-collapse: collapse;
1.803 bisitz 5523: padding: 0;
1.819 tempelho 5524: margin: 0;
1.359 albertel 5525: }
1.795 www 5526:
1.933 droeschl 5527: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5528: margin: 0;
5529: padding: 0;
1.933 droeschl 5530: position: relative;
5531: list-style: none;
1.913 droeschl 5532: }
1.933 droeschl 5533: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5534: display: inline;
5535: }
1.933 droeschl 5536:
5537: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5538: padding: 0;
1.933 droeschl 5539: margin: 0;
5540: float: left;
1.913 droeschl 5541: }
1.933 droeschl 5542: .LC_breadcrumb_tools_tools {
5543: padding: 0;
5544: margin: 0;
1.913 droeschl 5545: float: right;
5546: }
5547:
1.359 albertel 5548: table#LC_title_bar td {
5549: background: $tabbg;
5550: }
1.795 www 5551:
1.911 bisitz 5552: table#LC_menubuttons img {
1.803 bisitz 5553: border: none;
1.346 albertel 5554: }
1.795 www 5555:
1.842 droeschl 5556: .LC_breadcrumbs_component {
1.911 bisitz 5557: float: right;
5558: margin: 0 1em;
1.357 albertel 5559: }
1.842 droeschl 5560: .LC_breadcrumbs_component img {
1.911 bisitz 5561: vertical-align: middle;
1.777 tempelho 5562: }
1.795 www 5563:
1.383 albertel 5564: td.LC_table_cell_checkbox {
5565: text-align: center;
5566: }
1.795 www 5567:
5568: .LC_fontsize_small {
1.911 bisitz 5569: font-size: 70%;
1.705 tempelho 5570: }
5571:
1.844 bisitz 5572: #LC_breadcrumbs {
1.911 bisitz 5573: clear:both;
5574: background: $sidebg;
5575: border-bottom: 1px solid $lg_border_color;
5576: line-height: 2.5em;
1.933 droeschl 5577: overflow: hidden;
1.911 bisitz 5578: margin: 0;
5579: padding: 0;
1.995 raeburn 5580: text-align: left;
1.819 tempelho 5581: }
1.862 bisitz 5582:
1.1075.2.16 raeburn 5583: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5584: clear:both;
5585: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5586: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5587: margin: 0 0 10px 0;
1.966 bisitz 5588: padding: 3px;
1.995 raeburn 5589: text-align: left;
1.822 bisitz 5590: }
5591:
1.795 www 5592: .LC_fontsize_medium {
1.911 bisitz 5593: font-size: 85%;
1.705 tempelho 5594: }
5595:
1.795 www 5596: .LC_fontsize_large {
1.911 bisitz 5597: font-size: 120%;
1.705 tempelho 5598: }
5599:
1.346 albertel 5600: .LC_menubuttons_inline_text {
5601: color: $font;
1.698 harmsja 5602: font-size: 90%;
1.701 harmsja 5603: padding-left:3px;
1.346 albertel 5604: }
5605:
1.934 droeschl 5606: .LC_menubuttons_inline_text img{
5607: vertical-align: middle;
5608: }
5609:
1.1051 www 5610: li.LC_menubuttons_inline_text img {
1.951 onken 5611: cursor:pointer;
1.1002 droeschl 5612: text-decoration: none;
1.951 onken 5613: }
5614:
1.526 www 5615: .LC_menubuttons_link {
5616: text-decoration: none;
5617: }
1.795 www 5618:
1.522 albertel 5619: .LC_menubuttons_category {
1.521 www 5620: color: $font;
1.526 www 5621: background: $pgbg;
1.521 www 5622: font-size: larger;
5623: font-weight: bold;
5624: }
5625:
1.346 albertel 5626: td.LC_menubuttons_text {
1.911 bisitz 5627: color: $font;
1.346 albertel 5628: }
1.706 harmsja 5629:
1.346 albertel 5630: .LC_current_location {
5631: background: $tabbg;
5632: }
1.795 www 5633:
1.938 bisitz 5634: table.LC_data_table {
1.347 albertel 5635: border: 1px solid #000000;
1.402 albertel 5636: border-collapse: separate;
1.426 albertel 5637: border-spacing: 1px;
1.610 albertel 5638: background: $pgbg;
1.347 albertel 5639: }
1.795 www 5640:
1.422 albertel 5641: .LC_data_table_dense {
5642: font-size: small;
5643: }
1.795 www 5644:
1.507 raeburn 5645: table.LC_nested_outer {
5646: border: 1px solid #000000;
1.589 raeburn 5647: border-collapse: collapse;
1.803 bisitz 5648: border-spacing: 0;
1.507 raeburn 5649: width: 100%;
5650: }
1.795 www 5651:
1.879 raeburn 5652: table.LC_innerpickbox,
1.507 raeburn 5653: table.LC_nested {
1.803 bisitz 5654: border: none;
1.589 raeburn 5655: border-collapse: collapse;
1.803 bisitz 5656: border-spacing: 0;
1.507 raeburn 5657: width: 100%;
5658: }
1.795 www 5659:
1.911 bisitz 5660: table.LC_data_table tr th,
5661: table.LC_calendar tr th,
1.879 raeburn 5662: table.LC_prior_tries tr th,
5663: table.LC_innerpickbox tr th {
1.349 albertel 5664: font-weight: bold;
5665: background-color: $data_table_head;
1.801 tempelho 5666: color:$fontmenu;
1.701 harmsja 5667: font-size:90%;
1.347 albertel 5668: }
1.795 www 5669:
1.879 raeburn 5670: table.LC_innerpickbox tr th,
5671: table.LC_innerpickbox tr td {
5672: vertical-align: top;
5673: }
5674:
1.711 raeburn 5675: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5676: background-color: #CCCCCC;
1.711 raeburn 5677: font-weight: bold;
5678: text-align: left;
5679: }
1.795 www 5680:
1.912 bisitz 5681: table.LC_data_table tr.LC_odd_row > td {
5682: background-color: $data_table_light;
5683: padding: 2px;
5684: vertical-align: top;
5685: }
5686:
1.809 bisitz 5687: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5688: background-color: $data_table_light;
1.912 bisitz 5689: vertical-align: top;
5690: }
5691:
5692: table.LC_data_table tr.LC_even_row > td {
5693: background-color: $data_table_dark;
1.425 albertel 5694: padding: 2px;
1.900 bisitz 5695: vertical-align: top;
1.347 albertel 5696: }
1.795 www 5697:
1.809 bisitz 5698: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5699: background-color: $data_table_dark;
1.900 bisitz 5700: vertical-align: top;
1.347 albertel 5701: }
1.795 www 5702:
1.425 albertel 5703: table.LC_data_table tr.LC_data_table_highlight td {
5704: background-color: $data_table_darker;
5705: }
1.795 www 5706:
1.639 raeburn 5707: table.LC_data_table tr td.LC_leftcol_header {
5708: background-color: $data_table_head;
5709: font-weight: bold;
5710: }
1.795 www 5711:
1.451 albertel 5712: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5713: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5714: font-weight: bold;
5715: font-style: italic;
5716: text-align: center;
5717: padding: 8px;
1.347 albertel 5718: }
1.795 www 5719:
1.1075.2.30 raeburn 5720: table.LC_data_table tr.LC_empty_row td,
5721: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5722: background-color: $sidebg;
5723: }
5724:
5725: table.LC_nested tr.LC_empty_row td {
5726: background-color: #FFFFFF;
5727: }
5728:
1.890 droeschl 5729: table.LC_caption {
5730: }
5731:
1.507 raeburn 5732: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5733: padding: 4ex
5734: }
1.795 www 5735:
1.507 raeburn 5736: table.LC_nested_outer tr th {
5737: font-weight: bold;
1.801 tempelho 5738: color:$fontmenu;
1.507 raeburn 5739: background-color: $data_table_head;
1.701 harmsja 5740: font-size: small;
1.507 raeburn 5741: border-bottom: 1px solid #000000;
5742: }
1.795 www 5743:
1.507 raeburn 5744: table.LC_nested_outer tr td.LC_subheader {
5745: background-color: $data_table_head;
5746: font-weight: bold;
5747: font-size: small;
5748: border-bottom: 1px solid #000000;
5749: text-align: right;
1.451 albertel 5750: }
1.795 www 5751:
1.507 raeburn 5752: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5753: background-color: #CCCCCC;
1.451 albertel 5754: font-weight: bold;
5755: font-size: small;
1.507 raeburn 5756: text-align: center;
5757: }
1.795 www 5758:
1.589 raeburn 5759: table.LC_nested tr.LC_info_row td.LC_left_item,
5760: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5761: text-align: left;
1.451 albertel 5762: }
1.795 www 5763:
1.507 raeburn 5764: table.LC_nested td {
1.735 bisitz 5765: background-color: #FFFFFF;
1.451 albertel 5766: font-size: small;
1.507 raeburn 5767: }
1.795 www 5768:
1.507 raeburn 5769: table.LC_nested_outer tr th.LC_right_item,
5770: table.LC_nested tr.LC_info_row td.LC_right_item,
5771: table.LC_nested tr.LC_odd_row td.LC_right_item,
5772: table.LC_nested tr td.LC_right_item {
1.451 albertel 5773: text-align: right;
5774: }
5775:
1.507 raeburn 5776: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5777: background-color: #EEEEEE;
1.451 albertel 5778: }
5779:
1.473 raeburn 5780: table.LC_createuser {
5781: }
5782:
5783: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5784: font-size: small;
1.473 raeburn 5785: }
5786:
5787: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5788: background-color: #CCCCCC;
1.473 raeburn 5789: font-weight: bold;
5790: text-align: center;
5791: }
5792:
1.349 albertel 5793: table.LC_calendar {
5794: border: 1px solid #000000;
5795: border-collapse: collapse;
1.917 raeburn 5796: width: 98%;
1.349 albertel 5797: }
1.795 www 5798:
1.349 albertel 5799: table.LC_calendar_pickdate {
5800: font-size: xx-small;
5801: }
1.795 www 5802:
1.349 albertel 5803: table.LC_calendar tr td {
5804: border: 1px solid #000000;
5805: vertical-align: top;
1.917 raeburn 5806: width: 14%;
1.349 albertel 5807: }
1.795 www 5808:
1.349 albertel 5809: table.LC_calendar tr td.LC_calendar_day_empty {
5810: background-color: $data_table_dark;
5811: }
1.795 www 5812:
1.779 bisitz 5813: table.LC_calendar tr td.LC_calendar_day_current {
5814: background-color: $data_table_highlight;
1.777 tempelho 5815: }
1.795 www 5816:
1.938 bisitz 5817: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5818: background-color: $mail_new;
5819: }
1.795 www 5820:
1.938 bisitz 5821: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5822: background-color: $mail_new_hover;
5823: }
1.795 www 5824:
1.938 bisitz 5825: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5826: background-color: $mail_read;
5827: }
1.795 www 5828:
1.938 bisitz 5829: /*
5830: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5831: background-color: $mail_read_hover;
5832: }
1.938 bisitz 5833: */
1.795 www 5834:
1.938 bisitz 5835: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5836: background-color: $mail_replied;
5837: }
1.795 www 5838:
1.938 bisitz 5839: /*
5840: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5841: background-color: $mail_replied_hover;
5842: }
1.938 bisitz 5843: */
1.795 www 5844:
1.938 bisitz 5845: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5846: background-color: $mail_other;
5847: }
1.795 www 5848:
1.938 bisitz 5849: /*
5850: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5851: background-color: $mail_other_hover;
5852: }
1.938 bisitz 5853: */
1.494 raeburn 5854:
1.777 tempelho 5855: table.LC_data_table tr > td.LC_browser_file,
5856: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5857: background: #AAEE77;
1.389 albertel 5858: }
1.795 www 5859:
1.777 tempelho 5860: table.LC_data_table tr > td.LC_browser_file_locked,
5861: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5862: background: #FFAA99;
1.387 albertel 5863: }
1.795 www 5864:
1.777 tempelho 5865: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5866: background: #888888;
1.779 bisitz 5867: }
1.795 www 5868:
1.777 tempelho 5869: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5870: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5871: background: #F8F866;
1.777 tempelho 5872: }
1.795 www 5873:
1.696 bisitz 5874: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5875: background: #E0E8FF;
1.387 albertel 5876: }
1.696 bisitz 5877:
1.707 bisitz 5878: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5879: /* background: #77FF77; */
1.707 bisitz 5880: }
1.795 www 5881:
1.707 bisitz 5882: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 5883: border-right: 8px solid #FFFF77;
1.707 bisitz 5884: }
1.795 www 5885:
1.707 bisitz 5886: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 5887: border-right: 8px solid #FFAA77;
1.707 bisitz 5888: }
1.795 www 5889:
1.707 bisitz 5890: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 5891: border-right: 8px solid #FF7777;
1.707 bisitz 5892: }
1.795 www 5893:
1.707 bisitz 5894: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 5895: border-right: 8px solid #AAFF77;
1.707 bisitz 5896: }
1.795 www 5897:
1.707 bisitz 5898: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 5899: border-right: 8px solid #11CC55;
1.707 bisitz 5900: }
5901:
1.388 albertel 5902: span.LC_current_location {
1.701 harmsja 5903: font-size:larger;
1.388 albertel 5904: background: $pgbg;
5905: }
1.387 albertel 5906:
1.1029 www 5907: span.LC_current_nav_location {
5908: font-weight:bold;
5909: background: $sidebg;
5910: }
5911:
1.395 albertel 5912: span.LC_parm_menu_item {
5913: font-size: larger;
5914: }
1.795 www 5915:
1.395 albertel 5916: span.LC_parm_scope_all {
5917: color: red;
5918: }
1.795 www 5919:
1.395 albertel 5920: span.LC_parm_scope_folder {
5921: color: green;
5922: }
1.795 www 5923:
1.395 albertel 5924: span.LC_parm_scope_resource {
5925: color: orange;
5926: }
1.795 www 5927:
1.395 albertel 5928: span.LC_parm_part {
5929: color: blue;
5930: }
1.795 www 5931:
1.911 bisitz 5932: span.LC_parm_folder,
5933: span.LC_parm_symb {
1.395 albertel 5934: font-size: x-small;
5935: font-family: $mono;
5936: color: #AAAAAA;
5937: }
5938:
1.977 bisitz 5939: ul.LC_parm_parmlist li {
5940: display: inline-block;
5941: padding: 0.3em 0.8em;
5942: vertical-align: top;
5943: width: 150px;
5944: border-top:1px solid $lg_border_color;
5945: }
5946:
1.795 www 5947: td.LC_parm_overview_level_menu,
5948: td.LC_parm_overview_map_menu,
5949: td.LC_parm_overview_parm_selectors,
5950: td.LC_parm_overview_restrictions {
1.396 albertel 5951: border: 1px solid black;
5952: border-collapse: collapse;
5953: }
1.795 www 5954:
1.396 albertel 5955: table.LC_parm_overview_restrictions td {
5956: border-width: 1px 4px 1px 4px;
5957: border-style: solid;
5958: border-color: $pgbg;
5959: text-align: center;
5960: }
1.795 www 5961:
1.396 albertel 5962: table.LC_parm_overview_restrictions th {
5963: background: $tabbg;
5964: border-width: 1px 4px 1px 4px;
5965: border-style: solid;
5966: border-color: $pgbg;
5967: }
1.795 www 5968:
1.398 albertel 5969: table#LC_helpmenu {
1.803 bisitz 5970: border: none;
1.398 albertel 5971: height: 55px;
1.803 bisitz 5972: border-spacing: 0;
1.398 albertel 5973: }
5974:
5975: table#LC_helpmenu fieldset legend {
5976: font-size: larger;
5977: }
1.795 www 5978:
1.397 albertel 5979: table#LC_helpmenu_links {
5980: width: 100%;
5981: border: 1px solid black;
5982: background: $pgbg;
1.803 bisitz 5983: padding: 0;
1.397 albertel 5984: border-spacing: 1px;
5985: }
1.795 www 5986:
1.397 albertel 5987: table#LC_helpmenu_links tr td {
5988: padding: 1px;
5989: background: $tabbg;
1.399 albertel 5990: text-align: center;
5991: font-weight: bold;
1.397 albertel 5992: }
1.396 albertel 5993:
1.795 www 5994: table#LC_helpmenu_links a:link,
5995: table#LC_helpmenu_links a:visited,
1.397 albertel 5996: table#LC_helpmenu_links a:active {
5997: text-decoration: none;
5998: color: $font;
5999: }
1.795 www 6000:
1.397 albertel 6001: table#LC_helpmenu_links a:hover {
6002: text-decoration: underline;
6003: color: $vlink;
6004: }
1.396 albertel 6005:
1.417 albertel 6006: .LC_chrt_popup_exists {
6007: border: 1px solid #339933;
6008: margin: -1px;
6009: }
1.795 www 6010:
1.417 albertel 6011: .LC_chrt_popup_up {
6012: border: 1px solid yellow;
6013: margin: -1px;
6014: }
1.795 www 6015:
1.417 albertel 6016: .LC_chrt_popup {
6017: border: 1px solid #8888FF;
6018: background: #CCCCFF;
6019: }
1.795 www 6020:
1.421 albertel 6021: table.LC_pick_box {
6022: border-collapse: separate;
6023: background: white;
6024: border: 1px solid black;
6025: border-spacing: 1px;
6026: }
1.795 www 6027:
1.421 albertel 6028: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6029: background: $sidebg;
1.421 albertel 6030: font-weight: bold;
1.900 bisitz 6031: text-align: left;
1.740 bisitz 6032: vertical-align: top;
1.421 albertel 6033: width: 184px;
6034: padding: 8px;
6035: }
1.795 www 6036:
1.579 raeburn 6037: table.LC_pick_box td.LC_pick_box_value {
6038: text-align: left;
6039: padding: 8px;
6040: }
1.795 www 6041:
1.579 raeburn 6042: table.LC_pick_box td.LC_pick_box_select {
6043: text-align: left;
6044: padding: 8px;
6045: }
1.795 www 6046:
1.424 albertel 6047: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6048: padding: 0;
1.421 albertel 6049: height: 1px;
6050: background: black;
6051: }
1.795 www 6052:
1.421 albertel 6053: table.LC_pick_box td.LC_pick_box_submit {
6054: text-align: right;
6055: }
1.795 www 6056:
1.579 raeburn 6057: table.LC_pick_box td.LC_evenrow_value {
6058: text-align: left;
6059: padding: 8px;
6060: background-color: $data_table_light;
6061: }
1.795 www 6062:
1.579 raeburn 6063: table.LC_pick_box td.LC_oddrow_value {
6064: text-align: left;
6065: padding: 8px;
6066: background-color: $data_table_light;
6067: }
1.795 www 6068:
1.579 raeburn 6069: span.LC_helpform_receipt_cat {
6070: font-weight: bold;
6071: }
1.795 www 6072:
1.424 albertel 6073: table.LC_group_priv_box {
6074: background: white;
6075: border: 1px solid black;
6076: border-spacing: 1px;
6077: }
1.795 www 6078:
1.424 albertel 6079: table.LC_group_priv_box td.LC_pick_box_title {
6080: background: $tabbg;
6081: font-weight: bold;
6082: text-align: right;
6083: width: 184px;
6084: }
1.795 www 6085:
1.424 albertel 6086: table.LC_group_priv_box td.LC_groups_fixed {
6087: background: $data_table_light;
6088: text-align: center;
6089: }
1.795 www 6090:
1.424 albertel 6091: table.LC_group_priv_box td.LC_groups_optional {
6092: background: $data_table_dark;
6093: text-align: center;
6094: }
1.795 www 6095:
1.424 albertel 6096: table.LC_group_priv_box td.LC_groups_functionality {
6097: background: $data_table_darker;
6098: text-align: center;
6099: font-weight: bold;
6100: }
1.795 www 6101:
1.424 albertel 6102: table.LC_group_priv td {
6103: text-align: left;
1.803 bisitz 6104: padding: 0;
1.424 albertel 6105: }
6106:
6107: .LC_navbuttons {
6108: margin: 2ex 0ex 2ex 0ex;
6109: }
1.795 www 6110:
1.423 albertel 6111: .LC_topic_bar {
6112: font-weight: bold;
6113: background: $tabbg;
1.918 wenzelju 6114: margin: 1em 0em 1em 2em;
1.805 bisitz 6115: padding: 3px;
1.918 wenzelju 6116: font-size: 1.2em;
1.423 albertel 6117: }
1.795 www 6118:
1.423 albertel 6119: .LC_topic_bar span {
1.918 wenzelju 6120: left: 0.5em;
6121: position: absolute;
1.423 albertel 6122: vertical-align: middle;
1.918 wenzelju 6123: font-size: 1.2em;
1.423 albertel 6124: }
1.795 www 6125:
1.423 albertel 6126: table.LC_course_group_status {
6127: margin: 20px;
6128: }
1.795 www 6129:
1.423 albertel 6130: table.LC_status_selector td {
6131: vertical-align: top;
6132: text-align: center;
1.424 albertel 6133: padding: 4px;
6134: }
1.795 www 6135:
1.599 albertel 6136: div.LC_feedback_link {
1.616 albertel 6137: clear: both;
1.829 kalberla 6138: background: $sidebg;
1.779 bisitz 6139: width: 100%;
1.829 kalberla 6140: padding-bottom: 10px;
6141: border: 1px $tabbg solid;
1.833 kalberla 6142: height: 22px;
6143: line-height: 22px;
6144: padding-top: 5px;
6145: }
6146:
6147: div.LC_feedback_link img {
6148: height: 22px;
1.867 kalberla 6149: vertical-align:middle;
1.829 kalberla 6150: }
6151:
1.911 bisitz 6152: div.LC_feedback_link a {
1.829 kalberla 6153: text-decoration: none;
1.489 raeburn 6154: }
1.795 www 6155:
1.867 kalberla 6156: div.LC_comblock {
1.911 bisitz 6157: display:inline;
1.867 kalberla 6158: color:$font;
6159: font-size:90%;
6160: }
6161:
6162: div.LC_feedback_link div.LC_comblock {
6163: padding-left:5px;
6164: }
6165:
6166: div.LC_feedback_link div.LC_comblock a {
6167: color:$font;
6168: }
6169:
1.489 raeburn 6170: span.LC_feedback_link {
1.858 bisitz 6171: /* background: $feedback_link_bg; */
1.599 albertel 6172: font-size: larger;
6173: }
1.795 www 6174:
1.599 albertel 6175: span.LC_message_link {
1.858 bisitz 6176: /* background: $feedback_link_bg; */
1.599 albertel 6177: font-size: larger;
6178: position: absolute;
6179: right: 1em;
1.489 raeburn 6180: }
1.421 albertel 6181:
1.515 albertel 6182: table.LC_prior_tries {
1.524 albertel 6183: border: 1px solid #000000;
6184: border-collapse: separate;
6185: border-spacing: 1px;
1.515 albertel 6186: }
1.523 albertel 6187:
1.515 albertel 6188: table.LC_prior_tries td {
1.524 albertel 6189: padding: 2px;
1.515 albertel 6190: }
1.523 albertel 6191:
6192: .LC_answer_correct {
1.795 www 6193: background: lightgreen;
6194: color: darkgreen;
6195: padding: 6px;
1.523 albertel 6196: }
1.795 www 6197:
1.523 albertel 6198: .LC_answer_charged_try {
1.797 www 6199: background: #FFAAAA;
1.795 www 6200: color: darkred;
6201: padding: 6px;
1.523 albertel 6202: }
1.795 www 6203:
1.779 bisitz 6204: .LC_answer_not_charged_try,
1.523 albertel 6205: .LC_answer_no_grade,
6206: .LC_answer_late {
1.795 www 6207: background: lightyellow;
1.523 albertel 6208: color: black;
1.795 www 6209: padding: 6px;
1.523 albertel 6210: }
1.795 www 6211:
1.523 albertel 6212: .LC_answer_previous {
1.795 www 6213: background: lightblue;
6214: color: darkblue;
6215: padding: 6px;
1.523 albertel 6216: }
1.795 www 6217:
1.779 bisitz 6218: .LC_answer_no_message {
1.777 tempelho 6219: background: #FFFFFF;
6220: color: black;
1.795 www 6221: padding: 6px;
1.779 bisitz 6222: }
1.795 www 6223:
1.779 bisitz 6224: .LC_answer_unknown {
6225: background: orange;
6226: color: black;
1.795 www 6227: padding: 6px;
1.777 tempelho 6228: }
1.795 www 6229:
1.529 albertel 6230: span.LC_prior_numerical,
6231: span.LC_prior_string,
6232: span.LC_prior_custom,
6233: span.LC_prior_reaction,
6234: span.LC_prior_math {
1.925 bisitz 6235: font-family: $mono;
1.523 albertel 6236: white-space: pre;
6237: }
6238:
1.525 albertel 6239: span.LC_prior_string {
1.925 bisitz 6240: font-family: $mono;
1.525 albertel 6241: white-space: pre;
6242: }
6243:
1.523 albertel 6244: table.LC_prior_option {
6245: width: 100%;
6246: border-collapse: collapse;
6247: }
1.795 www 6248:
1.911 bisitz 6249: table.LC_prior_rank,
1.795 www 6250: table.LC_prior_match {
1.528 albertel 6251: border-collapse: collapse;
6252: }
1.795 www 6253:
1.528 albertel 6254: table.LC_prior_option tr td,
6255: table.LC_prior_rank tr td,
6256: table.LC_prior_match tr td {
1.524 albertel 6257: border: 1px solid #000000;
1.515 albertel 6258: }
6259:
1.855 bisitz 6260: .LC_nobreak {
1.544 albertel 6261: white-space: nowrap;
1.519 raeburn 6262: }
6263:
1.576 raeburn 6264: span.LC_cusr_emph {
6265: font-style: italic;
6266: }
6267:
1.633 raeburn 6268: span.LC_cusr_subheading {
6269: font-weight: normal;
6270: font-size: 85%;
6271: }
6272:
1.861 bisitz 6273: div.LC_docs_entry_move {
1.859 bisitz 6274: border: 1px solid #BBBBBB;
1.545 albertel 6275: background: #DDDDDD;
1.861 bisitz 6276: width: 22px;
1.859 bisitz 6277: padding: 1px;
6278: margin: 0;
1.545 albertel 6279: }
6280:
1.861 bisitz 6281: table.LC_data_table tr > td.LC_docs_entry_commands,
6282: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6283: font-size: x-small;
6284: }
1.795 www 6285:
1.861 bisitz 6286: .LC_docs_entry_parameter {
6287: white-space: nowrap;
6288: }
6289:
1.544 albertel 6290: .LC_docs_copy {
1.545 albertel 6291: color: #000099;
1.544 albertel 6292: }
1.795 www 6293:
1.544 albertel 6294: .LC_docs_cut {
1.545 albertel 6295: color: #550044;
1.544 albertel 6296: }
1.795 www 6297:
1.544 albertel 6298: .LC_docs_rename {
1.545 albertel 6299: color: #009900;
1.544 albertel 6300: }
1.795 www 6301:
1.544 albertel 6302: .LC_docs_remove {
1.545 albertel 6303: color: #990000;
6304: }
6305:
1.547 albertel 6306: .LC_docs_reinit_warn,
6307: .LC_docs_ext_edit {
6308: font-size: x-small;
6309: }
6310:
1.545 albertel 6311: table.LC_docs_adddocs td,
6312: table.LC_docs_adddocs th {
6313: border: 1px solid #BBBBBB;
6314: padding: 4px;
6315: background: #DDDDDD;
1.543 albertel 6316: }
6317:
1.584 albertel 6318: table.LC_sty_begin {
6319: background: #BBFFBB;
6320: }
1.795 www 6321:
1.584 albertel 6322: table.LC_sty_end {
6323: background: #FFBBBB;
6324: }
6325:
1.589 raeburn 6326: table.LC_double_column {
1.803 bisitz 6327: border-width: 0;
1.589 raeburn 6328: border-collapse: collapse;
6329: width: 100%;
6330: padding: 2px;
6331: }
6332:
6333: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6334: top: 2px;
1.589 raeburn 6335: left: 2px;
6336: width: 47%;
6337: vertical-align: top;
6338: }
6339:
6340: table.LC_double_column tr td.LC_right_col {
6341: top: 2px;
1.779 bisitz 6342: right: 2px;
1.589 raeburn 6343: width: 47%;
6344: vertical-align: top;
6345: }
6346:
1.591 raeburn 6347: div.LC_left_float {
6348: float: left;
6349: padding-right: 5%;
1.597 albertel 6350: padding-bottom: 4px;
1.591 raeburn 6351: }
6352:
6353: div.LC_clear_float_header {
1.597 albertel 6354: padding-bottom: 2px;
1.591 raeburn 6355: }
6356:
6357: div.LC_clear_float_footer {
1.597 albertel 6358: padding-top: 10px;
1.591 raeburn 6359: clear: both;
6360: }
6361:
1.597 albertel 6362: div.LC_grade_show_user {
1.941 bisitz 6363: /* border-left: 5px solid $sidebg; */
6364: border-top: 5px solid #000000;
6365: margin: 50px 0 0 0;
1.936 bisitz 6366: padding: 15px 0 5px 10px;
1.597 albertel 6367: }
1.795 www 6368:
1.936 bisitz 6369: div.LC_grade_show_user_odd_row {
1.941 bisitz 6370: /* border-left: 5px solid #000000; */
6371: }
6372:
6373: div.LC_grade_show_user div.LC_Box {
6374: margin-right: 50px;
1.597 albertel 6375: }
6376:
6377: div.LC_grade_submissions,
6378: div.LC_grade_message_center,
1.936 bisitz 6379: div.LC_grade_info_links {
1.597 albertel 6380: margin: 5px;
6381: width: 99%;
6382: background: #FFFFFF;
6383: }
1.795 www 6384:
1.597 albertel 6385: div.LC_grade_submissions_header,
1.936 bisitz 6386: div.LC_grade_message_center_header {
1.705 tempelho 6387: font-weight: bold;
6388: font-size: large;
1.597 albertel 6389: }
1.795 www 6390:
1.597 albertel 6391: div.LC_grade_submissions_body,
1.936 bisitz 6392: div.LC_grade_message_center_body {
1.597 albertel 6393: border: 1px solid black;
6394: width: 99%;
6395: background: #FFFFFF;
6396: }
1.795 www 6397:
1.613 albertel 6398: table.LC_scantron_action {
6399: width: 100%;
6400: }
1.795 www 6401:
1.613 albertel 6402: table.LC_scantron_action tr th {
1.698 harmsja 6403: font-weight:bold;
6404: font-style:normal;
1.613 albertel 6405: }
1.795 www 6406:
1.779 bisitz 6407: .LC_edit_problem_header,
1.614 albertel 6408: div.LC_edit_problem_footer {
1.705 tempelho 6409: font-weight: normal;
6410: font-size: medium;
1.602 albertel 6411: margin: 2px;
1.1060 bisitz 6412: background-color: $sidebg;
1.600 albertel 6413: }
1.795 www 6414:
1.600 albertel 6415: div.LC_edit_problem_header,
1.602 albertel 6416: div.LC_edit_problem_header div,
1.614 albertel 6417: div.LC_edit_problem_footer,
6418: div.LC_edit_problem_footer div,
1.602 albertel 6419: div.LC_edit_problem_editxml_header,
6420: div.LC_edit_problem_editxml_header div {
1.600 albertel 6421: margin-top: 5px;
6422: }
1.795 www 6423:
1.600 albertel 6424: div.LC_edit_problem_header_title {
1.705 tempelho 6425: font-weight: bold;
6426: font-size: larger;
1.602 albertel 6427: background: $tabbg;
6428: padding: 3px;
1.1060 bisitz 6429: margin: 0 0 5px 0;
1.602 albertel 6430: }
1.795 www 6431:
1.602 albertel 6432: table.LC_edit_problem_header_title {
6433: width: 100%;
1.600 albertel 6434: background: $tabbg;
1.602 albertel 6435: }
6436:
6437: div.LC_edit_problem_discards {
6438: float: left;
6439: padding-bottom: 5px;
6440: }
1.795 www 6441:
1.602 albertel 6442: div.LC_edit_problem_saves {
6443: float: right;
6444: padding-bottom: 5px;
1.600 albertel 6445: }
1.795 www 6446:
1.911 bisitz 6447: img.stift {
1.803 bisitz 6448: border-width: 0;
6449: vertical-align: middle;
1.677 riegler 6450: }
1.680 riegler 6451:
1.923 bisitz 6452: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6453: vertical-align: top;
1.777 tempelho 6454: }
1.795 www 6455:
1.716 raeburn 6456: div.LC_createcourse {
1.911 bisitz 6457: margin: 10px 10px 10px 10px;
1.716 raeburn 6458: }
6459:
1.917 raeburn 6460: .LC_dccid {
6461: margin: 0.2em 0 0 0;
6462: padding: 0;
6463: font-size: 90%;
6464: display:none;
6465: }
6466:
1.897 wenzelju 6467: ol.LC_primary_menu a:hover,
1.721 harmsja 6468: ol#LC_MenuBreadcrumbs a:hover,
6469: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6470: ul#LC_secondary_menu a:hover,
1.721 harmsja 6471: .LC_FormSectionClearButton input:hover
1.795 www 6472: ul.LC_TabContent li:hover a {
1.952 onken 6473: color:$button_hover;
1.911 bisitz 6474: text-decoration:none;
1.693 droeschl 6475: }
6476:
1.779 bisitz 6477: h1 {
1.911 bisitz 6478: padding: 0;
6479: line-height:130%;
1.693 droeschl 6480: }
1.698 harmsja 6481:
1.911 bisitz 6482: h2,
6483: h3,
6484: h4,
6485: h5,
6486: h6 {
6487: margin: 5px 0 5px 0;
6488: padding: 0;
6489: line-height:130%;
1.693 droeschl 6490: }
1.795 www 6491:
6492: .LC_hcell {
1.911 bisitz 6493: padding:3px 15px 3px 15px;
6494: margin: 0;
6495: background-color:$tabbg;
6496: color:$fontmenu;
6497: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6498: }
1.795 www 6499:
1.840 bisitz 6500: .LC_Box > .LC_hcell {
1.911 bisitz 6501: margin: 0 -10px 10px -10px;
1.835 bisitz 6502: }
6503:
1.721 harmsja 6504: .LC_noBorder {
1.911 bisitz 6505: border: 0;
1.698 harmsja 6506: }
1.693 droeschl 6507:
1.721 harmsja 6508: .LC_FormSectionClearButton input {
1.911 bisitz 6509: background-color:transparent;
6510: border: none;
6511: cursor:pointer;
6512: text-decoration:underline;
1.693 droeschl 6513: }
1.763 bisitz 6514:
6515: .LC_help_open_topic {
1.911 bisitz 6516: color: #FFFFFF;
6517: background-color: #EEEEFF;
6518: margin: 1px;
6519: padding: 4px;
6520: border: 1px solid #000033;
6521: white-space: nowrap;
6522: /* vertical-align: middle; */
1.759 neumanie 6523: }
1.693 droeschl 6524:
1.911 bisitz 6525: dl,
6526: ul,
6527: div,
6528: fieldset {
6529: margin: 10px 10px 10px 0;
6530: /* overflow: hidden; */
1.693 droeschl 6531: }
1.795 www 6532:
1.838 bisitz 6533: fieldset > legend {
1.911 bisitz 6534: font-weight: bold;
6535: padding: 0 5px 0 5px;
1.838 bisitz 6536: }
6537:
1.813 bisitz 6538: #LC_nav_bar {
1.911 bisitz 6539: float: left;
1.995 raeburn 6540: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6541: margin: 0 0 2px 0;
1.807 droeschl 6542: }
6543:
1.916 droeschl 6544: #LC_realm {
6545: margin: 0.2em 0 0 0;
6546: padding: 0;
6547: font-weight: bold;
6548: text-align: center;
1.995 raeburn 6549: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6550: }
6551:
1.911 bisitz 6552: #LC_nav_bar em {
6553: font-weight: bold;
6554: font-style: normal;
1.807 droeschl 6555: }
6556:
1.897 wenzelju 6557: ol.LC_primary_menu {
1.911 bisitz 6558: float: right;
1.934 droeschl 6559: margin: 0;
1.1075.2.2 raeburn 6560: padding: 0;
1.995 raeburn 6561: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6562: }
6563:
1.852 droeschl 6564: ol#LC_PathBreadcrumbs {
1.911 bisitz 6565: margin: 0;
1.693 droeschl 6566: }
6567:
1.897 wenzelju 6568: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6569: color: RGB(80, 80, 80);
6570: vertical-align: middle;
6571: text-align: left;
6572: list-style: none;
6573: float: left;
6574: }
6575:
6576: ol.LC_primary_menu li a {
6577: display: block;
6578: margin: 0;
6579: padding: 0 5px 0 10px;
6580: text-decoration: none;
6581: }
6582:
6583: ol.LC_primary_menu li ul {
6584: display: none;
6585: width: 10em;
6586: background-color: $data_table_light;
6587: }
6588:
6589: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6590: display: block;
6591: position: absolute;
6592: margin: 0;
6593: padding: 0;
1.1075.2.5 raeburn 6594: z-index: 2;
1.1075.2.2 raeburn 6595: }
6596:
6597: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6598: font-size: 90%;
1.911 bisitz 6599: vertical-align: top;
1.1075.2.2 raeburn 6600: float: none;
1.1075.2.5 raeburn 6601: border-left: 1px solid black;
6602: border-right: 1px solid black;
1.1075.2.2 raeburn 6603: }
6604:
6605: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6606: background-color:$data_table_light;
1.1075.2.2 raeburn 6607: }
6608:
6609: ol.LC_primary_menu li li a:hover {
6610: color:$button_hover;
6611: background-color:$data_table_dark;
1.693 droeschl 6612: }
6613:
1.897 wenzelju 6614: ol.LC_primary_menu li img {
1.911 bisitz 6615: vertical-align: bottom;
1.934 droeschl 6616: height: 1.1em;
1.1075.2.3 raeburn 6617: margin: 0.2em 0 0 0;
1.693 droeschl 6618: }
6619:
1.897 wenzelju 6620: ol.LC_primary_menu a {
1.911 bisitz 6621: color: RGB(80, 80, 80);
6622: text-decoration: none;
1.693 droeschl 6623: }
1.795 www 6624:
1.949 droeschl 6625: ol.LC_primary_menu a.LC_new_message {
6626: font-weight:bold;
6627: color: darkred;
6628: }
6629:
1.975 raeburn 6630: ol.LC_docs_parameters {
6631: margin-left: 0;
6632: padding: 0;
6633: list-style: none;
6634: }
6635:
6636: ol.LC_docs_parameters li {
6637: margin: 0;
6638: padding-right: 20px;
6639: display: inline;
6640: }
6641:
1.976 raeburn 6642: ol.LC_docs_parameters li:before {
6643: content: "\\002022 \\0020";
6644: }
6645:
6646: li.LC_docs_parameters_title {
6647: font-weight: bold;
6648: }
6649:
6650: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6651: content: "";
6652: }
6653:
1.897 wenzelju 6654: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6655: clear: right;
1.911 bisitz 6656: color: $fontmenu;
6657: background: $tabbg;
6658: list-style: none;
6659: padding: 0;
6660: margin: 0;
6661: width: 100%;
1.995 raeburn 6662: text-align: left;
1.1075.2.4 raeburn 6663: float: left;
1.808 droeschl 6664: }
6665:
1.897 wenzelju 6666: ul#LC_secondary_menu li {
1.911 bisitz 6667: font-weight: bold;
6668: line-height: 1.8em;
6669: border-right: 1px solid black;
6670: vertical-align: middle;
1.1075.2.4 raeburn 6671: float: left;
6672: }
6673:
6674: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6675: background-color: $data_table_light;
6676: }
6677:
6678: ul#LC_secondary_menu li a {
6679: padding: 0 0.8em;
6680: }
6681:
6682: ul#LC_secondary_menu li ul {
6683: display: none;
6684: }
6685:
6686: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6687: display: block;
6688: position: absolute;
6689: margin: 0;
6690: padding: 0;
6691: list-style:none;
6692: float: none;
6693: background-color: $data_table_light;
1.1075.2.5 raeburn 6694: z-index: 2;
1.1075.2.10 raeburn 6695: margin-left: -1px;
1.1075.2.4 raeburn 6696: }
6697:
6698: ul#LC_secondary_menu li ul li {
6699: font-size: 90%;
6700: vertical-align: top;
6701: border-left: 1px solid black;
6702: border-right: 1px solid black;
6703: background-color: $data_table_light
6704: list-style:none;
6705: float: none;
6706: }
6707:
6708: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6709: background-color: $data_table_dark;
1.807 droeschl 6710: }
6711:
1.847 tempelho 6712: ul.LC_TabContent {
1.911 bisitz 6713: display:block;
6714: background: $sidebg;
6715: border-bottom: solid 1px $lg_border_color;
6716: list-style:none;
1.1020 raeburn 6717: margin: -1px -10px 0 -10px;
1.911 bisitz 6718: padding: 0;
1.693 droeschl 6719: }
6720:
1.795 www 6721: ul.LC_TabContent li,
6722: ul.LC_TabContentBigger li {
1.911 bisitz 6723: float:left;
1.741 harmsja 6724: }
1.795 www 6725:
1.897 wenzelju 6726: ul#LC_secondary_menu li a {
1.911 bisitz 6727: color: $fontmenu;
6728: text-decoration: none;
1.693 droeschl 6729: }
1.795 www 6730:
1.721 harmsja 6731: ul.LC_TabContent {
1.952 onken 6732: min-height:20px;
1.721 harmsja 6733: }
1.795 www 6734:
6735: ul.LC_TabContent li {
1.911 bisitz 6736: vertical-align:middle;
1.959 onken 6737: padding: 0 16px 0 10px;
1.911 bisitz 6738: background-color:$tabbg;
6739: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6740: border-left: solid 1px $font;
1.721 harmsja 6741: }
1.795 www 6742:
1.847 tempelho 6743: ul.LC_TabContent .right {
1.911 bisitz 6744: float:right;
1.847 tempelho 6745: }
6746:
1.911 bisitz 6747: ul.LC_TabContent li a,
6748: ul.LC_TabContent li {
6749: color:rgb(47,47,47);
6750: text-decoration:none;
6751: font-size:95%;
6752: font-weight:bold;
1.952 onken 6753: min-height:20px;
6754: }
6755:
1.959 onken 6756: ul.LC_TabContent li a:hover,
6757: ul.LC_TabContent li a:focus {
1.952 onken 6758: color: $button_hover;
1.959 onken 6759: background:none;
6760: outline:none;
1.952 onken 6761: }
6762:
6763: ul.LC_TabContent li:hover {
6764: color: $button_hover;
6765: cursor:pointer;
1.721 harmsja 6766: }
1.795 www 6767:
1.911 bisitz 6768: ul.LC_TabContent li.active {
1.952 onken 6769: color: $font;
1.911 bisitz 6770: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6771: border-bottom:solid 1px #FFFFFF;
6772: cursor: default;
1.744 ehlerst 6773: }
1.795 www 6774:
1.959 onken 6775: ul.LC_TabContent li.active a {
6776: color:$font;
6777: background:#FFFFFF;
6778: outline: none;
6779: }
1.1047 raeburn 6780:
6781: ul.LC_TabContent li.goback {
6782: float: left;
6783: border-left: none;
6784: }
6785:
1.870 tempelho 6786: #maincoursedoc {
1.911 bisitz 6787: clear:both;
1.870 tempelho 6788: }
6789:
6790: ul.LC_TabContentBigger {
1.911 bisitz 6791: display:block;
6792: list-style:none;
6793: padding: 0;
1.870 tempelho 6794: }
6795:
1.795 www 6796: ul.LC_TabContentBigger li {
1.911 bisitz 6797: vertical-align:bottom;
6798: height: 30px;
6799: font-size:110%;
6800: font-weight:bold;
6801: color: #737373;
1.841 tempelho 6802: }
6803:
1.957 onken 6804: ul.LC_TabContentBigger li.active {
6805: position: relative;
6806: top: 1px;
6807: }
6808:
1.870 tempelho 6809: ul.LC_TabContentBigger li a {
1.911 bisitz 6810: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6811: height: 30px;
6812: line-height: 30px;
6813: text-align: center;
6814: display: block;
6815: text-decoration: none;
1.958 onken 6816: outline: none;
1.741 harmsja 6817: }
1.795 www 6818:
1.870 tempelho 6819: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6820: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6821: color:$font;
1.744 ehlerst 6822: }
1.795 www 6823:
1.870 tempelho 6824: ul.LC_TabContentBigger li b {
1.911 bisitz 6825: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6826: display: block;
6827: float: left;
6828: padding: 0 30px;
1.957 onken 6829: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6830: }
6831:
1.956 onken 6832: ul.LC_TabContentBigger li:hover b {
6833: color:$button_hover;
6834: }
6835:
1.870 tempelho 6836: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6837: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6838: color:$font;
1.957 onken 6839: border: 0;
1.741 harmsja 6840: }
1.693 droeschl 6841:
1.870 tempelho 6842:
1.862 bisitz 6843: ul.LC_CourseBreadcrumbs {
6844: background: $sidebg;
1.1020 raeburn 6845: height: 2em;
1.862 bisitz 6846: padding-left: 10px;
1.1020 raeburn 6847: margin: 0;
1.862 bisitz 6848: list-style-position: inside;
6849: }
6850:
1.911 bisitz 6851: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6852: ol#LC_PathBreadcrumbs {
1.911 bisitz 6853: padding-left: 10px;
6854: margin: 0;
1.933 droeschl 6855: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6856: }
6857:
1.911 bisitz 6858: ol#LC_MenuBreadcrumbs li,
6859: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6860: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6861: display: inline;
1.933 droeschl 6862: white-space: normal;
1.693 droeschl 6863: }
6864:
1.823 bisitz 6865: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6866: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6867: text-decoration: none;
6868: font-size:90%;
1.693 droeschl 6869: }
1.795 www 6870:
1.969 droeschl 6871: ol#LC_MenuBreadcrumbs h1 {
6872: display: inline;
6873: font-size: 90%;
6874: line-height: 2.5em;
6875: margin: 0;
6876: padding: 0;
6877: }
6878:
1.795 www 6879: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6880: text-decoration:none;
6881: font-size:100%;
6882: font-weight:bold;
1.693 droeschl 6883: }
1.795 www 6884:
1.840 bisitz 6885: .LC_Box {
1.911 bisitz 6886: border: solid 1px $lg_border_color;
6887: padding: 0 10px 10px 10px;
1.746 neumanie 6888: }
1.795 www 6889:
1.1020 raeburn 6890: .LC_DocsBox {
6891: border: solid 1px $lg_border_color;
6892: padding: 0 0 10px 10px;
6893: }
6894:
1.795 www 6895: .LC_AboutMe_Image {
1.911 bisitz 6896: float:left;
6897: margin-right:10px;
1.747 neumanie 6898: }
1.795 www 6899:
6900: .LC_Clear_AboutMe_Image {
1.911 bisitz 6901: clear:left;
1.747 neumanie 6902: }
1.795 www 6903:
1.721 harmsja 6904: dl.LC_ListStyleClean dt {
1.911 bisitz 6905: padding-right: 5px;
6906: display: table-header-group;
1.693 droeschl 6907: }
6908:
1.721 harmsja 6909: dl.LC_ListStyleClean dd {
1.911 bisitz 6910: display: table-row;
1.693 droeschl 6911: }
6912:
1.721 harmsja 6913: .LC_ListStyleClean,
6914: .LC_ListStyleSimple,
6915: .LC_ListStyleNormal,
1.795 www 6916: .LC_ListStyleSpecial {
1.911 bisitz 6917: /* display:block; */
6918: list-style-position: inside;
6919: list-style-type: none;
6920: overflow: hidden;
6921: padding: 0;
1.693 droeschl 6922: }
6923:
1.721 harmsja 6924: .LC_ListStyleSimple li,
6925: .LC_ListStyleSimple dd,
6926: .LC_ListStyleNormal li,
6927: .LC_ListStyleNormal dd,
6928: .LC_ListStyleSpecial li,
1.795 www 6929: .LC_ListStyleSpecial dd {
1.911 bisitz 6930: margin: 0;
6931: padding: 5px 5px 5px 10px;
6932: clear: both;
1.693 droeschl 6933: }
6934:
1.721 harmsja 6935: .LC_ListStyleClean li,
6936: .LC_ListStyleClean dd {
1.911 bisitz 6937: padding-top: 0;
6938: padding-bottom: 0;
1.693 droeschl 6939: }
6940:
1.721 harmsja 6941: .LC_ListStyleSimple dd,
1.795 www 6942: .LC_ListStyleSimple li {
1.911 bisitz 6943: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 6944: }
6945:
1.721 harmsja 6946: .LC_ListStyleSpecial li,
6947: .LC_ListStyleSpecial dd {
1.911 bisitz 6948: list-style-type: none;
6949: background-color: RGB(220, 220, 220);
6950: margin-bottom: 4px;
1.693 droeschl 6951: }
6952:
1.721 harmsja 6953: table.LC_SimpleTable {
1.911 bisitz 6954: margin:5px;
6955: border:solid 1px $lg_border_color;
1.795 www 6956: }
1.693 droeschl 6957:
1.721 harmsja 6958: table.LC_SimpleTable tr {
1.911 bisitz 6959: padding: 0;
6960: border:solid 1px $lg_border_color;
1.693 droeschl 6961: }
1.795 www 6962:
6963: table.LC_SimpleTable thead {
1.911 bisitz 6964: background:rgb(220,220,220);
1.693 droeschl 6965: }
6966:
1.721 harmsja 6967: div.LC_columnSection {
1.911 bisitz 6968: display: block;
6969: clear: both;
6970: overflow: hidden;
6971: margin: 0;
1.693 droeschl 6972: }
6973:
1.721 harmsja 6974: div.LC_columnSection>* {
1.911 bisitz 6975: float: left;
6976: margin: 10px 20px 10px 0;
6977: overflow:hidden;
1.693 droeschl 6978: }
1.721 harmsja 6979:
1.795 www 6980: table em {
1.911 bisitz 6981: font-weight: bold;
6982: font-style: normal;
1.748 schulted 6983: }
1.795 www 6984:
1.779 bisitz 6985: table.LC_tableBrowseRes,
1.795 www 6986: table.LC_tableOfContent {
1.911 bisitz 6987: border:none;
6988: border-spacing: 1px;
6989: padding: 3px;
6990: background-color: #FFFFFF;
6991: font-size: 90%;
1.753 droeschl 6992: }
1.789 droeschl 6993:
1.911 bisitz 6994: table.LC_tableOfContent {
6995: border-collapse: collapse;
1.789 droeschl 6996: }
6997:
1.771 droeschl 6998: table.LC_tableBrowseRes a,
1.768 schulted 6999: table.LC_tableOfContent a {
1.911 bisitz 7000: background-color: transparent;
7001: text-decoration: none;
1.753 droeschl 7002: }
7003:
1.795 www 7004: table.LC_tableOfContent img {
1.911 bisitz 7005: border: none;
7006: height: 1.3em;
7007: vertical-align: text-bottom;
7008: margin-right: 0.3em;
1.753 droeschl 7009: }
1.757 schulted 7010:
1.795 www 7011: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7012: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7013: }
7014:
1.795 www 7015: a#LC_content_toolbar_everything {
1.911 bisitz 7016: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7017: }
7018:
1.795 www 7019: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7020: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7021: }
7022:
1.795 www 7023: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7024: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7025: }
7026:
1.795 www 7027: a#LC_content_toolbar_changefolder {
1.911 bisitz 7028: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7029: }
7030:
1.795 www 7031: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7032: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7033: }
7034:
1.1043 raeburn 7035: a#LC_content_toolbar_edittoplevel {
7036: background-image:url(/res/adm/pages/edittoplevel.gif);
7037: }
7038:
1.795 www 7039: ul#LC_toolbar li a:hover {
1.911 bisitz 7040: background-position: bottom center;
1.757 schulted 7041: }
7042:
1.795 www 7043: ul#LC_toolbar {
1.911 bisitz 7044: padding: 0;
7045: margin: 2px;
7046: list-style:none;
7047: position:relative;
7048: background-color:white;
1.1075.2.9 raeburn 7049: overflow: auto;
1.757 schulted 7050: }
7051:
1.795 www 7052: ul#LC_toolbar li {
1.911 bisitz 7053: border:1px solid white;
7054: padding: 0;
7055: margin: 0;
7056: float: left;
7057: display:inline;
7058: vertical-align:middle;
1.1075.2.9 raeburn 7059: white-space: nowrap;
1.911 bisitz 7060: }
1.757 schulted 7061:
1.783 amueller 7062:
1.795 www 7063: a.LC_toolbarItem {
1.911 bisitz 7064: display:block;
7065: padding: 0;
7066: margin: 0;
7067: height: 32px;
7068: width: 32px;
7069: color:white;
7070: border: none;
7071: background-repeat:no-repeat;
7072: background-color:transparent;
1.757 schulted 7073: }
7074:
1.915 droeschl 7075: ul.LC_funclist {
7076: margin: 0;
7077: padding: 0.5em 1em 0.5em 0;
7078: }
7079:
1.933 droeschl 7080: ul.LC_funclist > li:first-child {
7081: font-weight:bold;
7082: margin-left:0.8em;
7083: }
7084:
1.915 droeschl 7085: ul.LC_funclist + ul.LC_funclist {
7086: /*
7087: left border as a seperator if we have more than
7088: one list
7089: */
7090: border-left: 1px solid $sidebg;
7091: /*
7092: this hides the left border behind the border of the
7093: outer box if element is wrapped to the next 'line'
7094: */
7095: margin-left: -1px;
7096: }
7097:
1.843 bisitz 7098: ul.LC_funclist li {
1.915 droeschl 7099: display: inline;
1.782 bisitz 7100: white-space: nowrap;
1.915 droeschl 7101: margin: 0 0 0 25px;
7102: line-height: 150%;
1.782 bisitz 7103: }
7104:
1.974 wenzelju 7105: .LC_hidden {
7106: display: none;
7107: }
7108:
1.1030 www 7109: .LCmodal-overlay {
7110: position:fixed;
7111: top:0;
7112: right:0;
7113: bottom:0;
7114: left:0;
7115: height:100%;
7116: width:100%;
7117: margin:0;
7118: padding:0;
7119: background:#999;
7120: opacity:.75;
7121: filter: alpha(opacity=75);
7122: -moz-opacity: 0.75;
7123: z-index:101;
7124: }
7125:
7126: * html .LCmodal-overlay {
7127: position: absolute;
7128: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7129: }
7130:
7131: .LCmodal-window {
7132: position:fixed;
7133: top:50%;
7134: left:50%;
7135: margin:0;
7136: padding:0;
7137: z-index:102;
7138: }
7139:
7140: * html .LCmodal-window {
7141: position:absolute;
7142: }
7143:
7144: .LCclose-window {
7145: position:absolute;
7146: width:32px;
7147: height:32px;
7148: right:8px;
7149: top:8px;
7150: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7151: text-indent:-99999px;
7152: overflow:hidden;
7153: cursor:pointer;
7154: }
7155:
1.1075.2.17 raeburn 7156: /*
7157: styles used by TTH when "Default set of options to pass to tth/m
7158: when converting TeX" in course settings has been set
7159:
7160: option passed: -t
7161:
7162: */
7163:
7164: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7165: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7166: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7167: td div.norm {line-height:normal;}
7168:
7169: /*
7170: option passed -y3
7171: */
7172:
7173: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7174: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7175: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7176:
1.343 albertel 7177: END
7178: }
7179:
1.306 albertel 7180: =pod
7181:
7182: =item * &headtag()
7183:
7184: Returns a uniform footer for LON-CAPA web pages.
7185:
1.307 albertel 7186: Inputs: $title - optional title for the head
7187: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7188: $args - optional arguments
1.319 albertel 7189: force_register - if is true call registerurl so the remote is
7190: informed
1.415 albertel 7191: redirect -> array ref of
7192: 1- seconds before redirect occurs
7193: 2- url to redirect to
7194: 3- whether the side effect should occur
1.315 albertel 7195: (side effect of setting
7196: $env{'internal.head.redirect'} to the url
7197: redirected too)
1.352 albertel 7198: domain -> force to color decorate a page for a specific
7199: domain
7200: function -> force usage of a specific rolish color scheme
7201: bgcolor -> override the default page bgcolor
1.460 albertel 7202: no_auto_mt_title
7203: -> prevent &mt()ing the title arg
1.464 albertel 7204:
1.306 albertel 7205: =cut
7206:
7207: sub headtag {
1.313 albertel 7208: my ($title,$head_extra,$args) = @_;
1.306 albertel 7209:
1.363 albertel 7210: my $function = $args->{'function'} || &get_users_function();
7211: my $domain = $args->{'domain'} || &determinedomain();
7212: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 7213: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7214: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7215: #time(),
1.418 albertel 7216: $env{'environment.color.timestamp'},
1.363 albertel 7217: $function,$domain,$bgcolor);
7218:
1.369 www 7219: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7220:
1.308 albertel 7221: my $result =
7222: '<head>'.
1.461 albertel 7223: &font_settings();
1.319 albertel 7224:
1.1064 raeburn 7225: my $inhibitprint = &print_suppression();
7226:
1.461 albertel 7227: if (!$args->{'frameset'}) {
7228: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7229: }
1.1075.2.12 raeburn 7230: if ($args->{'force_register'}) {
7231: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7232: }
1.436 albertel 7233: if (!$args->{'no_nav_bar'}
7234: && !$args->{'only_body'}
7235: && !$args->{'frameset'}) {
7236: $result .= &help_menu_js();
1.1032 www 7237: $result.=&modal_window();
1.1038 www 7238: $result.=&togglebox_script();
1.1034 www 7239: $result.=&wishlist_window();
1.1041 www 7240: $result.=&LCprogressbarUpdate_script();
1.1034 www 7241: } else {
7242: if ($args->{'add_modal'}) {
7243: $result.=&modal_window();
7244: }
7245: if ($args->{'add_wishlist'}) {
7246: $result.=&wishlist_window();
7247: }
1.1038 www 7248: if ($args->{'add_togglebox'}) {
7249: $result.=&togglebox_script();
7250: }
1.1041 www 7251: if ($args->{'add_progressbar'}) {
7252: $result.=&LCprogressbarUpdate_script();
7253: }
1.436 albertel 7254: }
1.314 albertel 7255: if (ref($args->{'redirect'})) {
1.414 albertel 7256: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7257: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7258: if (!$inhibit_continue) {
7259: $env{'internal.head.redirect'} = $url;
7260: }
1.313 albertel 7261: $result.=<<ADDMETA
7262: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7263: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7264: ADDMETA
7265: }
1.306 albertel 7266: if (!defined($title)) {
7267: $title = 'The LearningOnline Network with CAPA';
7268: }
1.460 albertel 7269: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7270: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 7271: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064 raeburn 7272: .$inhibitprint
1.414 albertel 7273: .$head_extra;
1.962 droeschl 7274: return $result.'</head>';
1.306 albertel 7275: }
7276:
7277: =pod
7278:
1.340 albertel 7279: =item * &font_settings()
7280:
7281: Returns neccessary <meta> to set the proper encoding
7282:
7283: Inputs: none
7284:
7285: =cut
7286:
7287: sub font_settings {
7288: my $headerstring='';
1.647 www 7289: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 7290: $headerstring.=
7291: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
7292: }
7293: return $headerstring;
7294: }
7295:
1.341 albertel 7296: =pod
7297:
1.1064 raeburn 7298: =item * &print_suppression()
7299:
7300: In course context returns css which causes the body to be blank when media="print",
7301: if printout generation is unavailable for the current resource.
7302:
7303: This could be because:
7304:
7305: (a) printstartdate is in the future
7306:
7307: (b) printenddate is in the past
7308:
7309: (c) there is an active exam block with "printout"
7310: functionality blocked
7311:
7312: Users with pav, pfo or evb privileges are exempt.
7313:
7314: Inputs: none
7315:
7316: =cut
7317:
7318:
7319: sub print_suppression {
7320: my $noprint;
7321: if ($env{'request.course.id'}) {
7322: my $scope = $env{'request.course.id'};
7323: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7324: (&Apache::lonnet::allowed('pfo',$scope))) {
7325: return;
7326: }
7327: if ($env{'request.course.sec'} ne '') {
7328: $scope .= "/$env{'request.course.sec'}";
7329: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7330: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7331: return;
1.1064 raeburn 7332: }
7333: }
7334: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7335: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065 raeburn 7336: my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064 raeburn 7337: if ($blocked) {
7338: my $checkrole = "cm./$cdom/$cnum";
7339: if ($env{'request.course.sec'} ne '') {
7340: $checkrole .= "/$env{'request.course.sec'}";
7341: }
7342: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7343: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7344: $noprint = 1;
7345: }
7346: }
7347: unless ($noprint) {
7348: my $symb = &Apache::lonnet::symbread();
7349: if ($symb ne '') {
7350: my $navmap = Apache::lonnavmaps::navmap->new();
7351: if (ref($navmap)) {
7352: my $res = $navmap->getBySymb($symb);
7353: if (ref($res)) {
7354: if (!$res->resprintable()) {
7355: $noprint = 1;
7356: }
7357: }
7358: }
7359: }
7360: }
7361: if ($noprint) {
7362: return <<"ENDSTYLE";
7363: <style type="text/css" media="print">
7364: body { display:none }
7365: </style>
7366: ENDSTYLE
7367: }
7368: }
7369: return;
7370: }
7371:
7372: =pod
7373:
1.341 albertel 7374: =item * &xml_begin()
7375:
7376: Returns the needed doctype and <html>
7377:
7378: Inputs: none
7379:
7380: =cut
7381:
7382: sub xml_begin {
7383: my $output='';
7384:
7385: if ($env{'browser.mathml'}) {
7386: $output='<?xml version="1.0"?>'
7387: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7388: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7389:
7390: # .'<!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">] >'
7391: .'<!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">'
7392: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7393: .'xmlns="http://www.w3.org/1999/xhtml">';
7394: } else {
1.849 bisitz 7395: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
7396: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 7397: }
7398: return $output;
7399: }
1.340 albertel 7400:
7401: =pod
7402:
1.306 albertel 7403: =item * &start_page()
7404:
7405: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7406:
1.648 raeburn 7407: Inputs:
7408:
7409: =over 4
7410:
7411: $title - optional title for the page
7412:
7413: $head_extra - optional extra HTML to incude inside the <head>
7414:
7415: $args - additional optional args supported are:
7416:
7417: =over 8
7418:
7419: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7420: arg on
1.814 bisitz 7421: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7422: add_entries -> additional attributes to add to the <body>
7423: domain -> force to color decorate a page for a
1.317 albertel 7424: specific domain
1.648 raeburn 7425: function -> force usage of a specific rolish color
1.317 albertel 7426: scheme
1.648 raeburn 7427: redirect -> see &headtag()
7428: bgcolor -> override the default page bg color
7429: js_ready -> return a string ready for being used in
1.317 albertel 7430: a javascript writeln
1.648 raeburn 7431: html_encode -> return a string ready for being used in
1.320 albertel 7432: a html attribute
1.648 raeburn 7433: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7434: $forcereg arg
1.648 raeburn 7435: frameset -> if true will start with a <frameset>
1.330 albertel 7436: rather than <body>
1.648 raeburn 7437: skip_phases -> hash ref of
1.338 albertel 7438: head -> skip the <html><head> generation
7439: body -> skip all <body> generation
1.1075.2.12 raeburn 7440: no_inline_link -> if true and in remote mode, don't show the
7441: 'Switch To Inline Menu' link
1.648 raeburn 7442: no_auto_mt_title -> prevent &mt()ing the title arg
7443: inherit_jsmath -> when creating popup window in a page,
7444: should it have jsmath forced on by the
7445: current page
1.867 kalberla 7446: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7447: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7448: group -> includes the current group, if page is for a
7449: specific group
1.361 albertel 7450:
1.648 raeburn 7451: =back
1.460 albertel 7452:
1.648 raeburn 7453: =back
1.562 albertel 7454:
1.306 albertel 7455: =cut
7456:
7457: sub start_page {
1.309 albertel 7458: my ($title,$head_extra,$args) = @_;
1.318 albertel 7459: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7460:
1.315 albertel 7461: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7462: my ($result,@advtools);
1.964 droeschl 7463:
1.338 albertel 7464: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030 www 7465: $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338 albertel 7466: }
7467:
7468: if (! exists($args->{'skip_phases'}{'body'}) ) {
7469: if ($args->{'frameset'}) {
7470: my $attr_string = &make_attr_string($args->{'force_register'},
7471: $args->{'add_entries'});
7472: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7473: } else {
7474: $result .=
7475: &bodytag($title,
7476: $args->{'function'}, $args->{'add_entries'},
7477: $args->{'only_body'}, $args->{'domain'},
7478: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7479: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7480: $args, \@advtools);
1.831 bisitz 7481: }
1.330 albertel 7482: }
1.338 albertel 7483:
1.315 albertel 7484: if ($args->{'js_ready'}) {
1.713 kaisler 7485: $result = &js_ready($result);
1.315 albertel 7486: }
1.320 albertel 7487: if ($args->{'html_encode'}) {
1.713 kaisler 7488: $result = &html_encode($result);
7489: }
7490:
1.813 bisitz 7491: # Preparation for new and consistent functionlist at top of screen
7492: # if ($args->{'functionlist'}) {
7493: # $result .= &build_functionlist();
7494: #}
7495:
1.964 droeschl 7496: # Don't add anything more if only_body wanted or in const space
7497: return $result if $args->{'only_body'}
7498: || $env{'request.state'} eq 'construct';
1.813 bisitz 7499:
7500: #Breadcrumbs
1.758 kaisler 7501: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7502: &Apache::lonhtmlcommon::clear_breadcrumbs();
7503: #if any br links exists, add them to the breadcrumbs
7504: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7505: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7506: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7507: }
7508: }
1.1075.2.19 raeburn 7509: # if @advtools array contains items add then to the breadcrumbs
7510: if (@advtools > 0) {
7511: &Apache::lonmenu::advtools_crumbs(@advtools);
7512: }
1.758 kaisler 7513:
7514: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7515: if(exists($args->{'bread_crumbs_component'})){
7516: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7517: }else{
7518: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7519: }
1.1075.2.24 raeburn 7520: } elsif (($env{'environment.remote'} eq 'on') &&
7521: ($env{'form.inhibitmenu'} ne 'yes') &&
7522: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7523: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7524: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7525: }
1.315 albertel 7526: return $result;
1.306 albertel 7527: }
7528:
7529: sub end_page {
1.315 albertel 7530: my ($args) = @_;
7531: $env{'internal.end_page'}++;
1.330 albertel 7532: my $result;
1.335 albertel 7533: if ($args->{'discussion'}) {
7534: my ($target,$parser);
7535: if (ref($args->{'discussion'})) {
7536: ($target,$parser) =($args->{'discussion'}{'target'},
7537: $args->{'discussion'}{'parser'});
7538: }
7539: $result .= &Apache::lonxml::xmlend($target,$parser);
7540: }
1.330 albertel 7541: if ($args->{'frameset'}) {
7542: $result .= '</frameset>';
7543: } else {
1.635 raeburn 7544: $result .= &endbodytag($args);
1.330 albertel 7545: }
1.1075.2.6 raeburn 7546: unless ($args->{'notbody'}) {
7547: $result .= "\n</html>";
7548: }
1.330 albertel 7549:
1.315 albertel 7550: if ($args->{'js_ready'}) {
1.317 albertel 7551: $result = &js_ready($result);
1.315 albertel 7552: }
1.335 albertel 7553:
1.320 albertel 7554: if ($args->{'html_encode'}) {
7555: $result = &html_encode($result);
7556: }
1.335 albertel 7557:
1.315 albertel 7558: return $result;
7559: }
7560:
1.1034 www 7561: sub wishlist_window {
7562: return(<<'ENDWISHLIST');
1.1046 raeburn 7563: <script type="text/javascript">
1.1034 www 7564: // <![CDATA[
7565: // <!-- BEGIN LON-CAPA Internal
7566: function set_wishlistlink(title, path) {
7567: if (!title) {
7568: title = document.title;
7569: title = title.replace(/^LON-CAPA /,'');
7570: }
7571: if (!path) {
7572: path = location.pathname;
7573: }
7574: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7575: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7576: }
7577: // END LON-CAPA Internal -->
7578: // ]]>
7579: </script>
7580: ENDWISHLIST
7581: }
7582:
1.1030 www 7583: sub modal_window {
7584: return(<<'ENDMODAL');
1.1046 raeburn 7585: <script type="text/javascript">
1.1030 www 7586: // <![CDATA[
7587: // <!-- BEGIN LON-CAPA Internal
7588: var modalWindow = {
7589: parent:"body",
7590: windowId:null,
7591: content:null,
7592: width:null,
7593: height:null,
7594: close:function()
7595: {
7596: $(".LCmodal-window").remove();
7597: $(".LCmodal-overlay").remove();
7598: },
7599: open:function()
7600: {
7601: var modal = "";
7602: modal += "<div class=\"LCmodal-overlay\"></div>";
7603: 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;\">";
7604: modal += this.content;
7605: modal += "</div>";
7606:
7607: $(this.parent).append(modal);
7608:
7609: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7610: $(".LCclose-window").click(function(){modalWindow.close();});
7611: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7612: }
7613: };
1.1031 www 7614: var openMyModal = function(source,width,height,scrolling)
1.1030 www 7615: {
7616: modalWindow.windowId = "myModal";
7617: modalWindow.width = width;
7618: modalWindow.height = height;
1.1031 www 7619: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'></iframe>";
1.1030 www 7620: modalWindow.open();
7621: };
7622: // END LON-CAPA Internal -->
7623: // ]]>
7624: </script>
7625: ENDMODAL
7626: }
7627:
7628: sub modal_link {
1.1052 www 7629: my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030 www 7630: unless ($width) { $width=480; }
7631: unless ($height) { $height=400; }
1.1031 www 7632: unless ($scrolling) { $scrolling='yes'; }
1.1074 raeburn 7633: my $target_attr;
7634: if (defined($target)) {
7635: $target_attr = 'target="'.$target.'"';
7636: }
7637: return <<"ENDLINK";
7638: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
7639: $linktext</a>
7640: ENDLINK
1.1030 www 7641: }
7642:
1.1032 www 7643: sub modal_adhoc_script {
7644: my ($funcname,$width,$height,$content)=@_;
7645: return (<<ENDADHOC);
1.1046 raeburn 7646: <script type="text/javascript">
1.1032 www 7647: // <![CDATA[
7648: var $funcname = function()
7649: {
7650: modalWindow.windowId = "myModal";
7651: modalWindow.width = $width;
7652: modalWindow.height = $height;
7653: modalWindow.content = '$content';
7654: modalWindow.open();
7655: };
7656: // ]]>
7657: </script>
7658: ENDADHOC
7659: }
7660:
1.1041 www 7661: sub modal_adhoc_inner {
7662: my ($funcname,$width,$height,$content)=@_;
7663: my $innerwidth=$width-20;
7664: $content=&js_ready(
1.1042 www 7665: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041 www 7666: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
7667: $content.
7668: &end_scrollbox().
7669: &end_page()
7670: );
7671: return &modal_adhoc_script($funcname,$width,$height,$content);
7672: }
7673:
7674: sub modal_adhoc_window {
7675: my ($funcname,$width,$height,$content,$linktext)=@_;
7676: return &modal_adhoc_inner($funcname,$width,$height,$content).
7677: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7678: }
7679:
7680: sub modal_adhoc_launch {
7681: my ($funcname,$width,$height,$content)=@_;
7682: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7683: <script type="text/javascript">
7684: // <![CDATA[
7685: $funcname();
7686: // ]]>
7687: </script>
7688: ENDLAUNCH
7689: }
7690:
7691: sub modal_adhoc_close {
7692: return (<<ENDCLOSE);
7693: <script type="text/javascript">
7694: // <![CDATA[
7695: modalWindow.close();
7696: // ]]>
7697: </script>
7698: ENDCLOSE
7699: }
7700:
1.1038 www 7701: sub togglebox_script {
7702: return(<<ENDTOGGLE);
7703: <script type="text/javascript">
7704: // <![CDATA[
7705: function LCtoggleDisplay(id,hidetext,showtext) {
7706: link = document.getElementById(id + "link").childNodes[0];
7707: with (document.getElementById(id).style) {
7708: if (display == "none" ) {
7709: display = "inline";
7710: link.nodeValue = hidetext;
7711: } else {
7712: display = "none";
7713: link.nodeValue = showtext;
7714: }
7715: }
7716: }
7717: // ]]>
7718: </script>
7719: ENDTOGGLE
7720: }
7721:
1.1039 www 7722: sub start_togglebox {
7723: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7724: unless ($heading) { $heading=''; } else { $heading.=' '; }
7725: unless ($showtext) { $showtext=&mt('show'); }
7726: unless ($hidetext) { $hidetext=&mt('hide'); }
7727: unless ($headerbg) { $headerbg='#FFFFFF'; }
7728: return &start_data_table().
7729: &start_data_table_header_row().
7730: '<td bgcolor="'.$headerbg.'">'.$heading.
7731: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7732: $showtext.'\')">'.$showtext.'</a>]</td>'.
7733: &end_data_table_header_row().
7734: '<tr id="'.$id.'" style="display:none""><td>';
7735: }
7736:
7737: sub end_togglebox {
7738: return '</td></tr>'.&end_data_table();
7739: }
7740:
1.1041 www 7741: sub LCprogressbar_script {
1.1045 www 7742: my ($id)=@_;
1.1041 www 7743: return(<<ENDPROGRESS);
7744: <script type="text/javascript">
7745: // <![CDATA[
1.1045 www 7746: \$('#progressbar$id').progressbar({
1.1041 www 7747: value: 0,
7748: change: function(event, ui) {
7749: var newVal = \$(this).progressbar('option', 'value');
7750: \$('.pblabel', this).text(LCprogressTxt);
7751: }
7752: });
7753: // ]]>
7754: </script>
7755: ENDPROGRESS
7756: }
7757:
7758: sub LCprogressbarUpdate_script {
7759: return(<<ENDPROGRESSUPDATE);
7760: <style type="text/css">
7761: .ui-progressbar { position:relative; }
7762: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7763: </style>
7764: <script type="text/javascript">
7765: // <![CDATA[
1.1045 www 7766: var LCprogressTxt='---';
7767:
7768: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7769: LCprogressTxt=progresstext;
1.1045 www 7770: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7771: }
7772: // ]]>
7773: </script>
7774: ENDPROGRESSUPDATE
7775: }
7776:
1.1042 www 7777: my $LClastpercent;
1.1045 www 7778: my $LCidcnt;
7779: my $LCcurrentid;
1.1042 www 7780:
1.1041 www 7781: sub LCprogressbar {
1.1042 www 7782: my ($r)=(@_);
7783: $LClastpercent=0;
1.1045 www 7784: $LCidcnt++;
7785: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7786: my $starting=&mt('Starting');
7787: my $content=(<<ENDPROGBAR);
7788: <p>
1.1045 www 7789: <div id="progressbar$LCcurrentid">
1.1041 www 7790: <span class="pblabel">$starting</span>
7791: </div>
7792: </p>
7793: ENDPROGBAR
1.1045 www 7794: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7795: }
7796:
7797: sub LCprogressbarUpdate {
1.1042 www 7798: my ($r,$val,$text)=@_;
7799: unless ($val) {
7800: if ($LClastpercent) {
7801: $val=$LClastpercent;
7802: } else {
7803: $val=0;
7804: }
7805: }
1.1041 www 7806: if ($val<0) { $val=0; }
7807: if ($val>100) { $val=0; }
1.1042 www 7808: $LClastpercent=$val;
1.1041 www 7809: unless ($text) { $text=$val.'%'; }
7810: $text=&js_ready($text);
1.1044 www 7811: &r_print($r,<<ENDUPDATE);
1.1041 www 7812: <script type="text/javascript">
7813: // <![CDATA[
1.1045 www 7814: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7815: // ]]>
7816: </script>
7817: ENDUPDATE
1.1035 www 7818: }
7819:
1.1042 www 7820: sub LCprogressbarClose {
7821: my ($r)=@_;
7822: $LClastpercent=0;
1.1044 www 7823: &r_print($r,<<ENDCLOSE);
1.1042 www 7824: <script type="text/javascript">
7825: // <![CDATA[
1.1045 www 7826: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7827: // ]]>
7828: </script>
7829: ENDCLOSE
1.1044 www 7830: }
7831:
7832: sub r_print {
7833: my ($r,$to_print)=@_;
7834: if ($r) {
7835: $r->print($to_print);
7836: $r->rflush();
7837: } else {
7838: print($to_print);
7839: }
1.1042 www 7840: }
7841:
1.320 albertel 7842: sub html_encode {
7843: my ($result) = @_;
7844:
1.322 albertel 7845: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7846:
7847: return $result;
7848: }
1.1044 www 7849:
1.317 albertel 7850: sub js_ready {
7851: my ($result) = @_;
7852:
1.323 albertel 7853: $result =~ s/[\n\r]/ /xmsg;
7854: $result =~ s/\\/\\\\/xmsg;
7855: $result =~ s/'/\\'/xmsg;
1.372 albertel 7856: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7857:
7858: return $result;
7859: }
7860:
1.315 albertel 7861: sub validate_page {
7862: if ( exists($env{'internal.start_page'})
1.316 albertel 7863: && $env{'internal.start_page'} > 1) {
7864: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7865: $env{'internal.start_page'}.' '.
1.316 albertel 7866: $ENV{'request.filename'});
1.315 albertel 7867: }
7868: if ( exists($env{'internal.end_page'})
1.316 albertel 7869: && $env{'internal.end_page'} > 1) {
7870: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7871: $env{'internal.end_page'}.' '.
1.316 albertel 7872: $env{'request.filename'});
1.315 albertel 7873: }
7874: if ( exists($env{'internal.start_page'})
7875: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7876: &Apache::lonnet::logthis('start_page called without end_page '.
7877: $env{'request.filename'});
1.315 albertel 7878: }
7879: if ( ! exists($env{'internal.start_page'})
7880: && exists($env{'internal.end_page'})) {
1.316 albertel 7881: &Apache::lonnet::logthis('end_page called without start_page'.
7882: $env{'request.filename'});
1.315 albertel 7883: }
1.306 albertel 7884: }
1.315 albertel 7885:
1.996 www 7886:
7887: sub start_scrollbox {
1.1075 raeburn 7888: my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998 raeburn 7889: unless ($outerwidth) { $outerwidth='520px'; }
7890: unless ($width) { $width='500px'; }
7891: unless ($height) { $height='200px'; }
1.1075 raeburn 7892: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 7893: if ($id ne '') {
1.1020 raeburn 7894: $table_id = " id='table_$id'";
7895: $div_id = " id='div_$id'";
1.1018 raeburn 7896: }
1.1075 raeburn 7897: if ($bgcolor ne '') {
7898: $tdcol = "background-color: $bgcolor;";
7899: }
7900: return <<"END";
7901: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol"><div style="overflow:auto; width:$width; height: $height;"$div_id>
7902: END
1.996 www 7903: }
7904:
7905: sub end_scrollbox {
1.1036 www 7906: return '</div></td></tr></table>';
1.996 www 7907: }
7908:
1.318 albertel 7909: sub simple_error_page {
7910: my ($r,$title,$msg) = @_;
7911: my $page =
7912: &Apache::loncommon::start_page($title).
1.1075.2.15 raeburn 7913: '<p class="LC_error">'.&mt($msg).'</p>'.
1.318 albertel 7914: &Apache::loncommon::end_page();
7915: if (ref($r)) {
7916: $r->print($page);
1.327 albertel 7917: return;
1.318 albertel 7918: }
7919: return $page;
7920: }
1.347 albertel 7921:
7922: {
1.610 albertel 7923: my @row_count;
1.961 onken 7924:
7925: sub start_data_table_count {
7926: unshift(@row_count, 0);
7927: return;
7928: }
7929:
7930: sub end_data_table_count {
7931: shift(@row_count);
7932: return;
7933: }
7934:
1.347 albertel 7935: sub start_data_table {
1.1018 raeburn 7936: my ($add_class,$id) = @_;
1.422 albertel 7937: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 7938: my $table_id;
7939: if (defined($id)) {
7940: $table_id = ' id="'.$id.'"';
7941: }
1.961 onken 7942: &start_data_table_count();
1.1018 raeburn 7943: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 7944: }
7945:
7946: sub end_data_table {
1.961 onken 7947: &end_data_table_count();
1.389 albertel 7948: return '</table>'."\n";;
1.347 albertel 7949: }
7950:
7951: sub start_data_table_row {
1.974 wenzelju 7952: my ($add_class, $id) = @_;
1.610 albertel 7953: $row_count[0]++;
7954: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 7955: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 7956: $id = (' id="'.$id.'"') unless ($id eq '');
7957: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 7958: }
1.471 banghart 7959:
7960: sub continue_data_table_row {
1.974 wenzelju 7961: my ($add_class, $id) = @_;
1.610 albertel 7962: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 7963: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
7964: $id = (' id="'.$id.'"') unless ($id eq '');
7965: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 7966: }
1.347 albertel 7967:
7968: sub end_data_table_row {
1.389 albertel 7969: return '</tr>'."\n";;
1.347 albertel 7970: }
1.367 www 7971:
1.421 albertel 7972: sub start_data_table_empty_row {
1.707 bisitz 7973: # $row_count[0]++;
1.421 albertel 7974: return '<tr class="LC_empty_row" >'."\n";;
7975: }
7976:
7977: sub end_data_table_empty_row {
7978: return '</tr>'."\n";;
7979: }
7980:
1.367 www 7981: sub start_data_table_header_row {
1.389 albertel 7982: return '<tr class="LC_header_row">'."\n";;
1.367 www 7983: }
7984:
7985: sub end_data_table_header_row {
1.389 albertel 7986: return '</tr>'."\n";;
1.367 www 7987: }
1.890 droeschl 7988:
7989: sub data_table_caption {
7990: my $caption = shift;
7991: return "<caption class=\"LC_caption\">$caption</caption>";
7992: }
1.347 albertel 7993: }
7994:
1.548 albertel 7995: =pod
7996:
7997: =item * &inhibit_menu_check($arg)
7998:
7999: Checks for a inhibitmenu state and generates output to preserve it
8000:
8001: Inputs: $arg - can be any of
8002: - undef - in which case the return value is a string
8003: to add into arguments list of a uri
8004: - 'input' - in which case the return value is a HTML
8005: <form> <input> field of type hidden to
8006: preserve the value
8007: - a url - in which case the return value is the url with
8008: the neccesary cgi args added to preserve the
8009: inhibitmenu state
8010: - a ref to a url - no return value, but the string is
8011: updated to include the neccessary cgi
8012: args to preserve the inhibitmenu state
8013:
8014: =cut
8015:
8016: sub inhibit_menu_check {
8017: my ($arg) = @_;
8018: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8019: if ($arg eq 'input') {
8020: if ($env{'form.inhibitmenu'}) {
8021: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8022: } else {
8023: return
8024: }
8025: }
8026: if ($env{'form.inhibitmenu'}) {
8027: if (ref($arg)) {
8028: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8029: } elsif ($arg eq '') {
8030: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8031: } else {
8032: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8033: }
8034: }
8035: if (!ref($arg)) {
8036: return $arg;
8037: }
8038: }
8039:
1.251 albertel 8040: ###############################################
1.182 matthew 8041:
8042: =pod
8043:
1.549 albertel 8044: =back
8045:
8046: =head1 User Information Routines
8047:
8048: =over 4
8049:
1.405 albertel 8050: =item * &get_users_function()
1.182 matthew 8051:
8052: Used by &bodytag to determine the current users primary role.
8053: Returns either 'student','coordinator','admin', or 'author'.
8054:
8055: =cut
8056:
8057: ###############################################
8058: sub get_users_function {
1.815 tempelho 8059: my $function = 'norole';
1.818 tempelho 8060: if ($env{'request.role'}=~/^(st)/) {
8061: $function='student';
8062: }
1.907 raeburn 8063: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8064: $function='coordinator';
8065: }
1.258 albertel 8066: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8067: $function='admin';
8068: }
1.826 bisitz 8069: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8070: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8071: $function='author';
8072: }
8073: return $function;
1.54 www 8074: }
1.99 www 8075:
8076: ###############################################
8077:
1.233 raeburn 8078: =pod
8079:
1.821 raeburn 8080: =item * &show_course()
8081:
8082: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8083: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8084:
8085: Inputs:
8086: None
8087:
8088: Outputs:
8089: Scalar: 1 if 'Course' to be used, 0 otherwise.
8090:
8091: =cut
8092:
8093: ###############################################
8094: sub show_course {
8095: my $course = !$env{'user.adv'};
8096: if (!$env{'user.adv'}) {
8097: foreach my $env (keys(%env)) {
8098: next if ($env !~ m/^user\.priv\./);
8099: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8100: $course = 0;
8101: last;
8102: }
8103: }
8104: }
8105: return $course;
8106: }
8107:
8108: ###############################################
8109:
8110: =pod
8111:
1.542 raeburn 8112: =item * &check_user_status()
1.274 raeburn 8113:
8114: Determines current status of supplied role for a
8115: specific user. Roles can be active, previous or future.
8116:
8117: Inputs:
8118: user's domain, user's username, course's domain,
1.375 raeburn 8119: course's number, optional section ID.
1.274 raeburn 8120:
8121: Outputs:
8122: role status: active, previous or future.
8123:
8124: =cut
8125:
8126: sub check_user_status {
1.412 raeburn 8127: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8128: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8129: my @uroles = keys %userinfo;
8130: my $srchstr;
8131: my $active_chk = 'none';
1.412 raeburn 8132: my $now = time;
1.274 raeburn 8133: if (@uroles > 0) {
1.908 raeburn 8134: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8135: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8136: } else {
1.412 raeburn 8137: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8138: }
8139: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8140: my $role_end = 0;
8141: my $role_start = 0;
8142: $active_chk = 'active';
1.412 raeburn 8143: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8144: $role_end = $1;
8145: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8146: $role_start = $1;
1.274 raeburn 8147: }
8148: }
8149: if ($role_start > 0) {
1.412 raeburn 8150: if ($now < $role_start) {
1.274 raeburn 8151: $active_chk = 'future';
8152: }
8153: }
8154: if ($role_end > 0) {
1.412 raeburn 8155: if ($now > $role_end) {
1.274 raeburn 8156: $active_chk = 'previous';
8157: }
8158: }
8159: }
8160: }
8161: return $active_chk;
8162: }
8163:
8164: ###############################################
8165:
8166: =pod
8167:
1.405 albertel 8168: =item * &get_sections()
1.233 raeburn 8169:
8170: Determines all the sections for a course including
8171: sections with students and sections containing other roles.
1.419 raeburn 8172: Incoming parameters:
8173:
8174: 1. domain
8175: 2. course number
8176: 3. reference to array containing roles for which sections should
8177: be gathered (optional).
8178: 4. reference to array containing status types for which sections
8179: should be gathered (optional).
8180:
8181: If the third argument is undefined, sections are gathered for any role.
8182: If the fourth argument is undefined, sections are gathered for any status.
8183: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8184:
1.374 raeburn 8185: Returns section hash (keys are section IDs, values are
8186: number of users in each section), subject to the
1.419 raeburn 8187: optional roles filter, optional status filter
1.233 raeburn 8188:
8189: =cut
8190:
8191: ###############################################
8192: sub get_sections {
1.419 raeburn 8193: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8194: if (!defined($cdom) || !defined($cnum)) {
8195: my $cid = $env{'request.course.id'};
8196:
8197: return if (!defined($cid));
8198:
8199: $cdom = $env{'course.'.$cid.'.domain'};
8200: $cnum = $env{'course.'.$cid.'.num'};
8201: }
8202:
8203: my %sectioncount;
1.419 raeburn 8204: my $now = time;
1.240 albertel 8205:
1.366 albertel 8206: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 8207: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8208: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8209: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8210: my $start_index = &Apache::loncoursedata::CL_START();
8211: my $end_index = &Apache::loncoursedata::CL_END();
8212: my $status;
1.366 albertel 8213: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8214: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8215: $data->[$status_index],
8216: $data->[$start_index],
8217: $data->[$end_index]);
8218: if ($stu_status eq 'Active') {
8219: $status = 'active';
8220: } elsif ($end < $now) {
8221: $status = 'previous';
8222: } elsif ($start > $now) {
8223: $status = 'future';
8224: }
8225: if ($section ne '-1' && $section !~ /^\s*$/) {
8226: if ((!defined($possible_status)) || (($status ne '') &&
8227: (grep/^\Q$status\E$/,@{$possible_status}))) {
8228: $sectioncount{$section}++;
8229: }
1.240 albertel 8230: }
8231: }
8232: }
8233: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8234: foreach my $user (sort(keys(%courseroles))) {
8235: if ($user !~ /^(\w{2})/) { next; }
8236: my ($role) = ($user =~ /^(\w{2})/);
8237: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8238: my ($section,$status);
1.240 albertel 8239: if ($role eq 'cr' &&
8240: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8241: $section=$1;
8242: }
8243: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8244: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8245: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8246: if ($end == -1 && $start == -1) {
8247: next; #deleted role
8248: }
8249: if (!defined($possible_status)) {
8250: $sectioncount{$section}++;
8251: } else {
8252: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8253: $status = 'active';
8254: } elsif ($end < $now) {
8255: $status = 'future';
8256: } elsif ($start > $now) {
8257: $status = 'previous';
8258: }
8259: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8260: $sectioncount{$section}++;
8261: }
8262: }
1.233 raeburn 8263: }
1.366 albertel 8264: return %sectioncount;
1.233 raeburn 8265: }
8266:
1.274 raeburn 8267: ###############################################
1.294 raeburn 8268:
8269: =pod
1.405 albertel 8270:
8271: =item * &get_course_users()
8272:
1.275 raeburn 8273: Retrieves usernames:domains for users in the specified course
8274: with specific role(s), and access status.
8275:
8276: Incoming parameters:
1.277 albertel 8277: 1. course domain
8278: 2. course number
8279: 3. access status: users must have - either active,
1.275 raeburn 8280: previous, future, or all.
1.277 albertel 8281: 4. reference to array of permissible roles
1.288 raeburn 8282: 5. reference to array of section restrictions (optional)
8283: 6. reference to results object (hash of hashes).
8284: 7. reference to optional userdata hash
1.609 raeburn 8285: 8. reference to optional statushash
1.630 raeburn 8286: 9. flag if privileged users (except those set to unhide in
8287: course settings) should be excluded
1.609 raeburn 8288: Keys of top level results hash are roles.
1.275 raeburn 8289: Keys of inner hashes are username:domain, with
8290: values set to access type.
1.288 raeburn 8291: Optional userdata hash returns an array with arguments in the
8292: same order as loncoursedata::get_classlist() for student data.
8293:
1.609 raeburn 8294: Optional statushash returns
8295:
1.288 raeburn 8296: Entries for end, start, section and status are blank because
8297: of the possibility of multiple values for non-student roles.
8298:
1.275 raeburn 8299: =cut
1.405 albertel 8300:
1.275 raeburn 8301: ###############################################
1.405 albertel 8302:
1.275 raeburn 8303: sub get_course_users {
1.630 raeburn 8304: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8305: my %idx = ();
1.419 raeburn 8306: my %seclists;
1.288 raeburn 8307:
8308: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8309: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8310: $idx{end} = &Apache::loncoursedata::CL_END();
8311: $idx{start} = &Apache::loncoursedata::CL_START();
8312: $idx{id} = &Apache::loncoursedata::CL_ID();
8313: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8314: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8315: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8316:
1.290 albertel 8317: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8318: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8319: my $now = time;
1.277 albertel 8320: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8321: my $match = 0;
1.412 raeburn 8322: my $secmatch = 0;
1.419 raeburn 8323: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8324: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8325: if ($section eq '') {
8326: $section = 'none';
8327: }
1.291 albertel 8328: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8329: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8330: $secmatch = 1;
8331: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8332: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8333: $secmatch = 1;
8334: }
8335: } else {
1.419 raeburn 8336: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8337: $secmatch = 1;
8338: }
1.290 albertel 8339: }
1.412 raeburn 8340: if (!$secmatch) {
8341: next;
8342: }
1.419 raeburn 8343: }
1.275 raeburn 8344: if (defined($$types{'active'})) {
1.288 raeburn 8345: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8346: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8347: $match = 1;
1.275 raeburn 8348: }
8349: }
8350: if (defined($$types{'previous'})) {
1.609 raeburn 8351: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8352: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8353: $match = 1;
1.275 raeburn 8354: }
8355: }
8356: if (defined($$types{'future'})) {
1.609 raeburn 8357: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8358: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8359: $match = 1;
1.275 raeburn 8360: }
8361: }
1.609 raeburn 8362: if ($match) {
8363: push(@{$seclists{$student}},$section);
8364: if (ref($userdata) eq 'HASH') {
8365: $$userdata{$student} = $$classlist{$student};
8366: }
8367: if (ref($statushash) eq 'HASH') {
8368: $statushash->{$student}{'st'}{$section} = $status;
8369: }
1.288 raeburn 8370: }
1.275 raeburn 8371: }
8372: }
1.412 raeburn 8373: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8374: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8375: my $now = time;
1.609 raeburn 8376: my %displaystatus = ( previous => 'Expired',
8377: active => 'Active',
8378: future => 'Future',
8379: );
1.630 raeburn 8380: my %nothide;
8381: if ($hidepriv) {
8382: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8383: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8384: if ($user !~ /:/) {
8385: $nothide{join(':',split(/[\@]/,$user))}=1;
8386: } else {
8387: $nothide{$user} = 1;
8388: }
8389: }
8390: }
1.439 raeburn 8391: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8392: my $match = 0;
1.412 raeburn 8393: my $secmatch = 0;
1.439 raeburn 8394: my $status;
1.412 raeburn 8395: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8396: $user =~ s/:$//;
1.439 raeburn 8397: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8398: if ($end == -1 || $start == -1) {
8399: next;
8400: }
8401: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8402: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8403: my ($uname,$udom) = split(/:/,$user);
8404: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8405: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8406: $secmatch = 1;
8407: } elsif ($usec eq '') {
1.420 albertel 8408: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8409: $secmatch = 1;
8410: }
8411: } else {
8412: if (grep(/^\Q$usec\E$/,@{$sections})) {
8413: $secmatch = 1;
8414: }
8415: }
8416: if (!$secmatch) {
8417: next;
8418: }
1.288 raeburn 8419: }
1.419 raeburn 8420: if ($usec eq '') {
8421: $usec = 'none';
8422: }
1.275 raeburn 8423: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8424: if ($hidepriv) {
8425: if ((&Apache::lonnet::privileged($uname,$udom)) &&
8426: (!$nothide{$uname.':'.$udom})) {
8427: next;
8428: }
8429: }
1.503 raeburn 8430: if ($end > 0 && $end < $now) {
1.439 raeburn 8431: $status = 'previous';
8432: } elsif ($start > $now) {
8433: $status = 'future';
8434: } else {
8435: $status = 'active';
8436: }
1.277 albertel 8437: foreach my $type (keys(%{$types})) {
1.275 raeburn 8438: if ($status eq $type) {
1.420 albertel 8439: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8440: push(@{$$users{$role}{$user}},$type);
8441: }
1.288 raeburn 8442: $match = 1;
8443: }
8444: }
1.419 raeburn 8445: if (($match) && (ref($userdata) eq 'HASH')) {
8446: if (!exists($$userdata{$uname.':'.$udom})) {
8447: &get_user_info($udom,$uname,\%idx,$userdata);
8448: }
1.420 albertel 8449: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8450: push(@{$seclists{$uname.':'.$udom}},$usec);
8451: }
1.609 raeburn 8452: if (ref($statushash) eq 'HASH') {
8453: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8454: }
1.275 raeburn 8455: }
8456: }
8457: }
8458: }
1.290 albertel 8459: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8460: if ((defined($cdom)) && (defined($cnum))) {
8461: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8462: if ( defined($csettings{'internal.courseowner'}) ) {
8463: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8464: next if ($owner eq '');
8465: my ($ownername,$ownerdom);
8466: if ($owner =~ /^([^:]+):([^:]+)$/) {
8467: $ownername = $1;
8468: $ownerdom = $2;
8469: } else {
8470: $ownername = $owner;
8471: $ownerdom = $cdom;
8472: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8473: }
8474: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8475: if (defined($userdata) &&
1.609 raeburn 8476: !exists($$userdata{$owner})) {
8477: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8478: if (!grep(/^none$/,@{$seclists{$owner}})) {
8479: push(@{$seclists{$owner}},'none');
8480: }
8481: if (ref($statushash) eq 'HASH') {
8482: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8483: }
1.290 albertel 8484: }
1.279 raeburn 8485: }
8486: }
8487: }
1.419 raeburn 8488: foreach my $user (keys(%seclists)) {
8489: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8490: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8491: }
1.275 raeburn 8492: }
8493: return;
8494: }
8495:
1.288 raeburn 8496: sub get_user_info {
8497: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8498: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8499: &plainname($uname,$udom,'lastname');
1.291 albertel 8500: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8501: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8502: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8503: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8504: return;
8505: }
1.275 raeburn 8506:
1.472 raeburn 8507: ###############################################
8508:
8509: =pod
8510:
8511: =item * &get_user_quota()
8512:
8513: Retrieves quota assigned for storage of portfolio files for a user
8514:
8515: Incoming parameters:
8516: 1. user's username
8517: 2. user's domain
8518:
8519: Returns:
1.536 raeburn 8520: 1. Disk quota (in Mb) assigned to student.
8521: 2. (Optional) Type of setting: custom or default
8522: (individually assigned or default for user's
8523: institutional status).
8524: 3. (Optional) - User's institutional status (e.g., faculty, staff
8525: or student - types as defined in localenroll::inst_usertypes
8526: for user's domain, which determines default quota for user.
8527: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8528:
8529: If a value has been stored in the user's environment,
1.536 raeburn 8530: it will return that, otherwise it returns the maximal default
8531: defined for the user's instituional status(es) in the domain.
1.472 raeburn 8532:
8533: =cut
8534:
8535: ###############################################
8536:
8537:
8538: sub get_user_quota {
8539: my ($uname,$udom) = @_;
1.536 raeburn 8540: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8541: if (!defined($udom)) {
8542: $udom = $env{'user.domain'};
8543: }
8544: if (!defined($uname)) {
8545: $uname = $env{'user.name'};
8546: }
8547: if (($udom eq '' || $uname eq '') ||
8548: ($udom eq 'public') && ($uname eq 'public')) {
8549: $quota = 0;
1.536 raeburn 8550: $quotatype = 'default';
8551: $defquota = 0;
1.472 raeburn 8552: } else {
1.536 raeburn 8553: my $inststatus;
1.472 raeburn 8554: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8555: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 8556: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 8557: } else {
1.536 raeburn 8558: my %userenv =
8559: &Apache::lonnet::get('environment',['portfolioquota',
8560: 'inststatus'],$udom,$uname);
1.472 raeburn 8561: my ($tmp) = keys(%userenv);
8562: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8563: $quota = $userenv{'portfolioquota'};
1.536 raeburn 8564: $inststatus = $userenv{'inststatus'};
1.472 raeburn 8565: } else {
8566: undef(%userenv);
8567: }
8568: }
1.536 raeburn 8569: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 8570: if ($quota eq '') {
1.536 raeburn 8571: $quota = $defquota;
8572: $quotatype = 'default';
8573: } else {
8574: $quotatype = 'custom';
1.472 raeburn 8575: }
8576: }
1.536 raeburn 8577: if (wantarray) {
8578: return ($quota,$quotatype,$settingstatus,$defquota);
8579: } else {
8580: return $quota;
8581: }
1.472 raeburn 8582: }
8583:
8584: ###############################################
8585:
8586: =pod
8587:
8588: =item * &default_quota()
8589:
1.536 raeburn 8590: Retrieves default quota assigned for storage of user portfolio files,
8591: given an (optional) user's institutional status.
1.472 raeburn 8592:
8593: Incoming parameters:
8594: 1. domain
1.536 raeburn 8595: 2. (Optional) institutional status(es). This is a : separated list of
8596: status types (e.g., faculty, staff, student etc.)
8597: which apply to the user for whom the default is being retrieved.
8598: If the institutional status string in undefined, the domain
8599: default quota will be returned.
1.472 raeburn 8600:
8601: Returns:
8602: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 8603: 2. (Optional) institutional type which determined the value of the
8604: default quota.
1.472 raeburn 8605:
8606: If a value has been stored in the domain's configuration db,
8607: it will return that, otherwise it returns 20 (for backwards
8608: compatibility with domains which have not set up a configuration
8609: db file; the original statically defined portfolio quota was 20 Mb).
8610:
1.536 raeburn 8611: If the user's status includes multiple types (e.g., staff and student),
8612: the largest default quota which applies to the user determines the
8613: default quota returned.
8614:
1.780 raeburn 8615: =back
8616:
1.472 raeburn 8617: =cut
8618:
8619: ###############################################
8620:
8621:
8622: sub default_quota {
1.536 raeburn 8623: my ($udom,$inststatus) = @_;
8624: my ($defquota,$settingstatus);
8625: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8626: ['quotas'],$udom);
8627: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8628: if ($inststatus ne '') {
1.765 raeburn 8629: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8630: foreach my $item (@statuses) {
1.711 raeburn 8631: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8632: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
8633: if ($defquota eq '') {
8634: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8635: $settingstatus = $item;
8636: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
8637: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8638: $settingstatus = $item;
8639: }
8640: }
8641: } else {
8642: if ($quotahash{'quotas'}{$item} ne '') {
8643: if ($defquota eq '') {
8644: $defquota = $quotahash{'quotas'}{$item};
8645: $settingstatus = $item;
8646: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8647: $defquota = $quotahash{'quotas'}{$item};
8648: $settingstatus = $item;
8649: }
1.536 raeburn 8650: }
8651: }
8652: }
8653: }
8654: if ($defquota eq '') {
1.711 raeburn 8655: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8656: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
8657: } else {
8658: $defquota = $quotahash{'quotas'}{'default'};
8659: }
1.536 raeburn 8660: $settingstatus = 'default';
8661: }
8662: } else {
8663: $settingstatus = 'default';
8664: $defquota = 20;
8665: }
8666: if (wantarray) {
8667: return ($defquota,$settingstatus);
1.472 raeburn 8668: } else {
1.536 raeburn 8669: return $defquota;
1.472 raeburn 8670: }
8671: }
8672:
1.384 raeburn 8673: sub get_secgrprole_info {
8674: my ($cdom,$cnum,$needroles,$type) = @_;
8675: my %sections_count = &get_sections($cdom,$cnum);
8676: my @sections = (sort {$a <=> $b} keys(%sections_count));
8677: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
8678: my @groups = sort(keys(%curr_groups));
8679: my $allroles = [];
8680: my $rolehash;
8681: my $accesshash = {
8682: active => 'Currently has access',
8683: future => 'Will have future access',
8684: previous => 'Previously had access',
8685: };
8686: if ($needroles) {
8687: $rolehash = {'all' => 'all'};
1.385 albertel 8688: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8689: if (&Apache::lonnet::error(%user_roles)) {
8690: undef(%user_roles);
8691: }
8692: foreach my $item (keys(%user_roles)) {
1.384 raeburn 8693: my ($role)=split(/\:/,$item,2);
8694: if ($role eq 'cr') { next; }
8695: if ($role =~ /^cr/) {
8696: $$rolehash{$role} = (split('/',$role))[3];
8697: } else {
8698: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
8699: }
8700: }
8701: foreach my $key (sort(keys(%{$rolehash}))) {
8702: push(@{$allroles},$key);
8703: }
8704: push (@{$allroles},'st');
8705: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
8706: }
8707: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
8708: }
8709:
1.555 raeburn 8710: sub user_picker {
1.994 raeburn 8711: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 8712: my $currdom = $dom;
8713: my %curr_selected = (
8714: srchin => 'dom',
1.580 raeburn 8715: srchby => 'lastname',
1.555 raeburn 8716: );
8717: my $srchterm;
1.625 raeburn 8718: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 8719: if ($srch->{'srchby'} ne '') {
8720: $curr_selected{'srchby'} = $srch->{'srchby'};
8721: }
8722: if ($srch->{'srchin'} ne '') {
8723: $curr_selected{'srchin'} = $srch->{'srchin'};
8724: }
8725: if ($srch->{'srchtype'} ne '') {
8726: $curr_selected{'srchtype'} = $srch->{'srchtype'};
8727: }
8728: if ($srch->{'srchdomain'} ne '') {
8729: $currdom = $srch->{'srchdomain'};
8730: }
8731: $srchterm = $srch->{'srchterm'};
8732: }
8733: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 8734: 'usr' => 'Search criteria',
1.563 raeburn 8735: 'doma' => 'Domain/institution to search',
1.558 albertel 8736: 'uname' => 'username',
8737: 'lastname' => 'last name',
1.555 raeburn 8738: 'lastfirst' => 'last name, first name',
1.558 albertel 8739: 'crs' => 'in this course',
1.576 raeburn 8740: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 8741: 'alc' => 'all LON-CAPA',
1.573 raeburn 8742: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 8743: 'exact' => 'is',
8744: 'contains' => 'contains',
1.569 raeburn 8745: 'begins' => 'begins with',
1.571 raeburn 8746: 'youm' => "You must include some text to search for.",
8747: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
8748: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
8749: 'yomc' => "You must choose a domain when using an institutional directory search.",
8750: 'ymcd' => "You must choose a domain when using a domain search.",
8751: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
8752: 'whse' => "When searching by last,first you must include at least one character in the first name.",
8753: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 8754: );
1.563 raeburn 8755: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
8756: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 8757:
8758: my @srchins = ('crs','dom','alc','instd');
8759:
8760: foreach my $option (@srchins) {
8761: # FIXME 'alc' option unavailable until
8762: # loncreateuser::print_user_query_page()
8763: # has been completed.
8764: next if ($option eq 'alc');
1.880 raeburn 8765: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 8766: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 8767: if ($curr_selected{'srchin'} eq $option) {
8768: $srchinsel .= '
8769: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8770: } else {
8771: $srchinsel .= '
8772: <option value="'.$option.'">'.$lt{$option}.'</option>';
8773: }
1.555 raeburn 8774: }
1.563 raeburn 8775: $srchinsel .= "\n </select>\n";
1.555 raeburn 8776:
8777: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 8778: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 8779: if ($curr_selected{'srchby'} eq $option) {
8780: $srchbysel .= '
8781: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8782: } else {
8783: $srchbysel .= '
8784: <option value="'.$option.'">'.$lt{$option}.'</option>';
8785: }
8786: }
8787: $srchbysel .= "\n </select>\n";
8788:
8789: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 8790: foreach my $option ('begins','contains','exact') {
1.555 raeburn 8791: if ($curr_selected{'srchtype'} eq $option) {
8792: $srchtypesel .= '
8793: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8794: } else {
8795: $srchtypesel .= '
8796: <option value="'.$option.'">'.$lt{$option}.'</option>';
8797: }
8798: }
8799: $srchtypesel .= "\n </select>\n";
8800:
1.558 albertel 8801: my ($newuserscript,$new_user_create);
1.994 raeburn 8802: my $context_dom = $env{'request.role.domain'};
8803: if ($context eq 'requestcrs') {
8804: if ($env{'form.coursedom'} ne '') {
8805: $context_dom = $env{'form.coursedom'};
8806: }
8807: }
1.556 raeburn 8808: if ($forcenewuser) {
1.576 raeburn 8809: if (ref($srch) eq 'HASH') {
1.994 raeburn 8810: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 8811: if ($cancreate) {
8812: $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>';
8813: } else {
1.799 bisitz 8814: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 8815: my %usertypetext = (
8816: official => 'institutional',
8817: unofficial => 'non-institutional',
8818: );
1.799 bisitz 8819: $new_user_create = '<p class="LC_warning">'
8820: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
8821: .' '
8822: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
8823: ,'<a href="'.$helplink.'">','</a>')
8824: .'</p><br />';
1.627 raeburn 8825: }
1.576 raeburn 8826: }
8827: }
8828:
1.556 raeburn 8829: $newuserscript = <<"ENDSCRIPT";
8830:
1.570 raeburn 8831: function setSearch(createnew,callingForm) {
1.556 raeburn 8832: if (createnew == 1) {
1.570 raeburn 8833: for (var i=0; i<callingForm.srchby.length; i++) {
8834: if (callingForm.srchby.options[i].value == 'uname') {
8835: callingForm.srchby.selectedIndex = i;
1.556 raeburn 8836: }
8837: }
1.570 raeburn 8838: for (var i=0; i<callingForm.srchin.length; i++) {
8839: if ( callingForm.srchin.options[i].value == 'dom') {
8840: callingForm.srchin.selectedIndex = i;
1.556 raeburn 8841: }
8842: }
1.570 raeburn 8843: for (var i=0; i<callingForm.srchtype.length; i++) {
8844: if (callingForm.srchtype.options[i].value == 'exact') {
8845: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 8846: }
8847: }
1.570 raeburn 8848: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 8849: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 8850: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 8851: }
8852: }
8853: }
8854: }
8855: ENDSCRIPT
1.558 albertel 8856:
1.556 raeburn 8857: }
8858:
1.555 raeburn 8859: my $output = <<"END_BLOCK";
1.556 raeburn 8860: <script type="text/javascript">
1.824 bisitz 8861: // <![CDATA[
1.570 raeburn 8862: function validateEntry(callingForm) {
1.558 albertel 8863:
1.556 raeburn 8864: var checkok = 1;
1.558 albertel 8865: var srchin;
1.570 raeburn 8866: for (var i=0; i<callingForm.srchin.length; i++) {
8867: if ( callingForm.srchin[i].checked ) {
8868: srchin = callingForm.srchin[i].value;
1.558 albertel 8869: }
8870: }
8871:
1.570 raeburn 8872: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
8873: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
8874: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
8875: var srchterm = callingForm.srchterm.value;
8876: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 8877: var msg = "";
8878:
8879: if (srchterm == "") {
8880: checkok = 0;
1.571 raeburn 8881: msg += "$lt{'youm'}\\n";
1.556 raeburn 8882: }
8883:
1.569 raeburn 8884: if (srchtype== 'begins') {
8885: if (srchterm.length < 2) {
8886: checkok = 0;
1.571 raeburn 8887: msg += "$lt{'thte'}\\n";
1.569 raeburn 8888: }
8889: }
8890:
1.556 raeburn 8891: if (srchtype== 'contains') {
8892: if (srchterm.length < 3) {
8893: checkok = 0;
1.571 raeburn 8894: msg += "$lt{'thet'}\\n";
1.556 raeburn 8895: }
8896: }
8897: if (srchin == 'instd') {
8898: if (srchdomain == '') {
8899: checkok = 0;
1.571 raeburn 8900: msg += "$lt{'yomc'}\\n";
1.556 raeburn 8901: }
8902: }
8903: if (srchin == 'dom') {
8904: if (srchdomain == '') {
8905: checkok = 0;
1.571 raeburn 8906: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 8907: }
8908: }
8909: if (srchby == 'lastfirst') {
8910: if (srchterm.indexOf(",") == -1) {
8911: checkok = 0;
1.571 raeburn 8912: msg += "$lt{'whus'}\\n";
1.556 raeburn 8913: }
8914: if (srchterm.indexOf(",") == srchterm.length -1) {
8915: checkok = 0;
1.571 raeburn 8916: msg += "$lt{'whse'}\\n";
1.556 raeburn 8917: }
8918: }
8919: if (checkok == 0) {
1.571 raeburn 8920: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 8921: return;
8922: }
8923: if (checkok == 1) {
1.570 raeburn 8924: callingForm.submit();
1.556 raeburn 8925: }
8926: }
8927:
8928: $newuserscript
8929:
1.824 bisitz 8930: // ]]>
1.556 raeburn 8931: </script>
1.558 albertel 8932:
8933: $new_user_create
8934:
1.555 raeburn 8935: END_BLOCK
1.558 albertel 8936:
1.876 raeburn 8937: $output .= &Apache::lonhtmlcommon::start_pick_box().
8938: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
8939: $domform.
8940: &Apache::lonhtmlcommon::row_closure().
8941: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
8942: $srchbysel.
8943: $srchtypesel.
8944: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
8945: $srchinsel.
8946: &Apache::lonhtmlcommon::row_closure(1).
8947: &Apache::lonhtmlcommon::end_pick_box().
8948: '<br />';
1.555 raeburn 8949: return $output;
8950: }
8951:
1.612 raeburn 8952: sub user_rule_check {
1.615 raeburn 8953: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 8954: my $response;
8955: if (ref($usershash) eq 'HASH') {
8956: foreach my $user (keys(%{$usershash})) {
8957: my ($uname,$udom) = split(/:/,$user);
8958: next if ($udom eq '' || $uname eq '');
1.615 raeburn 8959: my ($id,$newuser);
1.612 raeburn 8960: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 8961: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 8962: $id = $usershash->{$user}->{'id'};
8963: }
8964: my $inst_response;
8965: if (ref($checks) eq 'HASH') {
8966: if (defined($checks->{'username'})) {
1.615 raeburn 8967: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8968: &Apache::lonnet::get_instuser($udom,$uname);
8969: } elsif (defined($checks->{'id'})) {
1.615 raeburn 8970: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8971: &Apache::lonnet::get_instuser($udom,undef,$id);
8972: }
1.615 raeburn 8973: } else {
8974: ($inst_response,%{$inst_results->{$user}}) =
8975: &Apache::lonnet::get_instuser($udom,$uname);
8976: return;
1.612 raeburn 8977: }
1.615 raeburn 8978: if (!$got_rules->{$udom}) {
1.612 raeburn 8979: my %domconfig = &Apache::lonnet::get_dom('configuration',
8980: ['usercreation'],$udom);
8981: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 8982: foreach my $item ('username','id') {
1.612 raeburn 8983: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
8984: $$curr_rules{$udom}{$item} =
8985: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 8986: }
8987: }
8988: }
1.615 raeburn 8989: $got_rules->{$udom} = 1;
1.585 raeburn 8990: }
1.612 raeburn 8991: foreach my $item (keys(%{$checks})) {
8992: if (ref($$curr_rules{$udom}) eq 'HASH') {
8993: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
8994: if (@{$$curr_rules{$udom}{$item}} > 0) {
8995: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
8996: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
8997: if ($rule_check{$rule}) {
8998: $$rulematch{$user}{$item} = $rule;
8999: if ($inst_response eq 'ok') {
1.615 raeburn 9000: if (ref($inst_results) eq 'HASH') {
9001: if (ref($inst_results->{$user}) eq 'HASH') {
9002: if (keys(%{$inst_results->{$user}}) == 0) {
9003: $$alerts{$item}{$udom}{$uname} = 1;
9004: }
1.612 raeburn 9005: }
9006: }
1.615 raeburn 9007: }
9008: last;
1.585 raeburn 9009: }
9010: }
9011: }
9012: }
9013: }
9014: }
9015: }
9016: }
1.612 raeburn 9017: return;
9018: }
9019:
9020: sub user_rule_formats {
9021: my ($domain,$domdesc,$curr_rules,$check) = @_;
9022: my %text = (
9023: 'username' => 'Usernames',
9024: 'id' => 'IDs',
9025: );
9026: my $output;
9027: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9028: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9029: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9030: $output = '<br />'.
9031: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9032: '<span class="LC_cusr_emph">','</span>',$domdesc).
9033: ' <ul>';
1.612 raeburn 9034: foreach my $rule (@{$ruleorder}) {
9035: if (ref($curr_rules) eq 'ARRAY') {
9036: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9037: if (ref($rules->{$rule}) eq 'HASH') {
9038: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9039: $rules->{$rule}{'desc'}.'</li>';
9040: }
9041: }
9042: }
9043: }
9044: $output .= '</ul>';
9045: }
9046: }
9047: return $output;
9048: }
9049:
9050: sub instrule_disallow_msg {
1.615 raeburn 9051: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9052: my $response;
9053: my %text = (
9054: item => 'username',
9055: items => 'usernames',
9056: match => 'matches',
9057: do => 'does',
9058: action => 'a username',
9059: one => 'one',
9060: );
9061: if ($count > 1) {
9062: $text{'item'} = 'usernames';
9063: $text{'match'} ='match';
9064: $text{'do'} = 'do';
9065: $text{'action'} = 'usernames',
9066: $text{'one'} = 'ones';
9067: }
9068: if ($checkitem eq 'id') {
9069: $text{'items'} = 'IDs';
9070: $text{'item'} = 'ID';
9071: $text{'action'} = 'an ID';
1.615 raeburn 9072: if ($count > 1) {
9073: $text{'item'} = 'IDs';
9074: $text{'action'} = 'IDs';
9075: }
1.612 raeburn 9076: }
1.674 bisitz 9077: $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 9078: if ($mode eq 'upload') {
9079: if ($checkitem eq 'username') {
9080: $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'}.");
9081: } elsif ($checkitem eq 'id') {
1.674 bisitz 9082: $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 9083: }
1.669 raeburn 9084: } elsif ($mode eq 'selfcreate') {
9085: if ($checkitem eq 'id') {
9086: $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.");
9087: }
1.615 raeburn 9088: } else {
9089: if ($checkitem eq 'username') {
9090: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9091: } elsif ($checkitem eq 'id') {
9092: $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.");
9093: }
1.612 raeburn 9094: }
9095: return $response;
1.585 raeburn 9096: }
9097:
1.624 raeburn 9098: sub personal_data_fieldtitles {
9099: my %fieldtitles = &Apache::lonlocal::texthash (
9100: id => 'Student/Employee ID',
9101: permanentemail => 'E-mail address',
9102: lastname => 'Last Name',
9103: firstname => 'First Name',
9104: middlename => 'Middle Name',
9105: generation => 'Generation',
9106: gen => 'Generation',
1.765 raeburn 9107: inststatus => 'Affiliation',
1.624 raeburn 9108: );
9109: return %fieldtitles;
9110: }
9111:
1.642 raeburn 9112: sub sorted_inst_types {
9113: my ($dom) = @_;
9114: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9115: my $othertitle = &mt('All users');
9116: if ($env{'request.course.id'}) {
1.668 raeburn 9117: $othertitle = &mt('Any users');
1.642 raeburn 9118: }
9119: my @types;
9120: if (ref($order) eq 'ARRAY') {
9121: @types = @{$order};
9122: }
9123: if (@types == 0) {
9124: if (ref($usertypes) eq 'HASH') {
9125: @types = sort(keys(%{$usertypes}));
9126: }
9127: }
9128: if (keys(%{$usertypes}) > 0) {
9129: $othertitle = &mt('Other users');
9130: }
9131: return ($othertitle,$usertypes,\@types);
9132: }
9133:
1.645 raeburn 9134: sub get_institutional_codes {
9135: my ($settings,$allcourses,$LC_code) = @_;
9136: # Get complete list of course sections to update
9137: my @currsections = ();
9138: my @currxlists = ();
9139: my $coursecode = $$settings{'internal.coursecode'};
9140:
9141: if ($$settings{'internal.sectionnums'} ne '') {
9142: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9143: }
9144:
9145: if ($$settings{'internal.crosslistings'} ne '') {
9146: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9147: }
9148:
9149: if (@currxlists > 0) {
9150: foreach (@currxlists) {
9151: if (m/^([^:]+):(\w*)$/) {
9152: unless (grep/^$1$/,@{$allcourses}) {
9153: push @{$allcourses},$1;
9154: $$LC_code{$1} = $2;
9155: }
9156: }
9157: }
9158: }
9159:
9160: if (@currsections > 0) {
9161: foreach (@currsections) {
9162: if (m/^(\w+):(\w*)$/) {
9163: my $sec = $coursecode.$1;
9164: my $lc_sec = $2;
9165: unless (grep/^$sec$/,@{$allcourses}) {
9166: push @{$allcourses},$sec;
9167: $$LC_code{$sec} = $lc_sec;
9168: }
9169: }
9170: }
9171: }
9172: return;
9173: }
9174:
1.971 raeburn 9175: sub get_standard_codeitems {
9176: return ('Year','Semester','Department','Number','Section');
9177: }
9178:
1.112 bowersj2 9179: =pod
9180:
1.780 raeburn 9181: =head1 Slot Helpers
9182:
9183: =over 4
9184:
9185: =item * sorted_slots()
9186:
1.1040 raeburn 9187: Sorts an array of slot names in order of an optional sort key,
9188: default sort is by slot start time (earliest first).
1.780 raeburn 9189:
9190: Inputs:
9191:
9192: =over 4
9193:
9194: slotsarr - Reference to array of unsorted slot names.
9195:
9196: slots - Reference to hash of hash, where outer hash keys are slot names.
9197:
1.1040 raeburn 9198: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9199:
1.549 albertel 9200: =back
9201:
1.780 raeburn 9202: Returns:
9203:
9204: =over 4
9205:
1.1040 raeburn 9206: sorted - An array of slot names sorted by a specified sort key
9207: (default sort key is start time of the slot).
1.780 raeburn 9208:
9209: =back
9210:
9211: =cut
9212:
9213:
9214: sub sorted_slots {
1.1040 raeburn 9215: my ($slotsarr,$slots,$sortkey) = @_;
9216: if ($sortkey eq '') {
9217: $sortkey = 'starttime';
9218: }
1.780 raeburn 9219: my @sorted;
9220: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9221: @sorted =
9222: sort {
9223: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9224: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9225: }
9226: if (ref($slots->{$a})) { return -1;}
9227: if (ref($slots->{$b})) { return 1;}
9228: return 0;
9229: } @{$slotsarr};
9230: }
9231: return @sorted;
9232: }
9233:
1.1040 raeburn 9234: =pod
9235:
9236: =item * get_future_slots()
9237:
9238: Inputs:
9239:
9240: =over 4
9241:
9242: cnum - course number
9243:
9244: cdom - course domain
9245:
9246: now - current UNIX time
9247:
9248: symb - optional symb
9249:
9250: =back
9251:
9252: Returns:
9253:
9254: =over 4
9255:
9256: sorted_reservable - ref to array of student_schedulable slots currently
9257: reservable, ordered by end date of reservation period.
9258:
9259: reservable_now - ref to hash of student_schedulable slots currently
9260: reservable.
9261:
9262: Keys in inner hash are:
9263: (a) symb: either blank or symb to which slot use is restricted.
9264: (b) endreserve: end date of reservation period.
9265:
9266: sorted_future - ref to array of student_schedulable slots reservable in
9267: the future, ordered by start date of reservation period.
9268:
9269: future_reservable - ref to hash of student_schedulable slots reservable
9270: in the future.
9271:
9272: Keys in inner hash are:
9273: (a) symb: either blank or symb to which slot use is restricted.
9274: (b) startreserve: start date of reservation period.
9275:
9276: =back
9277:
9278: =cut
9279:
9280: sub get_future_slots {
9281: my ($cnum,$cdom,$now,$symb) = @_;
9282: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9283: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9284: foreach my $slot (keys(%slots)) {
9285: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9286: if ($symb) {
9287: next if (($slots{$slot}->{'symb'} ne '') &&
9288: ($slots{$slot}->{'symb'} ne $symb));
9289: }
9290: if (($slots{$slot}->{'starttime'} > $now) &&
9291: ($slots{$slot}->{'endtime'} > $now)) {
9292: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9293: my $userallowed = 0;
9294: if ($slots{$slot}->{'allowedsections'}) {
9295: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9296: if (!defined($env{'request.role.sec'})
9297: && grep(/^No section assigned$/,@allowed_sec)) {
9298: $userallowed=1;
9299: } else {
9300: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9301: $userallowed=1;
9302: }
9303: }
9304: unless ($userallowed) {
9305: if (defined($env{'request.course.groups'})) {
9306: my @groups = split(/:/,$env{'request.course.groups'});
9307: foreach my $group (@groups) {
9308: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9309: $userallowed=1;
9310: last;
9311: }
9312: }
9313: }
9314: }
9315: }
9316: if ($slots{$slot}->{'allowedusers'}) {
9317: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9318: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9319: if (grep(/^\Q$user\E$/,@allowed_users)) {
9320: $userallowed = 1;
9321: }
9322: }
9323: next unless($userallowed);
9324: }
9325: my $startreserve = $slots{$slot}->{'startreserve'};
9326: my $endreserve = $slots{$slot}->{'endreserve'};
9327: my $symb = $slots{$slot}->{'symb'};
9328: if (($startreserve < $now) &&
9329: (!$endreserve || $endreserve > $now)) {
9330: my $lastres = $endreserve;
9331: if (!$lastres) {
9332: $lastres = $slots{$slot}->{'starttime'};
9333: }
9334: $reservable_now{$slot} = {
9335: symb => $symb,
9336: endreserve => $lastres
9337: };
9338: } elsif (($startreserve > $now) &&
9339: (!$endreserve || $endreserve > $startreserve)) {
9340: $future_reservable{$slot} = {
9341: symb => $symb,
9342: startreserve => $startreserve
9343: };
9344: }
9345: }
9346: }
9347: my @unsorted_reservable = keys(%reservable_now);
9348: if (@unsorted_reservable > 0) {
9349: @sorted_reservable =
9350: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9351: }
9352: my @unsorted_future = keys(%future_reservable);
9353: if (@unsorted_future > 0) {
9354: @sorted_future =
9355: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9356: }
9357: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9358: }
1.780 raeburn 9359:
9360: =pod
9361:
1.1057 foxr 9362: =back
9363:
1.549 albertel 9364: =head1 HTTP Helpers
9365:
9366: =over 4
9367:
1.648 raeburn 9368: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9369:
1.258 albertel 9370: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9371: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9372: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9373:
9374: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9375: $possible_names is an ref to an array of form element names. As an example:
9376: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9377: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9378:
9379: =cut
1.1 albertel 9380:
1.6 albertel 9381: sub get_unprocessed_cgi {
1.25 albertel 9382: my ($query,$possible_names)= @_;
1.26 matthew 9383: # $Apache::lonxml::debug=1;
1.356 albertel 9384: foreach my $pair (split(/&/,$query)) {
9385: my ($name, $value) = split(/=/,$pair);
1.369 www 9386: $name = &unescape($name);
1.25 albertel 9387: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9388: $value =~ tr/+/ /;
9389: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9390: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9391: }
1.16 harris41 9392: }
1.6 albertel 9393: }
9394:
1.112 bowersj2 9395: =pod
9396:
1.648 raeburn 9397: =item * &cacheheader()
1.112 bowersj2 9398:
9399: returns cache-controlling header code
9400:
9401: =cut
9402:
1.7 albertel 9403: sub cacheheader {
1.258 albertel 9404: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9405: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9406: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9407: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9408: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9409: return $output;
1.7 albertel 9410: }
9411:
1.112 bowersj2 9412: =pod
9413:
1.648 raeburn 9414: =item * &no_cache($r)
1.112 bowersj2 9415:
9416: specifies header code to not have cache
9417:
9418: =cut
9419:
1.9 albertel 9420: sub no_cache {
1.216 albertel 9421: my ($r) = @_;
9422: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9423: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9424: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9425: $r->no_cache(1);
9426: $r->header_out("Expires" => $date);
9427: $r->header_out("Pragma" => "no-cache");
1.123 www 9428: }
9429:
9430: sub content_type {
1.181 albertel 9431: my ($r,$type,$charset) = @_;
1.299 foxr 9432: if ($r) {
9433: # Note that printout.pl calls this with undef for $r.
9434: &no_cache($r);
9435: }
1.258 albertel 9436: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9437: unless ($charset) {
9438: $charset=&Apache::lonlocal::current_encoding;
9439: }
9440: if ($charset) { $type.='; charset='.$charset; }
9441: if ($r) {
9442: $r->content_type($type);
9443: } else {
9444: print("Content-type: $type\n\n");
9445: }
1.9 albertel 9446: }
1.25 albertel 9447:
1.112 bowersj2 9448: =pod
9449:
1.648 raeburn 9450: =item * &add_to_env($name,$value)
1.112 bowersj2 9451:
1.258 albertel 9452: adds $name to the %env hash with value
1.112 bowersj2 9453: $value, if $name already exists, the entry is converted to an array
9454: reference and $value is added to the array.
9455:
9456: =cut
9457:
1.25 albertel 9458: sub add_to_env {
9459: my ($name,$value)=@_;
1.258 albertel 9460: if (defined($env{$name})) {
9461: if (ref($env{$name})) {
1.25 albertel 9462: #already have multiple values
1.258 albertel 9463: push(@{ $env{$name} },$value);
1.25 albertel 9464: } else {
9465: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9466: my $first=$env{$name};
9467: undef($env{$name});
9468: push(@{ $env{$name} },$first,$value);
1.25 albertel 9469: }
9470: } else {
1.258 albertel 9471: $env{$name}=$value;
1.25 albertel 9472: }
1.31 albertel 9473: }
1.149 albertel 9474:
9475: =pod
9476:
1.648 raeburn 9477: =item * &get_env_multiple($name)
1.149 albertel 9478:
1.258 albertel 9479: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9480: values may be defined and end up as an array ref.
9481:
9482: returns an array of values
9483:
9484: =cut
9485:
9486: sub get_env_multiple {
9487: my ($name) = @_;
9488: my @values;
1.258 albertel 9489: if (defined($env{$name})) {
1.149 albertel 9490: # exists is it an array
1.258 albertel 9491: if (ref($env{$name})) {
9492: @values=@{ $env{$name} };
1.149 albertel 9493: } else {
1.258 albertel 9494: $values[0]=$env{$name};
1.149 albertel 9495: }
9496: }
9497: return(@values);
9498: }
9499:
1.660 raeburn 9500: sub ask_for_embedded_content {
9501: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9502: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 9503: %currsubfile,%unused,$rem);
1.1071 raeburn 9504: my $counter = 0;
9505: my $numnew = 0;
1.987 raeburn 9506: my $numremref = 0;
9507: my $numinvalid = 0;
9508: my $numpathchg = 0;
9509: my $numexisting = 0;
1.1071 raeburn 9510: my $numunused = 0;
9511: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
9512: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
9513: my $heading = &mt('Upload embedded files');
9514: my $buttontext = &mt('Upload');
9515:
1.1075.2.11 raeburn 9516: my $navmap;
9517: if ($env{'request.course.id'}) {
9518: $navmap = Apache::lonnavmaps::navmap->new();
9519: }
1.984 raeburn 9520: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9521: my $current_path='/';
9522: if ($env{'form.currentpath'}) {
9523: $current_path = $env{'form.currentpath'};
9524: }
9525: if ($actionurl eq '/adm/coursegrp_portfolio') {
9526: $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9527: $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
9528: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9529: } else {
9530: $udom = $env{'user.domain'};
9531: $uname = $env{'user.name'};
9532: $url = '/userfiles/portfolio';
9533: }
1.987 raeburn 9534: $toplevel = $url.'/';
1.984 raeburn 9535: $url .= $current_path;
9536: $getpropath = 1;
1.987 raeburn 9537: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9538: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9539: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9540: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9541: $toplevel = $url;
1.984 raeburn 9542: if ($rest ne '') {
1.987 raeburn 9543: $url .= $rest;
9544: }
9545: } elsif ($actionurl eq '/adm/coursedocs') {
9546: if (ref($args) eq 'HASH') {
1.1071 raeburn 9547: $url = $args->{'docs_url'};
9548: $toplevel = $url;
1.1075.2.11 raeburn 9549: if ($args->{'context'} eq 'paste') {
9550: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9551: ($path) =
9552: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9553: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9554: $fileloc =~ s{^/}{};
9555: }
1.1071 raeburn 9556: }
9557: } elsif ($actionurl eq '/adm/dependencies') {
9558: if ($env{'request.course.id'} ne '') {
9559: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9560: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9561: if (ref($args) eq 'HASH') {
9562: $url = $args->{'docs_url'};
9563: $title = $args->{'docs_title'};
9564: $toplevel = "/$url";
1.1075.2.11 raeburn 9565: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071 raeburn 9566: ($path) =
9567: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9568: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9569: $fileloc =~ s{^/}{};
9570: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9571: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9572: }
1.987 raeburn 9573: }
9574: }
9575: my $now = time();
9576: foreach my $embed_file (keys(%{$allfiles})) {
9577: my $absolutepath;
9578: if ($embed_file =~ m{^\w+://}) {
9579: $newfiles{$embed_file} = 1;
9580: $mapping{$embed_file} = $embed_file;
9581: } else {
9582: if ($embed_file =~ m{^/}) {
9583: $absolutepath = $embed_file;
9584: $embed_file =~ s{^(/+)}{};
9585: }
9586: if ($embed_file =~ m{/}) {
9587: my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
9588: $path = &check_for_traversal($path,$url,$toplevel);
9589: my $item = $fname;
9590: if ($path ne '') {
9591: $item = $path.'/'.$fname;
9592: $subdependencies{$path}{$fname} = 1;
9593: } else {
9594: $dependencies{$item} = 1;
9595: }
9596: if ($absolutepath) {
9597: $mapping{$item} = $absolutepath;
9598: } else {
9599: $mapping{$item} = $embed_file;
9600: }
9601: } else {
9602: $dependencies{$embed_file} = 1;
9603: if ($absolutepath) {
9604: $mapping{$embed_file} = $absolutepath;
9605: } else {
9606: $mapping{$embed_file} = $embed_file;
9607: }
9608: }
1.984 raeburn 9609: }
9610: }
1.1071 raeburn 9611: my $dirptr = 16384;
1.984 raeburn 9612: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 9613: $currsubfile{$path} = {};
1.984 raeburn 9614: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9615: my ($sublistref,$listerror) =
9616: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
9617: if (ref($sublistref) eq 'ARRAY') {
9618: foreach my $line (@{$sublistref}) {
9619: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 9620: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 9621: }
1.984 raeburn 9622: }
1.987 raeburn 9623: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9624: if (opendir(my $dir,$url.'/'.$path)) {
9625: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 9626: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
9627: }
1.1075.2.11 raeburn 9628: } elsif (($actionurl eq '/adm/dependencies') ||
9629: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9630: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9631: if ($env{'request.course.id'} ne '') {
9632: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9633: if ($dir ne '') {
9634: my ($sublistref,$listerror) =
9635: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
9636: if (ref($sublistref) eq 'ARRAY') {
9637: foreach my $line (@{$sublistref}) {
9638: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
9639: undef,$mtime)=split(/\&/,$line,12);
9640: unless (($testdir&$dirptr) ||
9641: ($file_name =~ /^\.\.?$/)) {
9642: $currsubfile{$path}{$file_name} = [$size,$mtime];
9643: }
9644: }
9645: }
9646: }
1.984 raeburn 9647: }
9648: }
9649: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 9650: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 9651: my $item = $path.'/'.$file;
9652: unless ($mapping{$item} eq $item) {
9653: $pathchanges{$item} = 1;
9654: }
9655: $existing{$item} = 1;
9656: $numexisting ++;
9657: } else {
9658: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 9659: }
9660: }
1.1071 raeburn 9661: if ($actionurl eq '/adm/dependencies') {
9662: foreach my $path (keys(%currsubfile)) {
9663: if (ref($currsubfile{$path}) eq 'HASH') {
9664: foreach my $file (keys(%{$currsubfile{$path}})) {
9665: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 9666: next if (($rem ne '') &&
9667: (($env{"httpref.$rem"."$path/$file"} ne '') ||
9668: (ref($navmap) &&
9669: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
9670: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9671: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 9672: $unused{$path.'/'.$file} = 1;
9673: }
9674: }
9675: }
9676: }
9677: }
1.984 raeburn 9678: }
1.987 raeburn 9679: my %currfile;
1.984 raeburn 9680: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9681: my ($dirlistref,$listerror) =
9682: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
9683: if (ref($dirlistref) eq 'ARRAY') {
9684: foreach my $line (@{$dirlistref}) {
9685: my ($file_name,$rest) = split(/\&/,$line,2);
9686: $currfile{$file_name} = 1;
9687: }
1.984 raeburn 9688: }
1.987 raeburn 9689: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9690: if (opendir(my $dir,$url)) {
1.987 raeburn 9691: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 9692: map {$currfile{$_} = 1;} @dir_list;
9693: }
1.1075.2.11 raeburn 9694: } elsif (($actionurl eq '/adm/dependencies') ||
9695: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9696: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9697: if ($env{'request.course.id'} ne '') {
9698: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9699: if ($dir ne '') {
9700: my ($dirlistref,$listerror) =
9701: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
9702: if (ref($dirlistref) eq 'ARRAY') {
9703: foreach my $line (@{$dirlistref}) {
9704: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
9705: $size,undef,$mtime)=split(/\&/,$line,12);
9706: unless (($testdir&$dirptr) ||
9707: ($file_name =~ /^\.\.?$/)) {
9708: $currfile{$file_name} = [$size,$mtime];
9709: }
9710: }
9711: }
9712: }
9713: }
1.984 raeburn 9714: }
9715: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 9716: if (exists($currfile{$file})) {
1.987 raeburn 9717: unless ($mapping{$file} eq $file) {
9718: $pathchanges{$file} = 1;
9719: }
9720: $existing{$file} = 1;
9721: $numexisting ++;
9722: } else {
1.984 raeburn 9723: $newfiles{$file} = 1;
9724: }
9725: }
1.1071 raeburn 9726: foreach my $file (keys(%currfile)) {
9727: unless (($file eq $filename) ||
9728: ($file eq $filename.'.bak') ||
9729: ($dependencies{$file})) {
1.1075.2.11 raeburn 9730: if ($actionurl eq '/adm/dependencies') {
9731: next if (($rem ne '') &&
9732: (($env{"httpref.$rem".$file} ne '') ||
9733: (ref($navmap) &&
9734: (($navmap->getResourceByUrl($rem.$file) ne '') ||
9735: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9736: ($navmap->getResourceByUrl($rem.$1)))))));
9737: }
1.1071 raeburn 9738: $unused{$file} = 1;
9739: }
9740: }
1.1075.2.11 raeburn 9741: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9742: ($args->{'context'} eq 'paste')) {
9743: $counter = scalar(keys(%existing));
9744: $numpathchg = scalar(keys(%pathchanges));
9745: return ($output,$counter,$numpathchg,\%existing);
9746: }
1.984 raeburn 9747: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 9748: if ($actionurl eq '/adm/dependencies') {
9749: next if ($embed_file =~ m{^\w+://});
9750: }
1.660 raeburn 9751: $upload_output .= &start_data_table_row().
1.1071 raeburn 9752: '<td><img src="'.&icon($embed_file).'" /> '.
9753: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 9754: unless ($mapping{$embed_file} eq $embed_file) {
9755: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
9756: }
9757: $upload_output .= '</td><td>';
1.1071 raeburn 9758: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.660 raeburn 9759: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987 raeburn 9760: $numremref++;
1.660 raeburn 9761: } elsif ($args->{'error_on_invalid_names'}
9762: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987 raeburn 9763: $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
9764: $numinvalid++;
1.660 raeburn 9765: } else {
1.1071 raeburn 9766: $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 9767: $embed_file,\%mapping,
1.1071 raeburn 9768: $allfiles,$codebase,'upload');
9769: $counter ++;
9770: $numnew ++;
1.987 raeburn 9771: }
9772: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
9773: }
9774: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 9775: if ($actionurl eq '/adm/dependencies') {
9776: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
9777: $modify_output .= &start_data_table_row().
9778: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
9779: '<img src="'.&icon($embed_file).'" border="0" />'.
9780: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
9781: '<td>'.$size.'</td>'.
9782: '<td>'.$mtime.'</td>'.
9783: '<td><label><input type="checkbox" name="mod_upload_dep" '.
9784: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
9785: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
9786: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
9787: &embedded_file_element('upload_embedded',$counter,
9788: $embed_file,\%mapping,
9789: $allfiles,$codebase,'modify').
9790: '</div></td>'.
9791: &end_data_table_row()."\n";
9792: $counter ++;
9793: } else {
9794: $upload_output .= &start_data_table_row().
9795: '<td><span class="LC_filename">'.$embed_file.'</span></td>';
9796: '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
9797: &Apache::loncommon::end_data_table_row()."\n";
9798: }
9799: }
9800: my $delidx = $counter;
9801: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
9802: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
9803: $delete_output .= &start_data_table_row().
9804: '<td><img src="'.&icon($oldfile).'" />'.
9805: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
9806: '<td>'.$size.'</td>'.
9807: '<td>'.$mtime.'</td>'.
9808: '<td><label><input type="checkbox" name="del_upload_dep" '.
9809: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
9810: &embedded_file_element('upload_embedded',$delidx,
9811: $oldfile,\%mapping,$allfiles,
9812: $codebase,'delete').'</td>'.
9813: &end_data_table_row()."\n";
9814: $numunused ++;
9815: $delidx ++;
1.987 raeburn 9816: }
9817: if ($upload_output) {
9818: $upload_output = &start_data_table().
9819: $upload_output.
9820: &end_data_table()."\n";
9821: }
1.1071 raeburn 9822: if ($modify_output) {
9823: $modify_output = &start_data_table().
9824: &start_data_table_header_row().
9825: '<th>'.&mt('File').'</th>'.
9826: '<th>'.&mt('Size (KB)').'</th>'.
9827: '<th>'.&mt('Modified').'</th>'.
9828: '<th>'.&mt('Upload replacement?').'</th>'.
9829: &end_data_table_header_row().
9830: $modify_output.
9831: &end_data_table()."\n";
9832: }
9833: if ($delete_output) {
9834: $delete_output = &start_data_table().
9835: &start_data_table_header_row().
9836: '<th>'.&mt('File').'</th>'.
9837: '<th>'.&mt('Size (KB)').'</th>'.
9838: '<th>'.&mt('Modified').'</th>'.
9839: '<th>'.&mt('Delete?').'</th>'.
9840: &end_data_table_header_row().
9841: $delete_output.
9842: &end_data_table()."\n";
9843: }
1.987 raeburn 9844: my $applies = 0;
9845: if ($numremref) {
9846: $applies ++;
9847: }
9848: if ($numinvalid) {
9849: $applies ++;
9850: }
9851: if ($numexisting) {
9852: $applies ++;
9853: }
1.1071 raeburn 9854: if ($counter || $numunused) {
1.987 raeburn 9855: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
9856: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 9857: $state.'<h3>'.$heading.'</h3>';
9858: if ($actionurl eq '/adm/dependencies') {
9859: if ($numnew) {
9860: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
9861: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
9862: $upload_output.'<br />'."\n";
9863: }
9864: if ($numexisting) {
9865: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
9866: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
9867: $modify_output.'<br />'."\n";
9868: $buttontext = &mt('Save changes');
9869: }
9870: if ($numunused) {
9871: $output .= '<h4>'.&mt('Unused files').'</h4>'.
9872: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
9873: $delete_output.'<br />'."\n";
9874: $buttontext = &mt('Save changes');
9875: }
9876: } else {
9877: $output .= $upload_output.'<br />'."\n";
9878: }
9879: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
9880: $counter.'" />'."\n";
9881: if ($actionurl eq '/adm/dependencies') {
9882: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
9883: $numnew.'" />'."\n";
9884: } elsif ($actionurl eq '') {
1.987 raeburn 9885: $output .= '<input type="hidden" name="phase" value="three" />';
9886: }
9887: } elsif ($applies) {
9888: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
9889: if ($applies > 1) {
9890: $output .=
9891: &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
9892: if ($numremref) {
9893: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
9894: }
9895: if ($numinvalid) {
9896: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
9897: }
9898: if ($numexisting) {
9899: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
9900: }
9901: $output .= '</ul><br />';
9902: } elsif ($numremref) {
9903: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
9904: } elsif ($numinvalid) {
9905: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
9906: } elsif ($numexisting) {
9907: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
9908: }
9909: $output .= $upload_output.'<br />';
9910: }
9911: my ($pathchange_output,$chgcount);
1.1071 raeburn 9912: $chgcount = $counter;
1.987 raeburn 9913: if (keys(%pathchanges) > 0) {
9914: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 9915: if ($counter) {
1.987 raeburn 9916: $output .= &embedded_file_element('pathchange',$chgcount,
9917: $embed_file,\%mapping,
1.1071 raeburn 9918: $allfiles,$codebase,'change');
1.987 raeburn 9919: } else {
9920: $pathchange_output .=
9921: &start_data_table_row().
9922: '<td><input type ="checkbox" name="namechange" value="'.
9923: $chgcount.'" checked="checked" /></td>'.
9924: '<td>'.$mapping{$embed_file}.'</td>'.
9925: '<td>'.$embed_file.
9926: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 9927: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 9928: '</td>'.&end_data_table_row();
1.660 raeburn 9929: }
1.987 raeburn 9930: $numpathchg ++;
9931: $chgcount ++;
1.660 raeburn 9932: }
9933: }
1.1071 raeburn 9934: if ($counter) {
1.987 raeburn 9935: if ($numpathchg) {
9936: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
9937: $numpathchg.'" />'."\n";
9938: }
9939: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9940: ($actionurl eq '/adm/imsimport')) {
9941: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
9942: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
9943: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 9944: } elsif ($actionurl eq '/adm/dependencies') {
9945: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 9946: }
1.1071 raeburn 9947: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 9948: } elsif ($numpathchg) {
9949: my %pathchange = ();
9950: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
9951: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9952: $output .= '<p>'.&mt('or').'</p>';
9953: }
9954: }
1.1071 raeburn 9955: return ($output,$counter,$numpathchg);
1.987 raeburn 9956: }
9957:
9958: sub embedded_file_element {
1.1071 raeburn 9959: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 9960: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
9961: (ref($codebase) eq 'HASH'));
9962: my $output;
1.1071 raeburn 9963: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 9964: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
9965: }
9966: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
9967: &escape($embed_file).'" />';
9968: unless (($context eq 'upload_embedded') &&
9969: ($mapping->{$embed_file} eq $embed_file)) {
9970: $output .='
9971: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
9972: }
9973: my $attrib;
9974: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
9975: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
9976: }
9977: $output .=
9978: "\n\t\t".
9979: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
9980: $attrib.'" />';
9981: if (exists($codebase->{$mapping->{$embed_file}})) {
9982: $output .=
9983: "\n\t\t".
9984: '<input name="codebase_'.$num.'" type="hidden" value="'.
9985: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 9986: }
1.987 raeburn 9987: return $output;
1.660 raeburn 9988: }
9989:
1.1071 raeburn 9990: sub get_dependency_details {
9991: my ($currfile,$currsubfile,$embed_file) = @_;
9992: my ($size,$mtime,$showsize,$showmtime);
9993: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
9994: if ($embed_file =~ m{/}) {
9995: my ($path,$fname) = split(/\//,$embed_file);
9996: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
9997: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
9998: }
9999: } else {
10000: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10001: ($size,$mtime) = @{$currfile->{$embed_file}};
10002: }
10003: }
10004: $showsize = $size/1024.0;
10005: $showsize = sprintf("%.1f",$showsize);
10006: if ($mtime > 0) {
10007: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10008: }
10009: }
10010: return ($showsize,$showmtime);
10011: }
10012:
10013: sub ask_embedded_js {
10014: return <<"END";
10015: <script type="text/javascript"">
10016: // <![CDATA[
10017: function toggleBrowse(counter) {
10018: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10019: var fileid = document.getElementById('embedded_item_'+counter);
10020: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10021: if (chkboxid.checked == true) {
10022: uploaddivid.style.display='block';
10023: } else {
10024: uploaddivid.style.display='none';
10025: fileid.value = '';
10026: }
10027: }
10028: // ]]>
10029: </script>
10030:
10031: END
10032: }
10033:
1.661 raeburn 10034: sub upload_embedded {
10035: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10036: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10037: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10038: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10039: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10040: my $orig_uploaded_filename =
10041: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10042: foreach my $type ('orig','ref','attrib','codebase') {
10043: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10044: $env{'form.embedded_'.$type.'_'.$i} =
10045: &unescape($env{'form.embedded_'.$type.'_'.$i});
10046: }
10047: }
1.661 raeburn 10048: my ($path,$fname) =
10049: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10050: # no path, whole string is fname
10051: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10052: $fname = &Apache::lonnet::clean_filename($fname);
10053: # See if there is anything left
10054: next if ($fname eq '');
10055:
10056: # Check if file already exists as a file or directory.
10057: my ($state,$msg);
10058: if ($context eq 'portfolio') {
10059: my $port_path = $dirpath;
10060: if ($group ne '') {
10061: $port_path = "groups/$group/$port_path";
10062: }
1.987 raeburn 10063: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10064: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10065: $dir_root,$port_path,$disk_quota,
10066: $current_disk_usage,$uname,$udom);
10067: if ($state eq 'will_exceed_quota'
1.984 raeburn 10068: || $state eq 'file_locked') {
1.661 raeburn 10069: $output .= $msg;
10070: next;
10071: }
10072: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10073: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10074: if ($state eq 'exists') {
10075: $output .= $msg;
10076: next;
10077: }
10078: }
10079: # Check if extension is valid
10080: if (($fname =~ /\.(\w+)$/) &&
10081: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987 raeburn 10082: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661 raeburn 10083: next;
10084: } elsif (($fname =~ /\.(\w+)$/) &&
10085: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10086: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10087: next;
10088: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987 raeburn 10089: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661 raeburn 10090: next;
10091: }
10092: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
10093: if ($context eq 'portfolio') {
1.984 raeburn 10094: my $result;
10095: if ($state eq 'existingfile') {
10096: $result=
10097: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987 raeburn 10098: $dirpath.$env{'form.currentpath'}.$path);
1.661 raeburn 10099: } else {
1.984 raeburn 10100: $result=
10101: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10102: $dirpath.
10103: $env{'form.currentpath'}.$path);
1.984 raeburn 10104: if ($result !~ m|^/uploaded/|) {
10105: $output .= '<span class="LC_error">'
10106: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10107: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10108: .'</span><br />';
10109: next;
10110: } else {
1.987 raeburn 10111: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10112: $path.$fname.'</span>').'<br />';
1.984 raeburn 10113: }
1.661 raeburn 10114: }
1.987 raeburn 10115: } elsif ($context eq 'coursedoc') {
10116: my $result =
10117: &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
10118: $dirpath.'/'.$path);
10119: if ($result !~ m|^/uploaded/|) {
10120: $output .= '<span class="LC_error">'
10121: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10122: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10123: .'</span><br />';
10124: next;
10125: } else {
10126: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10127: $path.$fname.'</span>').'<br />';
10128: }
1.661 raeburn 10129: } else {
10130: # Save the file
10131: my $target = $env{'form.embedded_item_'.$i};
10132: my $fullpath = $dir_root.$dirpath.'/'.$path;
10133: my $dest = $fullpath.$fname;
10134: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10135: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10136: my $count;
10137: my $filepath = $dir_root;
1.1027 raeburn 10138: foreach my $subdir (@parts) {
10139: $filepath .= "/$subdir";
10140: if (!-e $filepath) {
1.661 raeburn 10141: mkdir($filepath,0770);
10142: }
10143: }
10144: my $fh;
10145: if (!open($fh,'>'.$dest)) {
10146: &Apache::lonnet::logthis('Failed to create '.$dest);
10147: $output .= '<span class="LC_error">'.
1.1071 raeburn 10148: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10149: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10150: '</span><br />';
10151: } else {
10152: if (!print $fh $env{'form.embedded_item_'.$i}) {
10153: &Apache::lonnet::logthis('Failed to write to '.$dest);
10154: $output .= '<span class="LC_error">'.
1.1071 raeburn 10155: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10156: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10157: '</span><br />';
10158: } else {
1.987 raeburn 10159: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10160: $url.'</span>').'<br />';
10161: unless ($context eq 'testbank') {
10162: $footer .= &mt('View embedded file: [_1]',
10163: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10164: }
10165: }
10166: close($fh);
10167: }
10168: }
10169: if ($env{'form.embedded_ref_'.$i}) {
10170: $pathchange{$i} = 1;
10171: }
10172: }
10173: if ($output) {
10174: $output = '<p>'.$output.'</p>';
10175: }
10176: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10177: $returnflag = 'ok';
1.1071 raeburn 10178: my $numpathchgs = scalar(keys(%pathchange));
10179: if ($numpathchgs > 0) {
1.987 raeburn 10180: if ($context eq 'portfolio') {
10181: $output .= '<p>'.&mt('or').'</p>';
10182: } elsif ($context eq 'testbank') {
1.1071 raeburn 10183: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10184: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10185: $returnflag = 'modify_orightml';
10186: }
10187: }
1.1071 raeburn 10188: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10189: }
10190:
10191: sub modify_html_form {
10192: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10193: my $end = 0;
10194: my $modifyform;
10195: if ($context eq 'upload_embedded') {
10196: return unless (ref($pathchange) eq 'HASH');
10197: if ($env{'form.number_embedded_items'}) {
10198: $end += $env{'form.number_embedded_items'};
10199: }
10200: if ($env{'form.number_pathchange_items'}) {
10201: $end += $env{'form.number_pathchange_items'};
10202: }
10203: if ($end) {
10204: for (my $i=0; $i<$end; $i++) {
10205: if ($i < $env{'form.number_embedded_items'}) {
10206: next unless($pathchange->{$i});
10207: }
10208: $modifyform .=
10209: &start_data_table_row().
10210: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10211: 'checked="checked" /></td>'.
10212: '<td>'.$env{'form.embedded_ref_'.$i}.
10213: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10214: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10215: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10216: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10217: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10218: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10219: '<td>'.$env{'form.embedded_orig_'.$i}.
10220: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10221: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10222: &end_data_table_row();
1.1071 raeburn 10223: }
1.987 raeburn 10224: }
10225: } else {
10226: $modifyform = $pathchgtable;
10227: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10228: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10229: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10230: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10231: }
10232: }
10233: if ($modifyform) {
1.1071 raeburn 10234: if ($actionurl eq '/adm/dependencies') {
10235: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10236: }
1.987 raeburn 10237: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10238: '<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".
10239: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10240: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10241: '</ol></p>'."\n".'<p>'.
10242: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10243: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10244: &start_data_table()."\n".
10245: &start_data_table_header_row().
10246: '<th>'.&mt('Change?').'</th>'.
10247: '<th>'.&mt('Current reference').'</th>'.
10248: '<th>'.&mt('Required reference').'</th>'.
10249: &end_data_table_header_row()."\n".
10250: $modifyform.
10251: &end_data_table().'<br />'."\n".$hiddenstate.
10252: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10253: '</form>'."\n";
10254: }
10255: return;
10256: }
10257:
10258: sub modify_html_refs {
10259: my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
10260: my $container;
10261: if ($context eq 'portfolio') {
10262: $container = $env{'form.container'};
10263: } elsif ($context eq 'coursedoc') {
10264: $container = $env{'form.primaryurl'};
1.1071 raeburn 10265: } elsif ($context eq 'manage_dependencies') {
10266: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10267: $container = "/$container";
1.987 raeburn 10268: } else {
1.1027 raeburn 10269: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10270: }
10271: my (%allfiles,%codebase,$output,$content);
10272: my @changes = &get_env_multiple('form.namechange');
1.1071 raeburn 10273: unless (@changes > 0) {
10274: if (wantarray) {
10275: return ('',0,0);
10276: } else {
10277: return;
10278: }
10279: }
10280: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10281: ($context eq 'manage_dependencies')) {
10282: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10283: if (wantarray) {
10284: return ('',0,0);
10285: } else {
10286: return;
10287: }
10288: }
1.987 raeburn 10289: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10290: if ($content eq '-1') {
10291: if (wantarray) {
10292: return ('',0,0);
10293: } else {
10294: return;
10295: }
10296: }
1.987 raeburn 10297: } else {
1.1071 raeburn 10298: unless ($container =~ /^\Q$dir_root\E/) {
10299: if (wantarray) {
10300: return ('',0,0);
10301: } else {
10302: return;
10303: }
10304: }
1.987 raeburn 10305: if (open(my $fh,"<$container")) {
10306: $content = join('', <$fh>);
10307: close($fh);
10308: } else {
1.1071 raeburn 10309: if (wantarray) {
10310: return ('',0,0);
10311: } else {
10312: return;
10313: }
1.987 raeburn 10314: }
10315: }
10316: my ($count,$codebasecount) = (0,0);
10317: my $mm = new File::MMagic;
10318: my $mime_type = $mm->checktype_contents($content);
10319: if ($mime_type eq 'text/html') {
10320: my $parse_result =
10321: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10322: \%codebase,\$content);
10323: if ($parse_result eq 'ok') {
10324: foreach my $i (@changes) {
10325: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10326: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10327: if ($allfiles{$ref}) {
10328: my $newname = $orig;
10329: my ($attrib_regexp,$codebase);
1.1006 raeburn 10330: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10331: if ($attrib_regexp =~ /:/) {
10332: $attrib_regexp =~ s/\:/|/g;
10333: }
10334: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10335: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10336: $count += $numchg;
10337: }
10338: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10339: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10340: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10341: $codebasecount ++;
10342: }
10343: }
10344: }
10345: if ($count || $codebasecount) {
10346: my $saveresult;
1.1071 raeburn 10347: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10348: ($context eq 'manage_dependencies')) {
1.987 raeburn 10349: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10350: if ($url eq $container) {
10351: my ($fname) = ($container =~ m{/([^/]+)$});
10352: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10353: $count,'<span class="LC_filename">'.
1.1071 raeburn 10354: $fname.'</span>').'</p>';
1.987 raeburn 10355: } else {
10356: $output = '<p class="LC_error">'.
10357: &mt('Error: update failed for: [_1].',
10358: '<span class="LC_filename">'.
10359: $container.'</span>').'</p>';
10360: }
10361: } else {
10362: if (open(my $fh,">$container")) {
10363: print $fh $content;
10364: close($fh);
10365: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10366: $count,'<span class="LC_filename">'.
10367: $container.'</span>').'</p>';
1.661 raeburn 10368: } else {
1.987 raeburn 10369: $output = '<p class="LC_error">'.
10370: &mt('Error: could not update [_1].',
10371: '<span class="LC_filename">'.
10372: $container.'</span>').'</p>';
1.661 raeburn 10373: }
10374: }
10375: }
1.987 raeburn 10376: } else {
10377: &logthis('Failed to parse '.$container.
10378: ' to modify references: '.$parse_result);
1.661 raeburn 10379: }
10380: }
1.1071 raeburn 10381: if (wantarray) {
10382: return ($output,$count,$codebasecount);
10383: } else {
10384: return $output;
10385: }
1.661 raeburn 10386: }
10387:
10388: sub check_for_existing {
10389: my ($path,$fname,$element) = @_;
10390: my ($state,$msg);
10391: if (-d $path.'/'.$fname) {
10392: $state = 'exists';
10393: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10394: } elsif (-e $path.'/'.$fname) {
10395: $state = 'exists';
10396: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10397: }
10398: if ($state eq 'exists') {
10399: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10400: }
10401: return ($state,$msg);
10402: }
10403:
10404: sub check_for_upload {
10405: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10406: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10407: my $filesize = length($env{'form.'.$element});
10408: if (!$filesize) {
10409: my $msg = '<span class="LC_error">'.
10410: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10411: '<span class="LC_filename">'.$fname.'</span>',
10412: $filesize).'<br />'.
1.1007 raeburn 10413: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10414: '</span>';
10415: return ('zero_bytes',$msg);
10416: }
10417: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10418: my $getpropath = 1;
1.1021 raeburn 10419: my ($dirlistref,$listerror) =
10420: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10421: my $found_file = 0;
10422: my $locked_file = 0;
1.991 raeburn 10423: my @lockers;
10424: my $navmap;
10425: if ($env{'request.course.id'}) {
10426: $navmap = Apache::lonnavmaps::navmap->new();
10427: }
1.1021 raeburn 10428: if (ref($dirlistref) eq 'ARRAY') {
10429: foreach my $line (@{$dirlistref}) {
10430: my ($file_name,$rest)=split(/\&/,$line,2);
10431: if ($file_name eq $fname){
10432: $file_name = $path.$file_name;
10433: if ($group ne '') {
10434: $file_name = $group.$file_name;
10435: }
10436: $found_file = 1;
10437: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10438: foreach my $lock (@lockers) {
10439: if (ref($lock) eq 'ARRAY') {
10440: my ($symb,$crsid) = @{$lock};
10441: if ($crsid eq $env{'request.course.id'}) {
10442: if (ref($navmap)) {
10443: my $res = $navmap->getBySymb($symb);
10444: foreach my $part (@{$res->parts()}) {
10445: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10446: unless (($slot_status == $res->RESERVED) ||
10447: ($slot_status == $res->RESERVED_LOCATION)) {
10448: $locked_file = 1;
10449: }
1.991 raeburn 10450: }
1.1021 raeburn 10451: } else {
10452: $locked_file = 1;
1.991 raeburn 10453: }
10454: } else {
10455: $locked_file = 1;
10456: }
10457: }
1.1021 raeburn 10458: }
10459: } else {
10460: my @info = split(/\&/,$rest);
10461: my $currsize = $info[6]/1000;
10462: if ($currsize < $filesize) {
10463: my $extra = $filesize - $currsize;
10464: if (($current_disk_usage + $extra) > $disk_quota) {
10465: my $msg = '<span class="LC_error">'.
10466: &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.',
10467: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
10468: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
10469: $disk_quota,$current_disk_usage);
10470: return ('will_exceed_quota',$msg);
10471: }
1.984 raeburn 10472: }
10473: }
1.661 raeburn 10474: }
10475: }
10476: }
10477: if (($current_disk_usage + $filesize) > $disk_quota){
10478: my $msg = '<span class="LC_error">'.
10479: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
10480: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
10481: return ('will_exceed_quota',$msg);
10482: } elsif ($found_file) {
10483: if ($locked_file) {
10484: my $msg = '<span class="LC_error">';
10485: $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>');
10486: $msg .= '</span><br />';
10487: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
10488: return ('file_locked',$msg);
10489: } else {
10490: my $msg = '<span class="LC_error">';
1.984 raeburn 10491: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.661 raeburn 10492: $msg .= '</span>';
1.984 raeburn 10493: return ('existingfile',$msg);
1.661 raeburn 10494: }
10495: }
10496: }
10497:
1.987 raeburn 10498: sub check_for_traversal {
10499: my ($path,$url,$toplevel) = @_;
10500: my @parts=split(/\//,$path);
10501: my $cleanpath;
10502: my $fullpath = $url;
10503: for (my $i=0;$i<@parts;$i++) {
10504: next if ($parts[$i] eq '.');
10505: if ($parts[$i] eq '..') {
10506: $fullpath =~ s{([^/]+/)$}{};
10507: } else {
10508: $fullpath .= $parts[$i].'/';
10509: }
10510: }
10511: if ($fullpath =~ /^\Q$url\E(.*)$/) {
10512: $cleanpath = $1;
10513: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
10514: my $curr_toprel = $1;
10515: my @parts = split(/\//,$curr_toprel);
10516: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
10517: my @urlparts = split(/\//,$url_toprel);
10518: my $doubledots;
10519: my $startdiff = -1;
10520: for (my $i=0; $i<@urlparts; $i++) {
10521: if ($startdiff == -1) {
10522: unless ($urlparts[$i] eq $parts[$i]) {
10523: $startdiff = $i;
10524: $doubledots .= '../';
10525: }
10526: } else {
10527: $doubledots .= '../';
10528: }
10529: }
10530: if ($startdiff > -1) {
10531: $cleanpath = $doubledots;
10532: for (my $i=$startdiff; $i<@parts; $i++) {
10533: $cleanpath .= $parts[$i].'/';
10534: }
10535: }
10536: }
10537: $cleanpath =~ s{(/)$}{};
10538: return $cleanpath;
10539: }
1.31 albertel 10540:
1.1053 raeburn 10541: sub is_archive_file {
10542: my ($mimetype) = @_;
10543: if (($mimetype eq 'application/octet-stream') ||
10544: ($mimetype eq 'application/x-stuffit') ||
10545: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
10546: return 1;
10547: }
10548: return;
10549: }
10550:
10551: sub decompress_form {
1.1065 raeburn 10552: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 10553: my %lt = &Apache::lonlocal::texthash (
10554: this => 'This file is an archive file.',
1.1067 raeburn 10555: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 10556: itsc => 'Its contents are as follows:',
1.1053 raeburn 10557: youm => 'You may wish to extract its contents.',
10558: extr => 'Extract contents',
1.1067 raeburn 10559: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
10560: proa => 'Process automatically?',
1.1053 raeburn 10561: yes => 'Yes',
10562: no => 'No',
1.1067 raeburn 10563: fold => 'Title for folder containing movie',
10564: movi => 'Title for page containing embedded movie',
1.1053 raeburn 10565: );
1.1065 raeburn 10566: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 10567: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 10568: my $info = &list_archive_contents($fileloc,\@paths);
10569: if (@paths) {
10570: foreach my $path (@paths) {
10571: $path =~ s{^/}{};
1.1067 raeburn 10572: if ($path =~ m{^([^/]+)/$}) {
10573: $topdir = $1;
10574: }
1.1065 raeburn 10575: if ($path =~ m{^([^/]+)/}) {
10576: $toplevel{$1} = $path;
10577: } else {
10578: $toplevel{$path} = $path;
10579: }
10580: }
10581: }
1.1067 raeburn 10582: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
10583: my @camtasia = ("$topdir/","$topdir/index.html",
10584: "$topdir/media/",
10585: "$topdir/media/$topdir.mp4",
10586: "$topdir/media/FirstFrame.png",
10587: "$topdir/media/player.swf",
10588: "$topdir/media/swfobject.js",
10589: "$topdir/media/expressInstall.swf");
10590: my @diffs = &compare_arrays(\@paths,\@camtasia);
10591: if (@diffs == 0) {
10592: $is_camtasia = 1;
10593: }
10594: }
10595: my $output;
10596: if ($is_camtasia) {
10597: $output = <<"ENDCAM";
10598: <script type="text/javascript" language="Javascript">
10599: // <![CDATA[
10600:
10601: function camtasiaToggle() {
10602: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
10603: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
10604: if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
10605:
10606: document.getElementById('camtasia_titles').style.display='block';
10607: } else {
10608: document.getElementById('camtasia_titles').style.display='none';
10609: }
10610: }
10611: }
10612: return;
10613: }
10614:
10615: // ]]>
10616: </script>
10617: <p>$lt{'camt'}</p>
10618: ENDCAM
1.1065 raeburn 10619: } else {
1.1067 raeburn 10620: $output = '<p>'.$lt{'this'};
10621: if ($info eq '') {
10622: $output .= ' '.$lt{'youm'}.'</p>'."\n";
10623: } else {
10624: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
10625: '<div><pre>'.$info.'</pre></div>';
10626: }
1.1065 raeburn 10627: }
1.1067 raeburn 10628: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 10629: my $duplicates;
10630: my $num = 0;
10631: if (ref($dirlist) eq 'ARRAY') {
10632: foreach my $item (@{$dirlist}) {
10633: if (ref($item) eq 'ARRAY') {
10634: if (exists($toplevel{$item->[0]})) {
10635: $duplicates .=
10636: &start_data_table_row().
10637: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
10638: 'value="0" checked="checked" />'.&mt('No').'</label>'.
10639: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
10640: 'value="1" />'.&mt('Yes').'</label>'.
10641: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
10642: '<td>'.$item->[0].'</td>';
10643: if ($item->[2]) {
10644: $duplicates .= '<td>'.&mt('Directory').'</td>';
10645: } else {
10646: $duplicates .= '<td>'.&mt('File').'</td>';
10647: }
10648: $duplicates .= '<td>'.$item->[3].'</td>'.
10649: '<td>'.
10650: &Apache::lonlocal::locallocaltime($item->[4]).
10651: '</td>'.
10652: &end_data_table_row();
10653: $num ++;
10654: }
10655: }
10656: }
10657: }
10658: my $itemcount;
10659: if (@paths > 0) {
10660: $itemcount = scalar(@paths);
10661: } else {
10662: $itemcount = 1;
10663: }
1.1067 raeburn 10664: if ($is_camtasia) {
10665: $output .= $lt{'auto'}.'<br />'.
10666: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
10667: '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
10668: $lt{'yes'}.'</label> <label>'.
10669: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
10670: $lt{'no'}.'</label></span><br />'.
10671: '<div id="camtasia_titles" style="display:block">'.
10672: &Apache::lonhtmlcommon::start_pick_box().
10673: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
10674: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
10675: &Apache::lonhtmlcommon::row_closure().
10676: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
10677: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
10678: &Apache::lonhtmlcommon::row_closure(1).
10679: &Apache::lonhtmlcommon::end_pick_box().
10680: '</div>';
10681: }
1.1065 raeburn 10682: $output .=
10683: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 10684: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
10685: "\n";
1.1065 raeburn 10686: if ($duplicates ne '') {
10687: $output .= '<p><span class="LC_warning">'.
10688: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
10689: &start_data_table().
10690: &start_data_table_header_row().
10691: '<th>'.&mt('Overwrite?').'</th>'.
10692: '<th>'.&mt('Name').'</th>'.
10693: '<th>'.&mt('Type').'</th>'.
10694: '<th>'.&mt('Size').'</th>'.
10695: '<th>'.&mt('Last modified').'</th>'.
10696: &end_data_table_header_row().
10697: $duplicates.
10698: &end_data_table().
10699: '</p>';
10700: }
1.1067 raeburn 10701: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 10702: if (ref($hiddenelements) eq 'HASH') {
10703: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
10704: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
10705: }
10706: }
10707: $output .= <<"END";
1.1067 raeburn 10708: <br />
1.1053 raeburn 10709: <input type="submit" name="decompress" value="$lt{'extr'}" />
10710: </form>
10711: $noextract
10712: END
10713: return $output;
10714: }
10715:
1.1065 raeburn 10716: sub decompression_utility {
10717: my ($program) = @_;
10718: my @utilities = ('tar','gunzip','bunzip2','unzip');
10719: my $location;
10720: if (grep(/^\Q$program\E$/,@utilities)) {
10721: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
10722: '/usr/sbin/') {
10723: if (-x $dir.$program) {
10724: $location = $dir.$program;
10725: last;
10726: }
10727: }
10728: }
10729: return $location;
10730: }
10731:
10732: sub list_archive_contents {
10733: my ($file,$pathsref) = @_;
10734: my (@cmd,$output);
10735: my $needsregexp;
10736: if ($file =~ /\.zip$/) {
10737: @cmd = (&decompression_utility('unzip'),"-l");
10738: $needsregexp = 1;
10739: } elsif (($file =~ m/\.tar\.gz$/) ||
10740: ($file =~ /\.tgz$/)) {
10741: @cmd = (&decompression_utility('tar'),"-ztf");
10742: } elsif ($file =~ /\.tar\.bz2$/) {
10743: @cmd = (&decompression_utility('tar'),"-jtf");
10744: } elsif ($file =~ m|\.tar$|) {
10745: @cmd = (&decompression_utility('tar'),"-tf");
10746: }
10747: if (@cmd) {
10748: undef($!);
10749: undef($@);
10750: if (open(my $fh,"-|", @cmd, $file)) {
10751: while (my $line = <$fh>) {
10752: $output .= $line;
10753: chomp($line);
10754: my $item;
10755: if ($needsregexp) {
10756: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
10757: } else {
10758: $item = $line;
10759: }
10760: if ($item ne '') {
10761: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
10762: push(@{$pathsref},$item);
10763: }
10764: }
10765: }
10766: close($fh);
10767: }
10768: }
10769: return $output;
10770: }
10771:
1.1053 raeburn 10772: sub decompress_uploaded_file {
10773: my ($file,$dir) = @_;
10774: &Apache::lonnet::appenv({'cgi.file' => $file});
10775: &Apache::lonnet::appenv({'cgi.dir' => $dir});
10776: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
10777: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
10778: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
10779: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
10780: my $decompressed = $env{'cgi.decompressed'};
10781: &Apache::lonnet::delenv('cgi.file');
10782: &Apache::lonnet::delenv('cgi.dir');
10783: &Apache::lonnet::delenv('cgi.decompressed');
10784: return ($decompressed,$result);
10785: }
10786:
1.1055 raeburn 10787: sub process_decompression {
10788: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
10789: my ($dir,$error,$warning,$output);
10790: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
10791: $error = &mt('File name not a supported archive file type.').
10792: '<br />'.&mt('File name should end with one of: [_1].',
10793: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
10794: } else {
10795: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
10796: if ($docuhome eq 'no_host') {
10797: $error = &mt('Could not determine home server for course.');
10798: } else {
10799: my @ids=&Apache::lonnet::current_machine_ids();
10800: my $currdir = "$dir_root/$destination";
10801: if (grep(/^\Q$docuhome\E$/,@ids)) {
10802: $dir = &LONCAPA::propath($docudom,$docuname).
10803: "$dir_root/$destination";
10804: } else {
10805: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
10806: "$dir_root/$docudom/$docuname/$destination";
10807: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
10808: $error = &mt('Archive file not found.');
10809: }
10810: }
1.1065 raeburn 10811: my (@to_overwrite,@to_skip);
10812: if ($env{'form.archive_overwrite_total'} > 0) {
10813: my $total = $env{'form.archive_overwrite_total'};
10814: for (my $i=0; $i<$total; $i++) {
10815: if ($env{'form.archive_overwrite_'.$i} == 1) {
10816: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
10817: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
10818: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
10819: }
10820: }
10821: }
10822: my $numskip = scalar(@to_skip);
10823: if (($numskip > 0) &&
10824: ($numskip == $env{'form.archive_itemcount'})) {
10825: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
10826: } elsif ($dir eq '') {
1.1055 raeburn 10827: $error = &mt('Directory containing archive file unavailable.');
10828: } elsif (!$error) {
1.1065 raeburn 10829: my ($decompressed,$display);
10830: if ($numskip > 0) {
10831: my $tempdir = time.'_'.$$.int(rand(10000));
10832: mkdir("$dir/$tempdir",0755);
10833: system("mv $dir/$file $dir/$tempdir/$file");
10834: ($decompressed,$display) =
10835: &decompress_uploaded_file($file,"$dir/$tempdir");
10836: foreach my $item (@to_skip) {
10837: if (($item ne '') && ($item !~ /\.\./)) {
10838: if (-f "$dir/$tempdir/$item") {
10839: unlink("$dir/$tempdir/$item");
10840: } elsif (-d "$dir/$tempdir/$item") {
10841: system("rm -rf $dir/$tempdir/$item");
10842: }
10843: }
10844: }
10845: system("mv $dir/$tempdir/* $dir");
10846: rmdir("$dir/$tempdir");
10847: } else {
10848: ($decompressed,$display) =
10849: &decompress_uploaded_file($file,$dir);
10850: }
1.1055 raeburn 10851: if ($decompressed eq 'ok') {
1.1065 raeburn 10852: $output = '<p class="LC_info">'.
10853: &mt('Files extracted successfully from archive.').
10854: '</p>'."\n";
1.1055 raeburn 10855: my ($warning,$result,@contents);
10856: my ($newdirlistref,$newlisterror) =
10857: &Apache::lonnet::dirlist($currdir,$docudom,
10858: $docuname,1);
10859: my (%is_dir,%changes,@newitems);
10860: my $dirptr = 16384;
1.1065 raeburn 10861: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 10862: foreach my $dir_line (@{$newdirlistref}) {
10863: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 10864: unless (($item =~ /^\.+$/) || ($item eq $file) ||
10865: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 10866: push(@newitems,$item);
10867: if ($dirptr&$testdir) {
10868: $is_dir{$item} = 1;
10869: }
10870: $changes{$item} = 1;
10871: }
10872: }
10873: }
10874: if (keys(%changes) > 0) {
10875: foreach my $item (sort(@newitems)) {
10876: if ($changes{$item}) {
10877: push(@contents,$item);
10878: }
10879: }
10880: }
10881: if (@contents > 0) {
1.1067 raeburn 10882: my $wantform;
10883: unless ($env{'form.autoextract_camtasia'}) {
10884: $wantform = 1;
10885: }
1.1056 raeburn 10886: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 10887: my ($count,$datatable) = &get_extracted($docudom,$docuname,
10888: $currdir,\%is_dir,
10889: \%children,\%parent,
1.1056 raeburn 10890: \@contents,\%dirorder,
10891: \%titles,$wantform);
1.1055 raeburn 10892: if ($datatable ne '') {
10893: $output .= &archive_options_form('decompressed',$datatable,
10894: $count,$hiddenelem);
1.1065 raeburn 10895: my $startcount = 6;
1.1055 raeburn 10896: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 10897: \%titles,\%children);
1.1055 raeburn 10898: }
1.1067 raeburn 10899: if ($env{'form.autoextract_camtasia'}) {
10900: my %displayed;
10901: my $total = 1;
10902: $env{'form.archive_directory'} = [];
10903: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
10904: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
10905: $path =~ s{/$}{};
10906: my $item;
10907: if ($path ne '') {
10908: $item = "$path/$titles{$i}";
10909: } else {
10910: $item = $titles{$i};
10911: }
10912: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
10913: if ($item eq $contents[0]) {
10914: push(@{$env{'form.archive_directory'}},$i);
10915: $env{'form.archive_'.$i} = 'display';
10916: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
10917: $displayed{'folder'} = $i;
10918: } elsif ($item eq "$contents[0]/index.html") {
10919: $env{'form.archive_'.$i} = 'display';
10920: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
10921: $displayed{'web'} = $i;
10922: } else {
10923: if ($item eq "$contents[0]/media") {
10924: push(@{$env{'form.archive_directory'}},$i);
10925: }
10926: $env{'form.archive_'.$i} = 'dependency';
10927: }
10928: $total ++;
10929: }
10930: for (my $i=1; $i<$total; $i++) {
10931: next if ($i == $displayed{'web'});
10932: next if ($i == $displayed{'folder'});
10933: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
10934: }
10935: $env{'form.phase'} = 'decompress_cleanup';
10936: $env{'form.archivedelete'} = 1;
10937: $env{'form.archive_count'} = $total-1;
10938: $output .=
10939: &process_extracted_files('coursedocs',$docudom,
10940: $docuname,$destination,
10941: $dir_root,$hiddenelem);
10942: }
1.1055 raeburn 10943: } else {
10944: $warning = &mt('No new items extracted from archive file.');
10945: }
10946: } else {
10947: $output = $display;
10948: $error = &mt('An error occurred during extraction from the archive file.');
10949: }
10950: }
10951: }
10952: }
10953: if ($error) {
10954: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
10955: $error.'</p>'."\n";
10956: }
10957: if ($warning) {
10958: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
10959: }
10960: return $output;
10961: }
10962:
10963: sub get_extracted {
1.1056 raeburn 10964: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
10965: $titles,$wantform) = @_;
1.1055 raeburn 10966: my $count = 0;
10967: my $depth = 0;
10968: my $datatable;
1.1056 raeburn 10969: my @hierarchy;
1.1055 raeburn 10970: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 10971: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
10972: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 10973: foreach my $item (@{$contents}) {
10974: $count ++;
1.1056 raeburn 10975: @{$dirorder->{$count}} = @hierarchy;
10976: $titles->{$count} = $item;
1.1055 raeburn 10977: &archive_hierarchy($depth,$count,$parent,$children);
10978: if ($wantform) {
10979: $datatable .= &archive_row($is_dir->{$item},$item,
10980: $currdir,$depth,$count);
10981: }
10982: if ($is_dir->{$item}) {
10983: $depth ++;
1.1056 raeburn 10984: push(@hierarchy,$count);
10985: $parent->{$depth} = $count;
1.1055 raeburn 10986: $datatable .=
10987: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 10988: \$depth,\$count,\@hierarchy,$dirorder,
10989: $children,$parent,$titles,$wantform);
1.1055 raeburn 10990: $depth --;
1.1056 raeburn 10991: pop(@hierarchy);
1.1055 raeburn 10992: }
10993: }
10994: return ($count,$datatable);
10995: }
10996:
10997: sub recurse_extracted_archive {
1.1056 raeburn 10998: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
10999: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11000: my $result='';
1.1056 raeburn 11001: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11002: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11003: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11004: return $result;
11005: }
11006: my $dirptr = 16384;
11007: my ($newdirlistref,$newlisterror) =
11008: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11009: if (ref($newdirlistref) eq 'ARRAY') {
11010: foreach my $dir_line (@{$newdirlistref}) {
11011: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11012: unless ($item =~ /^\.+$/) {
11013: $$count ++;
1.1056 raeburn 11014: @{$dirorder->{$$count}} = @{$hierarchy};
11015: $titles->{$$count} = $item;
1.1055 raeburn 11016: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11017:
1.1055 raeburn 11018: my $is_dir;
11019: if ($dirptr&$testdir) {
11020: $is_dir = 1;
11021: }
11022: if ($wantform) {
11023: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11024: }
11025: if ($is_dir) {
11026: $$depth ++;
1.1056 raeburn 11027: push(@{$hierarchy},$$count);
11028: $parent->{$$depth} = $$count;
1.1055 raeburn 11029: $result .=
11030: &recurse_extracted_archive("$currdir/$item",$docudom,
11031: $docuname,$depth,$count,
1.1056 raeburn 11032: $hierarchy,$dirorder,$children,
11033: $parent,$titles,$wantform);
1.1055 raeburn 11034: $$depth --;
1.1056 raeburn 11035: pop(@{$hierarchy});
1.1055 raeburn 11036: }
11037: }
11038: }
11039: }
11040: return $result;
11041: }
11042:
11043: sub archive_hierarchy {
11044: my ($depth,$count,$parent,$children) =@_;
11045: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11046: if (exists($parent->{$depth})) {
11047: $children->{$parent->{$depth}} .= $count.':';
11048: }
11049: }
11050: return;
11051: }
11052:
11053: sub archive_row {
11054: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11055: my ($name) = ($item =~ m{([^/]+)$});
11056: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11057: 'display' => 'Add as file',
1.1055 raeburn 11058: 'dependency' => 'Include as dependency',
11059: 'discard' => 'Discard',
11060: );
11061: if ($is_dir) {
1.1059 raeburn 11062: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11063: }
1.1056 raeburn 11064: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11065: my $offset = 0;
1.1055 raeburn 11066: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11067: $offset ++;
1.1065 raeburn 11068: if ($action ne 'display') {
11069: $offset ++;
11070: }
1.1055 raeburn 11071: $output .= '<td><span class="LC_nobreak">'.
11072: '<label><input type="radio" name="archive_'.$count.
11073: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11074: my $text = $choices{$action};
11075: if ($is_dir) {
11076: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11077: if ($action eq 'display') {
1.1059 raeburn 11078: $text = &mt('Add as folder');
1.1055 raeburn 11079: }
1.1056 raeburn 11080: } else {
11081: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11082:
11083: }
11084: $output .= ' /> '.$choices{$action}.'</label></span>';
11085: if ($action eq 'dependency') {
11086: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11087: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11088: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11089: '<option value=""></option>'."\n".
11090: '</select>'."\n".
11091: '</div>';
1.1059 raeburn 11092: } elsif ($action eq 'display') {
11093: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11094: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11095: '</div>';
1.1055 raeburn 11096: }
1.1056 raeburn 11097: $output .= '</td>';
1.1055 raeburn 11098: }
11099: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11100: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11101: for (my $i=0; $i<$depth; $i++) {
11102: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11103: }
11104: if ($is_dir) {
11105: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11106: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11107: } else {
11108: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11109: }
11110: $output .= ' '.$name.'</td>'."\n".
11111: &end_data_table_row();
11112: return $output;
11113: }
11114:
11115: sub archive_options_form {
1.1065 raeburn 11116: my ($form,$display,$count,$hiddenelem) = @_;
11117: my %lt = &Apache::lonlocal::texthash(
11118: perm => 'Permanently remove archive file?',
11119: hows => 'How should each extracted item be incorporated in the course?',
11120: cont => 'Content actions for all',
11121: addf => 'Add as folder/file',
11122: incd => 'Include as dependency for a displayed file',
11123: disc => 'Discard',
11124: no => 'No',
11125: yes => 'Yes',
11126: save => 'Save',
11127: );
11128: my $output = <<"END";
11129: <form name="$form" method="post" action="">
11130: <p><span class="LC_nobreak">$lt{'perm'}
11131: <label>
11132: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11133: </label>
11134:
11135: <label>
11136: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11137: </span>
11138: </p>
11139: <input type="hidden" name="phase" value="decompress_cleanup" />
11140: <br />$lt{'hows'}
11141: <div class="LC_columnSection">
11142: <fieldset>
11143: <legend>$lt{'cont'}</legend>
11144: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11145: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11146: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11147: </fieldset>
11148: </div>
11149: END
11150: return $output.
1.1055 raeburn 11151: &start_data_table()."\n".
1.1065 raeburn 11152: $display."\n".
1.1055 raeburn 11153: &end_data_table()."\n".
11154: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11155: $hiddenelem.
1.1065 raeburn 11156: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11157: '</form>';
11158: }
11159:
11160: sub archive_javascript {
1.1056 raeburn 11161: my ($startcount,$numitems,$titles,$children) = @_;
11162: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11163: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11164: my $scripttag = <<START;
11165: <script type="text/javascript">
11166: // <![CDATA[
11167:
11168: function checkAll(form,prefix) {
11169: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11170: for (var i=0; i < form.elements.length; i++) {
11171: var id = form.elements[i].id;
11172: if ((id != '') && (id != undefined)) {
11173: if (idstr.test(id)) {
11174: if (form.elements[i].type == 'radio') {
11175: form.elements[i].checked = true;
1.1056 raeburn 11176: var nostart = i-$startcount;
1.1059 raeburn 11177: var offset = nostart%7;
11178: var count = (nostart-offset)/7;
1.1056 raeburn 11179: dependencyCheck(form,count,offset);
1.1055 raeburn 11180: }
11181: }
11182: }
11183: }
11184: }
11185:
11186: function propagateCheck(form,count) {
11187: if (count > 0) {
1.1059 raeburn 11188: var startelement = $startcount + ((count-1) * 7);
11189: for (var j=1; j<6; j++) {
11190: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11191: var item = startelement + j;
11192: if (form.elements[item].type == 'radio') {
11193: if (form.elements[item].checked) {
11194: containerCheck(form,count,j);
11195: break;
11196: }
1.1055 raeburn 11197: }
11198: }
11199: }
11200: }
11201: }
11202:
11203: numitems = $numitems
1.1056 raeburn 11204: var titles = new Array(numitems);
11205: var parents = new Array(numitems);
1.1055 raeburn 11206: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11207: parents[i] = new Array;
1.1055 raeburn 11208: }
1.1059 raeburn 11209: var maintitle = '$maintitle';
1.1055 raeburn 11210:
11211: START
11212:
1.1056 raeburn 11213: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11214: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11215: for (my $i=0; $i<@contents; $i ++) {
11216: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11217: }
11218: }
11219:
1.1056 raeburn 11220: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11221: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11222: }
11223:
1.1055 raeburn 11224: $scripttag .= <<END;
11225:
11226: function containerCheck(form,count,offset) {
11227: if (count > 0) {
1.1056 raeburn 11228: dependencyCheck(form,count,offset);
1.1059 raeburn 11229: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11230: form.elements[item].checked = true;
11231: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11232: if (parents[count].length > 0) {
11233: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11234: containerCheck(form,parents[count][j],offset);
11235: }
11236: }
11237: }
11238: }
11239: }
11240:
11241: function dependencyCheck(form,count,offset) {
11242: if (count > 0) {
1.1059 raeburn 11243: var chosen = (offset+$startcount)+7*(count-1);
11244: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11245: var currtype = form.elements[depitem].type;
11246: if (form.elements[chosen].value == 'dependency') {
11247: document.getElementById('arc_depon_'+count).style.display='block';
11248: form.elements[depitem].options.length = 0;
11249: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 11250: for (var i=1; i<=numitems; i++) {
11251: if (i == count) {
11252: continue;
11253: }
1.1059 raeburn 11254: var startelement = $startcount + (i-1) * 7;
11255: for (var j=1; j<6; j++) {
11256: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11257: var item = startelement + j;
11258: if (form.elements[item].type == 'radio') {
11259: if (form.elements[item].checked) {
11260: if (form.elements[item].value == 'display') {
11261: var n = form.elements[depitem].options.length;
11262: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11263: }
11264: }
11265: }
11266: }
11267: }
11268: }
11269: } else {
11270: document.getElementById('arc_depon_'+count).style.display='none';
11271: form.elements[depitem].options.length = 0;
11272: form.elements[depitem].options[0] = new Option('Select','',true,true);
11273: }
1.1059 raeburn 11274: titleCheck(form,count,offset);
1.1056 raeburn 11275: }
11276: }
11277:
11278: function propagateSelect(form,count,offset) {
11279: if (count > 0) {
1.1065 raeburn 11280: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11281: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11282: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11283: if (parents[count].length > 0) {
11284: for (var j=0; j<parents[count].length; j++) {
11285: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11286: }
11287: }
11288: }
11289: }
11290: }
1.1056 raeburn 11291:
11292: function containerSelect(form,count,offset,picked) {
11293: if (count > 0) {
1.1065 raeburn 11294: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11295: if (form.elements[item].type == 'radio') {
11296: if (form.elements[item].value == 'dependency') {
11297: if (form.elements[item+1].type == 'select-one') {
11298: for (var i=0; i<form.elements[item+1].options.length; i++) {
11299: if (form.elements[item+1].options[i].value == picked) {
11300: form.elements[item+1].selectedIndex = i;
11301: break;
11302: }
11303: }
11304: }
11305: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11306: if (parents[count].length > 0) {
11307: for (var j=0; j<parents[count].length; j++) {
11308: containerSelect(form,parents[count][j],offset,picked);
11309: }
11310: }
11311: }
11312: }
11313: }
11314: }
11315: }
11316:
1.1059 raeburn 11317: function titleCheck(form,count,offset) {
11318: if (count > 0) {
11319: var chosen = (offset+$startcount)+7*(count-1);
11320: var depitem = $startcount + ((count-1) * 7) + 2;
11321: var currtype = form.elements[depitem].type;
11322: if (form.elements[chosen].value == 'display') {
11323: document.getElementById('arc_title_'+count).style.display='block';
11324: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11325: document.getElementById('archive_title_'+count).value=maintitle;
11326: }
11327: } else {
11328: document.getElementById('arc_title_'+count).style.display='none';
11329: if (currtype == 'text') {
11330: document.getElementById('archive_title_'+count).value='';
11331: }
11332: }
11333: }
11334: return;
11335: }
11336:
1.1055 raeburn 11337: // ]]>
11338: </script>
11339: END
11340: return $scripttag;
11341: }
11342:
11343: sub process_extracted_files {
1.1067 raeburn 11344: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11345: my $numitems = $env{'form.archive_count'};
11346: return unless ($numitems);
11347: my @ids=&Apache::lonnet::current_machine_ids();
11348: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11349: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11350: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11351: if (grep(/^\Q$docuhome\E$/,@ids)) {
11352: $prefix = &LONCAPA::propath($docudom,$docuname);
11353: $pathtocheck = "$dir_root/$destination";
11354: $dir = $dir_root;
11355: $ishome = 1;
11356: } else {
11357: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11358: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11359: $dir = "$dir_root/$docudom/$docuname";
11360: }
11361: my $currdir = "$dir_root/$destination";
11362: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11363: if ($env{'form.folderpath'}) {
11364: my @items = split('&',$env{'form.folderpath'});
11365: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 11366: if ($env{'form.folderpath'} =~ /\:1$/) {
11367: $containers{'0'}='page';
11368: } else {
11369: $containers{'0'}='sequence';
11370: }
1.1055 raeburn 11371: }
11372: my @archdirs = &get_env_multiple('form.archive_directory');
11373: if ($numitems) {
11374: for (my $i=1; $i<=$numitems; $i++) {
11375: my $path = $env{'form.archive_content_'.$i};
11376: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11377: my $item = $1;
11378: $toplevelitems{$item} = $i;
11379: if (grep(/^\Q$i\E$/,@archdirs)) {
11380: $is_dir{$item} = 1;
11381: }
11382: }
11383: }
11384: }
1.1067 raeburn 11385: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11386: if (keys(%toplevelitems) > 0) {
11387: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11388: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11389: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11390: }
1.1066 raeburn 11391: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11392: if ($numitems) {
11393: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 11394: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11395: my $path = $env{'form.archive_content_'.$i};
11396: if ($path =~ /^\Q$pathtocheck\E/) {
11397: if ($env{'form.archive_'.$i} eq 'discard') {
11398: if ($prefix ne '' && $path ne '') {
11399: if (-e $prefix.$path) {
1.1066 raeburn 11400: if ((@archdirs > 0) &&
11401: (grep(/^\Q$i\E$/,@archdirs))) {
11402: $todeletedir{$prefix.$path} = 1;
11403: } else {
11404: $todelete{$prefix.$path} = 1;
11405: }
1.1055 raeburn 11406: }
11407: }
11408: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 11409: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 11410: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 11411: $docstitle = $env{'form.archive_title_'.$i};
11412: if ($docstitle eq '') {
11413: $docstitle = $title;
11414: }
1.1055 raeburn 11415: $outer = 0;
1.1056 raeburn 11416: if (ref($dirorder{$i}) eq 'ARRAY') {
11417: if (@{$dirorder{$i}} > 0) {
11418: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 11419: if ($env{'form.archive_'.$item} eq 'display') {
11420: $outer = $item;
11421: last;
11422: }
11423: }
11424: }
11425: }
11426: my ($errtext,$fatal) =
11427: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
11428: '/'.$folders{$outer}.'.'.
11429: $containers{$outer});
11430: next if ($fatal);
11431: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
11432: if ($context eq 'coursedocs') {
1.1056 raeburn 11433: $mapinner{$i} = time;
1.1055 raeburn 11434: $folders{$i} = 'default_'.$mapinner{$i};
11435: $containers{$i} = 'sequence';
11436: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11437: $folders{$i}.'.'.$containers{$i};
11438: my $newidx = &LONCAPA::map::getresidx();
11439: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11440: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11441: push(@LONCAPA::map::order,$newidx);
11442: my ($outtext,$errtext) =
11443: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11444: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 11445: '.'.$containers{$outer},1,1);
1.1056 raeburn 11446: $newseqid{$i} = $newidx;
1.1067 raeburn 11447: unless ($errtext) {
11448: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
11449: }
1.1055 raeburn 11450: }
11451: } else {
11452: if ($context eq 'coursedocs') {
11453: my $newidx=&LONCAPA::map::getresidx();
11454: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11455: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
11456: $title;
11457: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
11458: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
11459: }
11460: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11461: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
11462: }
11463: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11464: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 11465: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 11466: unless ($ishome) {
11467: my $fetch = "$newdest{$i}/$title";
11468: $fetch =~ s/^\Q$prefix$dir\E//;
11469: $prompttofetch{$fetch} = 1;
11470: }
1.1055 raeburn 11471: }
11472: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11473: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11474: push(@LONCAPA::map::order, $newidx);
11475: my ($outtext,$errtext)=
11476: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11477: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 11478: '.'.$containers{$outer},1,1);
1.1067 raeburn 11479: unless ($errtext) {
11480: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
11481: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
11482: }
11483: }
1.1055 raeburn 11484: }
11485: }
1.1075.2.11 raeburn 11486: }
11487: } else {
11488: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11489: }
11490: }
11491: for (my $i=1; $i<=$numitems; $i++) {
11492: next unless ($env{'form.archive_'.$i} eq 'dependency');
11493: my $path = $env{'form.archive_content_'.$i};
11494: if ($path =~ /^\Q$pathtocheck\E/) {
11495: my ($title) = ($path =~ m{/([^/]+)$});
11496: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
11497: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
11498: if (ref($dirorder{$i}) eq 'ARRAY') {
11499: my ($itemidx,$fullpath,$relpath);
11500: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
11501: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 11502: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 11503: if ($dirorder{$i}->[$j] eq $container) {
11504: $itemidx = $j;
1.1056 raeburn 11505: }
11506: }
1.1075.2.11 raeburn 11507: }
11508: if ($itemidx eq '') {
11509: $itemidx = 0;
11510: }
11511: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
11512: if ($mapinner{$referrer{$i}}) {
11513: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
11514: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11515: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11516: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11517: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11518: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11519: if (!-e $fullpath) {
11520: mkdir($fullpath,0755);
1.1056 raeburn 11521: }
11522: }
1.1075.2.11 raeburn 11523: } else {
11524: last;
1.1056 raeburn 11525: }
1.1075.2.11 raeburn 11526: }
11527: }
11528: } elsif ($newdest{$referrer{$i}}) {
11529: $fullpath = $newdest{$referrer{$i}};
11530: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11531: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
11532: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
11533: last;
11534: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11535: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11536: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11537: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11538: if (!-e $fullpath) {
11539: mkdir($fullpath,0755);
1.1056 raeburn 11540: }
11541: }
1.1075.2.11 raeburn 11542: } else {
11543: last;
1.1056 raeburn 11544: }
1.1075.2.11 raeburn 11545: }
11546: }
11547: if ($fullpath ne '') {
11548: if (-e "$prefix$path") {
11549: system("mv $prefix$path $fullpath/$title");
11550: }
11551: if (-e "$fullpath/$title") {
11552: my $showpath;
11553: if ($relpath ne '') {
11554: $showpath = "$relpath/$title";
11555: } else {
11556: $showpath = "/$title";
1.1056 raeburn 11557: }
1.1075.2.11 raeburn 11558: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
11559: }
11560: unless ($ishome) {
11561: my $fetch = "$fullpath/$title";
11562: $fetch =~ s/^\Q$prefix$dir\E//;
11563: $prompttofetch{$fetch} = 1;
1.1055 raeburn 11564: }
11565: }
11566: }
1.1075.2.11 raeburn 11567: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
11568: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
11569: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 11570: }
11571: } else {
1.1075.2.11 raeburn 11572: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 11573: }
11574: }
11575: if (keys(%todelete)) {
11576: foreach my $key (keys(%todelete)) {
11577: unlink($key);
1.1066 raeburn 11578: }
11579: }
11580: if (keys(%todeletedir)) {
11581: foreach my $key (keys(%todeletedir)) {
11582: rmdir($key);
11583: }
11584: }
11585: foreach my $dir (sort(keys(%is_dir))) {
11586: if (($pathtocheck ne '') && ($dir ne '')) {
11587: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 11588: }
11589: }
1.1067 raeburn 11590: if ($result ne '') {
11591: $output .= '<ul>'."\n".
11592: $result."\n".
11593: '</ul>';
11594: }
11595: unless ($ishome) {
11596: my $replicationfail;
11597: foreach my $item (keys(%prompttofetch)) {
11598: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
11599: unless ($fetchresult eq 'ok') {
11600: $replicationfail .= '<li>'.$item.'</li>'."\n";
11601: }
11602: }
11603: if ($replicationfail) {
11604: $output .= '<p class="LC_error">'.
11605: &mt('Course home server failed to retrieve:').'<ul>'.
11606: $replicationfail.
11607: '</ul></p>';
11608: }
11609: }
1.1055 raeburn 11610: } else {
11611: $warning = &mt('No items found in archive.');
11612: }
11613: if ($error) {
11614: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11615: $error.'</p>'."\n";
11616: }
11617: if ($warning) {
11618: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11619: }
11620: return $output;
11621: }
11622:
1.1066 raeburn 11623: sub cleanup_empty_dirs {
11624: my ($path) = @_;
11625: if (($path ne '') && (-d $path)) {
11626: if (opendir(my $dirh,$path)) {
11627: my @dircontents = grep(!/^\./,readdir($dirh));
11628: my $numitems = 0;
11629: foreach my $item (@dircontents) {
11630: if (-d "$path/$item") {
1.1075.2.28 raeburn 11631: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 11632: if (-e "$path/$item") {
11633: $numitems ++;
11634: }
11635: } else {
11636: $numitems ++;
11637: }
11638: }
11639: if ($numitems == 0) {
11640: rmdir($path);
11641: }
11642: closedir($dirh);
11643: }
11644: }
11645: return;
11646: }
11647:
1.41 ng 11648: =pod
1.45 matthew 11649:
1.1068 raeburn 11650: =item &get_folder_hierarchy()
11651:
11652: Provides hierarchy of names of folders/sub-folders containing the current
11653: item,
11654:
11655: Inputs: 3
11656: - $navmap - navmaps object
11657:
11658: - $map - url for map (either the trigger itself, or map containing
11659: the resource, which is the trigger).
11660:
11661: - $showitem - 1 => show title for map itself; 0 => do not show.
11662:
11663: Outputs: 1 @pathitems - array of folder/subfolder names.
11664:
11665: =cut
11666:
11667: sub get_folder_hierarchy {
11668: my ($navmap,$map,$showitem) = @_;
11669: my @pathitems;
11670: if (ref($navmap)) {
11671: my $mapres = $navmap->getResourceByUrl($map);
11672: if (ref($mapres)) {
11673: my $pcslist = $mapres->map_hierarchy();
11674: if ($pcslist ne '') {
11675: my @pcs = split(/,/,$pcslist);
11676: foreach my $pc (@pcs) {
11677: if ($pc == 1) {
11678: push(@pathitems,&mt('Main Course Documents'));
11679: } else {
11680: my $res = $navmap->getByMapPc($pc);
11681: if (ref($res)) {
11682: my $title = $res->compTitle();
11683: $title =~ s/\W+/_/g;
11684: if ($title ne '') {
11685: push(@pathitems,$title);
11686: }
11687: }
11688: }
11689: }
11690: }
1.1071 raeburn 11691: if ($showitem) {
11692: if ($mapres->{ID} eq '0.0') {
11693: push(@pathitems,&mt('Main Course Documents'));
11694: } else {
11695: my $maptitle = $mapres->compTitle();
11696: $maptitle =~ s/\W+/_/g;
11697: if ($maptitle ne '') {
11698: push(@pathitems,$maptitle);
11699: }
1.1068 raeburn 11700: }
11701: }
11702: }
11703: }
11704: return @pathitems;
11705: }
11706:
11707: =pod
11708:
1.1015 raeburn 11709: =item * &get_turnedin_filepath()
11710:
11711: Determines path in a user's portfolio file for storage of files uploaded
11712: to a specific essayresponse or dropbox item.
11713:
11714: Inputs: 3 required + 1 optional.
11715: $symb is symb for resource, $uname and $udom are for current user (required).
11716: $caller is optional (can be "submission", if routine is called when storing
11717: an upoaded file when "Submit Answer" button was pressed).
11718:
11719: Returns array containing $path and $multiresp.
11720: $path is path in portfolio. $multiresp is 1 if this resource contains more
11721: than one file upload item. Callers of routine should append partid as a
11722: subdirectory to $path in cases where $multiresp is 1.
11723:
11724: Called by: homework/essayresponse.pm and homework/structuretags.pm
11725:
11726: =cut
11727:
11728: sub get_turnedin_filepath {
11729: my ($symb,$uname,$udom,$caller) = @_;
11730: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
11731: my $turnindir;
11732: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
11733: $turnindir = $userhash{'turnindir'};
11734: my ($path,$multiresp);
11735: if ($turnindir eq '') {
11736: if ($caller eq 'submission') {
11737: $turnindir = &mt('turned in');
11738: $turnindir =~ s/\W+/_/g;
11739: my %newhash = (
11740: 'turnindir' => $turnindir,
11741: );
11742: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
11743: }
11744: }
11745: if ($turnindir ne '') {
11746: $path = '/'.$turnindir.'/';
11747: my ($multipart,$turnin,@pathitems);
11748: my $navmap = Apache::lonnavmaps::navmap->new();
11749: if (defined($navmap)) {
11750: my $mapres = $navmap->getResourceByUrl($map);
11751: if (ref($mapres)) {
11752: my $pcslist = $mapres->map_hierarchy();
11753: if ($pcslist ne '') {
11754: foreach my $pc (split(/,/,$pcslist)) {
11755: my $res = $navmap->getByMapPc($pc);
11756: if (ref($res)) {
11757: my $title = $res->compTitle();
11758: $title =~ s/\W+/_/g;
11759: if ($title ne '') {
11760: push(@pathitems,$title);
11761: }
11762: }
11763: }
11764: }
11765: my $maptitle = $mapres->compTitle();
11766: $maptitle =~ s/\W+/_/g;
11767: if ($maptitle ne '') {
11768: push(@pathitems,$maptitle);
11769: }
11770: unless ($env{'request.state'} eq 'construct') {
11771: my $res = $navmap->getBySymb($symb);
11772: if (ref($res)) {
11773: my $partlist = $res->parts();
11774: my $totaluploads = 0;
11775: if (ref($partlist) eq 'ARRAY') {
11776: foreach my $part (@{$partlist}) {
11777: my @types = $res->responseType($part);
11778: my @ids = $res->responseIds($part);
11779: for (my $i=0; $i < scalar(@ids); $i++) {
11780: if ($types[$i] eq 'essay') {
11781: my $partid = $part.'_'.$ids[$i];
11782: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
11783: $totaluploads ++;
11784: }
11785: }
11786: }
11787: }
11788: if ($totaluploads > 1) {
11789: $multiresp = 1;
11790: }
11791: }
11792: }
11793: }
11794: } else {
11795: return;
11796: }
11797: } else {
11798: return;
11799: }
11800: my $restitle=&Apache::lonnet::gettitle($symb);
11801: $restitle =~ s/\W+/_/g;
11802: if ($restitle eq '') {
11803: $restitle = ($resurl =~ m{/[^/]+$});
11804: if ($restitle eq '') {
11805: $restitle = time;
11806: }
11807: }
11808: push(@pathitems,$restitle);
11809: $path .= join('/',@pathitems);
11810: }
11811: return ($path,$multiresp);
11812: }
11813:
11814: =pod
11815:
1.464 albertel 11816: =back
1.41 ng 11817:
1.112 bowersj2 11818: =head1 CSV Upload/Handling functions
1.38 albertel 11819:
1.41 ng 11820: =over 4
11821:
1.648 raeburn 11822: =item * &upfile_store($r)
1.41 ng 11823:
11824: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 11825: needs $env{'form.upfile'}
1.41 ng 11826: returns $datatoken to be put into hidden field
11827:
11828: =cut
1.31 albertel 11829:
11830: sub upfile_store {
11831: my $r=shift;
1.258 albertel 11832: $env{'form.upfile'}=~s/\r/\n/gs;
11833: $env{'form.upfile'}=~s/\f/\n/gs;
11834: $env{'form.upfile'}=~s/\n+/\n/gs;
11835: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 11836:
1.258 albertel 11837: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
11838: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 11839: {
1.158 raeburn 11840: my $datafile = $r->dir_config('lonDaemons').
11841: '/tmp/'.$datatoken.'.tmp';
11842: if ( open(my $fh,">$datafile") ) {
1.258 albertel 11843: print $fh $env{'form.upfile'};
1.158 raeburn 11844: close($fh);
11845: }
1.31 albertel 11846: }
11847: return $datatoken;
11848: }
11849:
1.56 matthew 11850: =pod
11851:
1.648 raeburn 11852: =item * &load_tmp_file($r)
1.41 ng 11853:
11854: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 11855: needs $env{'form.datatoken'},
11856: sets $env{'form.upfile'} to the contents of the file
1.41 ng 11857:
11858: =cut
1.31 albertel 11859:
11860: sub load_tmp_file {
11861: my $r=shift;
11862: my @studentdata=();
11863: {
1.158 raeburn 11864: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 11865: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 11866: if ( open(my $fh,"<$studentfile") ) {
11867: @studentdata=<$fh>;
11868: close($fh);
11869: }
1.31 albertel 11870: }
1.258 albertel 11871: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 11872: }
11873:
1.56 matthew 11874: =pod
11875:
1.648 raeburn 11876: =item * &upfile_record_sep()
1.41 ng 11877:
11878: Separate uploaded file into records
11879: returns array of records,
1.258 albertel 11880: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 11881:
11882: =cut
1.31 albertel 11883:
11884: sub upfile_record_sep {
1.258 albertel 11885: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 11886: } else {
1.248 albertel 11887: my @records;
1.258 albertel 11888: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 11889: if ($line=~/^\s*$/) { next; }
11890: push(@records,$line);
11891: }
11892: return @records;
1.31 albertel 11893: }
11894: }
11895:
1.56 matthew 11896: =pod
11897:
1.648 raeburn 11898: =item * &record_sep($record)
1.41 ng 11899:
1.258 albertel 11900: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 11901:
11902: =cut
11903:
1.263 www 11904: sub takeleft {
11905: my $index=shift;
11906: return substr('0000'.$index,-4,4);
11907: }
11908:
1.31 albertel 11909: sub record_sep {
11910: my $record=shift;
11911: my %components=();
1.258 albertel 11912: if ($env{'form.upfiletype'} eq 'xml') {
11913: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 11914: my $i=0;
1.356 albertel 11915: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 11916: $field=~s/^(\"|\')//;
11917: $field=~s/(\"|\')$//;
1.263 www 11918: $components{&takeleft($i)}=$field;
1.31 albertel 11919: $i++;
11920: }
1.258 albertel 11921: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 11922: my $i=0;
1.356 albertel 11923: foreach my $field (split(/\t/,$record)) {
1.31 albertel 11924: $field=~s/^(\"|\')//;
11925: $field=~s/(\"|\')$//;
1.263 www 11926: $components{&takeleft($i)}=$field;
1.31 albertel 11927: $i++;
11928: }
11929: } else {
1.561 www 11930: my $separator=',';
1.480 banghart 11931: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 11932: $separator=';';
1.480 banghart 11933: }
1.31 albertel 11934: my $i=0;
1.561 www 11935: # the character we are looking for to indicate the end of a quote or a record
11936: my $looking_for=$separator;
11937: # do not add the characters to the fields
11938: my $ignore=0;
11939: # we just encountered a separator (or the beginning of the record)
11940: my $just_found_separator=1;
11941: # store the field we are working on here
11942: my $field='';
11943: # work our way through all characters in record
11944: foreach my $character ($record=~/(.)/g) {
11945: if ($character eq $looking_for) {
11946: if ($character ne $separator) {
11947: # Found the end of a quote, again looking for separator
11948: $looking_for=$separator;
11949: $ignore=1;
11950: } else {
11951: # Found a separator, store away what we got
11952: $components{&takeleft($i)}=$field;
11953: $i++;
11954: $just_found_separator=1;
11955: $ignore=0;
11956: $field='';
11957: }
11958: next;
11959: }
11960: # single or double quotation marks after a separator indicate beginning of a quote
11961: # we are now looking for the end of the quote and need to ignore separators
11962: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
11963: $looking_for=$character;
11964: next;
11965: }
11966: # ignore would be true after we reached the end of a quote
11967: if ($ignore) { next; }
11968: if (($just_found_separator) && ($character=~/\s/)) { next; }
11969: $field.=$character;
11970: $just_found_separator=0;
1.31 albertel 11971: }
1.561 www 11972: # catch the very last entry, since we never encountered the separator
11973: $components{&takeleft($i)}=$field;
1.31 albertel 11974: }
11975: return %components;
11976: }
11977:
1.144 matthew 11978: ######################################################
11979: ######################################################
11980:
1.56 matthew 11981: =pod
11982:
1.648 raeburn 11983: =item * &upfile_select_html()
1.41 ng 11984:
1.144 matthew 11985: Return HTML code to select a file from the users machine and specify
11986: the file type.
1.41 ng 11987:
11988: =cut
11989:
1.144 matthew 11990: ######################################################
11991: ######################################################
1.31 albertel 11992: sub upfile_select_html {
1.144 matthew 11993: my %Types = (
11994: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 11995: semisv => &mt('Semicolon separated values'),
1.144 matthew 11996: space => &mt('Space separated'),
11997: tab => &mt('Tabulator separated'),
11998: # xml => &mt('HTML/XML'),
11999: );
12000: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12001: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12002: foreach my $type (sort(keys(%Types))) {
12003: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12004: }
12005: $Str .= "</select>\n";
12006: return $Str;
1.31 albertel 12007: }
12008:
1.301 albertel 12009: sub get_samples {
12010: my ($records,$toget) = @_;
12011: my @samples=({});
12012: my $got=0;
12013: foreach my $rec (@$records) {
12014: my %temp = &record_sep($rec);
12015: if (! grep(/\S/, values(%temp))) { next; }
12016: if (%temp) {
12017: $samples[$got]=\%temp;
12018: $got++;
12019: if ($got == $toget) { last; }
12020: }
12021: }
12022: return \@samples;
12023: }
12024:
1.144 matthew 12025: ######################################################
12026: ######################################################
12027:
1.56 matthew 12028: =pod
12029:
1.648 raeburn 12030: =item * &csv_print_samples($r,$records)
1.41 ng 12031:
12032: Prints a table of sample values from each column uploaded $r is an
12033: Apache Request ref, $records is an arrayref from
12034: &Apache::loncommon::upfile_record_sep
12035:
12036: =cut
12037:
1.144 matthew 12038: ######################################################
12039: ######################################################
1.31 albertel 12040: sub csv_print_samples {
12041: my ($r,$records) = @_;
1.662 bisitz 12042: my $samples = &get_samples($records,5);
1.301 albertel 12043:
1.594 raeburn 12044: $r->print(&mt('Samples').'<br />'.&start_data_table().
12045: &start_data_table_header_row());
1.356 albertel 12046: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12047: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12048: $r->print(&end_data_table_header_row());
1.301 albertel 12049: foreach my $hash (@$samples) {
1.594 raeburn 12050: $r->print(&start_data_table_row());
1.356 albertel 12051: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12052: $r->print('<td>');
1.356 albertel 12053: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12054: $r->print('</td>');
12055: }
1.594 raeburn 12056: $r->print(&end_data_table_row());
1.31 albertel 12057: }
1.594 raeburn 12058: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12059: }
12060:
1.144 matthew 12061: ######################################################
12062: ######################################################
12063:
1.56 matthew 12064: =pod
12065:
1.648 raeburn 12066: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12067:
12068: Prints a table to create associations between values and table columns.
1.144 matthew 12069:
1.41 ng 12070: $r is an Apache Request ref,
12071: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12072: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12073:
12074: =cut
12075:
1.144 matthew 12076: ######################################################
12077: ######################################################
1.31 albertel 12078: sub csv_print_select_table {
12079: my ($r,$records,$d) = @_;
1.301 albertel 12080: my $i=0;
12081: my $samples = &get_samples($records,1);
1.144 matthew 12082: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12083: &start_data_table().&start_data_table_header_row().
1.144 matthew 12084: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12085: '<th>'.&mt('Column').'</th>'.
12086: &end_data_table_header_row()."\n");
1.356 albertel 12087: foreach my $array_ref (@$d) {
12088: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12089: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12090:
1.875 bisitz 12091: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12092: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12093: $r->print('<option value="none"></option>');
1.356 albertel 12094: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12095: $r->print('<option value="'.$sample.'"'.
12096: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12097: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12098: }
1.594 raeburn 12099: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12100: $i++;
12101: }
1.594 raeburn 12102: $r->print(&end_data_table());
1.31 albertel 12103: $i--;
12104: return $i;
12105: }
1.56 matthew 12106:
1.144 matthew 12107: ######################################################
12108: ######################################################
12109:
1.56 matthew 12110: =pod
1.31 albertel 12111:
1.648 raeburn 12112: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12113:
12114: Prints a table of sample values from the upload and can make associate samples to internal names.
12115:
12116: $r is an Apache Request ref,
12117: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12118: $d is an array of 2 element arrays (internal name, displayed name)
12119:
12120: =cut
12121:
1.144 matthew 12122: ######################################################
12123: ######################################################
1.31 albertel 12124: sub csv_samples_select_table {
12125: my ($r,$records,$d) = @_;
12126: my $i=0;
1.144 matthew 12127: #
1.662 bisitz 12128: my $max_samples = 5;
12129: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12130: $r->print(&start_data_table().
12131: &start_data_table_header_row().'<th>'.
12132: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12133: &end_data_table_header_row());
1.301 albertel 12134:
12135: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12136: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12137: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12138: foreach my $option (@$d) {
12139: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12140: $r->print('<option value="'.$value.'"'.
1.253 albertel 12141: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12142: $display.'</option>');
1.31 albertel 12143: }
12144: $r->print('</select></td><td>');
1.662 bisitz 12145: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12146: if (defined($samples->[$line]{$key})) {
12147: $r->print($samples->[$line]{$key}."<br />\n");
12148: }
12149: }
1.594 raeburn 12150: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12151: $i++;
12152: }
1.594 raeburn 12153: $r->print(&end_data_table());
1.31 albertel 12154: $i--;
12155: return($i);
1.115 matthew 12156: }
12157:
1.144 matthew 12158: ######################################################
12159: ######################################################
12160:
1.115 matthew 12161: =pod
12162:
1.648 raeburn 12163: =item * &clean_excel_name($name)
1.115 matthew 12164:
12165: Returns a replacement for $name which does not contain any illegal characters.
12166:
12167: =cut
12168:
1.144 matthew 12169: ######################################################
12170: ######################################################
1.115 matthew 12171: sub clean_excel_name {
12172: my ($name) = @_;
12173: $name =~ s/[:\*\?\/\\]//g;
12174: if (length($name) > 31) {
12175: $name = substr($name,0,31);
12176: }
12177: return $name;
1.25 albertel 12178: }
1.84 albertel 12179:
1.85 albertel 12180: =pod
12181:
1.648 raeburn 12182: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12183:
12184: Returns either 1 or undef
12185:
12186: 1 if the part is to be hidden, undef if it is to be shown
12187:
12188: Arguments are:
12189:
12190: $id the id of the part to be checked
12191: $symb, optional the symb of the resource to check
12192: $udom, optional the domain of the user to check for
12193: $uname, optional the username of the user to check for
12194:
12195: =cut
1.84 albertel 12196:
12197: sub check_if_partid_hidden {
12198: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12199: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12200: $symb,$udom,$uname);
1.141 albertel 12201: my $truth=1;
12202: #if the string starts with !, then the list is the list to show not hide
12203: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12204: my @hiddenlist=split(/,/,$hiddenparts);
12205: foreach my $checkid (@hiddenlist) {
1.141 albertel 12206: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12207: }
1.141 albertel 12208: return !$truth;
1.84 albertel 12209: }
1.127 matthew 12210:
1.138 matthew 12211:
12212: ############################################################
12213: ############################################################
12214:
12215: =pod
12216:
1.157 matthew 12217: =back
12218:
1.138 matthew 12219: =head1 cgi-bin script and graphing routines
12220:
1.157 matthew 12221: =over 4
12222:
1.648 raeburn 12223: =item * &get_cgi_id()
1.138 matthew 12224:
12225: Inputs: none
12226:
12227: Returns an id which can be used to pass environment variables
12228: to various cgi-bin scripts. These environment variables will
12229: be removed from the users environment after a given time by
12230: the routine &Apache::lonnet::transfer_profile_to_env.
12231:
12232: =cut
12233:
12234: ############################################################
12235: ############################################################
1.152 albertel 12236: my $uniq=0;
1.136 matthew 12237: sub get_cgi_id {
1.154 albertel 12238: $uniq=($uniq+1)%100000;
1.280 albertel 12239: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12240: }
12241:
1.127 matthew 12242: ############################################################
12243: ############################################################
12244:
12245: =pod
12246:
1.648 raeburn 12247: =item * &DrawBarGraph()
1.127 matthew 12248:
1.138 matthew 12249: Facilitates the plotting of data in a (stacked) bar graph.
12250: Puts plot definition data into the users environment in order for
12251: graph.png to plot it. Returns an <img> tag for the plot.
12252: The bars on the plot are labeled '1','2',...,'n'.
12253:
12254: Inputs:
12255:
12256: =over 4
12257:
12258: =item $Title: string, the title of the plot
12259:
12260: =item $xlabel: string, text describing the X-axis of the plot
12261:
12262: =item $ylabel: string, text describing the Y-axis of the plot
12263:
12264: =item $Max: scalar, the maximum Y value to use in the plot
12265: If $Max is < any data point, the graph will not be rendered.
12266:
1.140 matthew 12267: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12268: they are plotted. If undefined, default values will be used.
12269:
1.178 matthew 12270: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12271:
1.138 matthew 12272: =item @Values: An array of array references. Each array reference holds data
12273: to be plotted in a stacked bar chart.
12274:
1.239 matthew 12275: =item If the final element of @Values is a hash reference the key/value
12276: pairs will be added to the graph definition.
12277:
1.138 matthew 12278: =back
12279:
12280: Returns:
12281:
12282: An <img> tag which references graph.png and the appropriate identifying
12283: information for the plot.
12284:
1.127 matthew 12285: =cut
12286:
12287: ############################################################
12288: ############################################################
1.134 matthew 12289: sub DrawBarGraph {
1.178 matthew 12290: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12291: #
12292: if (! defined($colors)) {
12293: $colors = ['#33ff00',
12294: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12295: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12296: ];
12297: }
1.228 matthew 12298: my $extra_settings = {};
12299: if (ref($Values[-1]) eq 'HASH') {
12300: $extra_settings = pop(@Values);
12301: }
1.127 matthew 12302: #
1.136 matthew 12303: my $identifier = &get_cgi_id();
12304: my $id = 'cgi.'.$identifier;
1.129 matthew 12305: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12306: return '';
12307: }
1.225 matthew 12308: #
12309: my @Labels;
12310: if (defined($labels)) {
12311: @Labels = @$labels;
12312: } else {
12313: for (my $i=0;$i<@{$Values[0]};$i++) {
12314: push (@Labels,$i+1);
12315: }
12316: }
12317: #
1.129 matthew 12318: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12319: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12320: my %ValuesHash;
12321: my $NumSets=1;
12322: foreach my $array (@Values) {
12323: next if (! ref($array));
1.136 matthew 12324: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12325: join(',',@$array);
1.129 matthew 12326: }
1.127 matthew 12327: #
1.136 matthew 12328: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12329: if ($NumBars < 3) {
12330: $width = 120+$NumBars*32;
1.220 matthew 12331: $xskip = 1;
1.225 matthew 12332: $bar_width = 30;
12333: } elsif ($NumBars < 5) {
12334: $width = 120+$NumBars*20;
12335: $xskip = 1;
12336: $bar_width = 20;
1.220 matthew 12337: } elsif ($NumBars < 10) {
1.136 matthew 12338: $width = 120+$NumBars*15;
12339: $xskip = 1;
12340: $bar_width = 15;
12341: } elsif ($NumBars <= 25) {
12342: $width = 120+$NumBars*11;
12343: $xskip = 5;
12344: $bar_width = 8;
12345: } elsif ($NumBars <= 50) {
12346: $width = 120+$NumBars*8;
12347: $xskip = 5;
12348: $bar_width = 4;
12349: } else {
12350: $width = 120+$NumBars*8;
12351: $xskip = 5;
12352: $bar_width = 4;
12353: }
12354: #
1.137 matthew 12355: $Max = 1 if ($Max < 1);
12356: if ( int($Max) < $Max ) {
12357: $Max++;
12358: $Max = int($Max);
12359: }
1.127 matthew 12360: $Title = '' if (! defined($Title));
12361: $xlabel = '' if (! defined($xlabel));
12362: $ylabel = '' if (! defined($ylabel));
1.369 www 12363: $ValuesHash{$id.'.title'} = &escape($Title);
12364: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12365: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12366: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12367: $ValuesHash{$id.'.NumBars'} = $NumBars;
12368: $ValuesHash{$id.'.NumSets'} = $NumSets;
12369: $ValuesHash{$id.'.PlotType'} = 'bar';
12370: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12371: $ValuesHash{$id.'.height'} = $height;
12372: $ValuesHash{$id.'.width'} = $width;
12373: $ValuesHash{$id.'.xskip'} = $xskip;
12374: $ValuesHash{$id.'.bar_width'} = $bar_width;
12375: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12376: #
1.228 matthew 12377: # Deal with other parameters
12378: while (my ($key,$value) = each(%$extra_settings)) {
12379: $ValuesHash{$id.'.'.$key} = $value;
12380: }
12381: #
1.646 raeburn 12382: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12383: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12384: }
12385:
12386: ############################################################
12387: ############################################################
12388:
12389: =pod
12390:
1.648 raeburn 12391: =item * &DrawXYGraph()
1.137 matthew 12392:
1.138 matthew 12393: Facilitates the plotting of data in an XY graph.
12394: Puts plot definition data into the users environment in order for
12395: graph.png to plot it. Returns an <img> tag for the plot.
12396:
12397: Inputs:
12398:
12399: =over 4
12400:
12401: =item $Title: string, the title of the plot
12402:
12403: =item $xlabel: string, text describing the X-axis of the plot
12404:
12405: =item $ylabel: string, text describing the Y-axis of the plot
12406:
12407: =item $Max: scalar, the maximum Y value to use in the plot
12408: If $Max is < any data point, the graph will not be rendered.
12409:
12410: =item $colors: Array ref containing the hex color codes for the data to be
12411: plotted in. If undefined, default values will be used.
12412:
12413: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12414:
12415: =item $Ydata: Array ref containing Array refs.
1.185 www 12416: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 12417:
12418: =item %Values: hash indicating or overriding any default values which are
12419: passed to graph.png.
12420: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12421:
12422: =back
12423:
12424: Returns:
12425:
12426: An <img> tag which references graph.png and the appropriate identifying
12427: information for the plot.
12428:
1.137 matthew 12429: =cut
12430:
12431: ############################################################
12432: ############################################################
12433: sub DrawXYGraph {
12434: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
12435: #
12436: # Create the identifier for the graph
12437: my $identifier = &get_cgi_id();
12438: my $id = 'cgi.'.$identifier;
12439: #
12440: $Title = '' if (! defined($Title));
12441: $xlabel = '' if (! defined($xlabel));
12442: $ylabel = '' if (! defined($ylabel));
12443: my %ValuesHash =
12444: (
1.369 www 12445: $id.'.title' => &escape($Title),
12446: $id.'.xlabel' => &escape($xlabel),
12447: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 12448: $id.'.y_max_value'=> $Max,
12449: $id.'.labels' => join(',',@$Xlabels),
12450: $id.'.PlotType' => 'XY',
12451: );
12452: #
12453: if (defined($colors) && ref($colors) eq 'ARRAY') {
12454: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12455: }
12456: #
12457: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
12458: return '';
12459: }
12460: my $NumSets=1;
1.138 matthew 12461: foreach my $array (@{$Ydata}){
1.137 matthew 12462: next if (! ref($array));
12463: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
12464: }
1.138 matthew 12465: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 12466: #
12467: # Deal with other parameters
12468: while (my ($key,$value) = each(%Values)) {
12469: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 12470: }
12471: #
1.646 raeburn 12472: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 12473: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12474: }
12475:
12476: ############################################################
12477: ############################################################
12478:
12479: =pod
12480:
1.648 raeburn 12481: =item * &DrawXYYGraph()
1.138 matthew 12482:
12483: Facilitates the plotting of data in an XY graph with two Y axes.
12484: Puts plot definition data into the users environment in order for
12485: graph.png to plot it. Returns an <img> tag for the plot.
12486:
12487: Inputs:
12488:
12489: =over 4
12490:
12491: =item $Title: string, the title of the plot
12492:
12493: =item $xlabel: string, text describing the X-axis of the plot
12494:
12495: =item $ylabel: string, text describing the Y-axis of the plot
12496:
12497: =item $colors: Array ref containing the hex color codes for the data to be
12498: plotted in. If undefined, default values will be used.
12499:
12500: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12501:
12502: =item $Ydata1: The first data set
12503:
12504: =item $Min1: The minimum value of the left Y-axis
12505:
12506: =item $Max1: The maximum value of the left Y-axis
12507:
12508: =item $Ydata2: The second data set
12509:
12510: =item $Min2: The minimum value of the right Y-axis
12511:
12512: =item $Max2: The maximum value of the left Y-axis
12513:
12514: =item %Values: hash indicating or overriding any default values which are
12515: passed to graph.png.
12516: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12517:
12518: =back
12519:
12520: Returns:
12521:
12522: An <img> tag which references graph.png and the appropriate identifying
12523: information for the plot.
1.136 matthew 12524:
12525: =cut
12526:
12527: ############################################################
12528: ############################################################
1.137 matthew 12529: sub DrawXYYGraph {
12530: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
12531: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 12532: #
12533: # Create the identifier for the graph
12534: my $identifier = &get_cgi_id();
12535: my $id = 'cgi.'.$identifier;
12536: #
12537: $Title = '' if (! defined($Title));
12538: $xlabel = '' if (! defined($xlabel));
12539: $ylabel = '' if (! defined($ylabel));
12540: my %ValuesHash =
12541: (
1.369 www 12542: $id.'.title' => &escape($Title),
12543: $id.'.xlabel' => &escape($xlabel),
12544: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 12545: $id.'.labels' => join(',',@$Xlabels),
12546: $id.'.PlotType' => 'XY',
12547: $id.'.NumSets' => 2,
1.137 matthew 12548: $id.'.two_axes' => 1,
12549: $id.'.y1_max_value' => $Max1,
12550: $id.'.y1_min_value' => $Min1,
12551: $id.'.y2_max_value' => $Max2,
12552: $id.'.y2_min_value' => $Min2,
1.136 matthew 12553: );
12554: #
1.137 matthew 12555: if (defined($colors) && ref($colors) eq 'ARRAY') {
12556: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12557: }
12558: #
12559: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
12560: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 12561: return '';
12562: }
12563: my $NumSets=1;
1.137 matthew 12564: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 12565: next if (! ref($array));
12566: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 12567: }
12568: #
12569: # Deal with other parameters
12570: while (my ($key,$value) = each(%Values)) {
12571: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 12572: }
12573: #
1.646 raeburn 12574: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 12575: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 12576: }
12577:
12578: ############################################################
12579: ############################################################
12580:
12581: =pod
12582:
1.157 matthew 12583: =back
12584:
1.139 matthew 12585: =head1 Statistics helper routines?
12586:
12587: Bad place for them but what the hell.
12588:
1.157 matthew 12589: =over 4
12590:
1.648 raeburn 12591: =item * &chartlink()
1.139 matthew 12592:
12593: Returns a link to the chart for a specific student.
12594:
12595: Inputs:
12596:
12597: =over 4
12598:
12599: =item $linktext: The text of the link
12600:
12601: =item $sname: The students username
12602:
12603: =item $sdomain: The students domain
12604:
12605: =back
12606:
1.157 matthew 12607: =back
12608:
1.139 matthew 12609: =cut
12610:
12611: ############################################################
12612: ############################################################
12613: sub chartlink {
12614: my ($linktext, $sname, $sdomain) = @_;
12615: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 12616: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 12617: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 12618: '">'.$linktext.'</a>';
1.153 matthew 12619: }
12620:
12621: #######################################################
12622: #######################################################
12623:
12624: =pod
12625:
12626: =head1 Course Environment Routines
1.157 matthew 12627:
12628: =over 4
1.153 matthew 12629:
1.648 raeburn 12630: =item * &restore_course_settings()
1.153 matthew 12631:
1.648 raeburn 12632: =item * &store_course_settings()
1.153 matthew 12633:
12634: Restores/Store indicated form parameters from the course environment.
12635: Will not overwrite existing values of the form parameters.
12636:
12637: Inputs:
12638: a scalar describing the data (e.g. 'chart', 'problem_analysis')
12639:
12640: a hash ref describing the data to be stored. For example:
12641:
12642: %Save_Parameters = ('Status' => 'scalar',
12643: 'chartoutputmode' => 'scalar',
12644: 'chartoutputdata' => 'scalar',
12645: 'Section' => 'array',
1.373 raeburn 12646: 'Group' => 'array',
1.153 matthew 12647: 'StudentData' => 'array',
12648: 'Maps' => 'array');
12649:
12650: Returns: both routines return nothing
12651:
1.631 raeburn 12652: =back
12653:
1.153 matthew 12654: =cut
12655:
12656: #######################################################
12657: #######################################################
12658: sub store_course_settings {
1.496 albertel 12659: return &store_settings($env{'request.course.id'},@_);
12660: }
12661:
12662: sub store_settings {
1.153 matthew 12663: # save to the environment
12664: # appenv the same items, just to be safe
1.300 albertel 12665: my $udom = $env{'user.domain'};
12666: my $uname = $env{'user.name'};
1.496 albertel 12667: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12668: my %SaveHash;
12669: my %AppHash;
12670: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 12671: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 12672: my $envname = 'environment.'.$basename;
1.258 albertel 12673: if (exists($env{'form.'.$setting})) {
1.153 matthew 12674: # Save this value away
12675: if ($type eq 'scalar' &&
1.258 albertel 12676: (! exists($env{$envname}) ||
12677: $env{$envname} ne $env{'form.'.$setting})) {
12678: $SaveHash{$basename} = $env{'form.'.$setting};
12679: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 12680: } elsif ($type eq 'array') {
12681: my $stored_form;
1.258 albertel 12682: if (ref($env{'form.'.$setting})) {
1.153 matthew 12683: $stored_form = join(',',
12684: map {
1.369 www 12685: &escape($_);
1.258 albertel 12686: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 12687: } else {
12688: $stored_form =
1.369 www 12689: &escape($env{'form.'.$setting});
1.153 matthew 12690: }
12691: # Determine if the array contents are the same.
1.258 albertel 12692: if ($stored_form ne $env{$envname}) {
1.153 matthew 12693: $SaveHash{$basename} = $stored_form;
12694: $AppHash{$envname} = $stored_form;
12695: }
12696: }
12697: }
12698: }
12699: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 12700: $udom,$uname);
1.153 matthew 12701: if ($put_result !~ /^(ok|delayed)/) {
12702: &Apache::lonnet::logthis('unable to save form parameters, '.
12703: 'got error:'.$put_result);
12704: }
12705: # Make sure these settings stick around in this session, too
1.646 raeburn 12706: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 12707: return;
12708: }
12709:
12710: sub restore_course_settings {
1.499 albertel 12711: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 12712: }
12713:
12714: sub restore_settings {
12715: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12716: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 12717: next if (exists($env{'form.'.$setting}));
1.496 albertel 12718: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 12719: '.'.$setting;
1.258 albertel 12720: if (exists($env{$envname})) {
1.153 matthew 12721: if ($type eq 'scalar') {
1.258 albertel 12722: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 12723: } elsif ($type eq 'array') {
1.258 albertel 12724: $env{'form.'.$setting} = [
1.153 matthew 12725: map {
1.369 www 12726: &unescape($_);
1.258 albertel 12727: } split(',',$env{$envname})
1.153 matthew 12728: ];
12729: }
12730: }
12731: }
1.127 matthew 12732: }
12733:
1.618 raeburn 12734: #######################################################
12735: #######################################################
12736:
12737: =pod
12738:
12739: =head1 Domain E-mail Routines
12740:
12741: =over 4
12742:
1.648 raeburn 12743: =item * &build_recipient_list()
1.618 raeburn 12744:
1.884 raeburn 12745: Build recipient lists for five types of e-mail:
1.766 raeburn 12746: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884 raeburn 12747: (d) Help requests, (e) Course requests needing approval, generated by
12748: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
12749: loncoursequeueadmin.pm respectively.
1.618 raeburn 12750:
12751: Inputs:
1.619 raeburn 12752: defmail (scalar - email address of default recipient),
1.618 raeburn 12753: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 12754: defdom (domain for which to retrieve configuration settings),
12755: origmail (scalar - email address of recipient from loncapa.conf,
12756: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 12757:
1.655 raeburn 12758: Returns: comma separated list of addresses to which to send e-mail.
12759:
12760: =back
1.618 raeburn 12761:
12762: =cut
12763:
12764: ############################################################
12765: ############################################################
12766: sub build_recipient_list {
1.619 raeburn 12767: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 12768: my @recipients;
12769: my $otheremails;
12770: my %domconfig =
12771: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
12772: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 12773: if (exists($domconfig{'contacts'}{$mailing})) {
12774: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
12775: my @contacts = ('adminemail','supportemail');
12776: foreach my $item (@contacts) {
12777: if ($domconfig{'contacts'}{$mailing}{$item}) {
12778: my $addr = $domconfig{'contacts'}{$item};
12779: if (!grep(/^\Q$addr\E$/,@recipients)) {
12780: push(@recipients,$addr);
12781: }
1.619 raeburn 12782: }
1.766 raeburn 12783: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 12784: }
12785: }
1.766 raeburn 12786: } elsif ($origmail ne '') {
12787: push(@recipients,$origmail);
1.618 raeburn 12788: }
1.619 raeburn 12789: } elsif ($origmail ne '') {
12790: push(@recipients,$origmail);
1.618 raeburn 12791: }
1.688 raeburn 12792: if (defined($defmail)) {
12793: if ($defmail ne '') {
12794: push(@recipients,$defmail);
12795: }
1.618 raeburn 12796: }
12797: if ($otheremails) {
1.619 raeburn 12798: my @others;
12799: if ($otheremails =~ /,/) {
12800: @others = split(/,/,$otheremails);
1.618 raeburn 12801: } else {
1.619 raeburn 12802: push(@others,$otheremails);
12803: }
12804: foreach my $addr (@others) {
12805: if (!grep(/^\Q$addr\E$/,@recipients)) {
12806: push(@recipients,$addr);
12807: }
1.618 raeburn 12808: }
12809: }
1.619 raeburn 12810: my $recipientlist = join(',',@recipients);
1.618 raeburn 12811: return $recipientlist;
12812: }
12813:
1.127 matthew 12814: ############################################################
12815: ############################################################
1.154 albertel 12816:
1.655 raeburn 12817: =pod
12818:
12819: =head1 Course Catalog Routines
12820:
12821: =over 4
12822:
12823: =item * &gather_categories()
12824:
12825: Converts category definitions - keys of categories hash stored in
12826: coursecategories in configuration.db on the primary library server in a
12827: domain - to an array. Also generates javascript and idx hash used to
12828: generate Domain Coordinator interface for editing Course Categories.
12829:
12830: Inputs:
1.663 raeburn 12831:
1.655 raeburn 12832: categories (reference to hash of category definitions).
1.663 raeburn 12833:
1.655 raeburn 12834: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12835: categories and subcategories).
1.663 raeburn 12836:
1.655 raeburn 12837: idx (reference to hash of counters used in Domain Coordinator interface for
12838: editing Course Categories).
1.663 raeburn 12839:
1.655 raeburn 12840: jsarray (reference to array of categories used to create Javascript arrays for
12841: Domain Coordinator interface for editing Course Categories).
12842:
12843: Returns: nothing
12844:
12845: Side effects: populates cats, idx and jsarray.
12846:
12847: =cut
12848:
12849: sub gather_categories {
12850: my ($categories,$cats,$idx,$jsarray) = @_;
12851: my %counters;
12852: my $num = 0;
12853: foreach my $item (keys(%{$categories})) {
12854: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
12855: if ($container eq '' && $depth == 0) {
12856: $cats->[$depth][$categories->{$item}] = $cat;
12857: } else {
12858: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
12859: }
12860: my ($escitem,$tail) = split(/:/,$item,2);
12861: if ($counters{$tail} eq '') {
12862: $counters{$tail} = $num;
12863: $num ++;
12864: }
12865: if (ref($idx) eq 'HASH') {
12866: $idx->{$item} = $counters{$tail};
12867: }
12868: if (ref($jsarray) eq 'ARRAY') {
12869: push(@{$jsarray->[$counters{$tail}]},$item);
12870: }
12871: }
12872: return;
12873: }
12874:
12875: =pod
12876:
12877: =item * &extract_categories()
12878:
12879: Used to generate breadcrumb trails for course categories.
12880:
12881: Inputs:
1.663 raeburn 12882:
1.655 raeburn 12883: categories (reference to hash of category definitions).
1.663 raeburn 12884:
1.655 raeburn 12885: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12886: categories and subcategories).
1.663 raeburn 12887:
1.655 raeburn 12888: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 12889:
1.655 raeburn 12890: allitems (reference to hash - key is category key
12891: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12892:
1.655 raeburn 12893: idx (reference to hash of counters used in Domain Coordinator interface for
12894: editing Course Categories).
1.663 raeburn 12895:
1.655 raeburn 12896: jsarray (reference to array of categories used to create Javascript arrays for
12897: Domain Coordinator interface for editing Course Categories).
12898:
1.665 raeburn 12899: subcats (reference to hash of arrays containing all subcategories within each
12900: category, -recursive)
12901:
1.655 raeburn 12902: Returns: nothing
12903:
12904: Side effects: populates trails and allitems hash references.
12905:
12906: =cut
12907:
12908: sub extract_categories {
1.665 raeburn 12909: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 12910: if (ref($categories) eq 'HASH') {
12911: &gather_categories($categories,$cats,$idx,$jsarray);
12912: if (ref($cats->[0]) eq 'ARRAY') {
12913: for (my $i=0; $i<@{$cats->[0]}; $i++) {
12914: my $name = $cats->[0][$i];
12915: my $item = &escape($name).'::0';
12916: my $trailstr;
12917: if ($name eq 'instcode') {
12918: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 12919: } elsif ($name eq 'communities') {
12920: $trailstr = &mt('Communities');
1.655 raeburn 12921: } else {
12922: $trailstr = $name;
12923: }
12924: if ($allitems->{$item} eq '') {
12925: push(@{$trails},$trailstr);
12926: $allitems->{$item} = scalar(@{$trails})-1;
12927: }
12928: my @parents = ($name);
12929: if (ref($cats->[1]{$name}) eq 'ARRAY') {
12930: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
12931: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 12932: if (ref($subcats) eq 'HASH') {
12933: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
12934: }
12935: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
12936: }
12937: } else {
12938: if (ref($subcats) eq 'HASH') {
12939: $subcats->{$item} = [];
1.655 raeburn 12940: }
12941: }
12942: }
12943: }
12944: }
12945: return;
12946: }
12947:
12948: =pod
12949:
12950: =item *&recurse_categories()
12951:
12952: Recursively used to generate breadcrumb trails for course categories.
12953:
12954: Inputs:
1.663 raeburn 12955:
1.655 raeburn 12956: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12957: categories and subcategories).
1.663 raeburn 12958:
1.655 raeburn 12959: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 12960:
12961: category (current course category, for which breadcrumb trail is being generated).
12962:
12963: trails (reference to array of breadcrumb trails for each category).
12964:
1.655 raeburn 12965: allitems (reference to hash - key is category key
12966: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12967:
1.655 raeburn 12968: parents (array containing containers directories for current category,
12969: back to top level).
12970:
12971: Returns: nothing
12972:
12973: Side effects: populates trails and allitems hash references
12974:
12975: =cut
12976:
12977: sub recurse_categories {
1.665 raeburn 12978: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 12979: my $shallower = $depth - 1;
12980: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
12981: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
12982: my $name = $cats->[$depth]{$category}[$k];
12983: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
12984: my $trailstr = join(' -> ',(@{$parents},$category));
12985: if ($allitems->{$item} eq '') {
12986: push(@{$trails},$trailstr);
12987: $allitems->{$item} = scalar(@{$trails})-1;
12988: }
12989: my $deeper = $depth+1;
12990: push(@{$parents},$category);
1.665 raeburn 12991: if (ref($subcats) eq 'HASH') {
12992: my $subcat = &escape($name).':'.$category.':'.$depth;
12993: for (my $j=@{$parents}; $j>=0; $j--) {
12994: my $higher;
12995: if ($j > 0) {
12996: $higher = &escape($parents->[$j]).':'.
12997: &escape($parents->[$j-1]).':'.$j;
12998: } else {
12999: $higher = &escape($parents->[$j]).'::'.$j;
13000: }
13001: push(@{$subcats->{$higher}},$subcat);
13002: }
13003: }
13004: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13005: $subcats);
1.655 raeburn 13006: pop(@{$parents});
13007: }
13008: } else {
13009: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13010: my $trailstr = join(' -> ',(@{$parents},$category));
13011: if ($allitems->{$item} eq '') {
13012: push(@{$trails},$trailstr);
13013: $allitems->{$item} = scalar(@{$trails})-1;
13014: }
13015: }
13016: return;
13017: }
13018:
1.663 raeburn 13019: =pod
13020:
13021: =item *&assign_categories_table()
13022:
13023: Create a datatable for display of hierarchical categories in a domain,
13024: with checkboxes to allow a course to be categorized.
13025:
13026: Inputs:
13027:
13028: cathash - reference to hash of categories defined for the domain (from
13029: configuration.db)
13030:
13031: currcat - scalar with an & separated list of categories assigned to a course.
13032:
1.919 raeburn 13033: type - scalar contains course type (Course or Community).
13034:
1.663 raeburn 13035: Returns: $output (markup to be displayed)
13036:
13037: =cut
13038:
13039: sub assign_categories_table {
1.919 raeburn 13040: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13041: my $output;
13042: if (ref($cathash) eq 'HASH') {
13043: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13044: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13045: $maxdepth = scalar(@cats);
13046: if (@cats > 0) {
13047: my $itemcount = 0;
13048: if (ref($cats[0]) eq 'ARRAY') {
13049: my @currcategories;
13050: if ($currcat ne '') {
13051: @currcategories = split('&',$currcat);
13052: }
1.919 raeburn 13053: my $table;
1.663 raeburn 13054: for (my $i=0; $i<@{$cats[0]}; $i++) {
13055: my $parent = $cats[0][$i];
1.919 raeburn 13056: next if ($parent eq 'instcode');
13057: if ($type eq 'Community') {
13058: next unless ($parent eq 'communities');
13059: } else {
13060: next if ($parent eq 'communities');
13061: }
1.663 raeburn 13062: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13063: my $item = &escape($parent).'::0';
13064: my $checked = '';
13065: if (@currcategories > 0) {
13066: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13067: $checked = ' checked="checked"';
1.663 raeburn 13068: }
13069: }
1.919 raeburn 13070: my $parent_title = $parent;
13071: if ($parent eq 'communities') {
13072: $parent_title = &mt('Communities');
13073: }
13074: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13075: '<input type="checkbox" name="usecategory" value="'.
13076: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13077: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13078: my $depth = 1;
13079: push(@path,$parent);
1.919 raeburn 13080: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13081: pop(@path);
1.919 raeburn 13082: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13083: $itemcount ++;
13084: }
1.919 raeburn 13085: if ($itemcount) {
13086: $output = &Apache::loncommon::start_data_table().
13087: $table.
13088: &Apache::loncommon::end_data_table();
13089: }
1.663 raeburn 13090: }
13091: }
13092: }
13093: return $output;
13094: }
13095:
13096: =pod
13097:
13098: =item *&assign_category_rows()
13099:
13100: Create a datatable row for display of nested categories in a domain,
13101: with checkboxes to allow a course to be categorized,called recursively.
13102:
13103: Inputs:
13104:
13105: itemcount - track row number for alternating colors
13106:
13107: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13108: categories and subcategories.
13109:
13110: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13111:
13112: parent - parent of current category item
13113:
13114: path - Array containing all categories back up through the hierarchy from the
13115: current category to the top level.
13116:
13117: currcategories - reference to array of current categories assigned to the course
13118:
13119: Returns: $output (markup to be displayed).
13120:
13121: =cut
13122:
13123: sub assign_category_rows {
13124: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13125: my ($text,$name,$item,$chgstr);
13126: if (ref($cats) eq 'ARRAY') {
13127: my $maxdepth = scalar(@{$cats});
13128: if (ref($cats->[$depth]) eq 'HASH') {
13129: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13130: my $numchildren = @{$cats->[$depth]{$parent}};
13131: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13132: $text .= '<td><table class="LC_datatable">';
13133: for (my $j=0; $j<$numchildren; $j++) {
13134: $name = $cats->[$depth]{$parent}[$j];
13135: $item = &escape($name).':'.&escape($parent).':'.$depth;
13136: my $deeper = $depth+1;
13137: my $checked = '';
13138: if (ref($currcategories) eq 'ARRAY') {
13139: if (@{$currcategories} > 0) {
13140: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13141: $checked = ' checked="checked"';
1.663 raeburn 13142: }
13143: }
13144: }
1.664 raeburn 13145: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13146: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13147: $item.'"'.$checked.' />'.$name.'</label></span>'.
13148: '<input type="hidden" name="catname" value="'.$name.'" />'.
13149: '</td><td>';
1.663 raeburn 13150: if (ref($path) eq 'ARRAY') {
13151: push(@{$path},$name);
13152: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13153: pop(@{$path});
13154: }
13155: $text .= '</td></tr>';
13156: }
13157: $text .= '</table></td>';
13158: }
13159: }
13160: }
13161: return $text;
13162: }
13163:
1.655 raeburn 13164: ############################################################
13165: ############################################################
13166:
13167:
1.443 albertel 13168: sub commit_customrole {
1.664 raeburn 13169: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13170: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13171: ($start?', '.&mt('starting').' '.localtime($start):'').
13172: ($end?', ending '.localtime($end):'').': <b>'.
13173: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13174: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13175: '</b><br />';
13176: return $output;
13177: }
13178:
13179: sub commit_standardrole {
1.1075.2.31! raeburn 13180: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13181: my ($output,$logmsg,$linefeed);
13182: if ($context eq 'auto') {
13183: $linefeed = "\n";
13184: } else {
13185: $linefeed = "<br />\n";
13186: }
1.443 albertel 13187: if ($three eq 'st') {
1.541 raeburn 13188: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31! raeburn 13189: $one,$two,$sec,$context,$credits);
1.541 raeburn 13190: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13191: ($result eq 'unknown_course') || ($result eq 'refused')) {
13192: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13193: } else {
1.541 raeburn 13194: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13195: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13196: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13197: if ($context eq 'auto') {
13198: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13199: } else {
13200: $output .= '<b>'.$result.'</b>'.$linefeed.
13201: &mt('Add to classlist').': <b>ok</b>';
13202: }
13203: $output .= $linefeed;
1.443 albertel 13204: }
13205: } else {
13206: $output = &mt('Assigning').' '.$three.' in '.$url.
13207: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13208: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13209: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13210: if ($context eq 'auto') {
13211: $output .= $result.$linefeed;
13212: } else {
13213: $output .= '<b>'.$result.'</b>'.$linefeed;
13214: }
1.443 albertel 13215: }
13216: return $output;
13217: }
13218:
13219: sub commit_studentrole {
1.1075.2.31! raeburn 13220: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
! 13221: $credits) = @_;
1.626 raeburn 13222: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13223: if ($context eq 'auto') {
13224: $linefeed = "\n";
13225: } else {
13226: $linefeed = '<br />'."\n";
13227: }
1.443 albertel 13228: if (defined($one) && defined($two)) {
13229: my $cid=$one.'_'.$two;
13230: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13231: my $secchange = 0;
13232: my $expire_role_result;
13233: my $modify_section_result;
1.628 raeburn 13234: if ($oldsec ne '-1') {
13235: if ($oldsec ne $sec) {
1.443 albertel 13236: $secchange = 1;
1.628 raeburn 13237: my $now = time;
1.443 albertel 13238: my $uurl='/'.$cid;
13239: $uurl=~s/\_/\//g;
13240: if ($oldsec) {
13241: $uurl.='/'.$oldsec;
13242: }
1.626 raeburn 13243: $oldsecurl = $uurl;
1.628 raeburn 13244: $expire_role_result =
1.652 raeburn 13245: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13246: if ($env{'request.course.sec'} ne '') {
13247: if ($expire_role_result eq 'refused') {
13248: my @roles = ('st');
13249: my @statuses = ('previous');
13250: my @roledoms = ($one);
13251: my $withsec = 1;
13252: my %roleshash =
13253: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13254: \@statuses,\@roles,\@roledoms,$withsec);
13255: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13256: my ($oldstart,$oldend) =
13257: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13258: if ($oldend > 0 && $oldend <= $now) {
13259: $expire_role_result = 'ok';
13260: }
13261: }
13262: }
13263: }
1.443 albertel 13264: $result = $expire_role_result;
13265: }
13266: }
13267: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31! raeburn 13268: $modify_section_result =
! 13269: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
! 13270: undef,undef,undef,$sec,
! 13271: $end,$start,'','',$cid,
! 13272: '',$context,$credits);
1.443 albertel 13273: if ($modify_section_result =~ /^ok/) {
13274: if ($secchange == 1) {
1.628 raeburn 13275: if ($sec eq '') {
13276: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13277: } else {
13278: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13279: }
1.443 albertel 13280: } elsif ($oldsec eq '-1') {
1.628 raeburn 13281: if ($sec eq '') {
13282: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13283: } else {
13284: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13285: }
1.443 albertel 13286: } else {
1.628 raeburn 13287: if ($sec eq '') {
13288: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13289: } else {
13290: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13291: }
1.443 albertel 13292: }
13293: } else {
1.628 raeburn 13294: if ($secchange) {
13295: $$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;
13296: } else {
13297: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13298: }
1.443 albertel 13299: }
13300: $result = $modify_section_result;
13301: } elsif ($secchange == 1) {
1.628 raeburn 13302: if ($oldsec eq '') {
1.1075.2.20 raeburn 13303: $$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 13304: } else {
13305: $$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;
13306: }
1.626 raeburn 13307: if ($expire_role_result eq 'refused') {
13308: my $newsecurl = '/'.$cid;
13309: $newsecurl =~ s/\_/\//g;
13310: if ($sec ne '') {
13311: $newsecurl.='/'.$sec;
13312: }
13313: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13314: if ($sec eq '') {
13315: $$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;
13316: } else {
13317: $$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;
13318: }
13319: }
13320: }
1.443 albertel 13321: }
13322: } else {
1.626 raeburn 13323: $$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 13324: $result = "error: incomplete course id\n";
13325: }
13326: return $result;
13327: }
13328:
1.1075.2.25 raeburn 13329: sub show_role_extent {
13330: my ($scope,$context,$role) = @_;
13331: $scope =~ s{^/}{};
13332: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13333: push(@courseroles,'co');
13334: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13335: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13336: $scope =~ s{/}{_};
13337: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13338: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13339: my ($audom,$auname) = split(/\//,$scope);
13340: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13341: &Apache::loncommon::plainname($auname,$audom).'</span>');
13342: } else {
13343: $scope =~ s{/$}{};
13344: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13345: &Apache::lonnet::domain($scope,'description').'</span>');
13346: }
13347: }
13348:
1.443 albertel 13349: ############################################################
13350: ############################################################
13351:
1.566 albertel 13352: sub check_clone {
1.578 raeburn 13353: my ($args,$linefeed) = @_;
1.566 albertel 13354: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13355: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13356: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13357: my $clonemsg;
13358: my $can_clone = 0;
1.944 raeburn 13359: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13360: if ($lctype ne 'community') {
13361: $lctype = 'course';
13362: }
1.566 albertel 13363: if ($clonehome eq 'no_host') {
1.944 raeburn 13364: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13365: $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'});
13366: } else {
13367: $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'});
13368: }
1.566 albertel 13369: } else {
13370: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13371: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13372: if ($clonedesc{'type'} ne 'Community') {
13373: $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'});
13374: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13375: }
13376: }
1.882 raeburn 13377: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13378: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13379: $can_clone = 1;
13380: } else {
13381: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13382: $args->{'clonedomain'},$args->{'clonecourse'});
13383: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 13384: if (grep(/^\*$/,@cloners)) {
13385: $can_clone = 1;
13386: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
13387: $can_clone = 1;
13388: } else {
1.908 raeburn 13389: my $ccrole = 'cc';
1.944 raeburn 13390: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13391: $ccrole = 'co';
13392: }
1.578 raeburn 13393: my %roleshash =
13394: &Apache::lonnet::get_my_roles($args->{'ccuname'},
13395: $args->{'ccdomain'},
1.908 raeburn 13396: 'userroles',['active'],[$ccrole],
1.578 raeburn 13397: [$args->{'clonedomain'}]);
1.908 raeburn 13398: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 13399: $can_clone = 1;
13400: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
13401: $can_clone = 1;
13402: } else {
1.944 raeburn 13403: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13404: $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'});
13405: } else {
13406: $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'});
13407: }
1.578 raeburn 13408: }
1.566 albertel 13409: }
1.578 raeburn 13410: }
1.566 albertel 13411: }
13412: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13413: }
13414:
1.444 albertel 13415: sub construct_course {
1.885 raeburn 13416: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 13417: my $outcome;
1.541 raeburn 13418: my $linefeed = '<br />'."\n";
13419: if ($context eq 'auto') {
13420: $linefeed = "\n";
13421: }
1.566 albertel 13422:
13423: #
13424: # Are we cloning?
13425: #
13426: my ($can_clone, $clonemsg, $cloneid, $clonehome);
13427: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 13428: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 13429: if ($context ne 'auto') {
1.578 raeburn 13430: if ($clonemsg ne '') {
13431: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
13432: }
1.566 albertel 13433: }
13434: $outcome .= $clonemsg.$linefeed;
13435:
13436: if (!$can_clone) {
13437: return (0,$outcome);
13438: }
13439: }
13440:
1.444 albertel 13441: #
13442: # Open course
13443: #
13444: my $crstype = lc($args->{'crstype'});
13445: my %cenv=();
13446: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
13447: $args->{'cdescr'},
13448: $args->{'curl'},
13449: $args->{'course_home'},
13450: $args->{'nonstandard'},
13451: $args->{'crscode'},
13452: $args->{'ccuname'}.':'.
13453: $args->{'ccdomain'},
1.882 raeburn 13454: $args->{'crstype'},
1.885 raeburn 13455: $cnum,$context,$category);
1.444 albertel 13456:
13457: # Note: The testing routines depend on this being output; see
13458: # Utils::Course. This needs to at least be output as a comment
13459: # if anyone ever decides to not show this, and Utils::Course::new
13460: # will need to be suitably modified.
1.541 raeburn 13461: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 13462: if ($$courseid =~ /^error:/) {
13463: return (0,$outcome);
13464: }
13465:
1.444 albertel 13466: #
13467: # Check if created correctly
13468: #
1.479 albertel 13469: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 13470: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 13471: if ($crsuhome eq 'no_host') {
13472: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
13473: return (0,$outcome);
13474: }
1.541 raeburn 13475: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 13476:
1.444 albertel 13477: #
1.566 albertel 13478: # Do the cloning
13479: #
13480: if ($can_clone && $cloneid) {
13481: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
13482: if ($context ne 'auto') {
13483: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
13484: }
13485: $outcome .= $clonemsg.$linefeed;
13486: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 13487: # Copy all files
1.637 www 13488: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 13489: # Restore URL
1.566 albertel 13490: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 13491: # Restore title
1.566 albertel 13492: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 13493: # Restore creation date, creator and creation context.
13494: $cenv{'internal.created'}=$oldcenv{'internal.created'};
13495: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
13496: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 13497: # Mark as cloned
1.566 albertel 13498: $cenv{'clonedfrom'}=$cloneid;
1.638 www 13499: # Need to clone grading mode
13500: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
13501: $cenv{'grading'}=$newenv{'grading'};
13502: # Do not clone these environment entries
13503: &Apache::lonnet::del('environment',
13504: ['default_enrollment_start_date',
13505: 'default_enrollment_end_date',
13506: 'question.email',
13507: 'policy.email',
13508: 'comment.email',
13509: 'pch.users.denied',
1.725 raeburn 13510: 'plc.users.denied',
13511: 'hidefromcat',
13512: 'categories'],
1.638 www 13513: $$crsudom,$$crsunum);
1.444 albertel 13514: }
1.566 albertel 13515:
1.444 albertel 13516: #
13517: # Set environment (will override cloned, if existing)
13518: #
13519: my @sections = ();
13520: my @xlists = ();
13521: if ($args->{'crstype'}) {
13522: $cenv{'type'}=$args->{'crstype'};
13523: }
13524: if ($args->{'crsid'}) {
13525: $cenv{'courseid'}=$args->{'crsid'};
13526: }
13527: if ($args->{'crscode'}) {
13528: $cenv{'internal.coursecode'}=$args->{'crscode'};
13529: }
13530: if ($args->{'crsquota'} ne '') {
13531: $cenv{'internal.coursequota'}=$args->{'crsquota'};
13532: } else {
13533: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
13534: }
13535: if ($args->{'ccuname'}) {
13536: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
13537: ':'.$args->{'ccdomain'};
13538: } else {
13539: $cenv{'internal.courseowner'} = $args->{'curruser'};
13540: }
1.1075.2.31! raeburn 13541: if ($args->{'defaultcredits'}) {
! 13542: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
! 13543: }
1.444 albertel 13544: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
13545: if ($args->{'crssections'}) {
13546: $cenv{'internal.sectionnums'} = '';
13547: if ($args->{'crssections'} =~ m/,/) {
13548: @sections = split/,/,$args->{'crssections'};
13549: } else {
13550: $sections[0] = $args->{'crssections'};
13551: }
13552: if (@sections > 0) {
13553: foreach my $item (@sections) {
13554: my ($sec,$gp) = split/:/,$item;
13555: my $class = $args->{'crscode'}.$sec;
13556: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
13557: $cenv{'internal.sectionnums'} .= $item.',';
13558: unless ($addcheck eq 'ok') {
13559: push @badclasses, $class;
13560: }
13561: }
13562: $cenv{'internal.sectionnums'} =~ s/,$//;
13563: }
13564: }
13565: # do not hide course coordinator from staff listing,
13566: # even if privileged
13567: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13568: # add crosslistings
13569: if ($args->{'crsxlist'}) {
13570: $cenv{'internal.crosslistings'}='';
13571: if ($args->{'crsxlist'} =~ m/,/) {
13572: @xlists = split/,/,$args->{'crsxlist'};
13573: } else {
13574: $xlists[0] = $args->{'crsxlist'};
13575: }
13576: if (@xlists > 0) {
13577: foreach my $item (@xlists) {
13578: my ($xl,$gp) = split/:/,$item;
13579: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
13580: $cenv{'internal.crosslistings'} .= $item.',';
13581: unless ($addcheck eq 'ok') {
13582: push @badclasses, $xl;
13583: }
13584: }
13585: $cenv{'internal.crosslistings'} =~ s/,$//;
13586: }
13587: }
13588: if ($args->{'autoadds'}) {
13589: $cenv{'internal.autoadds'}=$args->{'autoadds'};
13590: }
13591: if ($args->{'autodrops'}) {
13592: $cenv{'internal.autodrops'}=$args->{'autodrops'};
13593: }
13594: # check for notification of enrollment changes
13595: my @notified = ();
13596: if ($args->{'notify_owner'}) {
13597: if ($args->{'ccuname'} ne '') {
13598: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
13599: }
13600: }
13601: if ($args->{'notify_dc'}) {
13602: if ($uname ne '') {
1.630 raeburn 13603: push(@notified,$uname.':'.$udom);
1.444 albertel 13604: }
13605: }
13606: if (@notified > 0) {
13607: my $notifylist;
13608: if (@notified > 1) {
13609: $notifylist = join(',',@notified);
13610: } else {
13611: $notifylist = $notified[0];
13612: }
13613: $cenv{'internal.notifylist'} = $notifylist;
13614: }
13615: if (@badclasses > 0) {
13616: my %lt=&Apache::lonlocal::texthash(
13617: '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',
13618: 'dnhr' => 'does not have rights to access enrollment in these classes',
13619: 'adby' => 'as determined by the policies of your institution on access to official classlists'
13620: );
1.541 raeburn 13621: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
13622: ' ('.$lt{'adby'}.')';
13623: if ($context eq 'auto') {
13624: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 13625: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 13626: foreach my $item (@badclasses) {
13627: if ($context eq 'auto') {
13628: $outcome .= " - $item\n";
13629: } else {
13630: $outcome .= "<li>$item</li>\n";
13631: }
13632: }
13633: if ($context eq 'auto') {
13634: $outcome .= $linefeed;
13635: } else {
1.566 albertel 13636: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 13637: }
13638: }
1.444 albertel 13639: }
13640: if ($args->{'no_end_date'}) {
13641: $args->{'endaccess'} = 0;
13642: }
13643: $cenv{'internal.autostart'}=$args->{'enrollstart'};
13644: $cenv{'internal.autoend'}=$args->{'enrollend'};
13645: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
13646: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
13647: if ($args->{'showphotos'}) {
13648: $cenv{'internal.showphotos'}=$args->{'showphotos'};
13649: }
13650: $cenv{'internal.authtype'} = $args->{'authtype'};
13651: $cenv{'internal.autharg'} = $args->{'autharg'};
13652: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
13653: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 13654: 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');
13655: if ($context eq 'auto') {
13656: $outcome .= $krb_msg;
13657: } else {
1.566 albertel 13658: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 13659: }
13660: $outcome .= $linefeed;
1.444 albertel 13661: }
13662: }
13663: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
13664: if ($args->{'setpolicy'}) {
13665: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13666: }
13667: if ($args->{'setcontent'}) {
13668: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13669: }
13670: }
13671: if ($args->{'reshome'}) {
13672: $cenv{'reshome'}=$args->{'reshome'}.'/';
13673: $cenv{'reshome'}=~s/\/+$/\//;
13674: }
13675: #
13676: # course has keyed access
13677: #
13678: if ($args->{'setkeys'}) {
13679: $cenv{'keyaccess'}='yes';
13680: }
13681: # if specified, key authority is not course, but user
13682: # only active if keyaccess is yes
13683: if ($args->{'keyauth'}) {
1.487 albertel 13684: my ($user,$domain) = split(':',$args->{'keyauth'});
13685: $user = &LONCAPA::clean_username($user);
13686: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 13687: if ($user ne '' && $domain ne '') {
1.487 albertel 13688: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 13689: }
13690: }
13691:
13692: if ($args->{'disresdis'}) {
13693: $cenv{'pch.roles.denied'}='st';
13694: }
13695: if ($args->{'disablechat'}) {
13696: $cenv{'plc.roles.denied'}='st';
13697: }
13698:
13699: # Record we've not yet viewed the Course Initialization Helper for this
13700: # course
13701: $cenv{'course.helper.not.run'} = 1;
13702: #
13703: # Use new Randomseed
13704: #
13705: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
13706: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
13707: #
13708: # The encryption code and receipt prefix for this course
13709: #
13710: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
13711: $cenv{'internal.encpref'}=100+int(9*rand(99));
13712: #
13713: # By default, use standard grading
13714: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
13715:
1.541 raeburn 13716: $outcome .= $linefeed.&mt('Setting environment').': '.
13717: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13718: #
13719: # Open all assignments
13720: #
13721: if ($args->{'openall'}) {
13722: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
13723: my %storecontent = ($storeunder => time,
13724: $storeunder.'.type' => 'date_start');
13725:
13726: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 13727: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13728: }
13729: #
13730: # Set first page
13731: #
13732: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
13733: || ($cloneid)) {
1.445 albertel 13734: use LONCAPA::map;
1.444 albertel 13735: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 13736:
13737: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
13738: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
13739:
1.444 albertel 13740: $outcome .= ($fatal?$errtext:'read ok').' - ';
13741: my $title; my $url;
13742: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 13743: $title=&mt('Syllabus');
1.444 albertel 13744: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
13745: } else {
1.963 raeburn 13746: $title=&mt('Table of Contents');
1.444 albertel 13747: $url='/adm/navmaps';
13748: }
1.445 albertel 13749:
13750: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
13751: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
13752:
13753: if ($errtext) { $fatal=2; }
1.541 raeburn 13754: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 13755: }
1.566 albertel 13756:
13757: return (1,$outcome);
1.444 albertel 13758: }
13759:
13760: ############################################################
13761: ############################################################
13762:
1.953 droeschl 13763: #SD
13764: # only Community and Course, or anything else?
1.378 raeburn 13765: sub course_type {
13766: my ($cid) = @_;
13767: if (!defined($cid)) {
13768: $cid = $env{'request.course.id'};
13769: }
1.404 albertel 13770: if (defined($env{'course.'.$cid.'.type'})) {
13771: return $env{'course.'.$cid.'.type'};
1.378 raeburn 13772: } else {
13773: return 'Course';
1.377 raeburn 13774: }
13775: }
1.156 albertel 13776:
1.406 raeburn 13777: sub group_term {
13778: my $crstype = &course_type();
13779: my %names = (
13780: 'Course' => 'group',
1.865 raeburn 13781: 'Community' => 'group',
1.406 raeburn 13782: );
13783: return $names{$crstype};
13784: }
13785:
1.902 raeburn 13786: sub course_types {
13787: my @types = ('official','unofficial','community');
13788: my %typename = (
13789: official => 'Official course',
13790: unofficial => 'Unofficial course',
13791: community => 'Community',
13792: );
13793: return (\@types,\%typename);
13794: }
13795:
1.156 albertel 13796: sub icon {
13797: my ($file)=@_;
1.505 albertel 13798: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 13799: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 13800: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 13801: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
13802: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
13803: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13804: $curfext.".gif") {
13805: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13806: $curfext.".gif";
13807: }
13808: }
1.249 albertel 13809: return &lonhttpdurl($iconname);
1.154 albertel 13810: }
1.84 albertel 13811:
1.575 albertel 13812: sub lonhttpdurl {
1.692 www 13813: #
13814: # Had been used for "small fry" static images on separate port 8080.
13815: # Modify here if lightweight http functionality desired again.
13816: # Currently eliminated due to increasing firewall issues.
13817: #
1.575 albertel 13818: my ($url)=@_;
1.692 www 13819: return $url;
1.215 albertel 13820: }
13821:
1.213 albertel 13822: sub connection_aborted {
13823: my ($r)=@_;
13824: $r->print(" ");$r->rflush();
13825: my $c = $r->connection;
13826: return $c->aborted();
13827: }
13828:
1.221 foxr 13829: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 13830: # strings as 'strings'.
13831: sub escape_single {
1.221 foxr 13832: my ($input) = @_;
1.223 albertel 13833: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 13834: $input =~ s/\'/\\\'/g; # Esacpe the 's....
13835: return $input;
13836: }
1.223 albertel 13837:
1.222 foxr 13838: # Same as escape_single, but escape's "'s This
13839: # can be used for "strings"
13840: sub escape_double {
13841: my ($input) = @_;
13842: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
13843: $input =~ s/\"/\\\"/g; # Esacpe the "s....
13844: return $input;
13845: }
1.223 albertel 13846:
1.222 foxr 13847: # Escapes the last element of a full URL.
13848: sub escape_url {
13849: my ($url) = @_;
1.238 raeburn 13850: my @urlslices = split(/\//, $url,-1);
1.369 www 13851: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 13852: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 13853: }
1.462 albertel 13854:
1.820 raeburn 13855: sub compare_arrays {
13856: my ($arrayref1,$arrayref2) = @_;
13857: my (@difference,%count);
13858: @difference = ();
13859: %count = ();
13860: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
13861: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
13862: foreach my $element (keys(%count)) {
13863: if ($count{$element} == 1) {
13864: push(@difference,$element);
13865: }
13866: }
13867: }
13868: return @difference;
13869: }
13870:
1.817 bisitz 13871: # -------------------------------------------------------- Initialize user login
1.462 albertel 13872: sub init_user_environment {
1.463 albertel 13873: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 13874: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
13875:
13876: my $public=($username eq 'public' && $domain eq 'public');
13877:
13878: # See if old ID present, if so, remove
13879:
1.1062 raeburn 13880: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 13881: my $now=time;
13882:
13883: if ($public) {
13884: my $max_public=100;
13885: my $oldest;
13886: my $oldest_time=0;
13887: for(my $next=1;$next<=$max_public;$next++) {
13888: if (-e $lonids."/publicuser_$next.id") {
13889: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
13890: if ($mtime<$oldest_time || !$oldest_time) {
13891: $oldest_time=$mtime;
13892: $oldest=$next;
13893: }
13894: } else {
13895: $cookie="publicuser_$next";
13896: last;
13897: }
13898: }
13899: if (!$cookie) { $cookie="publicuser_$oldest"; }
13900: } else {
1.463 albertel 13901: # if this isn't a robot, kill any existing non-robot sessions
13902: if (!$args->{'robot'}) {
13903: opendir(DIR,$lonids);
13904: while ($filename=readdir(DIR)) {
13905: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
13906: unlink($lonids.'/'.$filename);
13907: }
1.462 albertel 13908: }
1.463 albertel 13909: closedir(DIR);
1.462 albertel 13910: }
13911: # Give them a new cookie
1.463 albertel 13912: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 13913: : $now.$$.int(rand(10000)));
1.463 albertel 13914: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 13915:
13916: # Initialize roles
13917:
1.1062 raeburn 13918: ($userroles,$firstaccenv,$timerintenv) =
13919: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 13920: }
13921: # ------------------------------------ Check browser type and MathML capability
13922:
13923: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
13924: $clientunicode,$clientos) = &decode_user_agent($r);
13925:
13926: # ------------------------------------------------------------- Get environment
13927:
13928: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
13929: my ($tmp) = keys(%userenv);
13930: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
13931: } else {
13932: undef(%userenv);
13933: }
13934: if (($userenv{'interface'}) && (!$form->{'interface'})) {
13935: $form->{'interface'}=$userenv{'interface'};
13936: }
13937: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
13938:
13939: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 13940: foreach my $option ('interface','localpath','localres') {
13941: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 13942: }
13943: # --------------------------------------------------------- Write first profile
13944:
13945: {
13946: my %initial_env =
13947: ("user.name" => $username,
13948: "user.domain" => $domain,
13949: "user.home" => $authhost,
13950: "browser.type" => $clientbrowser,
13951: "browser.version" => $clientversion,
13952: "browser.mathml" => $clientmathml,
13953: "browser.unicode" => $clientunicode,
13954: "browser.os" => $clientos,
13955: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
13956: "request.course.fn" => '',
13957: "request.course.uri" => '',
13958: "request.course.sec" => '',
13959: "request.role" => 'cm',
13960: "request.role.adv" => $env{'user.adv'},
13961: "request.host" => $ENV{'REMOTE_ADDR'},);
13962:
13963: if ($form->{'localpath'}) {
13964: $initial_env{"browser.localpath"} = $form->{'localpath'};
13965: $initial_env{"browser.localres"} = $form->{'localres'};
13966: }
13967:
13968: if ($form->{'interface'}) {
13969: $form->{'interface'}=~s/\W//gs;
13970: $initial_env{"browser.interface"} = $form->{'interface'};
13971: $env{'browser.interface'}=$form->{'interface'};
13972: }
13973:
1.981 raeburn 13974: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 13975: my %domdef;
13976: unless ($domain eq 'public') {
13977: %domdef = &Apache::lonnet::get_domain_defaults($domain);
13978: }
1.980 raeburn 13979:
1.1075.2.7 raeburn 13980: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 13981: $userenv{'availabletools.'.$tool} =
1.980 raeburn 13982: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
13983: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 13984: }
13985:
1.864 raeburn 13986: foreach my $crstype ('official','unofficial','community') {
1.765 raeburn 13987: $userenv{'canrequest.'.$crstype} =
13988: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 13989: 'reload','requestcourses',
13990: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 13991: }
13992:
1.1075.2.14 raeburn 13993: $userenv{'canrequest.author'} =
13994: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
13995: 'reload','requestauthor',
13996: \%userenv,\%domdef,\%is_adv);
13997: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
13998: $domain,$username);
13999: my $reqstatus = $reqauthor{'author_status'};
14000: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14001: if (ref($reqauthor{'author'}) eq 'HASH') {
14002: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14003: $reqauthor{'author'}{'timestamp'};
14004: }
14005: }
14006:
1.462 albertel 14007: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14008:
1.462 albertel 14009: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14010: &GDBM_WRCREAT(),0640)) {
14011: &_add_to_env(\%disk_env,\%initial_env);
14012: &_add_to_env(\%disk_env,\%userenv,'environment.');
14013: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14014: if (ref($firstaccenv) eq 'HASH') {
14015: &_add_to_env(\%disk_env,$firstaccenv);
14016: }
14017: if (ref($timerintenv) eq 'HASH') {
14018: &_add_to_env(\%disk_env,$timerintenv);
14019: }
1.463 albertel 14020: if (ref($args->{'extra_env'})) {
14021: &_add_to_env(\%disk_env,$args->{'extra_env'});
14022: }
1.462 albertel 14023: untie(%disk_env);
14024: } else {
1.705 tempelho 14025: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14026: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14027: return 'error: '.$!;
14028: }
14029: }
14030: $env{'request.role'}='cm';
14031: $env{'request.role.adv'}=$env{'user.adv'};
14032: $env{'browser.type'}=$clientbrowser;
14033:
14034: return $cookie;
14035:
14036: }
14037:
14038: sub _add_to_env {
14039: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14040: if (ref($env_data) eq 'HASH') {
14041: while (my ($key,$value) = each(%$env_data)) {
14042: $idf->{$prefix.$key} = $value;
14043: $env{$prefix.$key} = $value;
14044: }
1.462 albertel 14045: }
14046: }
14047:
1.685 tempelho 14048: # --- Get the symbolic name of a problem and the url
14049: sub get_symb {
14050: my ($request,$silent) = @_;
1.726 raeburn 14051: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14052: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14053: if ($symb eq '') {
14054: if (!$silent) {
1.1071 raeburn 14055: if (ref($request)) {
14056: $request->print("Unable to handle ambiguous references:$url:.");
14057: }
1.685 tempelho 14058: return ();
14059: }
14060: }
14061: &Apache::lonenc::check_decrypt(\$symb);
14062: return ($symb);
14063: }
14064:
14065: # --------------------------------------------------------------Get annotation
14066:
14067: sub get_annotation {
14068: my ($symb,$enc) = @_;
14069:
14070: my $key = $symb;
14071: if (!$enc) {
14072: $key =
14073: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14074: }
14075: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14076: return $annotation{$key};
14077: }
14078:
14079: sub clean_symb {
1.731 raeburn 14080: my ($symb,$delete_enc) = @_;
1.685 tempelho 14081:
14082: &Apache::lonenc::check_decrypt(\$symb);
14083: my $enc = $env{'request.enc'};
1.731 raeburn 14084: if ($delete_enc) {
1.730 raeburn 14085: delete($env{'request.enc'});
14086: }
1.685 tempelho 14087:
14088: return ($symb,$enc);
14089: }
1.462 albertel 14090:
1.990 raeburn 14091: sub build_release_hashes {
14092: my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
14093: return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
14094: (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
14095: (ref($randomizetry) eq 'HASH'));
14096: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14097: my ($item,$name,$value) = split(/:/,$key);
14098: if ($item eq 'parameter') {
14099: if (ref($checkparms->{$name}) eq 'ARRAY') {
14100: unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
14101: push(@{$checkparms->{$name}},$value);
14102: }
14103: } else {
14104: push(@{$checkparms->{$name}},$value);
14105: }
14106: } elsif ($item eq 'resourcetag') {
14107: if ($name eq 'responsetype') {
14108: $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
14109: }
14110: } elsif ($item eq 'course') {
14111: if ($name eq 'crstype') {
14112: $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
14113: }
14114: }
14115: }
14116: ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
14117: ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
14118: return;
14119: }
14120:
1.1075.2.11 raeburn 14121: sub update_content_constraints {
14122: my ($cdom,$cnum,$chome,$cid) = @_;
14123: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
14124: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
14125: my %checkresponsetypes;
14126: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14127: my ($item,$name,$value) = split(/:/,$key);
14128: if ($item eq 'resourcetag') {
14129: if ($name eq 'responsetype') {
14130: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
14131: }
14132: }
14133: }
14134: my $navmap = Apache::lonnavmaps::navmap->new();
14135: if (defined($navmap)) {
14136: my %allresponses;
14137: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
14138: my %responses = $res->responseTypes();
14139: foreach my $key (keys(%responses)) {
14140: next unless(exists($checkresponsetypes{$key}));
14141: $allresponses{$key} += $responses{$key};
14142: }
14143: }
14144: foreach my $key (keys(%allresponses)) {
14145: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
14146: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
14147: ($reqdmajor,$reqdminor) = ($major,$minor);
14148: }
14149: }
14150: undef($navmap);
14151: }
14152: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
14153: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
14154: }
14155: return;
14156: }
14157:
1.1075.2.27 raeburn 14158: sub allmaps_incourse {
14159: my ($cdom,$cnum,$chome,$cid) = @_;
14160: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
14161: $cid = $env{'request.course.id'};
14162: $cdom = $env{'course.'.$cid.'.domain'};
14163: $cnum = $env{'course.'.$cid.'.num'};
14164: $chome = $env{'course.'.$cid.'.home'};
14165: }
14166: my %allmaps = ();
14167: my $lastchange =
14168: &Apache::lonnet::get_coursechange($cdom,$cnum);
14169: if ($lastchange > $env{'request.course.tied'}) {
14170: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
14171: unless ($ferr) {
14172: &update_content_constraints($cdom,$cnum,$chome,$cid);
14173: }
14174: }
14175: my $navmap = Apache::lonnavmaps::navmap->new();
14176: if (defined($navmap)) {
14177: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
14178: $allmaps{$res->src()} = 1;
14179: }
14180: }
14181: return \%allmaps;
14182: }
14183:
1.1075.2.11 raeburn 14184: sub parse_supplemental_title {
14185: my ($title) = @_;
14186:
14187: my ($foldertitle,$renametitle);
14188: if ($title =~ /&&&/) {
14189: $title = &HTML::Entites::decode($title);
14190: }
14191: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
14192: $renametitle=$4;
14193: my ($time,$uname,$udom) = ($1,$2,$3);
14194: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
14195: my $name = &plainname($uname,$udom);
14196: $name = &HTML::Entities::encode($name,'"<>&\'');
14197: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
14198: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
14199: $name.': <br />'.$foldertitle;
14200: }
14201: if (wantarray) {
14202: return ($title,$foldertitle,$renametitle);
14203: }
14204: return $title;
14205: }
14206:
1.1075.2.18 raeburn 14207: sub symb_to_docspath {
14208: my ($symb) = @_;
14209: return unless ($symb);
14210: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
14211: if ($resurl=~/\.(sequence|page)$/) {
14212: $mapurl=$resurl;
14213: } elsif ($resurl eq 'adm/navmaps') {
14214: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
14215: }
14216: my $mapresobj;
14217: my $navmap = Apache::lonnavmaps::navmap->new();
14218: if (ref($navmap)) {
14219: $mapresobj = $navmap->getResourceByUrl($mapurl);
14220: }
14221: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
14222: my $type=$2;
14223: my $path;
14224: if (ref($mapresobj)) {
14225: my $pcslist = $mapresobj->map_hierarchy();
14226: if ($pcslist ne '') {
14227: foreach my $pc (split(/,/,$pcslist)) {
14228: next if ($pc <= 1);
14229: my $res = $navmap->getByMapPc($pc);
14230: if (ref($res)) {
14231: my $thisurl = $res->src();
14232: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
14233: my $thistitle = $res->title();
14234: $path .= '&'.
14235: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
14236: &Apache::lonhtmlcommon::entity_encode($thistitle).
14237: ':'.$res->randompick().
14238: ':'.$res->randomout().
14239: ':'.$res->encrypted().
14240: ':'.$res->randomorder().
14241: ':'.$res->is_page();
14242: }
14243: }
14244: }
14245: $path =~ s/^\&//;
14246: my $maptitle = $mapresobj->title();
14247: if ($mapurl eq 'default') {
14248: $maptitle = 'Main Course Documents';
14249: }
14250: $path .= (($path ne '')? '&' : '').
14251: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
14252: &Apache::lonhtmlcommon::entity_encode($maptitle).
14253: ':'.$mapresobj->randompick().
14254: ':'.$mapresobj->randomout().
14255: ':'.$mapresobj->encrypted().
14256: ':'.$mapresobj->randomorder().
14257: ':'.$mapresobj->is_page();
14258: } else {
14259: my $maptitle = &Apache::lonnet::gettitle($mapurl);
14260: my $ispage = (($type eq 'page')? 1 : '');
14261: if ($mapurl eq 'default') {
14262: $maptitle = 'Main Course Documents';
14263: }
14264: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
14265: &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
14266: }
14267: unless ($mapurl eq 'default') {
14268: $path = 'default&'.
14269: &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
14270: ':::::&'.$path;
14271: }
14272: return $path;
14273: }
14274:
1.1075.2.14 raeburn 14275: sub captcha_display {
14276: my ($context,$lonhost) = @_;
14277: my ($output,$error);
14278: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
14279: if ($captcha eq 'original') {
14280: $output = &create_captcha();
14281: unless ($output) {
14282: $error = 'captcha';
14283: }
14284: } elsif ($captcha eq 'recaptcha') {
14285: $output = &create_recaptcha($pubkey);
14286: unless ($output) {
14287: $error = 'recaptcha';
14288: }
14289: }
14290: return ($output,$error);
14291: }
14292:
14293: sub captcha_response {
14294: my ($context,$lonhost) = @_;
14295: my ($captcha_chk,$captcha_error);
14296: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
14297: if ($captcha eq 'original') {
14298: ($captcha_chk,$captcha_error) = &check_captcha();
14299: } elsif ($captcha eq 'recaptcha') {
14300: $captcha_chk = &check_recaptcha($privkey);
14301: } else {
14302: $captcha_chk = 1;
14303: }
14304: return ($captcha_chk,$captcha_error);
14305: }
14306:
14307: sub get_captcha_config {
14308: my ($context,$lonhost) = @_;
14309: my ($captcha,$pubkey,$privkey,$hashtocheck);
14310: my $hostname = &Apache::lonnet::hostname($lonhost);
14311: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
14312: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
14313: if ($context eq 'usercreation') {
14314: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
14315: if (ref($domconfig{$context}) eq 'HASH') {
14316: $hashtocheck = $domconfig{$context}{'cancreate'};
14317: if (ref($hashtocheck) eq 'HASH') {
14318: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
14319: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
14320: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
14321: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
14322: }
14323: if ($privkey && $pubkey) {
14324: $captcha = 'recaptcha';
14325: } else {
14326: $captcha = 'original';
14327: }
14328: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
14329: $captcha = 'original';
14330: }
14331: }
14332: } else {
14333: $captcha = 'captcha';
14334: }
14335: } elsif ($context eq 'login') {
14336: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
14337: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
14338: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
14339: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
14340: if ($privkey && $pubkey) {
14341: $captcha = 'recaptcha';
14342: } else {
14343: $captcha = 'original';
14344: }
14345: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
14346: $captcha = 'original';
14347: }
14348: }
14349: return ($captcha,$pubkey,$privkey);
14350: }
14351:
14352: sub create_captcha {
14353: my %captcha_params = &captcha_settings();
14354: my ($output,$maxtries,$tries) = ('',10,0);
14355: while ($tries < $maxtries) {
14356: $tries ++;
14357: my $captcha = Authen::Captcha->new (
14358: output_folder => $captcha_params{'output_dir'},
14359: data_folder => $captcha_params{'db_dir'},
14360: );
14361: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
14362:
14363: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
14364: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
14365: &mt('Type in the letters/numbers shown below').' '.
14366: '<input type="text" size="5" name="code" value="" /><br />'.
14367: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
14368: last;
14369: }
14370: }
14371: return $output;
14372: }
14373:
14374: sub captcha_settings {
14375: my %captcha_params = (
14376: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
14377: www_output_dir => "/captchaspool",
14378: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
14379: numchars => '5',
14380: );
14381: return %captcha_params;
14382: }
14383:
14384: sub check_captcha {
14385: my ($captcha_chk,$captcha_error);
14386: my $code = $env{'form.code'};
14387: my $md5sum = $env{'form.crypt'};
14388: my %captcha_params = &captcha_settings();
14389: my $captcha = Authen::Captcha->new(
14390: output_folder => $captcha_params{'output_dir'},
14391: data_folder => $captcha_params{'db_dir'},
14392: );
1.1075.2.26 raeburn 14393: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 14394: my %captcha_hash = (
14395: 0 => 'Code not checked (file error)',
14396: -1 => 'Failed: code expired',
14397: -2 => 'Failed: invalid code (not in database)',
14398: -3 => 'Failed: invalid code (code does not match crypt)',
14399: );
14400: if ($captcha_chk != 1) {
14401: $captcha_error = $captcha_hash{$captcha_chk}
14402: }
14403: return ($captcha_chk,$captcha_error);
14404: }
14405:
14406: sub create_recaptcha {
14407: my ($pubkey) = @_;
14408: my $captcha = Captcha::reCAPTCHA->new;
14409: return $captcha->get_options_setter({theme => 'white'})."\n".
14410: $captcha->get_html($pubkey).
14411: &mt('If either word is hard to read, [_1] will replace them.',
14412: '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
14413: '<br /><br />';
14414: }
14415:
14416: sub check_recaptcha {
14417: my ($privkey) = @_;
14418: my $captcha_chk;
14419: my $captcha = Captcha::reCAPTCHA->new;
14420: my $captcha_result =
14421: $captcha->check_answer(
14422: $privkey,
14423: $ENV{'REMOTE_ADDR'},
14424: $env{'form.recaptcha_challenge_field'},
14425: $env{'form.recaptcha_response_field'},
14426: );
14427: if ($captcha_result->{is_valid}) {
14428: $captcha_chk = 1;
14429: }
14430: return $captcha_chk;
14431: }
14432:
1.41 ng 14433: =pod
14434:
14435: =back
14436:
1.112 bowersj2 14437: =cut
1.41 ng 14438:
1.112 bowersj2 14439: 1;
14440: __END__;
1.41 ng 14441:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface