Annotation of loncom/interface/loncommon.pm, revision 1.1090
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1090 ! foxr 4: # $Id: loncommon.pm,v 1.1089 2012/08/07 09:25:39 foxr 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.479 albertel 70: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 71: use DateTime::TimeZone;
1.687 raeburn 72: use DateTime::Locale::Catalog;
1.117 www 73:
1.517 raeburn 74: # ---------------------------------------------- Designs
75: use vars qw(%defaultdesign);
76:
1.22 www 77: my $readit;
78:
1.517 raeburn 79:
1.157 matthew 80: ##
81: ## Global Variables
82: ##
1.46 matthew 83:
1.643 foxr 84:
85: # ----------------------------------------------- SSI with retries:
86: #
87:
88: =pod
89:
1.648 raeburn 90: =head1 Server Side include with retries:
1.643 foxr 91:
92: =over 4
93:
1.648 raeburn 94: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 95:
96: Performs an ssi with some number of retries. Retries continue either
97: until the result is ok or until the retry count supplied by the
98: caller is exhausted.
99:
100: Inputs:
1.648 raeburn 101:
102: =over 4
103:
1.643 foxr 104: resource - Identifies the resource to insert.
1.648 raeburn 105:
1.643 foxr 106: retries - Count of the number of retries allowed.
1.648 raeburn 107:
1.643 foxr 108: form - Hash that identifies the rendering options.
109:
1.648 raeburn 110: =back
111:
112: Returns:
113:
114: =over 4
115:
1.643 foxr 116: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 117:
1.643 foxr 118: response - The response from the last attempt (which may or may not have been successful.
119:
1.648 raeburn 120: =back
121:
122: =back
123:
1.643 foxr 124: =cut
125:
126: sub ssi_with_retries {
127: my ($resource, $retries, %form) = @_;
128:
129:
130: my $ok = 0; # True if we got a good response.
131: my $content;
132: my $response;
133:
134: # Try to get the ssi done. within the retries count:
135:
136: do {
137: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
138: $ok = $response->is_success;
1.650 www 139: if (!$ok) {
140: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
141: }
1.643 foxr 142: $retries--;
143: } while (!$ok && ($retries > 0));
144:
145: if (!$ok) {
146: $content = ''; # On error return an empty content.
147: }
148: return ($content, $response);
149:
150: }
151:
152:
153:
1.20 www 154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 155: my %language;
1.124 www 156: my %supported_language;
1.1088 foxr 157: my %supported_codes;
1.1048 foxr 158: my %latex_language; # For choosing hyphenation in <transl..>
159: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 160: my %cprtag;
1.192 taceyjo1 161: my %scprtag;
1.351 www 162: my %fe; my %fd; my %fm;
1.41 ng 163: my %category_extensions;
1.12 harris41 164:
1.46 matthew 165: # ---------------------------------------------- Thesaurus variables
1.144 matthew 166: #
167: # %Keywords:
168: # A hash used by &keyword to determine if a word is considered a keyword.
169: # $thesaurus_db_file
170: # Scalar containing the full path to the thesaurus database.
1.46 matthew 171:
172: my %Keywords;
173: my $thesaurus_db_file;
174:
1.144 matthew 175: #
176: # Initialize values from language.tab, copyright.tab, filetypes.tab,
177: # thesaurus.tab, and filecategories.tab.
178: #
1.18 www 179: BEGIN {
1.46 matthew 180: # Variable initialization
181: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
182: #
1.22 www 183: unless ($readit) {
1.12 harris41 184: # ------------------------------------------------------------------- languages
185: {
1.158 raeburn 186: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
187: '/language.tab';
188: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 189: while (my $line = <$fh>) {
190: next if ($line=~/^\#/);
191: chomp($line);
1.1088 foxr 192: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 193: $language{$key}=$val.' - '.$enc;
194: if ($sup) {
195: $supported_language{$key}=$sup;
1.1088 foxr 196: $supported_codes{$key} = $code;
1.158 raeburn 197: }
1.1048 foxr 198: if ($latex) {
199: $latex_language_bykey{$key} = $latex;
1.1088 foxr 200: $latex_language{$code} = $latex;
1.1048 foxr 201: }
1.158 raeburn 202: }
203: close($fh);
204: }
1.12 harris41 205: }
206: # ------------------------------------------------------------------ copyrights
207: {
1.158 raeburn 208: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
209: '/copyright.tab';
210: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 211: while (my $line = <$fh>) {
212: next if ($line=~/^\#/);
213: chomp($line);
214: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 215: $cprtag{$key}=$val;
216: }
217: close($fh);
218: }
1.12 harris41 219: }
1.351 www 220: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 221: {
222: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
223: '/source_copyright.tab';
224: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 225: while (my $line = <$fh>) {
226: next if ($line =~ /^\#/);
227: chomp($line);
228: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 229: $scprtag{$key}=$val;
230: }
231: close($fh);
232: }
233: }
1.63 www 234:
1.517 raeburn 235: # -------------------------------------------------------------- default domain designs
1.63 www 236: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 237: my $designfile = $designdir.'/default.tab';
238: if ( open (my $fh,"<$designfile") ) {
239: while (my $line = <$fh>) {
240: next if ($line =~ /^\#/);
241: chomp($line);
242: my ($key,$val)=(split(/\=/,$line));
243: if ($val) { $defaultdesign{$key}=$val; }
244: }
245: close($fh);
1.63 www 246: }
247:
1.15 harris41 248: # ------------------------------------------------------------- file categories
249: {
1.158 raeburn 250: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
251: '/filecategories.tab';
252: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 253: while (my $line = <$fh>) {
254: next if ($line =~ /^\#/);
255: chomp($line);
256: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 257: push @{$category_extensions{lc($category)}},$extension;
258: }
259: close($fh);
260: }
261:
1.15 harris41 262: }
1.12 harris41 263: # ------------------------------------------------------------------ file types
264: {
1.158 raeburn 265: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
266: '/filetypes.tab';
267: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 268: while (my $line = <$fh>) {
269: next if ($line =~ /^\#/);
270: chomp($line);
271: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 272: if ($descr ne '') {
273: $fe{$ending}=lc($emb);
274: $fd{$ending}=$descr;
1.351 www 275: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 276: }
277: }
278: close($fh);
279: }
1.12 harris41 280: }
1.22 www 281: &Apache::lonnet::logthis(
1.705 tempelho 282: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 283: $readit=1;
1.46 matthew 284: } # end of unless($readit)
1.32 matthew 285:
286: }
1.112 bowersj2 287:
1.42 matthew 288: ###############################################################
289: ## HTML and Javascript Helper Functions ##
290: ###############################################################
291:
292: =pod
293:
1.112 bowersj2 294: =head1 HTML and Javascript Functions
1.42 matthew 295:
1.112 bowersj2 296: =over 4
297:
1.648 raeburn 298: =item * &browser_and_searcher_javascript()
1.112 bowersj2 299:
300: X<browsing, javascript>X<searching, javascript>Returns a string
301: containing javascript with two functions, C<openbrowser> and
302: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
303: tags.
1.42 matthew 304:
1.648 raeburn 305: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 306:
307: inputs: formname, elementname, only, omit
308:
309: formname and elementname indicate the name of the html form and name of
310: the element that the results of the browsing selection are to be placed in.
311:
312: Specifying 'only' will restrict the browser to displaying only files
1.185 www 313: with the given extension. Can be a comma separated list.
1.42 matthew 314:
315: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 316: with the given extension. Can be a comma separated list.
1.42 matthew 317:
1.648 raeburn 318: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 319:
320: Inputs: formname, elementname
321:
322: formname and elementname specify the name of the html form and the name
323: of the element the selection from the search results will be placed in.
1.542 raeburn 324:
1.42 matthew 325: =cut
326:
327: sub browser_and_searcher_javascript {
1.199 albertel 328: my ($mode)=@_;
329: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 330: my $resurl=&escape_single(&lastresurl());
1.42 matthew 331: return <<END;
1.219 albertel 332: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 333: var editbrowser = null;
1.135 albertel 334: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 335: var url = '$resurl/?';
1.42 matthew 336: if (editbrowser == null) {
337: url += 'launch=1&';
338: }
339: url += 'catalogmode=interactive&';
1.199 albertel 340: url += 'mode=$mode&';
1.611 albertel 341: url += 'inhibitmenu=yes&';
1.42 matthew 342: url += 'form=' + formname + '&';
343: if (only != null) {
344: url += 'only=' + only + '&';
1.217 albertel 345: } else {
346: url += 'only=&';
347: }
1.42 matthew 348: if (omit != null) {
349: url += 'omit=' + omit + '&';
1.217 albertel 350: } else {
351: url += 'omit=&';
352: }
1.135 albertel 353: if (titleelement != null) {
354: url += 'titleelement=' + titleelement + '&';
1.217 albertel 355: } else {
356: url += 'titleelement=&';
357: }
1.42 matthew 358: url += 'element=' + elementname + '';
359: var title = 'Browser';
1.435 albertel 360: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 361: options += ',width=700,height=600';
362: editbrowser = open(url,title,options,'1');
363: editbrowser.focus();
364: }
365: var editsearcher;
1.135 albertel 366: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 367: var url = '/adm/searchcat?';
368: if (editsearcher == null) {
369: url += 'launch=1&';
370: }
371: url += 'catalogmode=interactive&';
1.199 albertel 372: url += 'mode=$mode&';
1.42 matthew 373: url += 'form=' + formname + '&';
1.135 albertel 374: if (titleelement != null) {
375: url += 'titleelement=' + titleelement + '&';
1.217 albertel 376: } else {
377: url += 'titleelement=&';
378: }
1.42 matthew 379: url += 'element=' + elementname + '';
380: var title = 'Search';
1.435 albertel 381: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 382: options += ',width=700,height=600';
383: editsearcher = open(url,title,options,'1');
384: editsearcher.focus();
385: }
1.219 albertel 386: // END LON-CAPA Internal -->
1.42 matthew 387: END
1.170 www 388: }
389:
390: sub lastresurl {
1.258 albertel 391: if ($env{'environment.lastresurl'}) {
392: return $env{'environment.lastresurl'}
1.170 www 393: } else {
394: return '/res';
395: }
396: }
397:
398: sub storeresurl {
399: my $resurl=&Apache::lonnet::clutter(shift);
400: unless ($resurl=~/^\/res/) { return 0; }
401: $resurl=~s/\/$//;
402: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 403: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 404: return 1;
1.42 matthew 405: }
406:
1.74 www 407: sub studentbrowser_javascript {
1.111 www 408: unless (
1.258 albertel 409: (($env{'request.course.id'}) &&
1.302 albertel 410: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
411: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
412: '/'.$env{'request.course.sec'})
413: ))
1.258 albertel 414: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 415: ) { return ''; }
1.74 www 416: return (<<'ENDSTDBRW');
1.776 bisitz 417: <script type="text/javascript" language="Javascript">
1.824 bisitz 418: // <![CDATA[
1.74 www 419: var stdeditbrowser;
1.999 www 420: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 421: var url = '/adm/pickstudent?';
422: var filter;
1.558 albertel 423: if (!ignorefilter) {
424: eval('filter=document.'+formname+'.'+uname+'.value;');
425: }
1.74 www 426: if (filter != null) {
427: if (filter != '') {
428: url += 'filter='+filter+'&';
429: }
430: }
431: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 432: '&udomelement='+udom+
433: '&clicker='+clicker;
1.111 www 434: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 435: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 436: var title = 'Student_Browser';
1.74 www 437: var options = 'scrollbars=1,resizable=1,menubar=0';
438: options += ',width=700,height=600';
439: stdeditbrowser = open(url,title,options,'1');
440: stdeditbrowser.focus();
441: }
1.824 bisitz 442: // ]]>
1.74 www 443: </script>
444: ENDSTDBRW
445: }
1.42 matthew 446:
1.1003 www 447: sub resourcebrowser_javascript {
448: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 449: return (<<'ENDRESBRW');
1.1003 www 450: <script type="text/javascript" language="Javascript">
451: // <![CDATA[
452: var reseditbrowser;
1.1004 www 453: function openresbrowser(formname,reslink) {
1.1005 www 454: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 455: var title = 'Resource_Browser';
456: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 457: options += ',width=700,height=500';
1.1004 www 458: reseditbrowser = open(url,title,options,'1');
459: reseditbrowser.focus();
1.1003 www 460: }
461: // ]]>
462: </script>
1.1004 www 463: ENDRESBRW
1.1003 www 464: }
465:
1.74 www 466: sub selectstudent_link {
1.999 www 467: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
468: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
469: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
470: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 471: if ($env{'request.course.id'}) {
1.302 albertel 472: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
473: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
474: '/'.$env{'request.course.sec'})) {
1.111 www 475: return '';
476: }
1.999 www 477: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 478: if ($courseadvonly) {
479: $callargs .= ",'',1,1";
480: }
481: return '<span class="LC_nobreak">'.
482: '<a href="javascript:openstdbrowser('.$callargs.');">'.
483: &mt('Select User').'</a></span>';
1.74 www 484: }
1.258 albertel 485: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 486: $callargs .= ",'',1";
1.793 raeburn 487: return '<span class="LC_nobreak">'.
488: '<a href="javascript:openstdbrowser('.$callargs.');">'.
489: &mt('Select User').'</a></span>';
1.111 www 490: }
491: return '';
1.91 www 492: }
493:
1.1004 www 494: sub selectresource_link {
495: my ($form,$reslink,$arg)=@_;
496:
497: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
498: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
499: unless ($env{'request.course.id'}) { return $arg; }
500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openresbrowser('.$callargs.');">'.
502: $arg.'</a></span>';
503: }
504:
505:
506:
1.653 raeburn 507: sub authorbrowser_javascript {
508: return <<"ENDAUTHORBRW";
1.776 bisitz 509: <script type="text/javascript" language="JavaScript">
1.824 bisitz 510: // <![CDATA[
1.653 raeburn 511: var stdeditbrowser;
512:
513: function openauthorbrowser(formname,udom) {
514: var url = '/adm/pickauthor?';
515: url += 'form='+formname+'&roledom='+udom;
516: var title = 'Author_Browser';
517: var options = 'scrollbars=1,resizable=1,menubar=0';
518: options += ',width=700,height=600';
519: stdeditbrowser = open(url,title,options,'1');
520: stdeditbrowser.focus();
521: }
522:
1.824 bisitz 523: // ]]>
1.653 raeburn 524: </script>
525: ENDAUTHORBRW
526: }
527:
1.91 www 528: sub coursebrowser_javascript {
1.909 raeburn 529: my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932 raeburn 530: my $wintitle = 'Course_Browser';
1.931 raeburn 531: if ($crstype eq 'Community') {
1.932 raeburn 532: $wintitle = 'Community_Browser';
1.909 raeburn 533: }
1.876 raeburn 534: my $id_functions = &javascript_index_functions();
535: my $output = '
1.776 bisitz 536: <script type="text/javascript" language="JavaScript">
1.824 bisitz 537: // <![CDATA[
1.468 raeburn 538: var stdeditbrowser;'."\n";
1.876 raeburn 539:
540: $output .= <<"ENDSTDBRW";
1.909 raeburn 541: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 542: var url = '/adm/pickcourse?';
1.895 raeburn 543: var formid = getFormIdByName(formname);
1.876 raeburn 544: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 545: if (domainfilter != null) {
546: if (domainfilter != '') {
547: url += 'domainfilter='+domainfilter+'&';
548: }
549: }
1.91 www 550: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 551: '&cdomelement='+udom+
552: '&cnameelement='+desc;
1.468 raeburn 553: if (extra_element !=null && extra_element != '') {
1.594 raeburn 554: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 555: url += '&roleelement='+extra_element;
556: if (domainfilter == null || domainfilter == '') {
557: url += '&domainfilter='+extra_element;
558: }
1.234 raeburn 559: }
1.468 raeburn 560: else {
561: if (formname == 'portform') {
562: url += '&setroles='+extra_element;
1.800 raeburn 563: } else {
564: if (formname == 'rules') {
565: url += '&fixeddom='+extra_element;
566: }
1.468 raeburn 567: }
568: }
1.230 raeburn 569: }
1.909 raeburn 570: if (type != null && type != '') {
571: url += '&type='+type;
572: }
573: if (type_elem != null && type_elem != '') {
574: url += '&typeelement='+type_elem;
575: }
1.872 raeburn 576: if (formname == 'ccrs') {
577: var ownername = document.forms[formid].ccuname.value;
578: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
579: url += '&cloner='+ownername+':'+ownerdom;
580: }
1.293 raeburn 581: if (multflag !=null && multflag != '') {
582: url += '&multiple='+multflag;
583: }
1.909 raeburn 584: var title = '$wintitle';
1.91 www 585: var options = 'scrollbars=1,resizable=1,menubar=0';
586: options += ',width=700,height=600';
587: stdeditbrowser = open(url,title,options,'1');
588: stdeditbrowser.focus();
589: }
1.876 raeburn 590: $id_functions
591: ENDSTDBRW
1.905 raeburn 592: if (($sec_element ne '') || ($role_element ne '')) {
593: $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876 raeburn 594: }
595: $output .= '
596: // ]]>
597: </script>';
598: return $output;
599: }
600:
601: sub javascript_index_functions {
602: return <<"ENDJS";
603:
604: function getFormIdByName(formname) {
605: for (var i=0;i<document.forms.length;i++) {
606: if (document.forms[i].name == formname) {
607: return i;
608: }
609: }
610: return -1;
611: }
612:
613: function getIndexByName(formid,item) {
614: for (var i=0;i<document.forms[formid].elements.length;i++) {
615: if (document.forms[formid].elements[i].name == item) {
616: return i;
617: }
618: }
619: return -1;
620: }
1.468 raeburn 621:
1.876 raeburn 622: function getDomainFromSelectbox(formname,udom) {
623: var userdom;
624: var formid = getFormIdByName(formname);
625: if (formid > -1) {
626: var domid = getIndexByName(formid,udom);
627: if (domid > -1) {
628: if (document.forms[formid].elements[domid].type == 'select-one') {
629: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
630: }
631: if (document.forms[formid].elements[domid].type == 'hidden') {
632: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 633: }
634: }
635: }
1.876 raeburn 636: return userdom;
637: }
638:
639: ENDJS
1.468 raeburn 640:
1.876 raeburn 641: }
642:
1.1017 raeburn 643: sub javascript_array_indexof {
1.1018 raeburn 644: return <<ENDJS;
1.1017 raeburn 645: <script type="text/javascript" language="JavaScript">
646: // <![CDATA[
647:
648: if (!Array.prototype.indexOf) {
649: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
650: "use strict";
651: if (this === void 0 || this === null) {
652: throw new TypeError();
653: }
654: var t = Object(this);
655: var len = t.length >>> 0;
656: if (len === 0) {
657: return -1;
658: }
659: var n = 0;
660: if (arguments.length > 0) {
661: n = Number(arguments[1]);
1.1088 foxr 662: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 663: n = 0;
664: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
665: n = (n > 0 || -1) * Math.floor(Math.abs(n));
666: }
667: }
668: if (n >= len) {
669: return -1;
670: }
671: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
672: for (; k < len; k++) {
673: if (k in t && t[k] === searchElement) {
674: return k;
675: }
676: }
677: return -1;
678: }
679: }
680:
681: // ]]>
682: </script>
683:
684: ENDJS
685:
686: }
687:
1.876 raeburn 688: sub userbrowser_javascript {
689: my $id_functions = &javascript_index_functions();
690: return <<"ENDUSERBRW";
691:
1.888 raeburn 692: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 693: var url = '/adm/pickuser?';
694: var userdom = getDomainFromSelectbox(formname,udom);
695: if (userdom != null) {
696: if (userdom != '') {
697: url += 'srchdom='+userdom+'&';
698: }
699: }
700: url += 'form=' + formname + '&unameelement='+uname+
701: '&udomelement='+udom+
702: '&ulastelement='+ulast+
703: '&ufirstelement='+ufirst+
704: '&uemailelement='+uemail+
1.881 raeburn 705: '&hideudomelement='+hideudom+
706: '&coursedom='+crsdom;
1.888 raeburn 707: if ((caller != null) && (caller != undefined)) {
708: url += '&caller='+caller;
709: }
1.876 raeburn 710: var title = 'User_Browser';
711: var options = 'scrollbars=1,resizable=1,menubar=0';
712: options += ',width=700,height=600';
713: var stdeditbrowser = open(url,title,options,'1');
714: stdeditbrowser.focus();
715: }
716:
1.888 raeburn 717: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 718: var formid = getFormIdByName(formname);
719: if (formid > -1) {
1.888 raeburn 720: var unameid = getIndexByName(formid,uname);
1.876 raeburn 721: var domid = getIndexByName(formid,udom);
722: var hidedomid = getIndexByName(formid,origdom);
723: if (hidedomid > -1) {
724: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 725: var unameval = document.forms[formid].elements[unameid].value;
726: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
727: if (domid > -1) {
728: var slct = document.forms[formid].elements[domid];
729: if (slct.type == 'select-one') {
730: var i;
731: for (i=0;i<slct.length;i++) {
732: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
733: }
734: }
735: if (slct.type == 'hidden') {
736: slct.value = fixeddom;
1.876 raeburn 737: }
738: }
1.468 raeburn 739: }
740: }
741: }
1.876 raeburn 742: return;
743: }
744:
745: $id_functions
746: ENDUSERBRW
1.468 raeburn 747: }
748:
749: sub setsec_javascript {
1.905 raeburn 750: my ($sec_element,$formname,$role_element) = @_;
751: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
752: $communityrolestr);
753: if ($role_element ne '') {
754: my @allroles = ('st','ta','ep','in','ad');
755: foreach my $crstype ('Course','Community') {
756: if ($crstype eq 'Community') {
757: foreach my $role (@allroles) {
758: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
759: }
760: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
761: } else {
762: foreach my $role (@allroles) {
763: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
764: }
765: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
766: }
767: }
768: $rolestr = '"'.join('","',@allroles).'"';
769: $courserolestr = '"'.join('","',@courserolenames).'"';
770: $communityrolestr = '"'.join('","',@communityrolenames).'"';
771: }
1.468 raeburn 772: my $setsections = qq|
773: function setSect(sectionlist) {
1.629 raeburn 774: var sectionsArray = new Array();
775: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
776: sectionsArray = sectionlist.split(",");
777: }
1.468 raeburn 778: var numSections = sectionsArray.length;
779: document.$formname.$sec_element.length = 0;
780: if (numSections == 0) {
781: document.$formname.$sec_element.multiple=false;
782: document.$formname.$sec_element.size=1;
783: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
784: } else {
785: if (numSections == 1) {
786: document.$formname.$sec_element.multiple=false;
787: document.$formname.$sec_element.size=1;
788: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
789: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
790: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
791: } else {
792: for (var i=0; i<numSections; i++) {
793: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
794: }
795: document.$formname.$sec_element.multiple=true
796: if (numSections < 3) {
797: document.$formname.$sec_element.size=numSections;
798: } else {
799: document.$formname.$sec_element.size=3;
800: }
801: document.$formname.$sec_element.options[0].selected = false
802: }
803: }
1.91 www 804: }
1.905 raeburn 805:
806: function setRole(crstype) {
1.468 raeburn 807: |;
1.905 raeburn 808: if ($role_element eq '') {
809: $setsections .= ' return;
810: }
811: ';
812: } else {
813: $setsections .= qq|
814: var elementLength = document.$formname.$role_element.length;
815: var allroles = Array($rolestr);
816: var courserolenames = Array($courserolestr);
817: var communityrolenames = Array($communityrolestr);
818: if (elementLength != undefined) {
819: if (document.$formname.$role_element.options[5].value == 'cc') {
820: if (crstype == 'Course') {
821: return;
822: } else {
823: allroles[5] = 'co';
824: for (var i=0; i<6; i++) {
825: document.$formname.$role_element.options[i].value = allroles[i];
826: document.$formname.$role_element.options[i].text = communityrolenames[i];
827: }
828: }
829: } else {
830: if (crstype == 'Community') {
831: return;
832: } else {
833: allroles[5] = 'cc';
834: for (var i=0; i<6; i++) {
835: document.$formname.$role_element.options[i].value = allroles[i];
836: document.$formname.$role_element.options[i].text = courserolenames[i];
837: }
838: }
839: }
840: }
841: return;
842: }
843: |;
844: }
1.468 raeburn 845: return $setsections;
846: }
847:
1.91 www 848: sub selectcourse_link {
1.909 raeburn 849: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
850: $typeelement) = @_;
851: my $type = $selecttype;
1.871 raeburn 852: my $linktext = &mt('Select Course');
853: if ($selecttype eq 'Community') {
1.909 raeburn 854: $linktext = &mt('Select Community');
1.906 raeburn 855: } elsif ($selecttype eq 'Course/Community') {
856: $linktext = &mt('Select Course/Community');
1.909 raeburn 857: $type = '';
1.1019 raeburn 858: } elsif ($selecttype eq 'Select') {
859: $linktext = &mt('Select');
860: $type = '';
1.871 raeburn 861: }
1.787 bisitz 862: return '<span class="LC_nobreak">'
863: ."<a href='"
864: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
865: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 866: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 867: ."'>".$linktext.'</a>'
1.787 bisitz 868: .'</span>';
1.74 www 869: }
1.42 matthew 870:
1.653 raeburn 871: sub selectauthor_link {
872: my ($form,$udom)=@_;
873: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
874: &mt('Select Author').'</a>';
875: }
876:
1.876 raeburn 877: sub selectuser_link {
1.881 raeburn 878: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 879: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 880: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 881: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 882: ');">'.$linktext.'</a>';
1.876 raeburn 883: }
884:
1.273 raeburn 885: sub check_uncheck_jscript {
886: my $jscript = <<"ENDSCRT";
887: function checkAll(field) {
888: if (field.length > 0) {
889: for (i = 0; i < field.length; i++) {
890: field[i].checked = true ;
891: }
892: } else {
893: field.checked = true
894: }
895: }
896:
897: function uncheckAll(field) {
898: if (field.length > 0) {
899: for (i = 0; i < field.length; i++) {
900: field[i].checked = false ;
1.543 albertel 901: }
902: } else {
1.273 raeburn 903: field.checked = false ;
904: }
905: }
906: ENDSCRT
907: return $jscript;
908: }
909:
1.656 www 910: sub select_timezone {
1.659 raeburn 911: my ($name,$selected,$onchange,$includeempty)=@_;
912: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
913: if ($includeempty) {
914: $output .= '<option value=""';
915: if (($selected eq '') || ($selected eq 'local')) {
916: $output .= ' selected="selected" ';
917: }
918: $output .= '> </option>';
919: }
1.657 raeburn 920: my @timezones = DateTime::TimeZone->all_names;
921: foreach my $tzone (@timezones) {
922: $output.= '<option value="'.$tzone.'"';
923: if ($tzone eq $selected) {
924: $output.=' selected="selected"';
925: }
926: $output.=">$tzone</option>\n";
1.656 www 927: }
928: $output.="</select>";
929: return $output;
930: }
1.273 raeburn 931:
1.687 raeburn 932: sub select_datelocale {
933: my ($name,$selected,$onchange,$includeempty)=@_;
934: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
935: if ($includeempty) {
936: $output .= '<option value=""';
937: if ($selected eq '') {
938: $output .= ' selected="selected" ';
939: }
940: $output .= '> </option>';
941: }
942: my (@possibles,%locale_names);
943: my @locales = DateTime::Locale::Catalog::Locales;
944: foreach my $locale (@locales) {
945: if (ref($locale) eq 'HASH') {
946: my $id = $locale->{'id'};
947: if ($id ne '') {
948: my $en_terr = $locale->{'en_territory'};
949: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 950: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 951: if (grep(/^en$/,@languages) || !@languages) {
952: if ($en_terr ne '') {
953: $locale_names{$id} = '('.$en_terr.')';
954: } elsif ($native_terr ne '') {
955: $locale_names{$id} = $native_terr;
956: }
957: } else {
958: if ($native_terr ne '') {
959: $locale_names{$id} = $native_terr.' ';
960: } elsif ($en_terr ne '') {
961: $locale_names{$id} = '('.$en_terr.')';
962: }
963: }
964: push (@possibles,$id);
965: }
966: }
967: }
968: foreach my $item (sort(@possibles)) {
969: $output.= '<option value="'.$item.'"';
970: if ($item eq $selected) {
971: $output.=' selected="selected"';
972: }
973: $output.=">$item";
974: if ($locale_names{$item} ne '') {
975: $output.=" $locale_names{$item}</option>\n";
976: }
977: $output.="</option>\n";
978: }
979: $output.="</select>";
980: return $output;
981: }
982:
1.792 raeburn 983: sub select_language {
984: my ($name,$selected,$includeempty) = @_;
985: my %langchoices;
986: if ($includeempty) {
987: %langchoices = ('' => 'No language preference');
988: }
989: foreach my $id (&languageids()) {
990: my $code = &supportedlanguagecode($id);
991: if ($code) {
992: $langchoices{$code} = &plainlanguagedescription($id);
993: }
994: }
1.970 raeburn 995: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 996: }
997:
1.42 matthew 998: =pod
1.36 matthew 999:
1.1088 foxr 1000:
1001: =item * &list_languages()
1002:
1003: Returns an array reference that is suitable for use in language prompters.
1004: Each array element is itself a two element array. The first element
1005: is the language code. The second element a descsriptiuon of the
1006: language itself. This is suitable for use in e.g.
1007: &Apache::edit::select_arg (once dereferenced that is).
1008:
1009: =cut
1010:
1011: sub list_languages {
1012: my @lang_choices;
1013:
1014: foreach my $id (&languageids()) {
1015: my $code = &supportedlanguagecode($id);
1016: if ($code) {
1017: my $selector = $supported_codes{$id};
1018: my $description = &plainlanguagedescription($id);
1019: push (@lang_choices, [$selector, $description]);
1020: }
1021: }
1022: return \@lang_choices;
1023: }
1024:
1025: =pod
1026:
1.648 raeburn 1027: =item * &linked_select_forms(...)
1.36 matthew 1028:
1029: linked_select_forms returns a string containing a <script></script> block
1030: and html for two <select> menus. The select menus will be linked in that
1031: changing the value of the first menu will result in new values being placed
1032: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1033: order unless a defined order is provided.
1.36 matthew 1034:
1035: linked_select_forms takes the following ordered inputs:
1036:
1037: =over 4
1038:
1.112 bowersj2 1039: =item * $formname, the name of the <form> tag
1.36 matthew 1040:
1.112 bowersj2 1041: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1042:
1.112 bowersj2 1043: =item * $firstdefault, the default value for the first menu
1.36 matthew 1044:
1.112 bowersj2 1045: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1046:
1.112 bowersj2 1047: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1048:
1.112 bowersj2 1049: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1050:
1.609 raeburn 1051: =item * $menuorder, the order of values in the first menu
1052:
1.41 ng 1053: =back
1054:
1.36 matthew 1055: Below is an example of such a hash. Only the 'text', 'default', and
1056: 'select2' keys must appear as stated. keys(%menu) are the possible
1057: values for the first select menu. The text that coincides with the
1.41 ng 1058: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1059: and text for the second menu are given in the hash pointed to by
1060: $menu{$choice1}->{'select2'}.
1061:
1.112 bowersj2 1062: my %menu = ( A1 => { text =>"Choice A1" ,
1063: default => "B3",
1064: select2 => {
1065: B1 => "Choice B1",
1066: B2 => "Choice B2",
1067: B3 => "Choice B3",
1068: B4 => "Choice B4"
1.609 raeburn 1069: },
1070: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1071: },
1072: A2 => { text =>"Choice A2" ,
1073: default => "C2",
1074: select2 => {
1075: C1 => "Choice C1",
1076: C2 => "Choice C2",
1077: C3 => "Choice C3"
1.609 raeburn 1078: },
1079: order => ['C2','C1','C3'],
1.112 bowersj2 1080: },
1081: A3 => { text =>"Choice A3" ,
1082: default => "D6",
1083: select2 => {
1084: D1 => "Choice D1",
1085: D2 => "Choice D2",
1086: D3 => "Choice D3",
1087: D4 => "Choice D4",
1088: D5 => "Choice D5",
1089: D6 => "Choice D6",
1090: D7 => "Choice D7"
1.609 raeburn 1091: },
1092: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1093: }
1094: );
1.36 matthew 1095:
1096: =cut
1097:
1098: sub linked_select_forms {
1099: my ($formname,
1100: $middletext,
1101: $firstdefault,
1102: $firstselectname,
1103: $secondselectname,
1.609 raeburn 1104: $hashref,
1105: $menuorder,
1.36 matthew 1106: ) = @_;
1107: my $second = "document.$formname.$secondselectname";
1108: my $first = "document.$formname.$firstselectname";
1109: # output the javascript to do the changing
1110: my $result = '';
1.776 bisitz 1111: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1112: $result.="// <![CDATA[\n";
1.36 matthew 1113: $result.="var select2data = new Object();\n";
1114: $" = '","';
1115: my $debug = '';
1116: foreach my $s1 (sort(keys(%$hashref))) {
1117: $result.="select2data.d_$s1 = new Object();\n";
1118: $result.="select2data.d_$s1.def = new String('".
1119: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1120: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1121: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1122: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1123: @s2values = @{$hashref->{$s1}->{'order'}};
1124: }
1.36 matthew 1125: $result.="\"@s2values\");\n";
1126: $result.="select2data.d_$s1.texts = new Array(";
1127: my @s2texts;
1128: foreach my $value (@s2values) {
1129: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1130: }
1131: $result.="\"@s2texts\");\n";
1132: }
1133: $"=' ';
1134: $result.= <<"END";
1135:
1136: function select1_changed() {
1137: // Determine new choice
1138: var newvalue = "d_" + $first.value;
1139: // update select2
1140: var values = select2data[newvalue].values;
1141: var texts = select2data[newvalue].texts;
1142: var select2def = select2data[newvalue].def;
1143: var i;
1144: // out with the old
1145: for (i = 0; i < $second.options.length; i++) {
1146: $second.options[i] = null;
1147: }
1148: // in with the nuclear
1149: for (i=0;i<values.length; i++) {
1150: $second.options[i] = new Option(values[i]);
1.143 matthew 1151: $second.options[i].value = values[i];
1.36 matthew 1152: $second.options[i].text = texts[i];
1153: if (values[i] == select2def) {
1154: $second.options[i].selected = true;
1155: }
1156: }
1157: }
1.824 bisitz 1158: // ]]>
1.36 matthew 1159: </script>
1160: END
1161: # output the initial values for the selection lists
1162: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 1163: my @order = sort(keys(%{$hashref}));
1164: if (ref($menuorder) eq 'ARRAY') {
1165: @order = @{$menuorder};
1166: }
1167: foreach my $value (@order) {
1.36 matthew 1168: $result.=" <option value=\"$value\" ";
1.253 albertel 1169: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1170: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1171: }
1172: $result .= "</select>\n";
1173: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1174: $result .= $middletext;
1175: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
1176: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1177:
1178: my @secondorder = sort(keys(%select2));
1179: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1180: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1181: }
1182: foreach my $value (@secondorder) {
1.36 matthew 1183: $result.=" <option value=\"$value\" ";
1.253 albertel 1184: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1185: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1186: }
1187: $result .= "</select>\n";
1188: # return $debug;
1189: return $result;
1190: } # end of sub linked_select_forms {
1191:
1.45 matthew 1192: =pod
1.44 bowersj2 1193:
1.973 raeburn 1194: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1195:
1.112 bowersj2 1196: Returns a string corresponding to an HTML link to the given help
1197: $topic, where $topic corresponds to the name of a .tex file in
1198: /home/httpd/html/adm/help/tex, with underscores replaced by
1199: spaces.
1200:
1201: $text will optionally be linked to the same topic, allowing you to
1202: link text in addition to the graphic. If you do not want to link
1203: text, but wish to specify one of the later parameters, pass an
1204: empty string.
1205:
1206: $stayOnPage is a value that will be interpreted as a boolean. If true,
1207: the link will not open a new window. If false, the link will open
1208: a new window using Javascript. (Default is false.)
1209:
1210: $width and $height are optional numerical parameters that will
1211: override the width and height of the popped up window, which may
1.973 raeburn 1212: be useful for certain help topics with big pictures included.
1213:
1214: $imgid is the id of the img tag used for the help icon. This may be
1215: used in a javascript call to switch the image src. See
1216: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1217:
1218: =cut
1219:
1220: sub help_open_topic {
1.973 raeburn 1221: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1222: $text = "" if (not defined $text);
1.44 bowersj2 1223: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1224: $width = 500 if (not defined $width);
1.44 bowersj2 1225: $height = 400 if (not defined $height);
1226: my $filename = $topic;
1227: $filename =~ s/ /_/g;
1228:
1.48 bowersj2 1229: my $template = "";
1230: my $link;
1.572 banghart 1231:
1.159 www 1232: $topic=~s/\W/\_/g;
1.44 bowersj2 1233:
1.572 banghart 1234: if (!$stayOnPage) {
1.1033 www 1235: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1236: } elsif ($stayOnPage eq 'popup') {
1237: $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 1238: } else {
1.48 bowersj2 1239: $link = "/adm/help/${filename}.hlp";
1240: }
1241:
1242: # Add the text
1.755 neumanie 1243: if ($text ne "") {
1.763 bisitz 1244: $template.='<span class="LC_help_open_topic">'
1245: .'<a target="_top" href="'.$link.'">'
1246: .$text.'</a>';
1.48 bowersj2 1247: }
1248:
1.763 bisitz 1249: # (Always) Add the graphic
1.179 matthew 1250: my $title = &mt('Online Help');
1.667 raeburn 1251: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1252: if ($imgid ne '') {
1253: $imgid = ' id="'.$imgid.'"';
1254: }
1.763 bisitz 1255: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1256: .'<img src="'.$helpicon.'" border="0"'
1257: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1258: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1259: .' /></a>';
1260: if ($text ne "") {
1261: $template.='</span>';
1262: }
1.44 bowersj2 1263: return $template;
1264:
1.106 bowersj2 1265: }
1266:
1267: # This is a quicky function for Latex cheatsheet editing, since it
1268: # appears in at least four places
1269: sub helpLatexCheatsheet {
1.1037 www 1270: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1271: my $out;
1.106 bowersj2 1272: my $addOther = '';
1.732 raeburn 1273: if ($topic) {
1.1037 www 1274: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1275: }
1276: $out = '<span>' # Start cheatsheet
1277: .$addOther
1278: .'<span>'
1.1037 www 1279: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1280: .'</span> <span>'
1.1037 www 1281: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1282: .'</span>';
1.732 raeburn 1283: unless ($not_author) {
1.763 bisitz 1284: $out .= ' <span>'
1.1037 www 1285: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763 bisitz 1286: .'</span>';
1.732 raeburn 1287: }
1.763 bisitz 1288: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1289: return $out;
1.172 www 1290: }
1291:
1.430 albertel 1292: sub general_help {
1293: my $helptopic='Student_Intro';
1294: if ($env{'request.role'}=~/^(ca|au)/) {
1295: $helptopic='Authoring_Intro';
1.907 raeburn 1296: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1297: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1298: } elsif ($env{'request.role'}=~/^dc/) {
1299: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1300: }
1301: return $helptopic;
1302: }
1303:
1304: sub update_help_link {
1305: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1306: my $origurl = $ENV{'REQUEST_URI'};
1307: $origurl=~s|^/~|/priv/|;
1308: my $timestamp = time;
1309: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1310: $$datum = &escape($$datum);
1311: }
1312:
1313: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1314: my $output .= <<"ENDOUTPUT";
1315: <script type="text/javascript">
1.824 bisitz 1316: // <![CDATA[
1.430 albertel 1317: banner_link = '$banner_link';
1.824 bisitz 1318: // ]]>
1.430 albertel 1319: </script>
1320: ENDOUTPUT
1321: return $output;
1322: }
1323:
1324: # now just updates the help link and generates a blue icon
1.193 raeburn 1325: sub help_open_menu {
1.430 albertel 1326: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1327: = @_;
1.949 droeschl 1328: $stayOnPage = 1;
1.430 albertel 1329: my $output;
1330: if ($component_help) {
1331: if (!$text) {
1332: $output=&help_open_topic($component_help,undef,$stayOnPage,
1333: $width,$height);
1334: } else {
1335: my $help_text;
1336: $help_text=&unescape($topic);
1337: $output='<table><tr><td>'.
1338: &help_open_topic($component_help,$help_text,$stayOnPage,
1339: $width,$height).'</td></tr></table>';
1340: }
1341: }
1342: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1343: return $output.$banner_link;
1344: }
1345:
1346: sub top_nav_help {
1347: my ($text) = @_;
1.436 albertel 1348: $text = &mt($text);
1.949 droeschl 1349: my $stay_on_page = 1;
1350:
1.572 banghart 1351: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1352: : "javascript:helpMenu('open')";
1.572 banghart 1353: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1354:
1.201 raeburn 1355: my $title = &mt('Get help');
1.436 albertel 1356:
1357: return <<"END";
1358: $banner_link
1359: <a href="$link" title="$title">$text</a>
1360: END
1361: }
1362:
1363: sub help_menu_js {
1364: my ($text) = @_;
1.949 droeschl 1365: my $stayOnPage = 1;
1.436 albertel 1366: my $width = 620;
1367: my $height = 600;
1.430 albertel 1368: my $helptopic=&general_help();
1369: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1370: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1371: my $start_page =
1372: &Apache::loncommon::start_page('Help Menu', undef,
1373: {'frameset' => 1,
1374: 'js_ready' => 1,
1375: 'add_entries' => {
1376: 'border' => '0',
1.579 raeburn 1377: 'rows' => "110,*",},});
1.331 albertel 1378: my $end_page =
1379: &Apache::loncommon::end_page({'frameset' => 1,
1380: 'js_ready' => 1,});
1381:
1.436 albertel 1382: my $template .= <<"ENDTEMPLATE";
1383: <script type="text/javascript">
1.877 bisitz 1384: // <![CDATA[
1.253 albertel 1385: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1386: var banner_link = '';
1.243 raeburn 1387: function helpMenu(target) {
1388: var caller = this;
1389: if (target == 'open') {
1390: var newWindow = null;
1391: try {
1.262 albertel 1392: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1393: }
1394: catch(error) {
1395: writeHelp(caller);
1396: return;
1397: }
1398: if (newWindow) {
1399: caller = newWindow;
1400: }
1.193 raeburn 1401: }
1.243 raeburn 1402: writeHelp(caller);
1403: return;
1404: }
1405: function writeHelp(caller) {
1.1072 raeburn 1406: 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 1407: caller.document.close()
1408: caller.focus()
1.193 raeburn 1409: }
1.877 bisitz 1410: // END LON-CAPA Internal -->
1.253 albertel 1411: // ]]>
1.436 albertel 1412: </script>
1.193 raeburn 1413: ENDTEMPLATE
1414: return $template;
1415: }
1416:
1.172 www 1417: sub help_open_bug {
1418: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1419: unless ($env{'user.adv'}) { return ''; }
1.172 www 1420: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1421: $text = "" if (not defined $text);
1422: $stayOnPage=1;
1.184 albertel 1423: $width = 600 if (not defined $width);
1424: $height = 600 if (not defined $height);
1.172 www 1425:
1426: $topic=~s/\W+/\+/g;
1427: my $link='';
1428: my $template='';
1.379 albertel 1429: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1430: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1431: if (!$stayOnPage)
1432: {
1433: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1434: }
1435: else
1436: {
1437: $link = $url;
1438: }
1439: # Add the text
1440: if ($text ne "")
1441: {
1442: $template .=
1443: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1444: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1445: }
1446:
1447: # Add the graphic
1.179 matthew 1448: my $title = &mt('Report a Bug');
1.215 albertel 1449: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1450: $template .= <<"ENDTEMPLATE";
1.436 albertel 1451: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1452: ENDTEMPLATE
1453: if ($text ne '') { $template.='</td></tr></table>' };
1454: return $template;
1455:
1456: }
1457:
1458: sub help_open_faq {
1459: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1460: unless ($env{'user.adv'}) { return ''; }
1.172 www 1461: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1462: $text = "" if (not defined $text);
1463: $stayOnPage=1;
1464: $width = 350 if (not defined $width);
1465: $height = 400 if (not defined $height);
1466:
1467: $topic=~s/\W+/\+/g;
1468: my $link='';
1469: my $template='';
1470: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1471: if (!$stayOnPage)
1472: {
1473: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1474: }
1475: else
1476: {
1477: $link = $url;
1478: }
1479:
1480: # Add the text
1481: if ($text ne "")
1482: {
1483: $template .=
1.173 www 1484: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1485: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1486: }
1487:
1488: # Add the graphic
1.179 matthew 1489: my $title = &mt('View the FAQ');
1.215 albertel 1490: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1491: $template .= <<"ENDTEMPLATE";
1.436 albertel 1492: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1493: ENDTEMPLATE
1494: if ($text ne '') { $template.='</td></tr></table>' };
1495: return $template;
1496:
1.44 bowersj2 1497: }
1.37 matthew 1498:
1.180 matthew 1499: ###############################################################
1500: ###############################################################
1501:
1.45 matthew 1502: =pod
1503:
1.648 raeburn 1504: =item * &change_content_javascript():
1.256 matthew 1505:
1506: This and the next function allow you to create small sections of an
1507: otherwise static HTML page that you can update on the fly with
1508: Javascript, even in Netscape 4.
1509:
1510: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1511: must be written to the HTML page once. It will prove the Javascript
1512: function "change(name, content)". Calling the change function with the
1513: name of the section
1514: you want to update, matching the name passed to C<changable_area>, and
1515: the new content you want to put in there, will put the content into
1516: that area.
1517:
1518: B<Note>: Netscape 4 only reserves enough space for the changable area
1519: to contain room for the original contents. You need to "make space"
1520: for whatever changes you wish to make, and be B<sure> to check your
1521: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1522: it's adequate for updating a one-line status display, but little more.
1523: This script will set the space to 100% width, so you only need to
1524: worry about height in Netscape 4.
1525:
1526: Modern browsers are much less limiting, and if you can commit to the
1527: user not using Netscape 4, this feature may be used freely with
1528: pretty much any HTML.
1529:
1530: =cut
1531:
1532: sub change_content_javascript {
1533: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1534: if ($env{'browser.type'} eq 'netscape' &&
1535: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1536: return (<<NETSCAPE4);
1537: function change(name, content) {
1538: doc = document.layers[name+"___escape"].layers[0].document;
1539: doc.open();
1540: doc.write(content);
1541: doc.close();
1542: }
1543: NETSCAPE4
1544: } else {
1545: # Otherwise, we need to use semi-standards-compliant code
1546: # (technically, "innerHTML" isn't standard but the equivalent
1547: # is really scary, and every useful browser supports it
1548: return (<<DOMBASED);
1549: function change(name, content) {
1550: element = document.getElementById(name);
1551: element.innerHTML = content;
1552: }
1553: DOMBASED
1554: }
1555: }
1556:
1557: =pod
1558:
1.648 raeburn 1559: =item * &changable_area($name,$origContent):
1.256 matthew 1560:
1561: This provides a "changable area" that can be modified on the fly via
1562: the Javascript code provided in C<change_content_javascript>. $name is
1563: the name you will use to reference the area later; do not repeat the
1564: same name on a given HTML page more then once. $origContent is what
1565: the area will originally contain, which can be left blank.
1566:
1567: =cut
1568:
1569: sub changable_area {
1570: my ($name, $origContent) = @_;
1571:
1.258 albertel 1572: if ($env{'browser.type'} eq 'netscape' &&
1573: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1574: # If this is netscape 4, we need to use the Layer tag
1575: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1576: } else {
1577: return "<span id='$name'>$origContent</span>";
1578: }
1579: }
1580:
1581: =pod
1582:
1.648 raeburn 1583: =item * &viewport_geometry_js
1.590 raeburn 1584:
1585: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1586:
1587: =cut
1588:
1589:
1590: sub viewport_geometry_js {
1591: return <<"GEOMETRY";
1592: var Geometry = {};
1593: function init_geometry() {
1594: if (Geometry.init) { return };
1595: Geometry.init=1;
1596: if (window.innerHeight) {
1597: Geometry.getViewportHeight = function() { return window.innerHeight; };
1598: Geometry.getViewportWidth = function() { return window.innerWidth; };
1599: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1600: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1601: }
1602: else if (document.documentElement && document.documentElement.clientHeight) {
1603: Geometry.getViewportHeight =
1604: function() { return document.documentElement.clientHeight; };
1605: Geometry.getViewportWidth =
1606: function() { return document.documentElement.clientWidth; };
1607:
1608: Geometry.getHorizontalScroll =
1609: function() { return document.documentElement.scrollLeft; };
1610: Geometry.getVerticalScroll =
1611: function() { return document.documentElement.scrollTop; };
1612: }
1613: else if (document.body.clientHeight) {
1614: Geometry.getViewportHeight =
1615: function() { return document.body.clientHeight; };
1616: Geometry.getViewportWidth =
1617: function() { return document.body.clientWidth; };
1618: Geometry.getHorizontalScroll =
1619: function() { return document.body.scrollLeft; };
1620: Geometry.getVerticalScroll =
1621: function() { return document.body.scrollTop; };
1622: }
1623: }
1624:
1625: GEOMETRY
1626: }
1627:
1628: =pod
1629:
1.648 raeburn 1630: =item * &viewport_size_js()
1.590 raeburn 1631:
1632: 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.
1633:
1634: =cut
1635:
1636: sub viewport_size_js {
1637: my $geometry = &viewport_geometry_js();
1638: return <<"DIMS";
1639:
1640: $geometry
1641:
1642: function getViewportDims(width,height) {
1643: init_geometry();
1644: width.value = Geometry.getViewportWidth();
1645: height.value = Geometry.getViewportHeight();
1646: return;
1647: }
1648:
1649: DIMS
1650: }
1651:
1652: =pod
1653:
1.648 raeburn 1654: =item * &resize_textarea_js()
1.565 albertel 1655:
1656: emits the needed javascript to resize a textarea to be as big as possible
1657:
1658: creates a function resize_textrea that takes two IDs first should be
1659: the id of the element to resize, second should be the id of a div that
1660: surrounds everything that comes after the textarea, this routine needs
1661: to be attached to the <body> for the onload and onresize events.
1662:
1.648 raeburn 1663: =back
1.565 albertel 1664:
1665: =cut
1666:
1667: sub resize_textarea_js {
1.590 raeburn 1668: my $geometry = &viewport_geometry_js();
1.565 albertel 1669: return <<"RESIZE";
1670: <script type="text/javascript">
1.824 bisitz 1671: // <![CDATA[
1.590 raeburn 1672: $geometry
1.565 albertel 1673:
1.588 albertel 1674: function getX(element) {
1675: var x = 0;
1676: while (element) {
1677: x += element.offsetLeft;
1678: element = element.offsetParent;
1679: }
1680: return x;
1681: }
1682: function getY(element) {
1683: var y = 0;
1684: while (element) {
1685: y += element.offsetTop;
1686: element = element.offsetParent;
1687: }
1688: return y;
1689: }
1690:
1691:
1.565 albertel 1692: function resize_textarea(textarea_id,bottom_id) {
1693: init_geometry();
1694: var textarea = document.getElementById(textarea_id);
1695: //alert(textarea);
1696:
1.588 albertel 1697: var textarea_top = getY(textarea);
1.565 albertel 1698: var textarea_height = textarea.offsetHeight;
1699: var bottom = document.getElementById(bottom_id);
1.588 albertel 1700: var bottom_top = getY(bottom);
1.565 albertel 1701: var bottom_height = bottom.offsetHeight;
1702: var window_height = Geometry.getViewportHeight();
1.588 albertel 1703: var fudge = 23;
1.565 albertel 1704: var new_height = window_height-fudge-textarea_top-bottom_height;
1705: if (new_height < 300) {
1706: new_height = 300;
1707: }
1708: textarea.style.height=new_height+'px';
1709: }
1.824 bisitz 1710: // ]]>
1.565 albertel 1711: </script>
1712: RESIZE
1713:
1714: }
1715:
1716: =pod
1717:
1.256 matthew 1718: =head1 Excel and CSV file utility routines
1719:
1720: =over 4
1721:
1722: =cut
1723:
1724: ###############################################################
1725: ###############################################################
1726:
1727: =pod
1728:
1.648 raeburn 1729: =item * &csv_translate($text)
1.37 matthew 1730:
1.185 www 1731: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1732: format.
1733:
1734: =cut
1735:
1.180 matthew 1736: ###############################################################
1737: ###############################################################
1.37 matthew 1738: sub csv_translate {
1739: my $text = shift;
1740: $text =~ s/\"/\"\"/g;
1.209 albertel 1741: $text =~ s/\n/ /g;
1.37 matthew 1742: return $text;
1743: }
1.180 matthew 1744:
1745: ###############################################################
1746: ###############################################################
1747:
1748: =pod
1749:
1.648 raeburn 1750: =item * &define_excel_formats()
1.180 matthew 1751:
1752: Define some commonly used Excel cell formats.
1753:
1754: Currently supported formats:
1755:
1756: =over 4
1757:
1758: =item header
1759:
1760: =item bold
1761:
1762: =item h1
1763:
1764: =item h2
1765:
1766: =item h3
1767:
1.256 matthew 1768: =item h4
1769:
1770: =item i
1771:
1.180 matthew 1772: =item date
1773:
1774: =back
1775:
1776: Inputs: $workbook
1777:
1778: Returns: $format, a hash reference.
1779:
1.1057 foxr 1780:
1.180 matthew 1781: =cut
1782:
1783: ###############################################################
1784: ###############################################################
1785: sub define_excel_formats {
1786: my ($workbook) = @_;
1787: my $format;
1788: $format->{'header'} = $workbook->add_format(bold => 1,
1789: bottom => 1,
1790: align => 'center');
1791: $format->{'bold'} = $workbook->add_format(bold=>1);
1792: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1793: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1794: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1795: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1796: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1797: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1798: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1799: return $format;
1800: }
1801:
1802: ###############################################################
1803: ###############################################################
1.113 bowersj2 1804:
1805: =pod
1806:
1.648 raeburn 1807: =item * &create_workbook()
1.255 matthew 1808:
1809: Create an Excel worksheet. If it fails, output message on the
1810: request object and return undefs.
1811:
1812: Inputs: Apache request object
1813:
1814: Returns (undef) on failure,
1815: Excel worksheet object, scalar with filename, and formats
1816: from &Apache::loncommon::define_excel_formats on success
1817:
1818: =cut
1819:
1820: ###############################################################
1821: ###############################################################
1822: sub create_workbook {
1823: my ($r) = @_;
1824: #
1825: # Create the excel spreadsheet
1826: my $filename = '/prtspool/'.
1.258 albertel 1827: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1828: time.'_'.rand(1000000000).'.xls';
1829: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1830: if (! defined($workbook)) {
1831: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1832: $r->print(
1833: '<p class="LC_error">'
1834: .&mt('Problems occurred in creating the new Excel file.')
1835: .' '.&mt('This error has been logged.')
1836: .' '.&mt('Please alert your LON-CAPA administrator.')
1837: .'</p>'
1838: );
1.255 matthew 1839: return (undef);
1840: }
1841: #
1.1014 foxr 1842: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1843: #
1844: my $format = &Apache::loncommon::define_excel_formats($workbook);
1845: return ($workbook,$filename,$format);
1846: }
1847:
1848: ###############################################################
1849: ###############################################################
1850:
1851: =pod
1852:
1.648 raeburn 1853: =item * &create_text_file()
1.113 bowersj2 1854:
1.542 raeburn 1855: Create a file to write to and eventually make available to the user.
1.256 matthew 1856: If file creation fails, outputs an error message on the request object and
1857: return undefs.
1.113 bowersj2 1858:
1.256 matthew 1859: Inputs: Apache request object, and file suffix
1.113 bowersj2 1860:
1.256 matthew 1861: Returns (undef) on failure,
1862: Filehandle and filename on success.
1.113 bowersj2 1863:
1864: =cut
1865:
1.256 matthew 1866: ###############################################################
1867: ###############################################################
1868: sub create_text_file {
1869: my ($r,$suffix) = @_;
1870: if (! defined($suffix)) { $suffix = 'txt'; };
1871: my $fh;
1872: my $filename = '/prtspool/'.
1.258 albertel 1873: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1874: time.'_'.rand(1000000000).'.'.$suffix;
1875: $fh = Apache::File->new('>/home/httpd'.$filename);
1876: if (! defined($fh)) {
1877: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1878: $r->print(
1879: '<p class="LC_error">'
1880: .&mt('Problems occurred in creating the output file.')
1881: .' '.&mt('This error has been logged.')
1882: .' '.&mt('Please alert your LON-CAPA administrator.')
1883: .'</p>'
1884: );
1.113 bowersj2 1885: }
1.256 matthew 1886: return ($fh,$filename)
1.113 bowersj2 1887: }
1888:
1889:
1.256 matthew 1890: =pod
1.113 bowersj2 1891:
1892: =back
1893:
1894: =cut
1.37 matthew 1895:
1896: ###############################################################
1.33 matthew 1897: ## Home server <option> list generating code ##
1898: ###############################################################
1.35 matthew 1899:
1.169 www 1900: # ------------------------------------------
1901:
1902: sub domain_select {
1903: my ($name,$value,$multiple)=@_;
1904: my %domains=map {
1.514 albertel 1905: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1906: } &Apache::lonnet::all_domains();
1.169 www 1907: if ($multiple) {
1908: $domains{''}=&mt('Any domain');
1.550 albertel 1909: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1910: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1911: } else {
1.550 albertel 1912: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1913: return &select_form($name,$value,\%domains);
1.169 www 1914: }
1915: }
1916:
1.282 albertel 1917: #-------------------------------------------
1918:
1919: =pod
1920:
1.519 raeburn 1921: =head1 Routines for form select boxes
1922:
1923: =over 4
1924:
1.648 raeburn 1925: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1926:
1927: Returns a string containing a <select> element int multiple mode
1928:
1929:
1930: Args:
1931: $name - name of the <select> element
1.506 raeburn 1932: $value - scalar or array ref of values that should already be selected
1.282 albertel 1933: $size - number of rows long the select element is
1.283 albertel 1934: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1935: (shown text should already have been &mt())
1.506 raeburn 1936: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1937:
1.282 albertel 1938: =cut
1939:
1940: #-------------------------------------------
1.169 www 1941: sub multiple_select_form {
1.284 albertel 1942: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1943: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1944: my $output='';
1.191 matthew 1945: if (! defined($size)) {
1946: $size = 4;
1.283 albertel 1947: if (scalar(keys(%$hash))<4) {
1948: $size = scalar(keys(%$hash));
1.191 matthew 1949: }
1950: }
1.734 bisitz 1951: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1952: my @order;
1.506 raeburn 1953: if (ref($order) eq 'ARRAY') {
1954: @order = @{$order};
1955: } else {
1956: @order = sort(keys(%$hash));
1.501 banghart 1957: }
1958: if (exists($$hash{'select_form_order'})) {
1959: @order = @{$$hash{'select_form_order'}};
1960: }
1961:
1.284 albertel 1962: foreach my $key (@order) {
1.356 albertel 1963: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1964: $output.='selected="selected" ' if ($selected{$key});
1965: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1966: }
1967: $output.="</select>\n";
1968: return $output;
1969: }
1970:
1.88 www 1971: #-------------------------------------------
1972:
1973: =pod
1974:
1.970 raeburn 1975: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 1976:
1977: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 1978: allow a user to select options from a ref to a hash containing:
1979: option_name => displayed text. An optional $onchange can include
1980: a javascript onchange item, e.g., onchange="this.form.submit();"
1981:
1.88 www 1982: See lonrights.pm for an example invocation and use.
1983:
1984: =cut
1985:
1986: #-------------------------------------------
1987: sub select_form {
1.970 raeburn 1988: my ($def,$name,$hashref,$onchange) = @_;
1989: return unless (ref($hashref) eq 'HASH');
1990: if ($onchange) {
1991: $onchange = ' onchange="'.$onchange.'"';
1992: }
1993: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 1994: my @keys;
1.970 raeburn 1995: if (exists($hashref->{'select_form_order'})) {
1996: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 1997: } else {
1.970 raeburn 1998: @keys=sort(keys(%{$hashref}));
1.128 albertel 1999: }
1.356 albertel 2000: foreach my $key (@keys) {
2001: $selectform.=
2002: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2003: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2004: ">".$hashref->{$key}."</option>\n";
1.88 www 2005: }
2006: $selectform.="</select>";
2007: return $selectform;
2008: }
2009:
1.475 www 2010: # For display filters
2011:
2012: sub display_filter {
1.1074 raeburn 2013: my ($context) = @_;
1.475 www 2014: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2015: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2016: my $phraseinput = 'hidden';
2017: my $includeinput = 'hidden';
2018: my ($checked,$includetypestext);
2019: if ($env{'form.displayfilter'} eq 'containing') {
2020: $phraseinput = 'text';
2021: if ($context eq 'parmslog') {
2022: $includeinput = 'checkbox';
2023: if ($env{'form.includetypes'}) {
2024: $checked = ' checked="checked"';
2025: }
2026: $includetypestext = &mt('Include parameter types');
2027: }
2028: } else {
2029: $includetypestext = ' ';
2030: }
2031: my ($additional,$secondid,$thirdid);
2032: if ($context eq 'parmslog') {
2033: $additional =
2034: '<label><input type="'.$includeinput.'" name="includetypes"'.
2035: $checked.' name="includetypes" value="1" id="includetypes" />'.
2036: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2037: '</label>';
2038: $secondid = 'includetypes';
2039: $thirdid = 'includetypestext';
2040: }
2041: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2042: '$secondid','$thirdid')";
2043: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2044: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2045: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2046: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2047: &mt('Filter: [_1]',
1.477 www 2048: &select_form($env{'form.displayfilter'},
2049: 'displayfilter',
1.970 raeburn 2050: {'currentfolder' => 'Current folder/page',
1.477 www 2051: 'containing' => 'Containing phrase',
1.1074 raeburn 2052: 'none' => 'None'},$onchange)).' '.
2053: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2054: &HTML::Entities::encode($env{'form.containingphrase'}).
2055: '" />'.$additional;
2056: }
2057:
2058: sub display_filter_js {
2059: my $includetext = &mt('Include parameter types');
2060: return <<"ENDJS";
2061:
2062: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2063: var firstType = 'hidden';
2064: if (setter.options[setter.selectedIndex].value == 'containing') {
2065: firstType = 'text';
2066: }
2067: firstObject = document.getElementById(firstid);
2068: if (typeof(firstObject) == 'object') {
2069: if (firstObject.type != firstType) {
2070: changeInputType(firstObject,firstType);
2071: }
2072: }
2073: if (context == 'parmslog') {
2074: var secondType = 'hidden';
2075: if (firstType == 'text') {
2076: secondType = 'checkbox';
2077: }
2078: secondObject = document.getElementById(secondid);
2079: if (typeof(secondObject) == 'object') {
2080: if (secondObject.type != secondType) {
2081: changeInputType(secondObject,secondType);
2082: }
2083: }
2084: var textItem = document.getElementById(thirdid);
2085: var currtext = textItem.innerHTML;
2086: var newtext;
2087: if (firstType == 'text') {
2088: newtext = '$includetext';
2089: } else {
2090: newtext = ' ';
2091: }
2092: if (currtext != newtext) {
2093: textItem.innerHTML = newtext;
2094: }
2095: }
2096: return;
2097: }
2098:
2099: function changeInputType(oldObject,newType) {
2100: var newObject = document.createElement('input');
2101: newObject.type = newType;
2102: if (oldObject.size) {
2103: newObject.size = oldObject.size;
2104: }
2105: if (oldObject.value) {
2106: newObject.value = oldObject.value;
2107: }
2108: if (oldObject.name) {
2109: newObject.name = oldObject.name;
2110: }
2111: if (oldObject.id) {
2112: newObject.id = oldObject.id;
2113: }
2114: oldObject.parentNode.replaceChild(newObject,oldObject);
2115: return;
2116: }
2117:
2118: ENDJS
1.475 www 2119: }
2120:
1.167 www 2121: sub gradeleveldescription {
2122: my $gradelevel=shift;
2123: my %gradelevels=(0 => 'Not specified',
2124: 1 => 'Grade 1',
2125: 2 => 'Grade 2',
2126: 3 => 'Grade 3',
2127: 4 => 'Grade 4',
2128: 5 => 'Grade 5',
2129: 6 => 'Grade 6',
2130: 7 => 'Grade 7',
2131: 8 => 'Grade 8',
2132: 9 => 'Grade 9',
2133: 10 => 'Grade 10',
2134: 11 => 'Grade 11',
2135: 12 => 'Grade 12',
2136: 13 => 'Grade 13',
2137: 14 => '100 Level',
2138: 15 => '200 Level',
2139: 16 => '300 Level',
2140: 17 => '400 Level',
2141: 18 => 'Graduate Level');
2142: return &mt($gradelevels{$gradelevel});
2143: }
2144:
1.163 www 2145: sub select_level_form {
2146: my ($deflevel,$name)=@_;
2147: unless ($deflevel) { $deflevel=0; }
1.167 www 2148: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2149: for (my $i=0; $i<=18; $i++) {
2150: $selectform.="<option value=\"$i\" ".
1.253 albertel 2151: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2152: ">".&gradeleveldescription($i)."</option>\n";
2153: }
2154: $selectform.="</select>";
2155: return $selectform;
1.163 www 2156: }
1.167 www 2157:
1.35 matthew 2158: #-------------------------------------------
2159:
1.45 matthew 2160: =pod
2161:
1.910 raeburn 2162: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35 matthew 2163:
2164: Returns a string containing a <select name='$name' size='1'> form to
2165: allow a user to select the domain to preform an operation in.
2166: See loncreateuser.pm for an example invocation and use.
2167:
1.90 www 2168: If the $includeempty flag is set, it also includes an empty choice ("no domain
2169: selected");
2170:
1.743 raeburn 2171: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2172:
1.910 raeburn 2173: 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.
2174:
2175: The optional $incdoms is a reference to an array of domains which will be the only available options.
1.563 raeburn 2176:
1.35 matthew 2177: =cut
2178:
2179: #-------------------------------------------
1.34 matthew 2180: sub select_dom_form {
1.910 raeburn 2181: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872 raeburn 2182: if ($onchange) {
1.874 raeburn 2183: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2184: }
1.910 raeburn 2185: my @domains;
2186: if (ref($incdoms) eq 'ARRAY') {
2187: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2188: } else {
2189: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2190: }
1.90 www 2191: if ($includeempty) { @domains=('',@domains); }
1.743 raeburn 2192: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2193: foreach my $dom (@domains) {
2194: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2195: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2196: if ($showdomdesc) {
2197: if ($dom ne '') {
2198: my $domdesc = &Apache::lonnet::domain($dom,'description');
2199: if ($domdesc ne '') {
2200: $selectdomain .= ' ('.$domdesc.')';
2201: }
2202: }
2203: }
2204: $selectdomain .= "</option>\n";
1.34 matthew 2205: }
2206: $selectdomain.="</select>";
2207: return $selectdomain;
2208: }
2209:
1.35 matthew 2210: #-------------------------------------------
2211:
1.45 matthew 2212: =pod
2213:
1.648 raeburn 2214: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2215:
1.586 raeburn 2216: input: 4 arguments (two required, two optional) -
2217: $domain - domain of new user
2218: $name - name of form element
2219: $default - Value of 'default' causes a default item to be first
2220: option, and selected by default.
2221: $hide - Value of 'hide' causes hiding of the name of the server,
2222: if 1 server found, or default, if 0 found.
1.594 raeburn 2223: output: returns 2 items:
1.586 raeburn 2224: (a) form element which contains either:
2225: (i) <select name="$name">
2226: <option value="$hostid1">$hostid $servers{$hostid}</option>
2227: <option value="$hostid2">$hostid $servers{$hostid}</option>
2228: </select>
2229: form item if there are multiple library servers in $domain, or
2230: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2231: if there is only one library server in $domain.
2232:
2233: (b) number of library servers found.
2234:
2235: See loncreateuser.pm for example of use.
1.35 matthew 2236:
2237: =cut
2238:
2239: #-------------------------------------------
1.586 raeburn 2240: sub home_server_form_item {
2241: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2242: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2243: my $result;
2244: my $numlib = keys(%servers);
2245: if ($numlib > 1) {
2246: $result .= '<select name="'.$name.'" />'."\n";
2247: if ($default) {
1.804 bisitz 2248: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2249: '</option>'."\n";
2250: }
2251: foreach my $hostid (sort(keys(%servers))) {
2252: $result.= '<option value="'.$hostid.'">'.
2253: $hostid.' '.$servers{$hostid}."</option>\n";
2254: }
2255: $result .= '</select>'."\n";
2256: } elsif ($numlib == 1) {
2257: my $hostid;
2258: foreach my $item (keys(%servers)) {
2259: $hostid = $item;
2260: }
2261: $result .= '<input type="hidden" name="'.$name.'" value="'.
2262: $hostid.'" />';
2263: if (!$hide) {
2264: $result .= $hostid.' '.$servers{$hostid};
2265: }
2266: $result .= "\n";
2267: } elsif ($default) {
2268: $result .= '<input type="hidden" name="'.$name.
2269: '" value="default" />';
2270: if (!$hide) {
2271: $result .= &mt('default');
2272: }
2273: $result .= "\n";
1.33 matthew 2274: }
1.586 raeburn 2275: return ($result,$numlib);
1.33 matthew 2276: }
1.112 bowersj2 2277:
2278: =pod
2279:
1.534 albertel 2280: =back
2281:
1.112 bowersj2 2282: =cut
1.87 matthew 2283:
2284: ###############################################################
1.112 bowersj2 2285: ## Decoding User Agent ##
1.87 matthew 2286: ###############################################################
2287:
2288: =pod
2289:
1.112 bowersj2 2290: =head1 Decoding the User Agent
2291:
2292: =over 4
2293:
2294: =item * &decode_user_agent()
1.87 matthew 2295:
2296: Inputs: $r
2297:
2298: Outputs:
2299:
2300: =over 4
2301:
1.112 bowersj2 2302: =item * $httpbrowser
1.87 matthew 2303:
1.112 bowersj2 2304: =item * $clientbrowser
1.87 matthew 2305:
1.112 bowersj2 2306: =item * $clientversion
1.87 matthew 2307:
1.112 bowersj2 2308: =item * $clientmathml
1.87 matthew 2309:
1.112 bowersj2 2310: =item * $clientunicode
1.87 matthew 2311:
1.112 bowersj2 2312: =item * $clientos
1.87 matthew 2313:
2314: =back
2315:
1.157 matthew 2316: =back
2317:
1.87 matthew 2318: =cut
2319:
2320: ###############################################################
2321: ###############################################################
2322: sub decode_user_agent {
1.247 albertel 2323: my ($r)=@_;
1.87 matthew 2324: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2325: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2326: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2327: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2328: my $clientbrowser='unknown';
2329: my $clientversion='0';
2330: my $clientmathml='';
2331: my $clientunicode='0';
2332: for (my $i=0;$i<=$#browsertype;$i++) {
2333: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2334: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2335: $clientbrowser=$bname;
2336: $httpbrowser=~/$vreg/i;
2337: $clientversion=$1;
2338: $clientmathml=($clientversion>=$minv);
2339: $clientunicode=($clientversion>=$univ);
2340: }
2341: }
2342: my $clientos='unknown';
2343: if (($httpbrowser=~/linux/i) ||
2344: ($httpbrowser=~/unix/i) ||
2345: ($httpbrowser=~/ux/i) ||
2346: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2347: if (($httpbrowser=~/vax/i) ||
2348: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2349: if ($httpbrowser=~/next/i) { $clientos='next'; }
2350: if (($httpbrowser=~/mac/i) ||
2351: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2352: if ($httpbrowser=~/win/i) { $clientos='win'; }
2353: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2354: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2355: $clientunicode,$clientos,);
2356: }
2357:
1.32 matthew 2358: ###############################################################
2359: ## Authentication changing form generation subroutines ##
2360: ###############################################################
2361: ##
2362: ## All of the authform_xxxxxxx subroutines take their inputs in a
2363: ## hash, and have reasonable default values.
2364: ##
2365: ## formname = the name given in the <form> tag.
1.35 matthew 2366: #-------------------------------------------
2367:
1.45 matthew 2368: =pod
2369:
1.112 bowersj2 2370: =head1 Authentication Routines
2371:
2372: =over 4
2373:
1.648 raeburn 2374: =item * &authform_xxxxxx()
1.35 matthew 2375:
2376: The authform_xxxxxx subroutines provide javascript and html forms which
2377: handle some of the conveniences required for authentication forms.
2378: This is not an optimal method, but it works.
2379:
2380: =over 4
2381:
1.112 bowersj2 2382: =item * authform_header
1.35 matthew 2383:
1.112 bowersj2 2384: =item * authform_authorwarning
1.35 matthew 2385:
1.112 bowersj2 2386: =item * authform_nochange
1.35 matthew 2387:
1.112 bowersj2 2388: =item * authform_kerberos
1.35 matthew 2389:
1.112 bowersj2 2390: =item * authform_internal
1.35 matthew 2391:
1.112 bowersj2 2392: =item * authform_filesystem
1.35 matthew 2393:
2394: =back
2395:
1.648 raeburn 2396: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2397:
1.35 matthew 2398: =cut
2399:
2400: #-------------------------------------------
1.32 matthew 2401: sub authform_header{
2402: my %in = (
2403: formname => 'cu',
1.80 albertel 2404: kerb_def_dom => '',
1.32 matthew 2405: @_,
2406: );
2407: $in{'formname'} = 'document.' . $in{'formname'};
2408: my $result='';
1.80 albertel 2409:
2410: #---------------------------------------------- Code for upper case translation
2411: my $Javascript_toUpperCase;
2412: unless ($in{kerb_def_dom}) {
2413: $Javascript_toUpperCase =<<"END";
2414: switch (choice) {
2415: case 'krb': currentform.elements[choicearg].value =
2416: currentform.elements[choicearg].value.toUpperCase();
2417: break;
2418: default:
2419: }
2420: END
2421: } else {
2422: $Javascript_toUpperCase = "";
2423: }
2424:
1.165 raeburn 2425: my $radioval = "'nochange'";
1.591 raeburn 2426: if (defined($in{'curr_authtype'})) {
2427: if ($in{'curr_authtype'} ne '') {
2428: $radioval = "'".$in{'curr_authtype'}."arg'";
2429: }
1.174 matthew 2430: }
1.165 raeburn 2431: my $argfield = 'null';
1.591 raeburn 2432: if (defined($in{'mode'})) {
1.165 raeburn 2433: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2434: if (defined($in{'curr_autharg'})) {
2435: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2436: $argfield = "'$in{'curr_autharg'}'";
2437: }
2438: }
2439: }
2440: }
2441:
1.32 matthew 2442: $result.=<<"END";
2443: var current = new Object();
1.165 raeburn 2444: current.radiovalue = $radioval;
2445: current.argfield = $argfield;
1.32 matthew 2446:
2447: function changed_radio(choice,currentform) {
2448: var choicearg = choice + 'arg';
2449: // If a radio button in changed, we need to change the argfield
2450: if (current.radiovalue != choice) {
2451: current.radiovalue = choice;
2452: if (current.argfield != null) {
2453: currentform.elements[current.argfield].value = '';
2454: }
2455: if (choice == 'nochange') {
2456: current.argfield = null;
2457: } else {
2458: current.argfield = choicearg;
2459: switch(choice) {
2460: case 'krb':
2461: currentform.elements[current.argfield].value =
2462: "$in{'kerb_def_dom'}";
2463: break;
2464: default:
2465: break;
2466: }
2467: }
2468: }
2469: return;
2470: }
1.22 www 2471:
1.32 matthew 2472: function changed_text(choice,currentform) {
2473: var choicearg = choice + 'arg';
2474: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2475: $Javascript_toUpperCase
1.32 matthew 2476: // clear old field
2477: if ((current.argfield != choicearg) && (current.argfield != null)) {
2478: currentform.elements[current.argfield].value = '';
2479: }
2480: current.argfield = choicearg;
2481: }
2482: set_auth_radio_buttons(choice,currentform);
2483: return;
1.20 www 2484: }
1.32 matthew 2485:
2486: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2487: var numauthchoices = currentform.login.length;
2488: if (typeof numauthchoices == "undefined") {
2489: return;
2490: }
1.32 matthew 2491: var i=0;
1.986 raeburn 2492: while (i < numauthchoices) {
1.32 matthew 2493: if (currentform.login[i].value == newvalue) { break; }
2494: i++;
2495: }
1.986 raeburn 2496: if (i == numauthchoices) {
1.32 matthew 2497: return;
2498: }
2499: current.radiovalue = newvalue;
2500: currentform.login[i].checked = true;
2501: return;
2502: }
2503: END
2504: return $result;
2505: }
2506:
2507: sub authform_authorwarning{
2508: my $result='';
1.144 matthew 2509: $result='<i>'.
2510: &mt('As a general rule, only authors or co-authors should be '.
2511: 'filesystem authenticated '.
2512: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2513: return $result;
2514: }
2515:
2516: sub authform_nochange{
2517: my %in = (
2518: formname => 'document.cu',
2519: kerb_def_dom => 'MSU.EDU',
2520: @_,
2521: );
1.586 raeburn 2522: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2523: my $result;
2524: if (keys(%can_assign) == 0) {
2525: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2526: } else {
2527: $result = '<label>'.&mt('[_1] Do not change login data',
2528: '<input type="radio" name="login" value="nochange" '.
2529: 'checked="checked" onclick="'.
1.281 albertel 2530: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2531: '</label>';
1.586 raeburn 2532: }
1.32 matthew 2533: return $result;
2534: }
2535:
1.591 raeburn 2536: sub authform_kerberos {
1.32 matthew 2537: my %in = (
2538: formname => 'document.cu',
2539: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2540: kerb_def_auth => 'krb4',
1.32 matthew 2541: @_,
2542: );
1.586 raeburn 2543: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2544: $autharg,$jscall);
2545: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2546: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2547: $check5 = ' checked="checked"';
1.80 albertel 2548: } else {
1.772 bisitz 2549: $check4 = ' checked="checked"';
1.80 albertel 2550: }
1.165 raeburn 2551: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2552: if (defined($in{'curr_authtype'})) {
2553: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2554: $krbcheck = ' checked="checked"';
1.623 raeburn 2555: if (defined($in{'mode'})) {
2556: if ($in{'mode'} eq 'modifyuser') {
2557: $krbcheck = '';
2558: }
2559: }
1.591 raeburn 2560: if (defined($in{'curr_kerb_ver'})) {
2561: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2562: $check5 = ' checked="checked"';
1.591 raeburn 2563: $check4 = '';
2564: } else {
1.772 bisitz 2565: $check4 = ' checked="checked"';
1.591 raeburn 2566: $check5 = '';
2567: }
1.586 raeburn 2568: }
1.591 raeburn 2569: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2570: $krbarg = $in{'curr_autharg'};
2571: }
1.586 raeburn 2572: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2573: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2574: $result =
2575: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2576: $in{'curr_autharg'},$krbver);
2577: } else {
2578: $result =
2579: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2580: }
2581: return $result;
2582: }
2583: }
2584: } else {
2585: if ($authnum == 1) {
1.784 bisitz 2586: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2587: }
2588: }
1.586 raeburn 2589: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2590: return;
1.587 raeburn 2591: } elsif ($authtype eq '') {
1.591 raeburn 2592: if (defined($in{'mode'})) {
1.587 raeburn 2593: if ($in{'mode'} eq 'modifycourse') {
2594: if ($authnum == 1) {
1.784 bisitz 2595: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2596: }
2597: }
2598: }
1.586 raeburn 2599: }
2600: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2601: if ($authtype eq '') {
2602: $authtype = '<input type="radio" name="login" value="krb" '.
2603: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2604: $krbcheck.' />';
2605: }
2606: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2607: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2608: $in{'curr_authtype'} eq 'krb5') ||
2609: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2610: $in{'curr_authtype'} eq 'krb4')) {
2611: $result .= &mt
1.144 matthew 2612: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2613: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2614: '<label>'.$authtype,
1.281 albertel 2615: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2616: 'value="'.$krbarg.'" '.
1.144 matthew 2617: 'onchange="'.$jscall.'" />',
1.281 albertel 2618: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2619: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2620: '</label>');
1.586 raeburn 2621: } elsif ($can_assign{'krb4'}) {
2622: $result .= &mt
2623: ('[_1] Kerberos authenticated with domain [_2] '.
2624: '[_3] Version 4 [_4]',
2625: '<label>'.$authtype,
2626: '</label><input type="text" size="10" name="krbarg" '.
2627: 'value="'.$krbarg.'" '.
2628: 'onchange="'.$jscall.'" />',
2629: '<label><input type="hidden" name="krbver" value="4" />',
2630: '</label>');
2631: } elsif ($can_assign{'krb5'}) {
2632: $result .= &mt
2633: ('[_1] Kerberos authenticated with domain [_2] '.
2634: '[_3] Version 5 [_4]',
2635: '<label>'.$authtype,
2636: '</label><input type="text" size="10" name="krbarg" '.
2637: 'value="'.$krbarg.'" '.
2638: 'onchange="'.$jscall.'" />',
2639: '<label><input type="hidden" name="krbver" value="5" />',
2640: '</label>');
2641: }
1.32 matthew 2642: return $result;
2643: }
2644:
2645: sub authform_internal{
1.586 raeburn 2646: my %in = (
1.32 matthew 2647: formname => 'document.cu',
2648: kerb_def_dom => 'MSU.EDU',
2649: @_,
2650: );
1.586 raeburn 2651: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2652: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2653: if (defined($in{'curr_authtype'})) {
2654: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2655: if ($can_assign{'int'}) {
1.772 bisitz 2656: $intcheck = 'checked="checked" ';
1.623 raeburn 2657: if (defined($in{'mode'})) {
2658: if ($in{'mode'} eq 'modifyuser') {
2659: $intcheck = '';
2660: }
2661: }
1.591 raeburn 2662: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2663: $intarg = $in{'curr_autharg'};
2664: }
2665: } else {
2666: $result = &mt('Currently internally authenticated.');
2667: return $result;
1.165 raeburn 2668: }
2669: }
1.586 raeburn 2670: } else {
2671: if ($authnum == 1) {
1.784 bisitz 2672: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2673: }
2674: }
2675: if (!$can_assign{'int'}) {
2676: return;
1.587 raeburn 2677: } elsif ($authtype eq '') {
1.591 raeburn 2678: if (defined($in{'mode'})) {
1.587 raeburn 2679: if ($in{'mode'} eq 'modifycourse') {
2680: if ($authnum == 1) {
1.784 bisitz 2681: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2682: }
2683: }
2684: }
1.165 raeburn 2685: }
1.586 raeburn 2686: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2687: if ($authtype eq '') {
2688: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2689: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2690: }
1.605 bisitz 2691: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2692: $intarg.'" onchange="'.$jscall.'" />';
2693: $result = &mt
1.144 matthew 2694: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2695: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2696: $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 2697: return $result;
2698: }
2699:
2700: sub authform_local{
2701: my %in = (
2702: formname => 'document.cu',
2703: kerb_def_dom => 'MSU.EDU',
2704: @_,
2705: );
1.586 raeburn 2706: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2707: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2708: if (defined($in{'curr_authtype'})) {
2709: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2710: if ($can_assign{'loc'}) {
1.772 bisitz 2711: $loccheck = 'checked="checked" ';
1.623 raeburn 2712: if (defined($in{'mode'})) {
2713: if ($in{'mode'} eq 'modifyuser') {
2714: $loccheck = '';
2715: }
2716: }
1.591 raeburn 2717: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2718: $locarg = $in{'curr_autharg'};
2719: }
2720: } else {
2721: $result = &mt('Currently using local (institutional) authentication.');
2722: return $result;
1.165 raeburn 2723: }
2724: }
1.586 raeburn 2725: } else {
2726: if ($authnum == 1) {
1.784 bisitz 2727: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2728: }
2729: }
2730: if (!$can_assign{'loc'}) {
2731: return;
1.587 raeburn 2732: } elsif ($authtype eq '') {
1.591 raeburn 2733: if (defined($in{'mode'})) {
1.587 raeburn 2734: if ($in{'mode'} eq 'modifycourse') {
2735: if ($authnum == 1) {
1.784 bisitz 2736: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2737: }
2738: }
2739: }
1.165 raeburn 2740: }
1.586 raeburn 2741: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2742: if ($authtype eq '') {
2743: $authtype = '<input type="radio" name="login" value="loc" '.
2744: $loccheck.' onchange="'.$jscall.'" onclick="'.
2745: $jscall.'" />';
2746: }
2747: $autharg = '<input type="text" size="10" name="locarg" value="'.
2748: $locarg.'" onchange="'.$jscall.'" />';
2749: $result = &mt('[_1] Local Authentication with argument [_2]',
2750: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2751: return $result;
2752: }
2753:
2754: sub authform_filesystem{
2755: my %in = (
2756: formname => 'document.cu',
2757: kerb_def_dom => 'MSU.EDU',
2758: @_,
2759: );
1.586 raeburn 2760: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2761: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2762: if (defined($in{'curr_authtype'})) {
2763: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2764: if ($can_assign{'fsys'}) {
1.772 bisitz 2765: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2766: if (defined($in{'mode'})) {
2767: if ($in{'mode'} eq 'modifyuser') {
2768: $fsyscheck = '';
2769: }
2770: }
1.586 raeburn 2771: } else {
2772: $result = &mt('Currently Filesystem Authenticated.');
2773: return $result;
2774: }
2775: }
2776: } else {
2777: if ($authnum == 1) {
1.784 bisitz 2778: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2779: }
2780: }
2781: if (!$can_assign{'fsys'}) {
2782: return;
1.587 raeburn 2783: } elsif ($authtype eq '') {
1.591 raeburn 2784: if (defined($in{'mode'})) {
1.587 raeburn 2785: if ($in{'mode'} eq 'modifycourse') {
2786: if ($authnum == 1) {
1.784 bisitz 2787: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2788: }
2789: }
2790: }
1.586 raeburn 2791: }
2792: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2793: if ($authtype eq '') {
2794: $authtype = '<input type="radio" name="login" value="fsys" '.
2795: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2796: $jscall.'" />';
2797: }
2798: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2799: ' onchange="'.$jscall.'" />';
2800: $result = &mt
1.144 matthew 2801: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2802: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2803: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2804: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2805: 'onchange="'.$jscall.'" />');
1.32 matthew 2806: return $result;
2807: }
2808:
1.586 raeburn 2809: sub get_assignable_auth {
2810: my ($dom) = @_;
2811: if ($dom eq '') {
2812: $dom = $env{'request.role.domain'};
2813: }
2814: my %can_assign = (
2815: krb4 => 1,
2816: krb5 => 1,
2817: int => 1,
2818: loc => 1,
2819: );
2820: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2821: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2822: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2823: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2824: my $context;
2825: if ($env{'request.role'} =~ /^au/) {
2826: $context = 'author';
2827: } elsif ($env{'request.role'} =~ /^dc/) {
2828: $context = 'domain';
2829: } elsif ($env{'request.course.id'}) {
2830: $context = 'course';
2831: }
2832: if ($context) {
2833: if (ref($authhash->{$context}) eq 'HASH') {
2834: %can_assign = %{$authhash->{$context}};
2835: }
2836: }
2837: }
2838: }
2839: my $authnum = 0;
2840: foreach my $key (keys(%can_assign)) {
2841: if ($can_assign{$key}) {
2842: $authnum ++;
2843: }
2844: }
2845: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2846: $authnum --;
2847: }
2848: return ($authnum,%can_assign);
2849: }
2850:
1.80 albertel 2851: ###############################################################
2852: ## Get Kerberos Defaults for Domain ##
2853: ###############################################################
2854: ##
2855: ## Returns default kerberos version and an associated argument
2856: ## as listed in file domain.tab. If not listed, provides
2857: ## appropriate default domain and kerberos version.
2858: ##
2859: #-------------------------------------------
2860:
2861: =pod
2862:
1.648 raeburn 2863: =item * &get_kerberos_defaults()
1.80 albertel 2864:
2865: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2866: version and domain. If not found, it defaults to version 4 and the
2867: domain of the server.
1.80 albertel 2868:
1.648 raeburn 2869: =over 4
2870:
1.80 albertel 2871: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2872:
1.648 raeburn 2873: =back
2874:
2875: =back
2876:
1.80 albertel 2877: =cut
2878:
2879: #-------------------------------------------
2880: sub get_kerberos_defaults {
2881: my $domain=shift;
1.641 raeburn 2882: my ($krbdef,$krbdefdom);
2883: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2884: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2885: $krbdef = $domdefaults{'auth_def'};
2886: $krbdefdom = $domdefaults{'auth_arg_def'};
2887: } else {
1.80 albertel 2888: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2889: my $krbdefdom=$1;
2890: $krbdefdom=~tr/a-z/A-Z/;
2891: $krbdef = "krb4";
2892: }
2893: return ($krbdef,$krbdefdom);
2894: }
1.112 bowersj2 2895:
1.32 matthew 2896:
1.46 matthew 2897: ###############################################################
2898: ## Thesaurus Functions ##
2899: ###############################################################
1.20 www 2900:
1.46 matthew 2901: =pod
1.20 www 2902:
1.112 bowersj2 2903: =head1 Thesaurus Functions
2904:
2905: =over 4
2906:
1.648 raeburn 2907: =item * &initialize_keywords()
1.46 matthew 2908:
2909: Initializes the package variable %Keywords if it is empty. Uses the
2910: package variable $thesaurus_db_file.
2911:
2912: =cut
2913:
2914: ###################################################
2915:
2916: sub initialize_keywords {
2917: return 1 if (scalar keys(%Keywords));
2918: # If we are here, %Keywords is empty, so fill it up
2919: # Make sure the file we need exists...
2920: if (! -e $thesaurus_db_file) {
2921: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2922: " failed because it does not exist");
2923: return 0;
2924: }
2925: # Set up the hash as a database
2926: my %thesaurus_db;
2927: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2928: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2929: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2930: $thesaurus_db_file);
2931: return 0;
2932: }
2933: # Get the average number of appearances of a word.
2934: my $avecount = $thesaurus_db{'average.count'};
2935: # Put keywords (those that appear > average) into %Keywords
2936: while (my ($word,$data)=each (%thesaurus_db)) {
2937: my ($count,undef) = split /:/,$data;
2938: $Keywords{$word}++ if ($count > $avecount);
2939: }
2940: untie %thesaurus_db;
2941: # Remove special values from %Keywords.
1.356 albertel 2942: foreach my $value ('total.count','average.count') {
2943: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2944: }
1.46 matthew 2945: return 1;
2946: }
2947:
2948: ###################################################
2949:
2950: =pod
2951:
1.648 raeburn 2952: =item * &keyword($word)
1.46 matthew 2953:
2954: Returns true if $word is a keyword. A keyword is a word that appears more
2955: than the average number of times in the thesaurus database. Calls
2956: &initialize_keywords
2957:
2958: =cut
2959:
2960: ###################################################
1.20 www 2961:
2962: sub keyword {
1.46 matthew 2963: return if (!&initialize_keywords());
2964: my $word=lc(shift());
2965: $word=~s/\W//g;
2966: return exists($Keywords{$word});
1.20 www 2967: }
1.46 matthew 2968:
2969: ###############################################################
2970:
2971: =pod
1.20 www 2972:
1.648 raeburn 2973: =item * &get_related_words()
1.46 matthew 2974:
1.160 matthew 2975: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2976: an array of words. If the keyword is not in the thesaurus, an empty array
2977: will be returned. The order of the words returned is determined by the
2978: database which holds them.
2979:
2980: Uses global $thesaurus_db_file.
2981:
1.1057 foxr 2982:
1.46 matthew 2983: =cut
2984:
2985: ###############################################################
2986: sub get_related_words {
2987: my $keyword = shift;
2988: my %thesaurus_db;
2989: if (! -e $thesaurus_db_file) {
2990: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2991: "failed because the file does not exist");
2992: return ();
2993: }
2994: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2995: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2996: return ();
2997: }
2998: my @Words=();
1.429 www 2999: my $count=0;
1.46 matthew 3000: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3001: # The first element is the number of times
3002: # the word appears. We do not need it now.
1.429 www 3003: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3004: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3005: my $threshold=$mostfrequentcount/10;
3006: foreach my $possibleword (@RelatedWords) {
3007: my ($word,$wordcount)=split(/\,/,$possibleword);
3008: if ($wordcount>$threshold) {
3009: push(@Words,$word);
3010: $count++;
3011: if ($count>10) { last; }
3012: }
1.20 www 3013: }
3014: }
1.46 matthew 3015: untie %thesaurus_db;
3016: return @Words;
1.14 harris41 3017: }
1.1090 ! foxr 3018: ###############################################################
! 3019: #
! 3020: # Spell checking
! 3021: #
! 3022:
! 3023: =pod
! 3024:
! 3025: =head1 Spell checking
! 3026:
! 3027: =over 4
! 3028:
! 3029: =item * &check_spelling($wordlist $language)
! 3030:
! 3031: Takes a string containing words and feeds it to an external
! 3032: spellcheck program via a pipeline. Returns a string containing
! 3033: them mis-spelled words.
! 3034:
! 3035: Parameters:
! 3036:
! 3037: =over 4
! 3038:
! 3039: =item - $wordlist
! 3040:
! 3041: String that will be fed into the spellcheck program.
! 3042:
! 3043: =item - $language
! 3044:
! 3045: Language string that specifies the language for which the spell
! 3046: check will be performed.
! 3047:
! 3048: =back
! 3049:
! 3050: =back
! 3051:
! 3052: Note: This sub assumes that aspell is installed.
! 3053:
! 3054:
! 3055: =cut
! 3056:
1.46 matthew 3057:
1.112 bowersj2 3058: =pod
3059:
3060: =back
3061:
3062: =cut
1.61 www 3063:
1.1090 ! foxr 3064: sub check_spelling {
! 3065: my ($wordlist, $language) = @_;
! 3066:
! 3067: # Format the command. If $language is null then
! 3068: # don't request a language - Note that's dangerous
! 3069: # because there's no assurance the server is running the intended default
! 3070: # language.
! 3071:
! 3072: my $langswitch = '';
! 3073: if ($language) {
! 3074: $langswitch = "--lang=$language";
! 3075: }
! 3076:
! 3077: my $aspell_command = "aspell -a $language";
! 3078: my $full_command = "echo $wordlist | $aspell_command";
! 3079:
! 3080: my $ispell_result = `$full_command`;
! 3081:
! 3082: # The result is several lines of text.
! 3083: # the first line will start with @(#). Other wise
! 3084: # There's an error. With an error our fallback is to declare
! 3085: # all the words are correctly spelled (return empty string).
! 3086:
! 3087: my @misspellings;
! 3088: my @lines = split(/\n/, $ispell_result);
! 3089: my $heading = shift(@lines); # header
! 3090: if ($heading =~ /^\@\(#\) /) {
! 3091: foreach my $word (split(/\s+/, $wordlist)) {
! 3092: my $spellok = pop(@lines);
! 3093: if (!($spellok =~ /^\*/)) {
! 3094: push(@misspellings, $word);
! 3095: }
! 3096: }
! 3097: return join(' ', (@misspellings)); # empty if all words ok.
! 3098: } else {
! 3099: return "";
! 3100: }
! 3101: }
! 3102:
1.61 www 3103: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3104: =pod
3105:
1.112 bowersj2 3106: =head1 User Name Functions
3107:
3108: =over 4
3109:
1.648 raeburn 3110: =item * &plainname($uname,$udom,$first)
1.81 albertel 3111:
1.112 bowersj2 3112: Takes a users logon name and returns it as a string in
1.226 albertel 3113: "first middle last generation" form
3114: if $first is set to 'lastname' then it returns it as
3115: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3116:
3117: =cut
1.61 www 3118:
1.295 www 3119:
1.81 albertel 3120: ###############################################################
1.61 www 3121: sub plainname {
1.226 albertel 3122: my ($uname,$udom,$first)=@_;
1.537 albertel 3123: return if (!defined($uname) || !defined($udom));
1.295 www 3124: my %names=&getnames($uname,$udom);
1.226 albertel 3125: my $name=&Apache::lonnet::format_name($names{'firstname'},
3126: $names{'middlename'},
3127: $names{'lastname'},
3128: $names{'generation'},$first);
3129: $name=~s/^\s+//;
1.62 www 3130: $name=~s/\s+$//;
3131: $name=~s/\s+/ /g;
1.353 albertel 3132: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3133: return $name;
1.61 www 3134: }
1.66 www 3135:
3136: # -------------------------------------------------------------------- Nickname
1.81 albertel 3137: =pod
3138:
1.648 raeburn 3139: =item * &nickname($uname,$udom)
1.81 albertel 3140:
3141: Gets a users name and returns it as a string as
3142:
3143: ""nickname""
1.66 www 3144:
1.81 albertel 3145: if the user has a nickname or
3146:
3147: "first middle last generation"
3148:
3149: if the user does not
3150:
3151: =cut
1.66 www 3152:
3153: sub nickname {
3154: my ($uname,$udom)=@_;
1.537 albertel 3155: return if (!defined($uname) || !defined($udom));
1.295 www 3156: my %names=&getnames($uname,$udom);
1.68 albertel 3157: my $name=$names{'nickname'};
1.66 www 3158: if ($name) {
3159: $name='"'.$name.'"';
3160: } else {
3161: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3162: $names{'lastname'}.' '.$names{'generation'};
3163: $name=~s/\s+$//;
3164: $name=~s/\s+/ /g;
3165: }
3166: return $name;
3167: }
3168:
1.295 www 3169: sub getnames {
3170: my ($uname,$udom)=@_;
1.537 albertel 3171: return if (!defined($uname) || !defined($udom));
1.433 albertel 3172: if ($udom eq 'public' && $uname eq 'public') {
3173: return ('lastname' => &mt('Public'));
3174: }
1.295 www 3175: my $id=$uname.':'.$udom;
3176: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3177: if ($cached) {
3178: return %{$names};
3179: } else {
3180: my %loadnames=&Apache::lonnet::get('environment',
3181: ['firstname','middlename','lastname','generation','nickname'],
3182: $udom,$uname);
3183: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3184: return %loadnames;
3185: }
3186: }
1.61 www 3187:
1.542 raeburn 3188: # -------------------------------------------------------------------- getemails
1.648 raeburn 3189:
1.542 raeburn 3190: =pod
3191:
1.648 raeburn 3192: =item * &getemails($uname,$udom)
1.542 raeburn 3193:
3194: Gets a user's email information and returns it as a hash with keys:
3195: notification, critnotification, permanentemail
3196:
3197: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3198: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3199:
1.648 raeburn 3200:
1.542 raeburn 3201: =cut
3202:
1.648 raeburn 3203:
1.466 albertel 3204: sub getemails {
3205: my ($uname,$udom)=@_;
3206: if ($udom eq 'public' && $uname eq 'public') {
3207: return;
3208: }
1.467 www 3209: if (!$udom) { $udom=$env{'user.domain'}; }
3210: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3211: my $id=$uname.':'.$udom;
3212: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3213: if ($cached) {
3214: return %{$names};
3215: } else {
3216: my %loadnames=&Apache::lonnet::get('environment',
3217: ['notification','critnotification',
3218: 'permanentemail'],
3219: $udom,$uname);
3220: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3221: return %loadnames;
3222: }
3223: }
3224:
1.551 albertel 3225: sub flush_email_cache {
3226: my ($uname,$udom)=@_;
3227: if (!$udom) { $udom =$env{'user.domain'}; }
3228: if (!$uname) { $uname=$env{'user.name'}; }
3229: return if ($udom eq 'public' && $uname eq 'public');
3230: my $id=$uname.':'.$udom;
3231: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3232: }
3233:
1.728 raeburn 3234: # -------------------------------------------------------------------- getlangs
3235:
3236: =pod
3237:
3238: =item * &getlangs($uname,$udom)
3239:
3240: Gets a user's language preference and returns it as a hash with key:
3241: language.
3242:
3243: =cut
3244:
3245:
3246: sub getlangs {
3247: my ($uname,$udom) = @_;
3248: if (!$udom) { $udom =$env{'user.domain'}; }
3249: if (!$uname) { $uname=$env{'user.name'}; }
3250: my $id=$uname.':'.$udom;
3251: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3252: if ($cached) {
3253: return %{$langs};
3254: } else {
3255: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3256: $udom,$uname);
3257: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3258: return %loadlangs;
3259: }
3260: }
3261:
3262: sub flush_langs_cache {
3263: my ($uname,$udom)=@_;
3264: if (!$udom) { $udom =$env{'user.domain'}; }
3265: if (!$uname) { $uname=$env{'user.name'}; }
3266: return if ($udom eq 'public' && $uname eq 'public');
3267: my $id=$uname.':'.$udom;
3268: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3269: }
3270:
1.61 www 3271: # ------------------------------------------------------------------ Screenname
1.81 albertel 3272:
3273: =pod
3274:
1.648 raeburn 3275: =item * &screenname($uname,$udom)
1.81 albertel 3276:
3277: Gets a users screenname and returns it as a string
3278:
3279: =cut
1.61 www 3280:
3281: sub screenname {
3282: my ($uname,$udom)=@_;
1.258 albertel 3283: if ($uname eq $env{'user.name'} &&
3284: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3285: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3286: return $names{'screenname'};
1.62 www 3287: }
3288:
1.212 albertel 3289:
1.802 bisitz 3290: # ------------------------------------------------------------- Confirm Wrapper
3291: =pod
3292:
3293: =item confirmwrapper
3294:
3295: Wrap messages about completion of operation in box
3296:
3297: =cut
3298:
3299: sub confirmwrapper {
3300: my ($message)=@_;
3301: if ($message) {
3302: return "\n".'<div class="LC_confirm_box">'."\n"
3303: .$message."\n"
3304: .'</div>'."\n";
3305: } else {
3306: return $message;
3307: }
3308: }
3309:
1.62 www 3310: # ------------------------------------------------------------- Message Wrapper
3311:
3312: sub messagewrapper {
1.369 www 3313: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3314: return
1.441 albertel 3315: '<a href="/adm/email?compose=individual&'.
3316: 'recname='.$username.'&recdom='.$domain.
3317: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3318: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3319: }
1.802 bisitz 3320:
1.74 www 3321: # --------------------------------------------------------------- Notes Wrapper
3322:
3323: sub noteswrapper {
3324: my ($link,$un,$do)=@_;
3325: return
1.896 amueller 3326: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3327: }
1.802 bisitz 3328:
1.62 www 3329: # ------------------------------------------------------------- Aboutme Wrapper
3330:
3331: sub aboutmewrapper {
1.1070 raeburn 3332: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3333: if (!defined($username) && !defined($domain)) {
3334: return;
3335: }
1.892 amueller 3336: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.1070 raeburn 3337: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3338: }
3339:
3340: # ------------------------------------------------------------ Syllabus Wrapper
3341:
3342: sub syllabuswrapper {
1.707 bisitz 3343: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3344: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3345: }
1.14 harris41 3346:
1.802 bisitz 3347: # -----------------------------------------------------------------------------
3348:
1.208 matthew 3349: sub track_student_link {
1.887 raeburn 3350: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3351: my $link ="/adm/trackstudent?";
1.208 matthew 3352: my $title = 'View recent activity';
3353: if (defined($sname) && $sname !~ /^\s*$/ &&
3354: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3355: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3356: $title .= ' of this student';
1.268 albertel 3357: }
1.208 matthew 3358: if (defined($target) && $target !~ /^\s*$/) {
3359: $target = qq{target="$target"};
3360: } else {
3361: $target = '';
3362: }
1.268 albertel 3363: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3364: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3365: $title = &mt($title);
3366: $linktext = &mt($linktext);
1.448 albertel 3367: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3368: &help_open_topic('View_recent_activity');
1.208 matthew 3369: }
3370:
1.781 raeburn 3371: sub slot_reservations_link {
3372: my ($linktext,$sname,$sdom,$target) = @_;
3373: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3374: my $title = 'View slot reservation history';
3375: if (defined($sname) && $sname !~ /^\s*$/ &&
3376: defined($sdom) && $sdom !~ /^\s*$/) {
3377: $link .= "&uname=$sname&udom=$sdom";
3378: $title .= ' of this student';
3379: }
3380: if (defined($target) && $target !~ /^\s*$/) {
3381: $target = qq{target="$target"};
3382: } else {
3383: $target = '';
3384: }
3385: $title = &mt($title);
3386: $linktext = &mt($linktext);
3387: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3388: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3389:
3390: }
3391:
1.508 www 3392: # ===================================================== Display a student photo
3393:
3394:
1.509 albertel 3395: sub student_image_tag {
1.508 www 3396: my ($domain,$user)=@_;
3397: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3398: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3399: return '<img src="'.$imgsrc.'" align="right" />';
3400: } else {
3401: return '';
3402: }
3403: }
3404:
1.112 bowersj2 3405: =pod
3406:
3407: =back
3408:
3409: =head1 Access .tab File Data
3410:
3411: =over 4
3412:
1.648 raeburn 3413: =item * &languageids()
1.112 bowersj2 3414:
3415: returns list of all language ids
3416:
3417: =cut
3418:
1.14 harris41 3419: sub languageids {
1.16 harris41 3420: return sort(keys(%language));
1.14 harris41 3421: }
3422:
1.112 bowersj2 3423: =pod
3424:
1.648 raeburn 3425: =item * &languagedescription()
1.112 bowersj2 3426:
3427: returns description of a specified language id
3428:
3429: =cut
3430:
1.14 harris41 3431: sub languagedescription {
1.125 www 3432: my $code=shift;
3433: return ($supported_language{$code}?'* ':'').
3434: $language{$code}.
1.126 www 3435: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3436: }
3437:
1.1048 foxr 3438: =pod
3439:
3440: =item * &plainlanguagedescription
3441:
3442: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3443: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3444:
3445: =cut
3446:
1.145 www 3447: sub plainlanguagedescription {
3448: my $code=shift;
3449: return $language{$code};
3450: }
3451:
1.1048 foxr 3452: =pod
3453:
3454: =item * &supportedlanguagecode
3455:
3456: Returns the supported language code (e.g. sptutf maps to pt) given a language
3457: code.
3458:
3459: =cut
3460:
1.145 www 3461: sub supportedlanguagecode {
3462: my $code=shift;
3463: return $supported_language{$code};
1.97 www 3464: }
3465:
1.112 bowersj2 3466: =pod
3467:
1.1048 foxr 3468: =item * &latexlanguage()
3469:
3470: Given a language key code returns the correspondnig language to use
3471: to select the correct hyphenation on LaTeX printouts. This is undef if there
3472: is no supported hyphenation for the language code.
3473:
3474: =cut
3475:
3476: sub latexlanguage {
3477: my $code = shift;
3478: return $latex_language{$code};
3479: }
3480:
3481: =pod
3482:
3483: =item * &latexhyphenation()
3484:
3485: Same as above but what's supplied is the language as it might be stored
3486: in the metadata.
3487:
3488: =cut
3489:
3490: sub latexhyphenation {
3491: my $key = shift;
3492: return $latex_language_bykey{$key};
3493: }
3494:
3495: =pod
3496:
1.648 raeburn 3497: =item * ©rightids()
1.112 bowersj2 3498:
3499: returns list of all copyrights
3500:
3501: =cut
3502:
3503: sub copyrightids {
3504: return sort(keys(%cprtag));
3505: }
3506:
3507: =pod
3508:
1.648 raeburn 3509: =item * ©rightdescription()
1.112 bowersj2 3510:
3511: returns description of a specified copyright id
3512:
3513: =cut
3514:
3515: sub copyrightdescription {
1.166 www 3516: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3517: }
1.197 matthew 3518:
3519: =pod
3520:
1.648 raeburn 3521: =item * &source_copyrightids()
1.192 taceyjo1 3522:
3523: returns list of all source copyrights
3524:
3525: =cut
3526:
3527: sub source_copyrightids {
3528: return sort(keys(%scprtag));
3529: }
3530:
3531: =pod
3532:
1.648 raeburn 3533: =item * &source_copyrightdescription()
1.192 taceyjo1 3534:
3535: returns description of a specified source copyright id
3536:
3537: =cut
3538:
3539: sub source_copyrightdescription {
3540: return &mt($scprtag{shift(@_)});
3541: }
1.112 bowersj2 3542:
3543: =pod
3544:
1.648 raeburn 3545: =item * &filecategories()
1.112 bowersj2 3546:
3547: returns list of all file categories
3548:
3549: =cut
3550:
3551: sub filecategories {
3552: return sort(keys(%category_extensions));
3553: }
3554:
3555: =pod
3556:
1.648 raeburn 3557: =item * &filecategorytypes()
1.112 bowersj2 3558:
3559: returns list of file types belonging to a given file
3560: category
3561:
3562: =cut
3563:
3564: sub filecategorytypes {
1.356 albertel 3565: my ($cat) = @_;
3566: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3567: }
3568:
3569: =pod
3570:
1.648 raeburn 3571: =item * &fileembstyle()
1.112 bowersj2 3572:
3573: returns embedding style for a specified file type
3574:
3575: =cut
3576:
3577: sub fileembstyle {
3578: return $fe{lc(shift(@_))};
1.169 www 3579: }
3580:
1.351 www 3581: sub filemimetype {
3582: return $fm{lc(shift(@_))};
3583: }
3584:
1.169 www 3585:
3586: sub filecategoryselect {
3587: my ($name,$value)=@_;
1.189 matthew 3588: return &select_form($value,$name,
1.970 raeburn 3589: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3590: }
3591:
3592: =pod
3593:
1.648 raeburn 3594: =item * &filedescription()
1.112 bowersj2 3595:
3596: returns description for a specified file type
3597:
3598: =cut
3599:
3600: sub filedescription {
1.188 matthew 3601: my $file_description = $fd{lc(shift())};
3602: $file_description =~ s:([\[\]]):~$1:g;
3603: return &mt($file_description);
1.112 bowersj2 3604: }
3605:
3606: =pod
3607:
1.648 raeburn 3608: =item * &filedescriptionex()
1.112 bowersj2 3609:
3610: returns description for a specified file type with
3611: extra formatting
3612:
3613: =cut
3614:
3615: sub filedescriptionex {
3616: my $ex=shift;
1.188 matthew 3617: my $file_description = $fd{lc($ex)};
3618: $file_description =~ s:([\[\]]):~$1:g;
3619: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3620: }
3621:
3622: # End of .tab access
3623: =pod
3624:
3625: =back
3626:
3627: =cut
3628:
3629: # ------------------------------------------------------------------ File Types
3630: sub fileextensions {
3631: return sort(keys(%fe));
3632: }
3633:
1.97 www 3634: # ----------------------------------------------------------- Display Languages
3635: # returns a hash with all desired display languages
3636: #
3637:
3638: sub display_languages {
3639: my %languages=();
1.695 raeburn 3640: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3641: $languages{$lang}=1;
1.97 www 3642: }
3643: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3644: if ($env{'form.displaylanguage'}) {
1.356 albertel 3645: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3646: $languages{$lang}=1;
1.97 www 3647: }
3648: }
3649: return %languages;
1.14 harris41 3650: }
3651:
1.582 albertel 3652: sub languages {
3653: my ($possible_langs) = @_;
1.695 raeburn 3654: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3655: if (!ref($possible_langs)) {
3656: if( wantarray ) {
3657: return @preferred_langs;
3658: } else {
3659: return $preferred_langs[0];
3660: }
3661: }
3662: my %possibilities = map { $_ => 1 } (@$possible_langs);
3663: my @preferred_possibilities;
3664: foreach my $preferred_lang (@preferred_langs) {
3665: if (exists($possibilities{$preferred_lang})) {
3666: push(@preferred_possibilities, $preferred_lang);
3667: }
3668: }
3669: if( wantarray ) {
3670: return @preferred_possibilities;
3671: }
3672: return $preferred_possibilities[0];
3673: }
3674:
1.742 raeburn 3675: sub user_lang {
3676: my ($touname,$toudom,$fromcid) = @_;
3677: my @userlangs;
3678: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3679: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3680: $env{'course.'.$fromcid.'.languages'}));
3681: } else {
3682: my %langhash = &getlangs($touname,$toudom);
3683: if ($langhash{'languages'} ne '') {
3684: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3685: } else {
3686: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3687: if ($domdefs{'lang_def'} ne '') {
3688: @userlangs = ($domdefs{'lang_def'});
3689: }
3690: }
3691: }
3692: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3693: my $user_lh = Apache::localize->get_handle(@languages);
3694: return $user_lh;
3695: }
3696:
3697:
1.112 bowersj2 3698: ###############################################################
3699: ## Student Answer Attempts ##
3700: ###############################################################
3701:
3702: =pod
3703:
3704: =head1 Alternate Problem Views
3705:
3706: =over 4
3707:
1.648 raeburn 3708: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3709: $getattempt, $regexp, $gradesub)
3710:
3711: Return string with previous attempt on problem. Arguments:
3712:
3713: =over 4
3714:
3715: =item * $symb: Problem, including path
3716:
3717: =item * $username: username of the desired student
3718:
3719: =item * $domain: domain of the desired student
1.14 harris41 3720:
1.112 bowersj2 3721: =item * $course: Course ID
1.14 harris41 3722:
1.112 bowersj2 3723: =item * $getattempt: Leave blank for all attempts, otherwise put
3724: something
1.14 harris41 3725:
1.112 bowersj2 3726: =item * $regexp: if string matches this regexp, the string will be
3727: sent to $gradesub
1.14 harris41 3728:
1.112 bowersj2 3729: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3730:
1.112 bowersj2 3731: =back
1.14 harris41 3732:
1.112 bowersj2 3733: The output string is a table containing all desired attempts, if any.
1.16 harris41 3734:
1.112 bowersj2 3735: =cut
1.1 albertel 3736:
3737: sub get_previous_attempt {
1.43 ng 3738: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3739: my $prevattempts='';
1.43 ng 3740: no strict 'refs';
1.1 albertel 3741: if ($symb) {
1.3 albertel 3742: my (%returnhash)=
3743: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3744: if ($returnhash{'version'}) {
3745: my %lasthash=();
3746: my $version;
3747: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3748: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3749: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3750: }
1.1 albertel 3751: }
1.596 albertel 3752: $prevattempts=&start_data_table().&start_data_table_header_row();
3753: $prevattempts.='<th>'.&mt('History').'</th>';
1.978 raeburn 3754: my (%typeparts,%lasthidden);
1.945 raeburn 3755: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3756: foreach my $key (sort(keys(%lasthash))) {
3757: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3758: if ($#parts > 0) {
1.31 albertel 3759: my $data=$parts[-1];
1.989 raeburn 3760: next if ($data eq 'foilorder');
1.31 albertel 3761: pop(@parts);
1.1010 www 3762: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3763: if ($data eq 'type') {
3764: unless ($showsurv) {
3765: my $id = join(',',@parts);
3766: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3767: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3768: $lasthidden{$ign.'.'.$id} = 1;
3769: }
1.945 raeburn 3770: }
1.1010 www 3771: }
1.31 albertel 3772: } else {
1.41 ng 3773: if ($#parts == 0) {
3774: $prevattempts.='<th>'.$parts[0].'</th>';
3775: } else {
3776: $prevattempts.='<th>'.$ign.'</th>';
3777: }
1.31 albertel 3778: }
1.16 harris41 3779: }
1.596 albertel 3780: $prevattempts.=&end_data_table_header_row();
1.40 ng 3781: if ($getattempt eq '') {
3782: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945 raeburn 3783: my @hidden;
3784: if (%typeparts) {
3785: foreach my $id (keys(%typeparts)) {
3786: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
3787: push(@hidden,$id);
3788: }
3789: }
3790: }
3791: $prevattempts.=&start_data_table_row().
3792: '<td>'.&mt('Transaction [_1]',$version).'</td>';
3793: if (@hidden) {
3794: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3795: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3796: my $hide;
3797: foreach my $id (@hidden) {
3798: if ($key =~ /^\Q$id\E/) {
3799: $hide = 1;
3800: last;
3801: }
3802: }
3803: if ($hide) {
3804: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3805: if (($data eq 'award') || ($data eq 'awarddetail')) {
3806: my $value = &format_previous_attempt_value($key,
3807: $returnhash{$version.':'.$key});
3808: $prevattempts.='<td>'.$value.' </td>';
3809: } else {
3810: $prevattempts.='<td> </td>';
3811: }
3812: } else {
3813: if ($key =~ /\./) {
3814: my $value = &format_previous_attempt_value($key,
3815: $returnhash{$version.':'.$key});
3816: $prevattempts.='<td>'.$value.' </td>';
3817: } else {
3818: $prevattempts.='<td> </td>';
3819: }
3820: }
3821: }
3822: } else {
3823: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3824: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3825: my $value = &format_previous_attempt_value($key,
3826: $returnhash{$version.':'.$key});
3827: $prevattempts.='<td>'.$value.' </td>';
3828: }
3829: }
3830: $prevattempts.=&end_data_table_row();
1.40 ng 3831: }
1.1 albertel 3832: }
1.945 raeburn 3833: my @currhidden = keys(%lasthidden);
1.596 albertel 3834: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3835: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3836: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3837: if (%typeparts) {
3838: my $hidden;
3839: foreach my $id (@currhidden) {
3840: if ($key =~ /^\Q$id\E/) {
3841: $hidden = 1;
3842: last;
3843: }
3844: }
3845: if ($hidden) {
3846: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3847: if (($data eq 'award') || ($data eq 'awarddetail')) {
3848: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3849: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3850: $value = &$gradesub($value);
3851: }
3852: $prevattempts.='<td>'.$value.' </td>';
3853: } else {
3854: $prevattempts.='<td> </td>';
3855: }
3856: } else {
3857: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3858: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3859: $value = &$gradesub($value);
3860: }
3861: $prevattempts.='<td>'.$value.' </td>';
3862: }
3863: } else {
3864: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3865: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3866: $value = &$gradesub($value);
3867: }
3868: $prevattempts.='<td>'.$value.' </td>';
3869: }
1.16 harris41 3870: }
1.596 albertel 3871: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3872: } else {
1.596 albertel 3873: $prevattempts=
3874: &start_data_table().&start_data_table_row().
3875: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3876: &end_data_table_row().&end_data_table();
1.1 albertel 3877: }
3878: } else {
1.596 albertel 3879: $prevattempts=
3880: &start_data_table().&start_data_table_row().
3881: '<td>'.&mt('No data.').'</td>'.
3882: &end_data_table_row().&end_data_table();
1.1 albertel 3883: }
1.10 albertel 3884: }
3885:
1.581 albertel 3886: sub format_previous_attempt_value {
3887: my ($key,$value) = @_;
1.1011 www 3888: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3889: $value = &Apache::lonlocal::locallocaltime($value);
3890: } elsif (ref($value) eq 'ARRAY') {
3891: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3892: } elsif ($key =~ /answerstring$/) {
3893: my %answers = &Apache::lonnet::str2hash($value);
3894: my @anskeys = sort(keys(%answers));
3895: if (@anskeys == 1) {
3896: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3897: if ($answer =~ m{\0}) {
3898: $answer =~ s{\0}{,}g;
1.988 raeburn 3899: }
3900: my $tag_internal_answer_name = 'INTERNAL';
3901: if ($anskeys[0] eq $tag_internal_answer_name) {
3902: $value = $answer;
3903: } else {
3904: $value = $anskeys[0].'='.$answer;
3905: }
3906: } else {
3907: foreach my $ans (@anskeys) {
3908: my $answer = $answers{$ans};
1.1001 raeburn 3909: if ($answer =~ m{\0}) {
3910: $answer =~ s{\0}{,}g;
1.988 raeburn 3911: }
3912: $value .= $ans.'='.$answer.'<br />';;
3913: }
3914: }
1.581 albertel 3915: } else {
3916: $value = &unescape($value);
3917: }
3918: return $value;
3919: }
3920:
3921:
1.107 albertel 3922: sub relative_to_absolute {
3923: my ($url,$output)=@_;
3924: my $parser=HTML::TokeParser->new(\$output);
3925: my $token;
3926: my $thisdir=$url;
3927: my @rlinks=();
3928: while ($token=$parser->get_token) {
3929: if ($token->[0] eq 'S') {
3930: if ($token->[1] eq 'a') {
3931: if ($token->[2]->{'href'}) {
3932: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3933: }
3934: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3935: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3936: } elsif ($token->[1] eq 'base') {
3937: $thisdir=$token->[2]->{'href'};
3938: }
3939: }
3940: }
3941: $thisdir=~s-/[^/]*$--;
1.356 albertel 3942: foreach my $link (@rlinks) {
1.726 raeburn 3943: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3944: ($link=~/^\//) ||
3945: ($link=~/^javascript:/i) ||
3946: ($link=~/^mailto:/i) ||
3947: ($link=~/^\#/)) {
3948: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3949: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3950: }
3951: }
3952: # -------------------------------------------------- Deal with Applet codebases
3953: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3954: return $output;
3955: }
3956:
1.112 bowersj2 3957: =pod
3958:
1.648 raeburn 3959: =item * &get_student_view()
1.112 bowersj2 3960:
3961: show a snapshot of what student was looking at
3962:
3963: =cut
3964:
1.10 albertel 3965: sub get_student_view {
1.186 albertel 3966: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3967: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3968: my (%form);
1.10 albertel 3969: my @elements=('symb','courseid','domain','username');
3970: foreach my $element (@elements) {
1.186 albertel 3971: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3972: }
1.186 albertel 3973: if (defined($moreenv)) {
3974: %form=(%form,%{$moreenv});
3975: }
1.236 albertel 3976: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3977: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3978: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3979: $userview=~s/\<body[^\>]*\>//gi;
3980: $userview=~s/\<\/body\>//gi;
3981: $userview=~s/\<html\>//gi;
3982: $userview=~s/\<\/html\>//gi;
3983: $userview=~s/\<head\>//gi;
3984: $userview=~s/\<\/head\>//gi;
3985: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3986: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3987: if (wantarray) {
3988: return ($userview,$response);
3989: } else {
3990: return $userview;
3991: }
3992: }
3993:
3994: sub get_student_view_with_retries {
3995: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3996:
3997: my $ok = 0; # True if we got a good response.
3998: my $content;
3999: my $response;
4000:
4001: # Try to get the student_view done. within the retries count:
4002:
4003: do {
4004: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4005: $ok = $response->is_success;
4006: if (!$ok) {
4007: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4008: }
4009: $retries--;
4010: } while (!$ok && ($retries > 0));
4011:
4012: if (!$ok) {
4013: $content = ''; # On error return an empty content.
4014: }
1.651 www 4015: if (wantarray) {
4016: return ($content, $response);
4017: } else {
4018: return $content;
4019: }
1.11 albertel 4020: }
4021:
1.112 bowersj2 4022: =pod
4023:
1.648 raeburn 4024: =item * &get_student_answers()
1.112 bowersj2 4025:
4026: show a snapshot of how student was answering problem
4027:
4028: =cut
4029:
1.11 albertel 4030: sub get_student_answers {
1.100 sakharuk 4031: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4032: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4033: my (%moreenv);
1.11 albertel 4034: my @elements=('symb','courseid','domain','username');
4035: foreach my $element (@elements) {
1.186 albertel 4036: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4037: }
1.186 albertel 4038: $moreenv{'grade_target'}='answer';
4039: %moreenv=(%form,%moreenv);
1.497 raeburn 4040: $feedurl = &Apache::lonnet::clutter($feedurl);
4041: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4042: return $userview;
1.1 albertel 4043: }
1.116 albertel 4044:
4045: =pod
4046:
4047: =item * &submlink()
4048:
1.242 albertel 4049: Inputs: $text $uname $udom $symb $target
1.116 albertel 4050:
4051: Returns: A link to grades.pm such as to see the SUBM view of a student
4052:
4053: =cut
4054:
4055: ###############################################
4056: sub submlink {
1.242 albertel 4057: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4058: if (!($uname && $udom)) {
4059: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4060: &Apache::lonnet::whichuser($symb);
1.116 albertel 4061: if (!$symb) { $symb=$cursymb; }
4062: }
1.254 matthew 4063: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4064: $symb=&escape($symb);
1.960 bisitz 4065: if ($target) { $target=" target=\"$target\""; }
4066: return
4067: '<a href="/adm/grades?command=submission'.
4068: '&symb='.$symb.
4069: '&student='.$uname.
4070: '&userdom='.$udom.'"'.
4071: $target.'>'.$text.'</a>';
1.242 albertel 4072: }
4073: ##############################################
4074:
4075: =pod
4076:
4077: =item * &pgrdlink()
4078:
4079: Inputs: $text $uname $udom $symb $target
4080:
4081: Returns: A link to grades.pm such as to see the PGRD view of a student
4082:
4083: =cut
4084:
4085: ###############################################
4086: sub pgrdlink {
4087: my $link=&submlink(@_);
4088: $link=~s/(&command=submission)/$1&showgrading=yes/;
4089: return $link;
4090: }
4091: ##############################################
4092:
4093: =pod
4094:
4095: =item * &pprmlink()
4096:
4097: Inputs: $text $uname $udom $symb $target
4098:
4099: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4100: student and a specific resource
1.242 albertel 4101:
4102: =cut
4103:
4104: ###############################################
4105: sub pprmlink {
4106: my ($text,$uname,$udom,$symb,$target)=@_;
4107: if (!($uname && $udom)) {
4108: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4109: &Apache::lonnet::whichuser($symb);
1.242 albertel 4110: if (!$symb) { $symb=$cursymb; }
4111: }
1.254 matthew 4112: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4113: $symb=&escape($symb);
1.242 albertel 4114: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4115: return '<a href="/adm/parmset?command=set&'.
4116: 'symb='.$symb.'&uname='.$uname.
4117: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4118: }
4119: ##############################################
1.37 matthew 4120:
1.112 bowersj2 4121: =pod
4122:
4123: =back
4124:
4125: =cut
4126:
1.37 matthew 4127: ###############################################
1.51 www 4128:
4129:
4130: sub timehash {
1.687 raeburn 4131: my ($thistime) = @_;
4132: my $timezone = &Apache::lonlocal::gettimezone();
4133: my $dt = DateTime->from_epoch(epoch => $thistime)
4134: ->set_time_zone($timezone);
4135: my $wday = $dt->day_of_week();
4136: if ($wday == 7) { $wday = 0; }
4137: return ( 'second' => $dt->second(),
4138: 'minute' => $dt->minute(),
4139: 'hour' => $dt->hour(),
4140: 'day' => $dt->day_of_month(),
4141: 'month' => $dt->month(),
4142: 'year' => $dt->year(),
4143: 'weekday' => $wday,
4144: 'dayyear' => $dt->day_of_year(),
4145: 'dlsav' => $dt->is_dst() );
1.51 www 4146: }
4147:
1.370 www 4148: sub utc_string {
4149: my ($date)=@_;
1.371 www 4150: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4151: }
4152:
1.51 www 4153: sub maketime {
4154: my %th=@_;
1.687 raeburn 4155: my ($epoch_time,$timezone,$dt);
4156: $timezone = &Apache::lonlocal::gettimezone();
4157: eval {
4158: $dt = DateTime->new( year => $th{'year'},
4159: month => $th{'month'},
4160: day => $th{'day'},
4161: hour => $th{'hour'},
4162: minute => $th{'minute'},
4163: second => $th{'second'},
4164: time_zone => $timezone,
4165: );
4166: };
4167: if (!$@) {
4168: $epoch_time = $dt->epoch;
4169: if ($epoch_time) {
4170: return $epoch_time;
4171: }
4172: }
1.51 www 4173: return POSIX::mktime(
4174: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4175: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4176: }
4177:
4178: #########################################
1.51 www 4179:
4180: sub findallcourses {
1.482 raeburn 4181: my ($roles,$uname,$udom) = @_;
1.355 albertel 4182: my %roles;
4183: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4184: my %courses;
1.51 www 4185: my $now=time;
1.482 raeburn 4186: if (!defined($uname)) {
4187: $uname = $env{'user.name'};
4188: }
4189: if (!defined($udom)) {
4190: $udom = $env{'user.domain'};
4191: }
4192: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4193: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4194: if (!%roles) {
4195: %roles = (
4196: cc => 1,
1.907 raeburn 4197: co => 1,
1.482 raeburn 4198: in => 1,
4199: ep => 1,
4200: ta => 1,
4201: cr => 1,
4202: st => 1,
4203: );
4204: }
4205: foreach my $entry (keys(%roleshash)) {
4206: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4207: if ($trole =~ /^cr/) {
4208: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4209: } else {
4210: next if (!exists($roles{$trole}));
4211: }
4212: if ($tend) {
4213: next if ($tend < $now);
4214: }
4215: if ($tstart) {
4216: next if ($tstart > $now);
4217: }
1.1058 raeburn 4218: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4219: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4220: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4221: if ($secpart eq '') {
4222: ($cnum,$role) = split(/_/,$cnumpart);
4223: $sec = 'none';
1.1058 raeburn 4224: $value .= $cnum.'/';
1.482 raeburn 4225: } else {
4226: $cnum = $cnumpart;
4227: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4228: $value .= $cnum.'/'.$sec;
4229: }
4230: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4231: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4232: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4233: }
4234: } else {
4235: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4236: }
1.482 raeburn 4237: }
4238: } else {
4239: foreach my $key (keys(%env)) {
1.483 albertel 4240: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4241: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4242: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4243: next if ($role eq 'ca' || $role eq 'aa');
4244: next if (%roles && !exists($roles{$role}));
4245: my ($starttime,$endtime)=split(/\./,$env{$key});
4246: my $active=1;
4247: if ($starttime) {
4248: if ($now<$starttime) { $active=0; }
4249: }
4250: if ($endtime) {
4251: if ($now>$endtime) { $active=0; }
4252: }
4253: if ($active) {
1.1058 raeburn 4254: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4255: if ($sec eq '') {
4256: $sec = 'none';
1.1058 raeburn 4257: } else {
4258: $value .= $sec;
4259: }
4260: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4261: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4262: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4263: }
4264: } else {
4265: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4266: }
1.474 raeburn 4267: }
4268: }
1.51 www 4269: }
4270: }
1.474 raeburn 4271: return %courses;
1.51 www 4272: }
1.37 matthew 4273:
1.54 www 4274: ###############################################
1.474 raeburn 4275:
4276: sub blockcheck {
1.1062 raeburn 4277: my ($setters,$activity,$uname,$udom,$url) = @_;
1.490 raeburn 4278:
4279: if (!defined($udom)) {
4280: $udom = $env{'user.domain'};
4281: }
4282: if (!defined($uname)) {
4283: $uname = $env{'user.name'};
4284: }
4285:
4286: # If uname and udom are for a course, check for blocks in the course.
4287:
4288: if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062 raeburn 4289: my ($startblock,$endblock,$triggerblock) =
4290: &get_blocks($setters,$activity,$udom,$uname,$url);
4291: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4292: }
1.474 raeburn 4293:
1.502 raeburn 4294: my $startblock = 0;
4295: my $endblock = 0;
1.1062 raeburn 4296: my $triggerblock = '';
1.482 raeburn 4297: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4298:
1.490 raeburn 4299: # If uname is for a user, and activity is course-specific, i.e.,
4300: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4301:
1.490 raeburn 4302: if (($activity eq 'boards' || $activity eq 'chat' ||
4303: $activity eq 'groups') && ($env{'request.course.id'})) {
4304: foreach my $key (keys(%live_courses)) {
4305: if ($key ne $env{'request.course.id'}) {
4306: delete($live_courses{$key});
4307: }
4308: }
4309: }
4310:
4311: my $otheruser = 0;
4312: my %own_courses;
4313: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4314: # Resource belongs to user other than current user.
4315: $otheruser = 1;
4316: # Gather courses for current user
4317: %own_courses =
4318: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4319: }
4320:
4321: # Gather active course roles - course coordinator, instructor,
4322: # exam proctor, ta, student, or custom role.
1.474 raeburn 4323:
4324: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4325: my ($cdom,$cnum);
4326: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4327: $cdom = $env{'course.'.$course.'.domain'};
4328: $cnum = $env{'course.'.$course.'.num'};
4329: } else {
1.490 raeburn 4330: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4331: }
4332: my $no_ownblock = 0;
4333: my $no_userblock = 0;
1.533 raeburn 4334: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4335: # Check if current user has 'evb' priv for this
4336: if (defined($own_courses{$course})) {
4337: foreach my $sec (keys(%{$own_courses{$course}})) {
4338: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4339: if ($sec ne 'none') {
4340: $checkrole .= '/'.$sec;
4341: }
4342: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4343: $no_ownblock = 1;
4344: last;
4345: }
4346: }
4347: }
4348: # if they have 'evb' priv and are currently not playing student
4349: next if (($no_ownblock) &&
4350: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4351: }
1.474 raeburn 4352: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4353: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4354: if ($sec ne 'none') {
1.482 raeburn 4355: $checkrole .= '/'.$sec;
1.474 raeburn 4356: }
1.490 raeburn 4357: if ($otheruser) {
4358: # Resource belongs to user other than current user.
4359: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4360: my (%allroles,%userroles);
4361: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4362: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4363: my ($trole,$tdom,$tnum,$tsec);
4364: if ($entry =~ /^cr/) {
4365: ($trole,$tdom,$tnum,$tsec) =
4366: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4367: } else {
4368: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4369: }
4370: my ($spec,$area,$trest);
4371: $area = '/'.$tdom.'/'.$tnum;
4372: $trest = $tnum;
4373: if ($tsec ne '') {
4374: $area .= '/'.$tsec;
4375: $trest .= '/'.$tsec;
4376: }
4377: $spec = $trole.'.'.$area;
4378: if ($trole =~ /^cr/) {
4379: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4380: $tdom,$spec,$trest,$area);
4381: } else {
4382: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4383: $tdom,$spec,$trest,$area);
4384: }
4385: }
4386: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4387: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4388: if ($1) {
4389: $no_userblock = 1;
4390: last;
4391: }
1.486 raeburn 4392: }
4393: }
1.490 raeburn 4394: } else {
4395: # Resource belongs to current user
4396: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4397: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4398: $no_ownblock = 1;
4399: last;
4400: }
1.474 raeburn 4401: }
4402: }
4403: # if they have the evb priv and are currently not playing student
1.482 raeburn 4404: next if (($no_ownblock) &&
1.491 albertel 4405: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4406: next if ($no_userblock);
1.474 raeburn 4407:
1.866 kalberla 4408: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4409: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4410:
1.1062 raeburn 4411: my ($start,$end,$trigger) =
4412: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4413: if (($start != 0) &&
4414: (($startblock == 0) || ($startblock > $start))) {
4415: $startblock = $start;
1.1062 raeburn 4416: if ($trigger ne '') {
4417: $triggerblock = $trigger;
4418: }
1.502 raeburn 4419: }
4420: if (($end != 0) &&
4421: (($endblock == 0) || ($endblock < $end))) {
4422: $endblock = $end;
1.1062 raeburn 4423: if ($trigger ne '') {
4424: $triggerblock = $trigger;
4425: }
1.502 raeburn 4426: }
1.490 raeburn 4427: }
1.1062 raeburn 4428: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4429: }
4430:
4431: sub get_blocks {
1.1062 raeburn 4432: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4433: my $startblock = 0;
4434: my $endblock = 0;
1.1062 raeburn 4435: my $triggerblock = '';
1.490 raeburn 4436: my $course = $cdom.'_'.$cnum;
4437: $setters->{$course} = {};
4438: $setters->{$course}{'staff'} = [];
4439: $setters->{$course}{'times'} = [];
1.1062 raeburn 4440: $setters->{$course}{'triggers'} = [];
4441: my (@blockers,%triggered);
4442: my $now = time;
4443: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4444: if ($activity eq 'docs') {
4445: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4446: foreach my $block (@blockers) {
4447: if ($block =~ /^firstaccess____(.+)$/) {
4448: my $item = $1;
4449: my $type = 'map';
4450: my $timersymb = $item;
4451: if ($item eq 'course') {
4452: $type = 'course';
4453: } elsif ($item =~ /___\d+___/) {
4454: $type = 'resource';
4455: } else {
4456: $timersymb = &Apache::lonnet::symbread($item);
4457: }
4458: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4459: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4460: $triggered{$block} = {
4461: start => $start,
4462: end => $end,
4463: type => $type,
4464: };
4465: }
4466: }
4467: } else {
4468: foreach my $block (keys(%commblocks)) {
4469: if ($block =~ m/^(\d+)____(\d+)$/) {
4470: my ($start,$end) = ($1,$2);
4471: if ($start <= time && $end >= time) {
4472: if (ref($commblocks{$block}) eq 'HASH') {
4473: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4474: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4475: unless(grep(/^\Q$block\E$/,@blockers)) {
4476: push(@blockers,$block);
4477: }
4478: }
4479: }
4480: }
4481: }
4482: } elsif ($block =~ /^firstaccess____(.+)$/) {
4483: my $item = $1;
4484: my $timersymb = $item;
4485: my $type = 'map';
4486: if ($item eq 'course') {
4487: $type = 'course';
4488: } elsif ($item =~ /___\d+___/) {
4489: $type = 'resource';
4490: } else {
4491: $timersymb = &Apache::lonnet::symbread($item);
4492: }
4493: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4494: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4495: if ($start && $end) {
4496: if (($start <= time) && ($end >= time)) {
4497: unless (grep(/^\Q$block\E$/,@blockers)) {
4498: push(@blockers,$block);
4499: $triggered{$block} = {
4500: start => $start,
4501: end => $end,
4502: type => $type,
4503: };
4504: }
4505: }
1.490 raeburn 4506: }
1.1062 raeburn 4507: }
4508: }
4509: }
4510: foreach my $blocker (@blockers) {
4511: my ($staff_name,$staff_dom,$title,$blocks) =
4512: &parse_block_record($commblocks{$blocker});
4513: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4514: my ($start,$end,$triggertype);
4515: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4516: ($start,$end) = ($1,$2);
4517: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4518: $start = $triggered{$blocker}{'start'};
4519: $end = $triggered{$blocker}{'end'};
4520: $triggertype = $triggered{$blocker}{'type'};
4521: }
4522: if ($start) {
4523: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4524: if ($triggertype) {
4525: push(@{$$setters{$course}{'triggers'}},$triggertype);
4526: } else {
4527: push(@{$$setters{$course}{'triggers'}},0);
4528: }
4529: if ( ($startblock == 0) || ($startblock > $start) ) {
4530: $startblock = $start;
4531: if ($triggertype) {
4532: $triggerblock = $blocker;
1.474 raeburn 4533: }
4534: }
1.1062 raeburn 4535: if ( ($endblock == 0) || ($endblock < $end) ) {
4536: $endblock = $end;
4537: if ($triggertype) {
4538: $triggerblock = $blocker;
4539: }
4540: }
1.474 raeburn 4541: }
4542: }
1.1062 raeburn 4543: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4544: }
4545:
4546: sub parse_block_record {
4547: my ($record) = @_;
4548: my ($setuname,$setudom,$title,$blocks);
4549: if (ref($record) eq 'HASH') {
4550: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4551: $title = &unescape($record->{'event'});
4552: $blocks = $record->{'blocks'};
4553: } else {
4554: my @data = split(/:/,$record,3);
4555: if (scalar(@data) eq 2) {
4556: $title = $data[1];
4557: ($setuname,$setudom) = split(/@/,$data[0]);
4558: } else {
4559: ($setuname,$setudom,$title) = @data;
4560: }
4561: $blocks = { 'com' => 'on' };
4562: }
4563: return ($setuname,$setudom,$title,$blocks);
4564: }
4565:
1.854 kalberla 4566: sub blocking_status {
1.1062 raeburn 4567: my ($activity,$uname,$udom,$url) = @_;
1.1061 raeburn 4568: my %setters;
1.890 droeschl 4569:
1.1061 raeburn 4570: # check for active blocking
1.1062 raeburn 4571: my ($startblock,$endblock,$triggerblock) =
4572: &blockcheck(\%setters,$activity,$uname,$udom,$url);
4573: my $blocked = 0;
4574: if ($startblock && $endblock) {
4575: $blocked = 1;
4576: }
1.890 droeschl 4577:
1.1061 raeburn 4578: # caller just wants to know whether a block is active
4579: if (!wantarray) { return $blocked; }
4580:
4581: # build a link to a popup window containing the details
4582: my $querystring = "?activity=$activity";
4583: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4584: if ($activity eq 'port') {
4585: $querystring .= "&udom=$udom" if $udom;
4586: $querystring .= "&uname=$uname" if $uname;
4587: } elsif ($activity eq 'docs') {
4588: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4589: }
1.1061 raeburn 4590:
4591: my $output .= <<'END_MYBLOCK';
4592: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4593: var options = "width=" + w + ",height=" + h + ",";
4594: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4595: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4596: var newWin = window.open(url, wdwName, options);
4597: newWin.focus();
4598: }
1.890 droeschl 4599: END_MYBLOCK
1.854 kalberla 4600:
1.1061 raeburn 4601: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4602:
1.1061 raeburn 4603: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4604: my $text = &mt('Communication Blocked');
4605: if ($activity eq 'docs') {
4606: $text = &mt('Content Access Blocked');
1.1063 raeburn 4607: } elsif ($activity eq 'printout') {
4608: $text = &mt('Printing Blocked');
1.1062 raeburn 4609: }
1.1061 raeburn 4610: $output .= <<"END_BLOCK";
1.867 kalberla 4611: <div class='LC_comblock'>
1.869 kalberla 4612: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4613: title='$text'>
4614: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4615: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4616: title='$text'>$text</a>
1.867 kalberla 4617: </div>
4618:
4619: END_BLOCK
1.474 raeburn 4620:
1.1061 raeburn 4621: return ($blocked, $output);
1.854 kalberla 4622: }
1.490 raeburn 4623:
1.60 matthew 4624: ###############################################
4625:
1.682 raeburn 4626: sub check_ip_acc {
4627: my ($acc)=@_;
4628: &Apache::lonxml::debug("acc is $acc");
4629: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4630: return 1;
4631: }
4632: my $allowed=0;
4633: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4634:
4635: my $name;
4636: foreach my $pattern (split(',',$acc)) {
4637: $pattern =~ s/^\s*//;
4638: $pattern =~ s/\s*$//;
4639: if ($pattern =~ /\*$/) {
4640: #35.8.*
4641: $pattern=~s/\*//;
4642: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4643: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4644: #35.8.3.[34-56]
4645: my $low=$2;
4646: my $high=$3;
4647: $pattern=$1;
4648: if ($ip =~ /^\Q$pattern\E/) {
4649: my $last=(split(/\./,$ip))[3];
4650: if ($last <=$high && $last >=$low) { $allowed=1; }
4651: }
4652: } elsif ($pattern =~ /^\*/) {
4653: #*.msu.edu
4654: $pattern=~s/\*//;
4655: if (!defined($name)) {
4656: use Socket;
4657: my $netaddr=inet_aton($ip);
4658: ($name)=gethostbyaddr($netaddr,AF_INET);
4659: }
4660: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4661: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4662: #127.0.0.1
4663: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4664: } else {
4665: #some.name.com
4666: if (!defined($name)) {
4667: use Socket;
4668: my $netaddr=inet_aton($ip);
4669: ($name)=gethostbyaddr($netaddr,AF_INET);
4670: }
4671: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4672: }
4673: if ($allowed) { last; }
4674: }
4675: return $allowed;
4676: }
4677:
4678: ###############################################
4679:
1.60 matthew 4680: =pod
4681:
1.112 bowersj2 4682: =head1 Domain Template Functions
4683:
4684: =over 4
4685:
4686: =item * &determinedomain()
1.60 matthew 4687:
4688: Inputs: $domain (usually will be undef)
4689:
1.63 www 4690: Returns: Determines which domain should be used for designs
1.60 matthew 4691:
4692: =cut
1.54 www 4693:
1.60 matthew 4694: ###############################################
1.63 www 4695: sub determinedomain {
4696: my $domain=shift;
1.531 albertel 4697: if (! $domain) {
1.60 matthew 4698: # Determine domain if we have not been given one
1.893 raeburn 4699: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4700: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4701: if ($env{'request.role.domain'}) {
4702: $domain=$env{'request.role.domain'};
1.60 matthew 4703: }
4704: }
1.63 www 4705: return $domain;
4706: }
4707: ###############################################
1.517 raeburn 4708:
1.518 albertel 4709: sub devalidate_domconfig_cache {
4710: my ($udom)=@_;
4711: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4712: }
4713:
4714: # ---------------------- Get domain configuration for a domain
4715: sub get_domainconf {
4716: my ($udom) = @_;
4717: my $cachetime=1800;
4718: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4719: if (defined($cached)) { return %{$result}; }
4720:
4721: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4722: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4723: my (%designhash,%legacy);
1.518 albertel 4724: if (keys(%domconfig) > 0) {
4725: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4726: if (keys(%{$domconfig{'login'}})) {
4727: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4728: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4729: if ($key eq 'loginvia') {
4730: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4731: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4732: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4733: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4734: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4735: $designhash{$udom.'.login.loginvia'} = $server;
4736: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4737:
4738: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4739: } else {
1.1013 raeburn 4740: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4741: }
4742: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4743: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4744: }
1.946 raeburn 4745: }
4746: }
4747: }
4748: }
4749: } else {
4750: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4751: $designhash{$udom.'.login.'.$key.'_'.$img} =
4752: $domconfig{'login'}{$key}{$img};
4753: }
1.699 raeburn 4754: }
4755: } else {
4756: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4757: }
1.632 raeburn 4758: }
4759: } else {
4760: $legacy{'login'} = 1;
1.518 albertel 4761: }
1.632 raeburn 4762: } else {
4763: $legacy{'login'} = 1;
1.518 albertel 4764: }
4765: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4766: if (keys(%{$domconfig{'rolecolors'}})) {
4767: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4768: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4769: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4770: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4771: }
1.518 albertel 4772: }
4773: }
1.632 raeburn 4774: } else {
4775: $legacy{'rolecolors'} = 1;
1.518 albertel 4776: }
1.632 raeburn 4777: } else {
4778: $legacy{'rolecolors'} = 1;
1.518 albertel 4779: }
1.948 raeburn 4780: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4781: if ($domconfig{'autoenroll'}{'co-owners'}) {
4782: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4783: }
4784: }
1.632 raeburn 4785: if (keys(%legacy) > 0) {
4786: my %legacyhash = &get_legacy_domconf($udom);
4787: foreach my $item (keys(%legacyhash)) {
4788: if ($item =~ /^\Q$udom\E\.login/) {
4789: if ($legacy{'login'}) {
4790: $designhash{$item} = $legacyhash{$item};
4791: }
4792: } else {
4793: if ($legacy{'rolecolors'}) {
4794: $designhash{$item} = $legacyhash{$item};
4795: }
1.518 albertel 4796: }
4797: }
4798: }
1.632 raeburn 4799: } else {
4800: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4801: }
4802: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4803: $cachetime);
4804: return %designhash;
4805: }
4806:
1.632 raeburn 4807: sub get_legacy_domconf {
4808: my ($udom) = @_;
4809: my %legacyhash;
4810: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4811: my $designfile = $designdir.'/'.$udom.'.tab';
4812: if (-e $designfile) {
4813: if ( open (my $fh,"<$designfile") ) {
4814: while (my $line = <$fh>) {
4815: next if ($line =~ /^\#/);
4816: chomp($line);
4817: my ($key,$val)=(split(/\=/,$line));
4818: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4819: }
4820: close($fh);
4821: }
4822: }
1.1026 raeburn 4823: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4824: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4825: }
4826: return %legacyhash;
4827: }
4828:
1.63 www 4829: =pod
4830:
1.112 bowersj2 4831: =item * &domainlogo()
1.63 www 4832:
4833: Inputs: $domain (usually will be undef)
4834:
4835: Returns: A link to a domain logo, if the domain logo exists.
4836: If the domain logo does not exist, a description of the domain.
4837:
4838: =cut
1.112 bowersj2 4839:
1.63 www 4840: ###############################################
4841: sub domainlogo {
1.517 raeburn 4842: my $domain = &determinedomain(shift);
1.518 albertel 4843: my %designhash = &get_domainconf($domain);
1.517 raeburn 4844: # See if there is a logo
4845: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4846: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4847: if ($imgsrc =~ m{^/(adm|res)/}) {
4848: if ($imgsrc =~ m{^/res/}) {
4849: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4850: &Apache::lonnet::repcopy($local_name);
4851: }
4852: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4853: }
4854: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4855: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4856: return &Apache::lonnet::domain($domain,'description');
1.59 www 4857: } else {
1.60 matthew 4858: return '';
1.59 www 4859: }
4860: }
1.63 www 4861: ##############################################
4862:
4863: =pod
4864:
1.112 bowersj2 4865: =item * &designparm()
1.63 www 4866:
4867: Inputs: $which parameter; $domain (usually will be undef)
4868:
4869: Returns: value of designparamter $which
4870:
4871: =cut
1.112 bowersj2 4872:
1.397 albertel 4873:
1.400 albertel 4874: ##############################################
1.397 albertel 4875: sub designparm {
4876: my ($which,$domain)=@_;
4877: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4878: return $env{'environment.color.'.$which};
1.96 www 4879: }
1.63 www 4880: $domain=&determinedomain($domain);
1.1016 raeburn 4881: my %domdesign;
4882: unless ($domain eq 'public') {
4883: %domdesign = &get_domainconf($domain);
4884: }
1.520 raeburn 4885: my $output;
1.517 raeburn 4886: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4887: $output = $domdesign{$domain.'.'.$which};
1.63 www 4888: } else {
1.520 raeburn 4889: $output = $defaultdesign{$which};
4890: }
4891: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4892: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4893: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4894: if ($output =~ m{^/res/}) {
4895: my $local_name = &Apache::lonnet::filelocation('',$output);
4896: &Apache::lonnet::repcopy($local_name);
4897: }
1.520 raeburn 4898: $output = &lonhttpdurl($output);
4899: }
1.63 www 4900: }
1.520 raeburn 4901: return $output;
1.63 www 4902: }
1.59 www 4903:
1.822 bisitz 4904: ##############################################
4905: =pod
4906:
1.832 bisitz 4907: =item * &authorspace()
4908:
1.1028 raeburn 4909: Inputs: $url (usually will be undef).
1.832 bisitz 4910:
1.1028 raeburn 4911: Returns: Path to Construction Space containing the resource or
4912: directory being viewed (or for which action is being taken).
4913: If $url is provided, and begins /priv/<domain>/<uname>
4914: the path will be that portion of the $context argument.
4915: Otherwise the path will be for the author space of the current
4916: user when the current role is author, or for that of the
4917: co-author/assistant co-author space when the current role
4918: is co-author or assistant co-author.
1.832 bisitz 4919:
4920: =cut
4921:
4922: sub authorspace {
1.1028 raeburn 4923: my ($url) = @_;
4924: if ($url ne '') {
4925: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4926: return $1;
4927: }
4928: }
1.832 bisitz 4929: my $caname = '';
1.1024 www 4930: my $cadom = '';
1.1028 raeburn 4931: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4932: ($cadom,$caname) =
1.832 bisitz 4933: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4934: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4935: $caname = $env{'user.name'};
1.1024 www 4936: $cadom = $env{'user.domain'};
1.832 bisitz 4937: }
1.1028 raeburn 4938: if (($caname ne '') && ($cadom ne '')) {
4939: return "/priv/$cadom/$caname/";
4940: }
4941: return;
1.832 bisitz 4942: }
4943:
4944: ##############################################
4945: =pod
4946:
1.822 bisitz 4947: =item * &head_subbox()
4948:
4949: Inputs: $content (contains HTML code with page functions, etc.)
4950:
4951: Returns: HTML div with $content
4952: To be included in page header
4953:
4954: =cut
4955:
4956: sub head_subbox {
4957: my ($content)=@_;
4958: my $output =
1.993 raeburn 4959: '<div class="LC_head_subbox">'
1.822 bisitz 4960: .$content
4961: .'</div>'
4962: }
4963:
4964: ##############################################
4965: =pod
4966:
4967: =item * &CSTR_pageheader()
4968:
1.1026 raeburn 4969: Input: (optional) filename from which breadcrumb trail is built.
4970: In most cases no input as needed, as $env{'request.filename'}
4971: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 4972:
4973: Returns: HTML div with CSTR path and recent box
4974: To be included on Construction Space pages
4975:
4976: =cut
4977:
4978: sub CSTR_pageheader {
1.1026 raeburn 4979: my ($trailfile) = @_;
4980: if ($trailfile eq '') {
4981: $trailfile = $env{'request.filename'};
4982: }
4983:
4984: # this is for resources; directories have customtitle, and crumbs
4985: # and select recent are created in lonpubdir.pm
4986:
4987: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 4988: my ($udom,$uname,$thisdisfn)=
1.1026 raeburn 4989: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
4990: my $formaction = "/priv/$udom/$uname/$thisdisfn";
4991: $formaction =~ s{/+}{/}g;
1.822 bisitz 4992:
4993: my $parentpath = '';
4994: my $lastitem = '';
4995: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4996: $parentpath = $1;
4997: $lastitem = $2;
4998: } else {
4999: $lastitem = $thisdisfn;
5000: }
1.921 bisitz 5001:
5002: my $output =
1.822 bisitz 5003: '<div>'
5004: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
5005: .'<b>'.&mt('Construction Space:').'</b> '
5006: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5007: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5008: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5009:
5010: if ($lastitem) {
5011: $output .=
5012: '<span class="LC_filename">'
5013: .$lastitem
5014: .'</span>';
5015: }
5016: $output .=
5017: '<br />'
1.822 bisitz 5018: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5019: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5020: .'</form>'
5021: .&Apache::lonmenu::constspaceform()
5022: .'</div>';
1.921 bisitz 5023:
5024: return $output;
1.822 bisitz 5025: }
5026:
1.60 matthew 5027: ###############################################
5028: ###############################################
5029:
5030: =pod
5031:
1.112 bowersj2 5032: =back
5033:
1.549 albertel 5034: =head1 HTML Helpers
1.112 bowersj2 5035:
5036: =over 4
5037:
5038: =item * &bodytag()
1.60 matthew 5039:
5040: Returns a uniform header for LON-CAPA web pages.
5041:
5042: Inputs:
5043:
1.112 bowersj2 5044: =over 4
5045:
5046: =item * $title, A title to be displayed on the page.
5047:
5048: =item * $function, the current role (can be undef).
5049:
5050: =item * $addentries, extra parameters for the <body> tag.
5051:
5052: =item * $bodyonly, if defined, only return the <body> tag.
5053:
5054: =item * $domain, if defined, force a given domain.
5055:
5056: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5057: text interface only)
1.60 matthew 5058:
1.814 bisitz 5059: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5060: navigational links
1.317 albertel 5061:
1.338 albertel 5062: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5063:
1.460 albertel 5064: =item * $args, optional argument valid values are
5065: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5066: inherit_jsmath -> when creating popup window in a page,
5067: should it have jsmath forced on by the
5068: current page
1.460 albertel 5069:
1.112 bowersj2 5070: =back
5071:
1.60 matthew 5072: Returns: A uniform header for LON-CAPA web pages.
5073: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5074: If $bodyonly is undef or zero, an html string containing a <body> tag and
5075: other decorations will be returned.
5076:
5077: =cut
5078:
1.54 www 5079: sub bodytag {
1.831 bisitz 5080: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962 droeschl 5081: $no_nav_bar,$bgcolor,$args)=@_;
1.339 albertel 5082:
1.954 raeburn 5083: my $public;
5084: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5085: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5086: $public = 1;
5087: }
1.460 albertel 5088: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 5089:
1.183 matthew 5090: $function = &get_users_function() if (!$function);
1.339 albertel 5091: my $img = &designparm($function.'.img',$domain);
5092: my $font = &designparm($function.'.font',$domain);
5093: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5094:
1.803 bisitz 5095: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5096: 'bgcolor' => $pgbg,
1.339 albertel 5097: 'text' => $font,
5098: 'alink' => &designparm($function.'.alink',$domain),
5099: 'vlink' => &designparm($function.'.vlink',$domain),
5100: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5101: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5102:
1.63 www 5103: # role and realm
1.378 raeburn 5104: my ($role,$realm) = split(/\./,$env{'request.role'},2);
5105: if ($role eq 'ca') {
1.479 albertel 5106: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5107: $realm = &plainname($rname,$rdom);
1.378 raeburn 5108: }
1.55 www 5109: # realm
1.258 albertel 5110: if ($env{'request.course.id'}) {
1.378 raeburn 5111: if ($env{'request.role'} !~ /^cr/) {
5112: $role = &Apache::lonnet::plaintext($role,&course_type());
5113: }
1.898 raeburn 5114: if ($env{'request.course.sec'}) {
5115: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5116: }
1.359 albertel 5117: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5118: } else {
5119: $role = &Apache::lonnet::plaintext($role);
1.54 www 5120: }
1.433 albertel 5121:
1.359 albertel 5122: if (!$realm) { $realm=' '; }
1.330 albertel 5123:
1.438 albertel 5124: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5125:
1.101 www 5126: # construct main body tag
1.359 albertel 5127: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5128: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5129:
1.530 albertel 5130: if ($bodyonly) {
1.60 matthew 5131: return $bodytag;
1.798 tempelho 5132: }
1.359 albertel 5133:
1.410 albertel 5134: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954 raeburn 5135: if ($public) {
1.433 albertel 5136: undef($role);
1.434 albertel 5137: } else {
1.1070 raeburn 5138: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5139: undef,'LC_menubuttons_link');
1.433 albertel 5140: }
1.359 albertel 5141:
1.762 bisitz 5142: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5143: #
5144: # Extra info if you are the DC
5145: my $dc_info = '';
5146: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5147: $env{'course.'.$env{'request.course.id'}.
5148: '.domain'}.'/'})) {
5149: my $cid = $env{'request.course.id'};
1.917 raeburn 5150: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5151: $dc_info =~ s/\s+$//;
1.359 albertel 5152: }
5153:
1.898 raeburn 5154: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5155: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5156:
1.916 droeschl 5157: if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
5158: return $bodytag;
5159: }
1.903 droeschl 5160:
5161: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5162:
5163: # if ($env{'request.state'} eq 'construct') {
5164: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5165: # }
5166:
1.359 albertel 5167:
5168:
1.916 droeschl 5169: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5170: if ($dc_info) {
5171: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5172: }
1.916 droeschl 5173: $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
5174: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5175: return $bodytag;
5176: }
1.894 droeschl 5177:
1.927 raeburn 5178: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
5179: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
5180: }
1.916 droeschl 5181:
1.903 droeschl 5182: $bodytag .= Apache::lonhtmlcommon::scripttag(
5183: Apache::lonmenu::utilityfunctions(), 'start');
1.816 bisitz 5184:
1.903 droeschl 5185: $bodytag .= Apache::lonmenu::primary_menu();
1.852 droeschl 5186:
1.917 raeburn 5187: if ($dc_info) {
5188: $dc_info = &dc_courseid_toggle($dc_info);
5189: }
5190: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5191:
1.903 droeschl 5192: #don't show menus for public users
1.954 raeburn 5193: if (!$public){
1.903 droeschl 5194: $bodytag .= Apache::lonmenu::secondary_menu();
5195: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5196: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5197: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5198: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5199: $args->{'bread_crumbs'});
5200: } elsif ($forcereg) {
5201: $bodytag .= &Apache::lonmenu::innerregister($forcereg);
5202: }
1.903 droeschl 5203: }else{
5204: # this is to seperate menu from content when there's no secondary
5205: # menu. Especially needed for public accessible ressources.
5206: $bodytag .= '<hr style="clear:both" />';
5207: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5208: }
1.903 droeschl 5209:
1.235 raeburn 5210: return $bodytag;
1.182 matthew 5211: }
5212:
1.917 raeburn 5213: sub dc_courseid_toggle {
5214: my ($dc_info) = @_;
1.980 raeburn 5215: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5216: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5217: &mt('(More ...)').'</a></span>'.
5218: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5219: }
5220:
1.330 albertel 5221: sub make_attr_string {
5222: my ($register,$attr_ref) = @_;
5223:
5224: if ($attr_ref && !ref($attr_ref)) {
5225: die("addentries Must be a hash ref ".
5226: join(':',caller(1))." ".
5227: join(':',caller(0))." ");
5228: }
5229:
5230: if ($register) {
1.339 albertel 5231: my ($on_load,$on_unload);
5232: foreach my $key (keys(%{$attr_ref})) {
5233: if (lc($key) eq 'onload') {
5234: $on_load.=$attr_ref->{$key}.';';
5235: delete($attr_ref->{$key});
5236:
5237: } elsif (lc($key) eq 'onunload') {
5238: $on_unload.=$attr_ref->{$key}.';';
5239: delete($attr_ref->{$key});
5240: }
5241: }
1.953 droeschl 5242: $attr_ref->{'onload'} = $on_load;
5243: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5244: }
1.339 albertel 5245:
1.330 albertel 5246: my $attr_string;
5247: foreach my $attr (keys(%$attr_ref)) {
5248: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5249: }
5250: return $attr_string;
5251: }
5252:
5253:
1.182 matthew 5254: ###############################################
1.251 albertel 5255: ###############################################
5256:
5257: =pod
5258:
5259: =item * &endbodytag()
5260:
5261: Returns a uniform footer for LON-CAPA web pages.
5262:
1.635 raeburn 5263: Inputs: 1 - optional reference to an args hash
5264: If in the hash, key for noredirectlink has a value which evaluates to true,
5265: a 'Continue' link is not displayed if the page contains an
5266: internal redirect in the <head></head> section,
5267: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5268:
5269: =cut
5270:
5271: sub endbodytag {
1.635 raeburn 5272: my ($args) = @_;
1.1080 raeburn 5273: my $endbodytag;
5274: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5275: $endbodytag='</body>';
5276: }
1.269 albertel 5277: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5278: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5279: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5280: $endbodytag=
5281: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5282: &mt('Continue').'</a>'.
5283: $endbodytag;
5284: }
1.315 albertel 5285: }
1.251 albertel 5286: return $endbodytag;
5287: }
5288:
1.352 albertel 5289: =pod
5290:
5291: =item * &standard_css()
5292:
5293: Returns a style sheet
5294:
5295: Inputs: (all optional)
5296: domain -> force to color decorate a page for a specific
5297: domain
5298: function -> force usage of a specific rolish color scheme
5299: bgcolor -> override the default page bgcolor
5300:
5301: =cut
5302:
1.343 albertel 5303: sub standard_css {
1.345 albertel 5304: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5305: $function = &get_users_function() if (!$function);
5306: my $img = &designparm($function.'.img', $domain);
5307: my $tabbg = &designparm($function.'.tabbg', $domain);
5308: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5309: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5310: #second colour for later usage
1.345 albertel 5311: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5312: my $pgbg_or_bgcolor =
5313: $bgcolor ||
1.352 albertel 5314: &designparm($function.'.pgbg', $domain);
1.382 albertel 5315: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5316: my $alink = &designparm($function.'.alink', $domain);
5317: my $vlink = &designparm($function.'.vlink', $domain);
5318: my $link = &designparm($function.'.link', $domain);
5319:
1.602 albertel 5320: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5321: my $mono = 'monospace';
1.850 bisitz 5322: my $data_table_head = $sidebg;
5323: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5324: my $data_table_dark = '#E0E0E0';
1.470 banghart 5325: my $data_table_darker = '#CCCCCC';
1.349 albertel 5326: my $data_table_highlight = '#FFFF00';
1.352 albertel 5327: my $mail_new = '#FFBB77';
5328: my $mail_new_hover = '#DD9955';
5329: my $mail_read = '#BBBB77';
5330: my $mail_read_hover = '#999944';
5331: my $mail_replied = '#AAAA88';
5332: my $mail_replied_hover = '#888855';
5333: my $mail_other = '#99BBBB';
5334: my $mail_other_hover = '#669999';
1.391 albertel 5335: my $table_header = '#DDDDDD';
1.489 raeburn 5336: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5337: my $lg_border_color = '#C8C8C8';
1.952 onken 5338: my $button_hover = '#BF2317';
1.392 albertel 5339:
1.608 albertel 5340: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5341: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5342: : '0 3px 0 4px';
1.448 albertel 5343:
1.523 albertel 5344:
1.343 albertel 5345: return <<END;
1.947 droeschl 5346:
5347: /* needed for iframe to allow 100% height in FF */
5348: body, html {
5349: margin: 0;
5350: padding: 0 0.5%;
5351: height: 99%; /* to avoid scrollbars */
5352: }
5353:
1.795 www 5354: body {
1.911 bisitz 5355: font-family: $sans;
5356: line-height:130%;
5357: font-size:0.83em;
5358: color:$font;
1.795 www 5359: }
5360:
1.959 onken 5361: a:focus,
5362: a:focus img {
1.795 www 5363: color: red;
5364: }
1.698 harmsja 5365:
1.911 bisitz 5366: form, .inline {
5367: display: inline;
1.795 www 5368: }
1.721 harmsja 5369:
1.795 www 5370: .LC_right {
1.911 bisitz 5371: text-align:right;
1.795 www 5372: }
5373:
5374: .LC_middle {
1.911 bisitz 5375: vertical-align:middle;
1.795 www 5376: }
1.721 harmsja 5377:
1.911 bisitz 5378: .LC_400Box {
5379: width:400px;
5380: }
1.721 harmsja 5381:
1.947 droeschl 5382: .LC_iframecontainer {
5383: width: 98%;
5384: margin: 0;
5385: position: fixed;
5386: top: 8.5em;
5387: bottom: 0;
5388: }
5389:
5390: .LC_iframecontainer iframe{
5391: border: none;
5392: width: 100%;
5393: height: 100%;
5394: }
5395:
1.778 bisitz 5396: .LC_filename {
5397: font-family: $mono;
5398: white-space:pre;
1.921 bisitz 5399: font-size: 120%;
1.778 bisitz 5400: }
5401:
5402: .LC_fileicon {
5403: border: none;
5404: height: 1.3em;
5405: vertical-align: text-bottom;
5406: margin-right: 0.3em;
5407: text-decoration:none;
5408: }
5409:
1.1008 www 5410: .LC_setting {
5411: text-decoration:underline;
5412: }
5413:
1.350 albertel 5414: .LC_error {
5415: color: red;
5416: font-size: larger;
5417: }
1.795 www 5418:
1.457 albertel 5419: .LC_warning,
5420: .LC_diff_removed {
1.733 bisitz 5421: color: red;
1.394 albertel 5422: }
1.532 albertel 5423:
5424: .LC_info,
1.457 albertel 5425: .LC_success,
5426: .LC_diff_added {
1.350 albertel 5427: color: green;
5428: }
1.795 www 5429:
1.802 bisitz 5430: div.LC_confirm_box {
5431: background-color: #FAFAFA;
5432: border: 1px solid $lg_border_color;
5433: margin-right: 0;
5434: padding: 5px;
5435: }
5436:
5437: div.LC_confirm_box .LC_error img,
5438: div.LC_confirm_box .LC_success img {
5439: vertical-align: middle;
5440: }
5441:
1.440 albertel 5442: .LC_icon {
1.771 droeschl 5443: border: none;
1.790 droeschl 5444: vertical-align: middle;
1.771 droeschl 5445: }
5446:
1.543 albertel 5447: .LC_docs_spacer {
5448: width: 25px;
5449: height: 1px;
1.771 droeschl 5450: border: none;
1.543 albertel 5451: }
1.346 albertel 5452:
1.532 albertel 5453: .LC_internal_info {
1.735 bisitz 5454: color: #999999;
1.532 albertel 5455: }
5456:
1.794 www 5457: .LC_discussion {
1.1050 www 5458: background: $data_table_dark;
1.911 bisitz 5459: border: 1px solid black;
5460: margin: 2px;
1.794 www 5461: }
5462:
5463: .LC_disc_action_left {
1.1050 www 5464: background: $sidebg;
1.911 bisitz 5465: text-align: left;
1.1050 www 5466: padding: 4px;
5467: margin: 2px;
1.794 www 5468: }
5469:
5470: .LC_disc_action_right {
1.1050 www 5471: background: $sidebg;
1.911 bisitz 5472: text-align: right;
1.1050 www 5473: padding: 4px;
5474: margin: 2px;
1.794 www 5475: }
5476:
5477: .LC_disc_new_item {
1.911 bisitz 5478: background: white;
5479: border: 2px solid red;
1.1050 www 5480: margin: 4px;
5481: padding: 4px;
1.794 www 5482: }
5483:
5484: .LC_disc_old_item {
1.911 bisitz 5485: background: white;
1.1050 www 5486: margin: 4px;
5487: padding: 4px;
1.794 www 5488: }
5489:
1.458 albertel 5490: table.LC_pastsubmission {
5491: border: 1px solid black;
5492: margin: 2px;
5493: }
5494:
1.924 bisitz 5495: table#LC_menubuttons {
1.345 albertel 5496: width: 100%;
5497: background: $pgbg;
1.392 albertel 5498: border: 2px;
1.402 albertel 5499: border-collapse: separate;
1.803 bisitz 5500: padding: 0;
1.345 albertel 5501: }
1.392 albertel 5502:
1.801 tempelho 5503: table#LC_title_bar a {
5504: color: $fontmenu;
5505: }
1.836 bisitz 5506:
1.807 droeschl 5507: table#LC_title_bar {
1.819 tempelho 5508: clear: both;
1.836 bisitz 5509: display: none;
1.807 droeschl 5510: }
5511:
1.795 www 5512: table#LC_title_bar,
1.933 droeschl 5513: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5514: table#LC_title_bar.LC_with_remote {
1.359 albertel 5515: width: 100%;
1.392 albertel 5516: border-color: $pgbg;
5517: border-style: solid;
5518: border-width: $border;
1.379 albertel 5519: background: $pgbg;
1.801 tempelho 5520: color: $fontmenu;
1.392 albertel 5521: border-collapse: collapse;
1.803 bisitz 5522: padding: 0;
1.819 tempelho 5523: margin: 0;
1.359 albertel 5524: }
1.795 www 5525:
1.933 droeschl 5526: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5527: margin: 0;
5528: padding: 0;
1.933 droeschl 5529: position: relative;
5530: list-style: none;
1.913 droeschl 5531: }
1.933 droeschl 5532: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5533: display: inline;
5534: }
1.933 droeschl 5535:
5536: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5537: padding: 0;
1.933 droeschl 5538: margin: 0;
5539: float: left;
1.913 droeschl 5540: }
1.933 droeschl 5541: .LC_breadcrumb_tools_tools {
5542: padding: 0;
5543: margin: 0;
1.913 droeschl 5544: float: right;
5545: }
5546:
1.359 albertel 5547: table#LC_title_bar td {
5548: background: $tabbg;
5549: }
1.795 www 5550:
1.911 bisitz 5551: table#LC_menubuttons img {
1.803 bisitz 5552: border: none;
1.346 albertel 5553: }
1.795 www 5554:
1.842 droeschl 5555: .LC_breadcrumbs_component {
1.911 bisitz 5556: float: right;
5557: margin: 0 1em;
1.357 albertel 5558: }
1.842 droeschl 5559: .LC_breadcrumbs_component img {
1.911 bisitz 5560: vertical-align: middle;
1.777 tempelho 5561: }
1.795 www 5562:
1.383 albertel 5563: td.LC_table_cell_checkbox {
5564: text-align: center;
5565: }
1.795 www 5566:
5567: .LC_fontsize_small {
1.911 bisitz 5568: font-size: 70%;
1.705 tempelho 5569: }
5570:
1.844 bisitz 5571: #LC_breadcrumbs {
1.911 bisitz 5572: clear:both;
5573: background: $sidebg;
5574: border-bottom: 1px solid $lg_border_color;
5575: line-height: 2.5em;
1.933 droeschl 5576: overflow: hidden;
1.911 bisitz 5577: margin: 0;
5578: padding: 0;
1.995 raeburn 5579: text-align: left;
1.819 tempelho 5580: }
1.862 bisitz 5581:
1.993 raeburn 5582: .LC_head_subbox {
1.911 bisitz 5583: clear:both;
5584: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5585: border: 1px solid $sidebg;
5586: margin: 0 0 10px 0;
1.966 bisitz 5587: padding: 3px;
1.995 raeburn 5588: text-align: left;
1.822 bisitz 5589: }
5590:
1.795 www 5591: .LC_fontsize_medium {
1.911 bisitz 5592: font-size: 85%;
1.705 tempelho 5593: }
5594:
1.795 www 5595: .LC_fontsize_large {
1.911 bisitz 5596: font-size: 120%;
1.705 tempelho 5597: }
5598:
1.346 albertel 5599: .LC_menubuttons_inline_text {
5600: color: $font;
1.698 harmsja 5601: font-size: 90%;
1.701 harmsja 5602: padding-left:3px;
1.346 albertel 5603: }
5604:
1.934 droeschl 5605: .LC_menubuttons_inline_text img{
5606: vertical-align: middle;
5607: }
5608:
1.1051 www 5609: li.LC_menubuttons_inline_text img {
1.951 onken 5610: cursor:pointer;
1.1002 droeschl 5611: text-decoration: none;
1.951 onken 5612: }
5613:
1.526 www 5614: .LC_menubuttons_link {
5615: text-decoration: none;
5616: }
1.795 www 5617:
1.522 albertel 5618: .LC_menubuttons_category {
1.521 www 5619: color: $font;
1.526 www 5620: background: $pgbg;
1.521 www 5621: font-size: larger;
5622: font-weight: bold;
5623: }
5624:
1.346 albertel 5625: td.LC_menubuttons_text {
1.911 bisitz 5626: color: $font;
1.346 albertel 5627: }
1.706 harmsja 5628:
1.346 albertel 5629: .LC_current_location {
5630: background: $tabbg;
5631: }
1.795 www 5632:
1.938 bisitz 5633: table.LC_data_table {
1.347 albertel 5634: border: 1px solid #000000;
1.402 albertel 5635: border-collapse: separate;
1.426 albertel 5636: border-spacing: 1px;
1.610 albertel 5637: background: $pgbg;
1.347 albertel 5638: }
1.795 www 5639:
1.422 albertel 5640: .LC_data_table_dense {
5641: font-size: small;
5642: }
1.795 www 5643:
1.507 raeburn 5644: table.LC_nested_outer {
5645: border: 1px solid #000000;
1.589 raeburn 5646: border-collapse: collapse;
1.803 bisitz 5647: border-spacing: 0;
1.507 raeburn 5648: width: 100%;
5649: }
1.795 www 5650:
1.879 raeburn 5651: table.LC_innerpickbox,
1.507 raeburn 5652: table.LC_nested {
1.803 bisitz 5653: border: none;
1.589 raeburn 5654: border-collapse: collapse;
1.803 bisitz 5655: border-spacing: 0;
1.507 raeburn 5656: width: 100%;
5657: }
1.795 www 5658:
1.911 bisitz 5659: table.LC_data_table tr th,
5660: table.LC_calendar tr th,
1.879 raeburn 5661: table.LC_prior_tries tr th,
5662: table.LC_innerpickbox tr th {
1.349 albertel 5663: font-weight: bold;
5664: background-color: $data_table_head;
1.801 tempelho 5665: color:$fontmenu;
1.701 harmsja 5666: font-size:90%;
1.347 albertel 5667: }
1.795 www 5668:
1.879 raeburn 5669: table.LC_innerpickbox tr th,
5670: table.LC_innerpickbox tr td {
5671: vertical-align: top;
5672: }
5673:
1.711 raeburn 5674: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5675: background-color: #CCCCCC;
1.711 raeburn 5676: font-weight: bold;
5677: text-align: left;
5678: }
1.795 www 5679:
1.912 bisitz 5680: table.LC_data_table tr.LC_odd_row > td {
5681: background-color: $data_table_light;
5682: padding: 2px;
5683: vertical-align: top;
5684: }
5685:
1.809 bisitz 5686: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5687: background-color: $data_table_light;
1.912 bisitz 5688: vertical-align: top;
5689: }
5690:
5691: table.LC_data_table tr.LC_even_row > td {
5692: background-color: $data_table_dark;
1.425 albertel 5693: padding: 2px;
1.900 bisitz 5694: vertical-align: top;
1.347 albertel 5695: }
1.795 www 5696:
1.809 bisitz 5697: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5698: background-color: $data_table_dark;
1.900 bisitz 5699: vertical-align: top;
1.347 albertel 5700: }
1.795 www 5701:
1.425 albertel 5702: table.LC_data_table tr.LC_data_table_highlight td {
5703: background-color: $data_table_darker;
5704: }
1.795 www 5705:
1.639 raeburn 5706: table.LC_data_table tr td.LC_leftcol_header {
5707: background-color: $data_table_head;
5708: font-weight: bold;
5709: }
1.795 www 5710:
1.451 albertel 5711: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5712: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5713: font-weight: bold;
5714: font-style: italic;
5715: text-align: center;
5716: padding: 8px;
1.347 albertel 5717: }
1.795 www 5718:
1.940 bisitz 5719: table.LC_data_table tr.LC_empty_row td {
5720: background-color: $sidebg;
5721: }
5722:
5723: table.LC_nested tr.LC_empty_row td {
5724: background-color: #FFFFFF;
5725: }
5726:
1.890 droeschl 5727: table.LC_caption {
5728: }
5729:
1.507 raeburn 5730: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5731: padding: 4ex
5732: }
1.795 www 5733:
1.507 raeburn 5734: table.LC_nested_outer tr th {
5735: font-weight: bold;
1.801 tempelho 5736: color:$fontmenu;
1.507 raeburn 5737: background-color: $data_table_head;
1.701 harmsja 5738: font-size: small;
1.507 raeburn 5739: border-bottom: 1px solid #000000;
5740: }
1.795 www 5741:
1.507 raeburn 5742: table.LC_nested_outer tr td.LC_subheader {
5743: background-color: $data_table_head;
5744: font-weight: bold;
5745: font-size: small;
5746: border-bottom: 1px solid #000000;
5747: text-align: right;
1.451 albertel 5748: }
1.795 www 5749:
1.507 raeburn 5750: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5751: background-color: #CCCCCC;
1.451 albertel 5752: font-weight: bold;
5753: font-size: small;
1.507 raeburn 5754: text-align: center;
5755: }
1.795 www 5756:
1.589 raeburn 5757: table.LC_nested tr.LC_info_row td.LC_left_item,
5758: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5759: text-align: left;
1.451 albertel 5760: }
1.795 www 5761:
1.507 raeburn 5762: table.LC_nested td {
1.735 bisitz 5763: background-color: #FFFFFF;
1.451 albertel 5764: font-size: small;
1.507 raeburn 5765: }
1.795 www 5766:
1.507 raeburn 5767: table.LC_nested_outer tr th.LC_right_item,
5768: table.LC_nested tr.LC_info_row td.LC_right_item,
5769: table.LC_nested tr.LC_odd_row td.LC_right_item,
5770: table.LC_nested tr td.LC_right_item {
1.451 albertel 5771: text-align: right;
5772: }
5773:
1.507 raeburn 5774: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5775: background-color: #EEEEEE;
1.451 albertel 5776: }
5777:
1.473 raeburn 5778: table.LC_createuser {
5779: }
5780:
5781: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5782: font-size: small;
1.473 raeburn 5783: }
5784:
5785: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5786: background-color: #CCCCCC;
1.473 raeburn 5787: font-weight: bold;
5788: text-align: center;
5789: }
5790:
1.349 albertel 5791: table.LC_calendar {
5792: border: 1px solid #000000;
5793: border-collapse: collapse;
1.917 raeburn 5794: width: 98%;
1.349 albertel 5795: }
1.795 www 5796:
1.349 albertel 5797: table.LC_calendar_pickdate {
5798: font-size: xx-small;
5799: }
1.795 www 5800:
1.349 albertel 5801: table.LC_calendar tr td {
5802: border: 1px solid #000000;
5803: vertical-align: top;
1.917 raeburn 5804: width: 14%;
1.349 albertel 5805: }
1.795 www 5806:
1.349 albertel 5807: table.LC_calendar tr td.LC_calendar_day_empty {
5808: background-color: $data_table_dark;
5809: }
1.795 www 5810:
1.779 bisitz 5811: table.LC_calendar tr td.LC_calendar_day_current {
5812: background-color: $data_table_highlight;
1.777 tempelho 5813: }
1.795 www 5814:
1.938 bisitz 5815: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5816: background-color: $mail_new;
5817: }
1.795 www 5818:
1.938 bisitz 5819: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5820: background-color: $mail_new_hover;
5821: }
1.795 www 5822:
1.938 bisitz 5823: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5824: background-color: $mail_read;
5825: }
1.795 www 5826:
1.938 bisitz 5827: /*
5828: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5829: background-color: $mail_read_hover;
5830: }
1.938 bisitz 5831: */
1.795 www 5832:
1.938 bisitz 5833: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5834: background-color: $mail_replied;
5835: }
1.795 www 5836:
1.938 bisitz 5837: /*
5838: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5839: background-color: $mail_replied_hover;
5840: }
1.938 bisitz 5841: */
1.795 www 5842:
1.938 bisitz 5843: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5844: background-color: $mail_other;
5845: }
1.795 www 5846:
1.938 bisitz 5847: /*
5848: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5849: background-color: $mail_other_hover;
5850: }
1.938 bisitz 5851: */
1.494 raeburn 5852:
1.777 tempelho 5853: table.LC_data_table tr > td.LC_browser_file,
5854: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5855: background: #AAEE77;
1.389 albertel 5856: }
1.795 www 5857:
1.777 tempelho 5858: table.LC_data_table tr > td.LC_browser_file_locked,
5859: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5860: background: #FFAA99;
1.387 albertel 5861: }
1.795 www 5862:
1.777 tempelho 5863: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5864: background: #888888;
1.779 bisitz 5865: }
1.795 www 5866:
1.777 tempelho 5867: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5868: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5869: background: #F8F866;
1.777 tempelho 5870: }
1.795 www 5871:
1.696 bisitz 5872: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5873: background: #E0E8FF;
1.387 albertel 5874: }
1.696 bisitz 5875:
1.707 bisitz 5876: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5877: /* background: #77FF77; */
1.707 bisitz 5878: }
1.795 www 5879:
1.707 bisitz 5880: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 5881: border-right: 8px solid #FFFF77;
1.707 bisitz 5882: }
1.795 www 5883:
1.707 bisitz 5884: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 5885: border-right: 8px solid #FFAA77;
1.707 bisitz 5886: }
1.795 www 5887:
1.707 bisitz 5888: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 5889: border-right: 8px solid #FF7777;
1.707 bisitz 5890: }
1.795 www 5891:
1.707 bisitz 5892: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 5893: border-right: 8px solid #AAFF77;
1.707 bisitz 5894: }
1.795 www 5895:
1.707 bisitz 5896: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 5897: border-right: 8px solid #11CC55;
1.707 bisitz 5898: }
5899:
1.388 albertel 5900: span.LC_current_location {
1.701 harmsja 5901: font-size:larger;
1.388 albertel 5902: background: $pgbg;
5903: }
1.387 albertel 5904:
1.1029 www 5905: span.LC_current_nav_location {
5906: font-weight:bold;
5907: background: $sidebg;
5908: }
5909:
1.395 albertel 5910: span.LC_parm_menu_item {
5911: font-size: larger;
5912: }
1.795 www 5913:
1.395 albertel 5914: span.LC_parm_scope_all {
5915: color: red;
5916: }
1.795 www 5917:
1.395 albertel 5918: span.LC_parm_scope_folder {
5919: color: green;
5920: }
1.795 www 5921:
1.395 albertel 5922: span.LC_parm_scope_resource {
5923: color: orange;
5924: }
1.795 www 5925:
1.395 albertel 5926: span.LC_parm_part {
5927: color: blue;
5928: }
1.795 www 5929:
1.911 bisitz 5930: span.LC_parm_folder,
5931: span.LC_parm_symb {
1.395 albertel 5932: font-size: x-small;
5933: font-family: $mono;
5934: color: #AAAAAA;
5935: }
5936:
1.977 bisitz 5937: ul.LC_parm_parmlist li {
5938: display: inline-block;
5939: padding: 0.3em 0.8em;
5940: vertical-align: top;
5941: width: 150px;
5942: border-top:1px solid $lg_border_color;
5943: }
5944:
1.795 www 5945: td.LC_parm_overview_level_menu,
5946: td.LC_parm_overview_map_menu,
5947: td.LC_parm_overview_parm_selectors,
5948: td.LC_parm_overview_restrictions {
1.396 albertel 5949: border: 1px solid black;
5950: border-collapse: collapse;
5951: }
1.795 www 5952:
1.396 albertel 5953: table.LC_parm_overview_restrictions td {
5954: border-width: 1px 4px 1px 4px;
5955: border-style: solid;
5956: border-color: $pgbg;
5957: text-align: center;
5958: }
1.795 www 5959:
1.396 albertel 5960: table.LC_parm_overview_restrictions th {
5961: background: $tabbg;
5962: border-width: 1px 4px 1px 4px;
5963: border-style: solid;
5964: border-color: $pgbg;
5965: }
1.795 www 5966:
1.398 albertel 5967: table#LC_helpmenu {
1.803 bisitz 5968: border: none;
1.398 albertel 5969: height: 55px;
1.803 bisitz 5970: border-spacing: 0;
1.398 albertel 5971: }
5972:
5973: table#LC_helpmenu fieldset legend {
5974: font-size: larger;
5975: }
1.795 www 5976:
1.397 albertel 5977: table#LC_helpmenu_links {
5978: width: 100%;
5979: border: 1px solid black;
5980: background: $pgbg;
1.803 bisitz 5981: padding: 0;
1.397 albertel 5982: border-spacing: 1px;
5983: }
1.795 www 5984:
1.397 albertel 5985: table#LC_helpmenu_links tr td {
5986: padding: 1px;
5987: background: $tabbg;
1.399 albertel 5988: text-align: center;
5989: font-weight: bold;
1.397 albertel 5990: }
1.396 albertel 5991:
1.795 www 5992: table#LC_helpmenu_links a:link,
5993: table#LC_helpmenu_links a:visited,
1.397 albertel 5994: table#LC_helpmenu_links a:active {
5995: text-decoration: none;
5996: color: $font;
5997: }
1.795 www 5998:
1.397 albertel 5999: table#LC_helpmenu_links a:hover {
6000: text-decoration: underline;
6001: color: $vlink;
6002: }
1.396 albertel 6003:
1.417 albertel 6004: .LC_chrt_popup_exists {
6005: border: 1px solid #339933;
6006: margin: -1px;
6007: }
1.795 www 6008:
1.417 albertel 6009: .LC_chrt_popup_up {
6010: border: 1px solid yellow;
6011: margin: -1px;
6012: }
1.795 www 6013:
1.417 albertel 6014: .LC_chrt_popup {
6015: border: 1px solid #8888FF;
6016: background: #CCCCFF;
6017: }
1.795 www 6018:
1.421 albertel 6019: table.LC_pick_box {
6020: border-collapse: separate;
6021: background: white;
6022: border: 1px solid black;
6023: border-spacing: 1px;
6024: }
1.795 www 6025:
1.421 albertel 6026: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6027: background: $sidebg;
1.421 albertel 6028: font-weight: bold;
1.900 bisitz 6029: text-align: left;
1.740 bisitz 6030: vertical-align: top;
1.421 albertel 6031: width: 184px;
6032: padding: 8px;
6033: }
1.795 www 6034:
1.579 raeburn 6035: table.LC_pick_box td.LC_pick_box_value {
6036: text-align: left;
6037: padding: 8px;
6038: }
1.795 www 6039:
1.579 raeburn 6040: table.LC_pick_box td.LC_pick_box_select {
6041: text-align: left;
6042: padding: 8px;
6043: }
1.795 www 6044:
1.424 albertel 6045: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6046: padding: 0;
1.421 albertel 6047: height: 1px;
6048: background: black;
6049: }
1.795 www 6050:
1.421 albertel 6051: table.LC_pick_box td.LC_pick_box_submit {
6052: text-align: right;
6053: }
1.795 www 6054:
1.579 raeburn 6055: table.LC_pick_box td.LC_evenrow_value {
6056: text-align: left;
6057: padding: 8px;
6058: background-color: $data_table_light;
6059: }
1.795 www 6060:
1.579 raeburn 6061: table.LC_pick_box td.LC_oddrow_value {
6062: text-align: left;
6063: padding: 8px;
6064: background-color: $data_table_light;
6065: }
1.795 www 6066:
1.579 raeburn 6067: span.LC_helpform_receipt_cat {
6068: font-weight: bold;
6069: }
1.795 www 6070:
1.424 albertel 6071: table.LC_group_priv_box {
6072: background: white;
6073: border: 1px solid black;
6074: border-spacing: 1px;
6075: }
1.795 www 6076:
1.424 albertel 6077: table.LC_group_priv_box td.LC_pick_box_title {
6078: background: $tabbg;
6079: font-weight: bold;
6080: text-align: right;
6081: width: 184px;
6082: }
1.795 www 6083:
1.424 albertel 6084: table.LC_group_priv_box td.LC_groups_fixed {
6085: background: $data_table_light;
6086: text-align: center;
6087: }
1.795 www 6088:
1.424 albertel 6089: table.LC_group_priv_box td.LC_groups_optional {
6090: background: $data_table_dark;
6091: text-align: center;
6092: }
1.795 www 6093:
1.424 albertel 6094: table.LC_group_priv_box td.LC_groups_functionality {
6095: background: $data_table_darker;
6096: text-align: center;
6097: font-weight: bold;
6098: }
1.795 www 6099:
1.424 albertel 6100: table.LC_group_priv td {
6101: text-align: left;
1.803 bisitz 6102: padding: 0;
1.424 albertel 6103: }
6104:
6105: .LC_navbuttons {
6106: margin: 2ex 0ex 2ex 0ex;
6107: }
1.795 www 6108:
1.423 albertel 6109: .LC_topic_bar {
6110: font-weight: bold;
6111: background: $tabbg;
1.918 wenzelju 6112: margin: 1em 0em 1em 2em;
1.805 bisitz 6113: padding: 3px;
1.918 wenzelju 6114: font-size: 1.2em;
1.423 albertel 6115: }
1.795 www 6116:
1.423 albertel 6117: .LC_topic_bar span {
1.918 wenzelju 6118: left: 0.5em;
6119: position: absolute;
1.423 albertel 6120: vertical-align: middle;
1.918 wenzelju 6121: font-size: 1.2em;
1.423 albertel 6122: }
1.795 www 6123:
1.423 albertel 6124: table.LC_course_group_status {
6125: margin: 20px;
6126: }
1.795 www 6127:
1.423 albertel 6128: table.LC_status_selector td {
6129: vertical-align: top;
6130: text-align: center;
1.424 albertel 6131: padding: 4px;
6132: }
1.795 www 6133:
1.599 albertel 6134: div.LC_feedback_link {
1.616 albertel 6135: clear: both;
1.829 kalberla 6136: background: $sidebg;
1.779 bisitz 6137: width: 100%;
1.829 kalberla 6138: padding-bottom: 10px;
6139: border: 1px $tabbg solid;
1.833 kalberla 6140: height: 22px;
6141: line-height: 22px;
6142: padding-top: 5px;
6143: }
6144:
6145: div.LC_feedback_link img {
6146: height: 22px;
1.867 kalberla 6147: vertical-align:middle;
1.829 kalberla 6148: }
6149:
1.911 bisitz 6150: div.LC_feedback_link a {
1.829 kalberla 6151: text-decoration: none;
1.489 raeburn 6152: }
1.795 www 6153:
1.867 kalberla 6154: div.LC_comblock {
1.911 bisitz 6155: display:inline;
1.867 kalberla 6156: color:$font;
6157: font-size:90%;
6158: }
6159:
6160: div.LC_feedback_link div.LC_comblock {
6161: padding-left:5px;
6162: }
6163:
6164: div.LC_feedback_link div.LC_comblock a {
6165: color:$font;
6166: }
6167:
1.489 raeburn 6168: span.LC_feedback_link {
1.858 bisitz 6169: /* background: $feedback_link_bg; */
1.599 albertel 6170: font-size: larger;
6171: }
1.795 www 6172:
1.599 albertel 6173: span.LC_message_link {
1.858 bisitz 6174: /* background: $feedback_link_bg; */
1.599 albertel 6175: font-size: larger;
6176: position: absolute;
6177: right: 1em;
1.489 raeburn 6178: }
1.421 albertel 6179:
1.515 albertel 6180: table.LC_prior_tries {
1.524 albertel 6181: border: 1px solid #000000;
6182: border-collapse: separate;
6183: border-spacing: 1px;
1.515 albertel 6184: }
1.523 albertel 6185:
1.515 albertel 6186: table.LC_prior_tries td {
1.524 albertel 6187: padding: 2px;
1.515 albertel 6188: }
1.523 albertel 6189:
6190: .LC_answer_correct {
1.795 www 6191: background: lightgreen;
6192: color: darkgreen;
6193: padding: 6px;
1.523 albertel 6194: }
1.795 www 6195:
1.523 albertel 6196: .LC_answer_charged_try {
1.797 www 6197: background: #FFAAAA;
1.795 www 6198: color: darkred;
6199: padding: 6px;
1.523 albertel 6200: }
1.795 www 6201:
1.779 bisitz 6202: .LC_answer_not_charged_try,
1.523 albertel 6203: .LC_answer_no_grade,
6204: .LC_answer_late {
1.795 www 6205: background: lightyellow;
1.523 albertel 6206: color: black;
1.795 www 6207: padding: 6px;
1.523 albertel 6208: }
1.795 www 6209:
1.523 albertel 6210: .LC_answer_previous {
1.795 www 6211: background: lightblue;
6212: color: darkblue;
6213: padding: 6px;
1.523 albertel 6214: }
1.795 www 6215:
1.779 bisitz 6216: .LC_answer_no_message {
1.777 tempelho 6217: background: #FFFFFF;
6218: color: black;
1.795 www 6219: padding: 6px;
1.779 bisitz 6220: }
1.795 www 6221:
1.779 bisitz 6222: .LC_answer_unknown {
6223: background: orange;
6224: color: black;
1.795 www 6225: padding: 6px;
1.777 tempelho 6226: }
1.795 www 6227:
1.529 albertel 6228: span.LC_prior_numerical,
6229: span.LC_prior_string,
6230: span.LC_prior_custom,
6231: span.LC_prior_reaction,
6232: span.LC_prior_math {
1.925 bisitz 6233: font-family: $mono;
1.523 albertel 6234: white-space: pre;
6235: }
6236:
1.525 albertel 6237: span.LC_prior_string {
1.925 bisitz 6238: font-family: $mono;
1.525 albertel 6239: white-space: pre;
6240: }
6241:
1.523 albertel 6242: table.LC_prior_option {
6243: width: 100%;
6244: border-collapse: collapse;
6245: }
1.795 www 6246:
1.911 bisitz 6247: table.LC_prior_rank,
1.795 www 6248: table.LC_prior_match {
1.528 albertel 6249: border-collapse: collapse;
6250: }
1.795 www 6251:
1.528 albertel 6252: table.LC_prior_option tr td,
6253: table.LC_prior_rank tr td,
6254: table.LC_prior_match tr td {
1.524 albertel 6255: border: 1px solid #000000;
1.515 albertel 6256: }
6257:
1.855 bisitz 6258: .LC_nobreak {
1.544 albertel 6259: white-space: nowrap;
1.519 raeburn 6260: }
6261:
1.576 raeburn 6262: span.LC_cusr_emph {
6263: font-style: italic;
6264: }
6265:
1.633 raeburn 6266: span.LC_cusr_subheading {
6267: font-weight: normal;
6268: font-size: 85%;
6269: }
6270:
1.861 bisitz 6271: div.LC_docs_entry_move {
1.859 bisitz 6272: border: 1px solid #BBBBBB;
1.545 albertel 6273: background: #DDDDDD;
1.861 bisitz 6274: width: 22px;
1.859 bisitz 6275: padding: 1px;
6276: margin: 0;
1.545 albertel 6277: }
6278:
1.861 bisitz 6279: table.LC_data_table tr > td.LC_docs_entry_commands,
6280: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6281: background: #DDDDDD;
6282: font-size: x-small;
6283: }
1.795 www 6284:
1.861 bisitz 6285: .LC_docs_entry_parameter {
6286: white-space: nowrap;
6287: }
6288:
1.544 albertel 6289: .LC_docs_copy {
1.545 albertel 6290: color: #000099;
1.544 albertel 6291: }
1.795 www 6292:
1.544 albertel 6293: .LC_docs_cut {
1.545 albertel 6294: color: #550044;
1.544 albertel 6295: }
1.795 www 6296:
1.544 albertel 6297: .LC_docs_rename {
1.545 albertel 6298: color: #009900;
1.544 albertel 6299: }
1.795 www 6300:
1.544 albertel 6301: .LC_docs_remove {
1.545 albertel 6302: color: #990000;
6303: }
6304:
1.547 albertel 6305: .LC_docs_reinit_warn,
6306: .LC_docs_ext_edit {
6307: font-size: x-small;
6308: }
6309:
1.545 albertel 6310: table.LC_docs_adddocs td,
6311: table.LC_docs_adddocs th {
6312: border: 1px solid #BBBBBB;
6313: padding: 4px;
6314: background: #DDDDDD;
1.543 albertel 6315: }
6316:
1.584 albertel 6317: table.LC_sty_begin {
6318: background: #BBFFBB;
6319: }
1.795 www 6320:
1.584 albertel 6321: table.LC_sty_end {
6322: background: #FFBBBB;
6323: }
6324:
1.589 raeburn 6325: table.LC_double_column {
1.803 bisitz 6326: border-width: 0;
1.589 raeburn 6327: border-collapse: collapse;
6328: width: 100%;
6329: padding: 2px;
6330: }
6331:
6332: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6333: top: 2px;
1.589 raeburn 6334: left: 2px;
6335: width: 47%;
6336: vertical-align: top;
6337: }
6338:
6339: table.LC_double_column tr td.LC_right_col {
6340: top: 2px;
1.779 bisitz 6341: right: 2px;
1.589 raeburn 6342: width: 47%;
6343: vertical-align: top;
6344: }
6345:
1.591 raeburn 6346: div.LC_left_float {
6347: float: left;
6348: padding-right: 5%;
1.597 albertel 6349: padding-bottom: 4px;
1.591 raeburn 6350: }
6351:
6352: div.LC_clear_float_header {
1.597 albertel 6353: padding-bottom: 2px;
1.591 raeburn 6354: }
6355:
6356: div.LC_clear_float_footer {
1.597 albertel 6357: padding-top: 10px;
1.591 raeburn 6358: clear: both;
6359: }
6360:
1.597 albertel 6361: div.LC_grade_show_user {
1.941 bisitz 6362: /* border-left: 5px solid $sidebg; */
6363: border-top: 5px solid #000000;
6364: margin: 50px 0 0 0;
1.936 bisitz 6365: padding: 15px 0 5px 10px;
1.597 albertel 6366: }
1.795 www 6367:
1.936 bisitz 6368: div.LC_grade_show_user_odd_row {
1.941 bisitz 6369: /* border-left: 5px solid #000000; */
6370: }
6371:
6372: div.LC_grade_show_user div.LC_Box {
6373: margin-right: 50px;
1.597 albertel 6374: }
6375:
6376: div.LC_grade_submissions,
6377: div.LC_grade_message_center,
1.936 bisitz 6378: div.LC_grade_info_links {
1.597 albertel 6379: margin: 5px;
6380: width: 99%;
6381: background: #FFFFFF;
6382: }
1.795 www 6383:
1.597 albertel 6384: div.LC_grade_submissions_header,
1.936 bisitz 6385: div.LC_grade_message_center_header {
1.705 tempelho 6386: font-weight: bold;
6387: font-size: large;
1.597 albertel 6388: }
1.795 www 6389:
1.597 albertel 6390: div.LC_grade_submissions_body,
1.936 bisitz 6391: div.LC_grade_message_center_body {
1.597 albertel 6392: border: 1px solid black;
6393: width: 99%;
6394: background: #FFFFFF;
6395: }
1.795 www 6396:
1.613 albertel 6397: table.LC_scantron_action {
6398: width: 100%;
6399: }
1.795 www 6400:
1.613 albertel 6401: table.LC_scantron_action tr th {
1.698 harmsja 6402: font-weight:bold;
6403: font-style:normal;
1.613 albertel 6404: }
1.795 www 6405:
1.779 bisitz 6406: .LC_edit_problem_header,
1.614 albertel 6407: div.LC_edit_problem_footer {
1.705 tempelho 6408: font-weight: normal;
6409: font-size: medium;
1.602 albertel 6410: margin: 2px;
1.1060 bisitz 6411: background-color: $sidebg;
1.600 albertel 6412: }
1.795 www 6413:
1.600 albertel 6414: div.LC_edit_problem_header,
1.602 albertel 6415: div.LC_edit_problem_header div,
1.614 albertel 6416: div.LC_edit_problem_footer,
6417: div.LC_edit_problem_footer div,
1.602 albertel 6418: div.LC_edit_problem_editxml_header,
6419: div.LC_edit_problem_editxml_header div {
1.600 albertel 6420: margin-top: 5px;
6421: }
1.795 www 6422:
1.600 albertel 6423: div.LC_edit_problem_header_title {
1.705 tempelho 6424: font-weight: bold;
6425: font-size: larger;
1.602 albertel 6426: background: $tabbg;
6427: padding: 3px;
1.1060 bisitz 6428: margin: 0 0 5px 0;
1.602 albertel 6429: }
1.795 www 6430:
1.602 albertel 6431: table.LC_edit_problem_header_title {
6432: width: 100%;
1.600 albertel 6433: background: $tabbg;
1.602 albertel 6434: }
6435:
6436: div.LC_edit_problem_discards {
6437: float: left;
6438: padding-bottom: 5px;
6439: }
1.795 www 6440:
1.602 albertel 6441: div.LC_edit_problem_saves {
6442: float: right;
6443: padding-bottom: 5px;
1.600 albertel 6444: }
1.795 www 6445:
1.911 bisitz 6446: img.stift {
1.803 bisitz 6447: border-width: 0;
6448: vertical-align: middle;
1.677 riegler 6449: }
1.680 riegler 6450:
1.923 bisitz 6451: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6452: vertical-align: top;
1.777 tempelho 6453: }
1.795 www 6454:
1.716 raeburn 6455: div.LC_createcourse {
1.911 bisitz 6456: margin: 10px 10px 10px 10px;
1.716 raeburn 6457: }
6458:
1.917 raeburn 6459: .LC_dccid {
6460: margin: 0.2em 0 0 0;
6461: padding: 0;
6462: font-size: 90%;
6463: display:none;
6464: }
6465:
1.897 wenzelju 6466: ol.LC_primary_menu a:hover,
1.721 harmsja 6467: ol#LC_MenuBreadcrumbs a:hover,
6468: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6469: ul#LC_secondary_menu a:hover,
1.721 harmsja 6470: .LC_FormSectionClearButton input:hover
1.795 www 6471: ul.LC_TabContent li:hover a {
1.952 onken 6472: color:$button_hover;
1.911 bisitz 6473: text-decoration:none;
1.693 droeschl 6474: }
6475:
1.779 bisitz 6476: h1 {
1.911 bisitz 6477: padding: 0;
6478: line-height:130%;
1.693 droeschl 6479: }
1.698 harmsja 6480:
1.911 bisitz 6481: h2,
6482: h3,
6483: h4,
6484: h5,
6485: h6 {
6486: margin: 5px 0 5px 0;
6487: padding: 0;
6488: line-height:130%;
1.693 droeschl 6489: }
1.795 www 6490:
6491: .LC_hcell {
1.911 bisitz 6492: padding:3px 15px 3px 15px;
6493: margin: 0;
6494: background-color:$tabbg;
6495: color:$fontmenu;
6496: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6497: }
1.795 www 6498:
1.840 bisitz 6499: .LC_Box > .LC_hcell {
1.911 bisitz 6500: margin: 0 -10px 10px -10px;
1.835 bisitz 6501: }
6502:
1.721 harmsja 6503: .LC_noBorder {
1.911 bisitz 6504: border: 0;
1.698 harmsja 6505: }
1.693 droeschl 6506:
1.721 harmsja 6507: .LC_FormSectionClearButton input {
1.911 bisitz 6508: background-color:transparent;
6509: border: none;
6510: cursor:pointer;
6511: text-decoration:underline;
1.693 droeschl 6512: }
1.763 bisitz 6513:
6514: .LC_help_open_topic {
1.911 bisitz 6515: color: #FFFFFF;
6516: background-color: #EEEEFF;
6517: margin: 1px;
6518: padding: 4px;
6519: border: 1px solid #000033;
6520: white-space: nowrap;
6521: /* vertical-align: middle; */
1.759 neumanie 6522: }
1.693 droeschl 6523:
1.911 bisitz 6524: dl,
6525: ul,
6526: div,
6527: fieldset {
6528: margin: 10px 10px 10px 0;
6529: /* overflow: hidden; */
1.693 droeschl 6530: }
1.795 www 6531:
1.838 bisitz 6532: fieldset > legend {
1.911 bisitz 6533: font-weight: bold;
6534: padding: 0 5px 0 5px;
1.838 bisitz 6535: }
6536:
1.813 bisitz 6537: #LC_nav_bar {
1.911 bisitz 6538: float: left;
1.995 raeburn 6539: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6540: margin: 0 0 2px 0;
1.807 droeschl 6541: }
6542:
1.916 droeschl 6543: #LC_realm {
6544: margin: 0.2em 0 0 0;
6545: padding: 0;
6546: font-weight: bold;
6547: text-align: center;
1.995 raeburn 6548: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6549: }
6550:
1.911 bisitz 6551: #LC_nav_bar em {
6552: font-weight: bold;
6553: font-style: normal;
1.807 droeschl 6554: }
6555:
1.897 wenzelju 6556: ol.LC_primary_menu {
1.911 bisitz 6557: float: right;
1.934 droeschl 6558: margin: 0;
1.1076 raeburn 6559: padding: 0;
1.995 raeburn 6560: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6561: }
6562:
1.852 droeschl 6563: ol#LC_PathBreadcrumbs {
1.911 bisitz 6564: margin: 0;
1.693 droeschl 6565: }
6566:
1.897 wenzelju 6567: ol.LC_primary_menu li {
1.1076 raeburn 6568: color: RGB(80, 80, 80);
6569: vertical-align: middle;
6570: text-align: left;
6571: list-style: none;
6572: float: left;
6573: }
6574:
6575: ol.LC_primary_menu li a {
6576: display: block;
6577: margin: 0;
6578: padding: 0 5px 0 10px;
6579: text-decoration: none;
6580: }
6581:
6582: ol.LC_primary_menu li ul {
6583: display: none;
6584: width: 10em;
6585: background-color: $data_table_light;
6586: }
6587:
6588: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6589: display: block;
6590: position: absolute;
6591: margin: 0;
6592: padding: 0;
1.1078 raeburn 6593: z-index: 2;
1.1076 raeburn 6594: }
6595:
6596: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6597: font-size: 90%;
1.911 bisitz 6598: vertical-align: top;
1.1076 raeburn 6599: float: none;
1.1079 raeburn 6600: border-left: 1px solid black;
6601: border-right: 1px solid black;
1.1076 raeburn 6602: }
6603:
6604: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078 raeburn 6605: background-color:$data_table_light;
1.1076 raeburn 6606: }
6607:
6608: ol.LC_primary_menu li li a:hover {
6609: color:$button_hover;
6610: background-color:$data_table_dark;
1.693 droeschl 6611: }
6612:
1.897 wenzelju 6613: ol.LC_primary_menu li img {
1.911 bisitz 6614: vertical-align: bottom;
1.934 droeschl 6615: height: 1.1em;
1.1077 raeburn 6616: margin: 0.2em 0 0 0;
1.693 droeschl 6617: }
6618:
1.897 wenzelju 6619: ol.LC_primary_menu a {
1.911 bisitz 6620: color: RGB(80, 80, 80);
6621: text-decoration: none;
1.693 droeschl 6622: }
1.795 www 6623:
1.949 droeschl 6624: ol.LC_primary_menu a.LC_new_message {
6625: font-weight:bold;
6626: color: darkred;
6627: }
6628:
1.975 raeburn 6629: ol.LC_docs_parameters {
6630: margin-left: 0;
6631: padding: 0;
6632: list-style: none;
6633: }
6634:
6635: ol.LC_docs_parameters li {
6636: margin: 0;
6637: padding-right: 20px;
6638: display: inline;
6639: }
6640:
1.976 raeburn 6641: ol.LC_docs_parameters li:before {
6642: content: "\\002022 \\0020";
6643: }
6644:
6645: li.LC_docs_parameters_title {
6646: font-weight: bold;
6647: }
6648:
6649: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6650: content: "";
6651: }
6652:
1.897 wenzelju 6653: ul#LC_secondary_menu {
1.911 bisitz 6654: clear: both;
6655: color: $fontmenu;
6656: background: $tabbg;
6657: list-style: none;
6658: padding: 0;
6659: margin: 0;
6660: width: 100%;
1.995 raeburn 6661: text-align: left;
1.808 droeschl 6662: }
6663:
1.897 wenzelju 6664: ul#LC_secondary_menu li {
1.911 bisitz 6665: font-weight: bold;
6666: line-height: 1.8em;
6667: padding: 0 0.8em;
6668: border-right: 1px solid black;
6669: display: inline;
6670: vertical-align: middle;
1.807 droeschl 6671: }
6672:
1.847 tempelho 6673: ul.LC_TabContent {
1.911 bisitz 6674: display:block;
6675: background: $sidebg;
6676: border-bottom: solid 1px $lg_border_color;
6677: list-style:none;
1.1020 raeburn 6678: margin: -1px -10px 0 -10px;
1.911 bisitz 6679: padding: 0;
1.693 droeschl 6680: }
6681:
1.795 www 6682: ul.LC_TabContent li,
6683: ul.LC_TabContentBigger li {
1.911 bisitz 6684: float:left;
1.741 harmsja 6685: }
1.795 www 6686:
1.897 wenzelju 6687: ul#LC_secondary_menu li a {
1.911 bisitz 6688: color: $fontmenu;
6689: text-decoration: none;
1.693 droeschl 6690: }
1.795 www 6691:
1.721 harmsja 6692: ul.LC_TabContent {
1.952 onken 6693: min-height:20px;
1.721 harmsja 6694: }
1.795 www 6695:
6696: ul.LC_TabContent li {
1.911 bisitz 6697: vertical-align:middle;
1.959 onken 6698: padding: 0 16px 0 10px;
1.911 bisitz 6699: background-color:$tabbg;
6700: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6701: border-left: solid 1px $font;
1.721 harmsja 6702: }
1.795 www 6703:
1.847 tempelho 6704: ul.LC_TabContent .right {
1.911 bisitz 6705: float:right;
1.847 tempelho 6706: }
6707:
1.911 bisitz 6708: ul.LC_TabContent li a,
6709: ul.LC_TabContent li {
6710: color:rgb(47,47,47);
6711: text-decoration:none;
6712: font-size:95%;
6713: font-weight:bold;
1.952 onken 6714: min-height:20px;
6715: }
6716:
1.959 onken 6717: ul.LC_TabContent li a:hover,
6718: ul.LC_TabContent li a:focus {
1.952 onken 6719: color: $button_hover;
1.959 onken 6720: background:none;
6721: outline:none;
1.952 onken 6722: }
6723:
6724: ul.LC_TabContent li:hover {
6725: color: $button_hover;
6726: cursor:pointer;
1.721 harmsja 6727: }
1.795 www 6728:
1.911 bisitz 6729: ul.LC_TabContent li.active {
1.952 onken 6730: color: $font;
1.911 bisitz 6731: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6732: border-bottom:solid 1px #FFFFFF;
6733: cursor: default;
1.744 ehlerst 6734: }
1.795 www 6735:
1.959 onken 6736: ul.LC_TabContent li.active a {
6737: color:$font;
6738: background:#FFFFFF;
6739: outline: none;
6740: }
1.1047 raeburn 6741:
6742: ul.LC_TabContent li.goback {
6743: float: left;
6744: border-left: none;
6745: }
6746:
1.870 tempelho 6747: #maincoursedoc {
1.911 bisitz 6748: clear:both;
1.870 tempelho 6749: }
6750:
6751: ul.LC_TabContentBigger {
1.911 bisitz 6752: display:block;
6753: list-style:none;
6754: padding: 0;
1.870 tempelho 6755: }
6756:
1.795 www 6757: ul.LC_TabContentBigger li {
1.911 bisitz 6758: vertical-align:bottom;
6759: height: 30px;
6760: font-size:110%;
6761: font-weight:bold;
6762: color: #737373;
1.841 tempelho 6763: }
6764:
1.957 onken 6765: ul.LC_TabContentBigger li.active {
6766: position: relative;
6767: top: 1px;
6768: }
6769:
1.870 tempelho 6770: ul.LC_TabContentBigger li a {
1.911 bisitz 6771: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6772: height: 30px;
6773: line-height: 30px;
6774: text-align: center;
6775: display: block;
6776: text-decoration: none;
1.958 onken 6777: outline: none;
1.741 harmsja 6778: }
1.795 www 6779:
1.870 tempelho 6780: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6781: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6782: color:$font;
1.744 ehlerst 6783: }
1.795 www 6784:
1.870 tempelho 6785: ul.LC_TabContentBigger li b {
1.911 bisitz 6786: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6787: display: block;
6788: float: left;
6789: padding: 0 30px;
1.957 onken 6790: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6791: }
6792:
1.956 onken 6793: ul.LC_TabContentBigger li:hover b {
6794: color:$button_hover;
6795: }
6796:
1.870 tempelho 6797: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6798: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6799: color:$font;
1.957 onken 6800: border: 0;
1.741 harmsja 6801: }
1.693 droeschl 6802:
1.870 tempelho 6803:
1.862 bisitz 6804: ul.LC_CourseBreadcrumbs {
6805: background: $sidebg;
1.1020 raeburn 6806: height: 2em;
1.862 bisitz 6807: padding-left: 10px;
1.1020 raeburn 6808: margin: 0;
1.862 bisitz 6809: list-style-position: inside;
6810: }
6811:
1.911 bisitz 6812: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6813: ol#LC_PathBreadcrumbs {
1.911 bisitz 6814: padding-left: 10px;
6815: margin: 0;
1.933 droeschl 6816: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6817: }
6818:
1.911 bisitz 6819: ol#LC_MenuBreadcrumbs li,
6820: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6821: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6822: display: inline;
1.933 droeschl 6823: white-space: normal;
1.693 droeschl 6824: }
6825:
1.823 bisitz 6826: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6827: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6828: text-decoration: none;
6829: font-size:90%;
1.693 droeschl 6830: }
1.795 www 6831:
1.969 droeschl 6832: ol#LC_MenuBreadcrumbs h1 {
6833: display: inline;
6834: font-size: 90%;
6835: line-height: 2.5em;
6836: margin: 0;
6837: padding: 0;
6838: }
6839:
1.795 www 6840: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6841: text-decoration:none;
6842: font-size:100%;
6843: font-weight:bold;
1.693 droeschl 6844: }
1.795 www 6845:
1.840 bisitz 6846: .LC_Box {
1.911 bisitz 6847: border: solid 1px $lg_border_color;
6848: padding: 0 10px 10px 10px;
1.746 neumanie 6849: }
1.795 www 6850:
1.1020 raeburn 6851: .LC_DocsBox {
6852: border: solid 1px $lg_border_color;
6853: padding: 0 0 10px 10px;
6854: }
6855:
1.795 www 6856: .LC_AboutMe_Image {
1.911 bisitz 6857: float:left;
6858: margin-right:10px;
1.747 neumanie 6859: }
1.795 www 6860:
6861: .LC_Clear_AboutMe_Image {
1.911 bisitz 6862: clear:left;
1.747 neumanie 6863: }
1.795 www 6864:
1.721 harmsja 6865: dl.LC_ListStyleClean dt {
1.911 bisitz 6866: padding-right: 5px;
6867: display: table-header-group;
1.693 droeschl 6868: }
6869:
1.721 harmsja 6870: dl.LC_ListStyleClean dd {
1.911 bisitz 6871: display: table-row;
1.693 droeschl 6872: }
6873:
1.721 harmsja 6874: .LC_ListStyleClean,
6875: .LC_ListStyleSimple,
6876: .LC_ListStyleNormal,
1.795 www 6877: .LC_ListStyleSpecial {
1.911 bisitz 6878: /* display:block; */
6879: list-style-position: inside;
6880: list-style-type: none;
6881: overflow: hidden;
6882: padding: 0;
1.693 droeschl 6883: }
6884:
1.721 harmsja 6885: .LC_ListStyleSimple li,
6886: .LC_ListStyleSimple dd,
6887: .LC_ListStyleNormal li,
6888: .LC_ListStyleNormal dd,
6889: .LC_ListStyleSpecial li,
1.795 www 6890: .LC_ListStyleSpecial dd {
1.911 bisitz 6891: margin: 0;
6892: padding: 5px 5px 5px 10px;
6893: clear: both;
1.693 droeschl 6894: }
6895:
1.721 harmsja 6896: .LC_ListStyleClean li,
6897: .LC_ListStyleClean dd {
1.911 bisitz 6898: padding-top: 0;
6899: padding-bottom: 0;
1.693 droeschl 6900: }
6901:
1.721 harmsja 6902: .LC_ListStyleSimple dd,
1.795 www 6903: .LC_ListStyleSimple li {
1.911 bisitz 6904: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 6905: }
6906:
1.721 harmsja 6907: .LC_ListStyleSpecial li,
6908: .LC_ListStyleSpecial dd {
1.911 bisitz 6909: list-style-type: none;
6910: background-color: RGB(220, 220, 220);
6911: margin-bottom: 4px;
1.693 droeschl 6912: }
6913:
1.721 harmsja 6914: table.LC_SimpleTable {
1.911 bisitz 6915: margin:5px;
6916: border:solid 1px $lg_border_color;
1.795 www 6917: }
1.693 droeschl 6918:
1.721 harmsja 6919: table.LC_SimpleTable tr {
1.911 bisitz 6920: padding: 0;
6921: border:solid 1px $lg_border_color;
1.693 droeschl 6922: }
1.795 www 6923:
6924: table.LC_SimpleTable thead {
1.911 bisitz 6925: background:rgb(220,220,220);
1.693 droeschl 6926: }
6927:
1.721 harmsja 6928: div.LC_columnSection {
1.911 bisitz 6929: display: block;
6930: clear: both;
6931: overflow: hidden;
6932: margin: 0;
1.693 droeschl 6933: }
6934:
1.721 harmsja 6935: div.LC_columnSection>* {
1.911 bisitz 6936: float: left;
6937: margin: 10px 20px 10px 0;
6938: overflow:hidden;
1.693 droeschl 6939: }
1.721 harmsja 6940:
1.795 www 6941: table em {
1.911 bisitz 6942: font-weight: bold;
6943: font-style: normal;
1.748 schulted 6944: }
1.795 www 6945:
1.779 bisitz 6946: table.LC_tableBrowseRes,
1.795 www 6947: table.LC_tableOfContent {
1.911 bisitz 6948: border:none;
6949: border-spacing: 1px;
6950: padding: 3px;
6951: background-color: #FFFFFF;
6952: font-size: 90%;
1.753 droeschl 6953: }
1.789 droeschl 6954:
1.911 bisitz 6955: table.LC_tableOfContent {
6956: border-collapse: collapse;
1.789 droeschl 6957: }
6958:
1.771 droeschl 6959: table.LC_tableBrowseRes a,
1.768 schulted 6960: table.LC_tableOfContent a {
1.911 bisitz 6961: background-color: transparent;
6962: text-decoration: none;
1.753 droeschl 6963: }
6964:
1.795 www 6965: table.LC_tableOfContent img {
1.911 bisitz 6966: border: none;
6967: height: 1.3em;
6968: vertical-align: text-bottom;
6969: margin-right: 0.3em;
1.753 droeschl 6970: }
1.757 schulted 6971:
1.795 www 6972: a#LC_content_toolbar_firsthomework {
1.911 bisitz 6973: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 6974: }
6975:
1.795 www 6976: a#LC_content_toolbar_everything {
1.911 bisitz 6977: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 6978: }
6979:
1.795 www 6980: a#LC_content_toolbar_uncompleted {
1.911 bisitz 6981: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 6982: }
6983:
1.795 www 6984: #LC_content_toolbar_clearbubbles {
1.911 bisitz 6985: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 6986: }
6987:
1.795 www 6988: a#LC_content_toolbar_changefolder {
1.911 bisitz 6989: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 6990: }
6991:
1.795 www 6992: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 6993: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 6994: }
6995:
1.1043 raeburn 6996: a#LC_content_toolbar_edittoplevel {
6997: background-image:url(/res/adm/pages/edittoplevel.gif);
6998: }
6999:
1.795 www 7000: ul#LC_toolbar li a:hover {
1.911 bisitz 7001: background-position: bottom center;
1.757 schulted 7002: }
7003:
1.795 www 7004: ul#LC_toolbar {
1.911 bisitz 7005: padding: 0;
7006: margin: 2px;
7007: list-style:none;
7008: position:relative;
7009: background-color:white;
1.1082 raeburn 7010: overflow: auto;
1.757 schulted 7011: }
7012:
1.795 www 7013: ul#LC_toolbar li {
1.911 bisitz 7014: border:1px solid white;
7015: padding: 0;
7016: margin: 0;
7017: float: left;
7018: display:inline;
7019: vertical-align:middle;
1.1082 raeburn 7020: white-space: nowrap;
1.911 bisitz 7021: }
1.757 schulted 7022:
1.783 amueller 7023:
1.795 www 7024: a.LC_toolbarItem {
1.911 bisitz 7025: display:block;
7026: padding: 0;
7027: margin: 0;
7028: height: 32px;
7029: width: 32px;
7030: color:white;
7031: border: none;
7032: background-repeat:no-repeat;
7033: background-color:transparent;
1.757 schulted 7034: }
7035:
1.915 droeschl 7036: ul.LC_funclist {
7037: margin: 0;
7038: padding: 0.5em 1em 0.5em 0;
7039: }
7040:
1.933 droeschl 7041: ul.LC_funclist > li:first-child {
7042: font-weight:bold;
7043: margin-left:0.8em;
7044: }
7045:
1.915 droeschl 7046: ul.LC_funclist + ul.LC_funclist {
7047: /*
7048: left border as a seperator if we have more than
7049: one list
7050: */
7051: border-left: 1px solid $sidebg;
7052: /*
7053: this hides the left border behind the border of the
7054: outer box if element is wrapped to the next 'line'
7055: */
7056: margin-left: -1px;
7057: }
7058:
1.843 bisitz 7059: ul.LC_funclist li {
1.915 droeschl 7060: display: inline;
1.782 bisitz 7061: white-space: nowrap;
1.915 droeschl 7062: margin: 0 0 0 25px;
7063: line-height: 150%;
1.782 bisitz 7064: }
7065:
1.974 wenzelju 7066: .LC_hidden {
7067: display: none;
7068: }
7069:
1.1030 www 7070: .LCmodal-overlay {
7071: position:fixed;
7072: top:0;
7073: right:0;
7074: bottom:0;
7075: left:0;
7076: height:100%;
7077: width:100%;
7078: margin:0;
7079: padding:0;
7080: background:#999;
7081: opacity:.75;
7082: filter: alpha(opacity=75);
7083: -moz-opacity: 0.75;
7084: z-index:101;
7085: }
7086:
7087: * html .LCmodal-overlay {
7088: position: absolute;
7089: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7090: }
7091:
7092: .LCmodal-window {
7093: position:fixed;
7094: top:50%;
7095: left:50%;
7096: margin:0;
7097: padding:0;
7098: z-index:102;
7099: }
7100:
7101: * html .LCmodal-window {
7102: position:absolute;
7103: }
7104:
7105: .LCclose-window {
7106: position:absolute;
7107: width:32px;
7108: height:32px;
7109: right:8px;
7110: top:8px;
7111: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7112: text-indent:-99999px;
7113: overflow:hidden;
7114: cursor:pointer;
7115: }
7116:
1.343 albertel 7117: END
7118: }
7119:
1.306 albertel 7120: =pod
7121:
7122: =item * &headtag()
7123:
7124: Returns a uniform footer for LON-CAPA web pages.
7125:
1.307 albertel 7126: Inputs: $title - optional title for the head
7127: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7128: $args - optional arguments
1.319 albertel 7129: force_register - if is true call registerurl so the remote is
7130: informed
1.415 albertel 7131: redirect -> array ref of
7132: 1- seconds before redirect occurs
7133: 2- url to redirect to
7134: 3- whether the side effect should occur
1.315 albertel 7135: (side effect of setting
7136: $env{'internal.head.redirect'} to the url
7137: redirected too)
1.352 albertel 7138: domain -> force to color decorate a page for a specific
7139: domain
7140: function -> force usage of a specific rolish color scheme
7141: bgcolor -> override the default page bgcolor
1.460 albertel 7142: no_auto_mt_title
7143: -> prevent &mt()ing the title arg
1.464 albertel 7144:
1.306 albertel 7145: =cut
7146:
7147: sub headtag {
1.313 albertel 7148: my ($title,$head_extra,$args) = @_;
1.306 albertel 7149:
1.363 albertel 7150: my $function = $args->{'function'} || &get_users_function();
7151: my $domain = $args->{'domain'} || &determinedomain();
7152: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 7153: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7154: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7155: #time(),
1.418 albertel 7156: $env{'environment.color.timestamp'},
1.363 albertel 7157: $function,$domain,$bgcolor);
7158:
1.369 www 7159: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7160:
1.308 albertel 7161: my $result =
7162: '<head>'.
1.461 albertel 7163: &font_settings();
1.319 albertel 7164:
1.1064 raeburn 7165: my $inhibitprint = &print_suppression();
7166:
1.461 albertel 7167: if (!$args->{'frameset'}) {
7168: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7169: }
1.962 droeschl 7170: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7171: $result .= Apache::lonxml::display_title();
1.319 albertel 7172: }
1.436 albertel 7173: if (!$args->{'no_nav_bar'}
7174: && !$args->{'only_body'}
7175: && !$args->{'frameset'}) {
7176: $result .= &help_menu_js();
1.1032 www 7177: $result.=&modal_window();
1.1038 www 7178: $result.=&togglebox_script();
1.1034 www 7179: $result.=&wishlist_window();
1.1041 www 7180: $result.=&LCprogressbarUpdate_script();
1.1034 www 7181: } else {
7182: if ($args->{'add_modal'}) {
7183: $result.=&modal_window();
7184: }
7185: if ($args->{'add_wishlist'}) {
7186: $result.=&wishlist_window();
7187: }
1.1038 www 7188: if ($args->{'add_togglebox'}) {
7189: $result.=&togglebox_script();
7190: }
1.1041 www 7191: if ($args->{'add_progressbar'}) {
7192: $result.=&LCprogressbarUpdate_script();
7193: }
1.436 albertel 7194: }
1.314 albertel 7195: if (ref($args->{'redirect'})) {
1.414 albertel 7196: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7197: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7198: if (!$inhibit_continue) {
7199: $env{'internal.head.redirect'} = $url;
7200: }
1.313 albertel 7201: $result.=<<ADDMETA
7202: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7203: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7204: ADDMETA
7205: }
1.306 albertel 7206: if (!defined($title)) {
7207: $title = 'The LearningOnline Network with CAPA';
7208: }
1.460 albertel 7209: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7210: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 7211: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064 raeburn 7212: .$inhibitprint
1.414 albertel 7213: .$head_extra;
1.962 droeschl 7214: return $result.'</head>';
1.306 albertel 7215: }
7216:
7217: =pod
7218:
1.340 albertel 7219: =item * &font_settings()
7220:
7221: Returns neccessary <meta> to set the proper encoding
7222:
7223: Inputs: none
7224:
7225: =cut
7226:
7227: sub font_settings {
7228: my $headerstring='';
1.647 www 7229: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 7230: $headerstring.=
7231: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
7232: }
7233: return $headerstring;
7234: }
7235:
1.341 albertel 7236: =pod
7237:
1.1064 raeburn 7238: =item * &print_suppression()
7239:
7240: In course context returns css which causes the body to be blank when media="print",
7241: if printout generation is unavailable for the current resource.
7242:
7243: This could be because:
7244:
7245: (a) printstartdate is in the future
7246:
7247: (b) printenddate is in the past
7248:
7249: (c) there is an active exam block with "printout"
7250: functionality blocked
7251:
7252: Users with pav, pfo or evb privileges are exempt.
7253:
7254: Inputs: none
7255:
7256: =cut
7257:
7258:
7259: sub print_suppression {
7260: my $noprint;
7261: if ($env{'request.course.id'}) {
7262: my $scope = $env{'request.course.id'};
7263: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7264: (&Apache::lonnet::allowed('pfo',$scope))) {
7265: return;
7266: }
7267: if ($env{'request.course.sec'} ne '') {
7268: $scope .= "/$env{'request.course.sec'}";
7269: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7270: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7271: return;
1.1064 raeburn 7272: }
7273: }
7274: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7275: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065 raeburn 7276: my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064 raeburn 7277: if ($blocked) {
7278: my $checkrole = "cm./$cdom/$cnum";
7279: if ($env{'request.course.sec'} ne '') {
7280: $checkrole .= "/$env{'request.course.sec'}";
7281: }
7282: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7283: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7284: $noprint = 1;
7285: }
7286: }
7287: unless ($noprint) {
7288: my $symb = &Apache::lonnet::symbread();
7289: if ($symb ne '') {
7290: my $navmap = Apache::lonnavmaps::navmap->new();
7291: if (ref($navmap)) {
7292: my $res = $navmap->getBySymb($symb);
7293: if (ref($res)) {
7294: if (!$res->resprintable()) {
7295: $noprint = 1;
7296: }
7297: }
7298: }
7299: }
7300: }
7301: if ($noprint) {
7302: return <<"ENDSTYLE";
7303: <style type="text/css" media="print">
7304: body { display:none }
7305: </style>
7306: ENDSTYLE
7307: }
7308: }
7309: return;
7310: }
7311:
7312: =pod
7313:
1.341 albertel 7314: =item * &xml_begin()
7315:
7316: Returns the needed doctype and <html>
7317:
7318: Inputs: none
7319:
7320: =cut
7321:
7322: sub xml_begin {
7323: my $output='';
7324:
7325: if ($env{'browser.mathml'}) {
7326: $output='<?xml version="1.0"?>'
7327: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7328: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7329:
7330: # .'<!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">] >'
7331: .'<!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">'
7332: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7333: .'xmlns="http://www.w3.org/1999/xhtml">';
7334: } else {
1.849 bisitz 7335: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
7336: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 7337: }
7338: return $output;
7339: }
1.340 albertel 7340:
7341: =pod
7342:
1.306 albertel 7343: =item * &start_page()
7344:
7345: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7346:
1.648 raeburn 7347: Inputs:
7348:
7349: =over 4
7350:
7351: $title - optional title for the page
7352:
7353: $head_extra - optional extra HTML to incude inside the <head>
7354:
7355: $args - additional optional args supported are:
7356:
7357: =over 8
7358:
7359: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7360: arg on
1.814 bisitz 7361: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7362: add_entries -> additional attributes to add to the <body>
7363: domain -> force to color decorate a page for a
1.317 albertel 7364: specific domain
1.648 raeburn 7365: function -> force usage of a specific rolish color
1.317 albertel 7366: scheme
1.648 raeburn 7367: redirect -> see &headtag()
7368: bgcolor -> override the default page bg color
7369: js_ready -> return a string ready for being used in
1.317 albertel 7370: a javascript writeln
1.648 raeburn 7371: html_encode -> return a string ready for being used in
1.320 albertel 7372: a html attribute
1.648 raeburn 7373: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7374: $forcereg arg
1.648 raeburn 7375: frameset -> if true will start with a <frameset>
1.330 albertel 7376: rather than <body>
1.648 raeburn 7377: skip_phases -> hash ref of
1.338 albertel 7378: head -> skip the <html><head> generation
7379: body -> skip all <body> generation
1.648 raeburn 7380: no_auto_mt_title -> prevent &mt()ing the title arg
7381: inherit_jsmath -> when creating popup window in a page,
7382: should it have jsmath forced on by the
7383: current page
1.867 kalberla 7384: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7385: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.361 albertel 7386:
1.648 raeburn 7387: =back
1.460 albertel 7388:
1.648 raeburn 7389: =back
1.562 albertel 7390:
1.306 albertel 7391: =cut
7392:
7393: sub start_page {
1.309 albertel 7394: my ($title,$head_extra,$args) = @_;
1.318 albertel 7395: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7396:
1.315 albertel 7397: $env{'internal.start_page'}++;
1.338 albertel 7398: my $result;
1.964 droeschl 7399:
1.338 albertel 7400: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030 www 7401: $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338 albertel 7402: }
7403:
7404: if (! exists($args->{'skip_phases'}{'body'}) ) {
7405: if ($args->{'frameset'}) {
7406: my $attr_string = &make_attr_string($args->{'force_register'},
7407: $args->{'add_entries'});
7408: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7409: } else {
7410: $result .=
7411: &bodytag($title,
7412: $args->{'function'}, $args->{'add_entries'},
7413: $args->{'only_body'}, $args->{'domain'},
7414: $args->{'force_register'}, $args->{'no_nav_bar'},
1.962 droeschl 7415: $args->{'bgcolor'}, $args);
1.831 bisitz 7416: }
1.330 albertel 7417: }
1.338 albertel 7418:
1.315 albertel 7419: if ($args->{'js_ready'}) {
1.713 kaisler 7420: $result = &js_ready($result);
1.315 albertel 7421: }
1.320 albertel 7422: if ($args->{'html_encode'}) {
1.713 kaisler 7423: $result = &html_encode($result);
7424: }
7425:
1.813 bisitz 7426: # Preparation for new and consistent functionlist at top of screen
7427: # if ($args->{'functionlist'}) {
7428: # $result .= &build_functionlist();
7429: #}
7430:
1.964 droeschl 7431: # Don't add anything more if only_body wanted or in const space
7432: return $result if $args->{'only_body'}
7433: || $env{'request.state'} eq 'construct';
1.813 bisitz 7434:
7435: #Breadcrumbs
1.758 kaisler 7436: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7437: &Apache::lonhtmlcommon::clear_breadcrumbs();
7438: #if any br links exists, add them to the breadcrumbs
7439: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7440: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7441: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7442: }
7443: }
7444:
7445: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7446: if(exists($args->{'bread_crumbs_component'})){
7447: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7448: }else{
7449: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7450: }
1.320 albertel 7451: }
1.315 albertel 7452: return $result;
1.306 albertel 7453: }
7454:
7455: sub end_page {
1.315 albertel 7456: my ($args) = @_;
7457: $env{'internal.end_page'}++;
1.330 albertel 7458: my $result;
1.335 albertel 7459: if ($args->{'discussion'}) {
7460: my ($target,$parser);
7461: if (ref($args->{'discussion'})) {
7462: ($target,$parser) =($args->{'discussion'}{'target'},
7463: $args->{'discussion'}{'parser'});
7464: }
7465: $result .= &Apache::lonxml::xmlend($target,$parser);
7466: }
1.330 albertel 7467: if ($args->{'frameset'}) {
7468: $result .= '</frameset>';
7469: } else {
1.635 raeburn 7470: $result .= &endbodytag($args);
1.330 albertel 7471: }
1.1080 raeburn 7472: unless ($args->{'notbody'}) {
7473: $result .= "\n</html>";
7474: }
1.330 albertel 7475:
1.315 albertel 7476: if ($args->{'js_ready'}) {
1.317 albertel 7477: $result = &js_ready($result);
1.315 albertel 7478: }
1.335 albertel 7479:
1.320 albertel 7480: if ($args->{'html_encode'}) {
7481: $result = &html_encode($result);
7482: }
1.335 albertel 7483:
1.315 albertel 7484: return $result;
7485: }
7486:
1.1034 www 7487: sub wishlist_window {
7488: return(<<'ENDWISHLIST');
1.1046 raeburn 7489: <script type="text/javascript">
1.1034 www 7490: // <![CDATA[
7491: // <!-- BEGIN LON-CAPA Internal
7492: function set_wishlistlink(title, path) {
7493: if (!title) {
7494: title = document.title;
7495: title = title.replace(/^LON-CAPA /,'');
7496: }
7497: if (!path) {
7498: path = location.pathname;
7499: }
7500: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7501: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7502: }
7503: // END LON-CAPA Internal -->
7504: // ]]>
7505: </script>
7506: ENDWISHLIST
7507: }
7508:
1.1030 www 7509: sub modal_window {
7510: return(<<'ENDMODAL');
1.1046 raeburn 7511: <script type="text/javascript">
1.1030 www 7512: // <![CDATA[
7513: // <!-- BEGIN LON-CAPA Internal
7514: var modalWindow = {
7515: parent:"body",
7516: windowId:null,
7517: content:null,
7518: width:null,
7519: height:null,
7520: close:function()
7521: {
7522: $(".LCmodal-window").remove();
7523: $(".LCmodal-overlay").remove();
7524: },
7525: open:function()
7526: {
7527: var modal = "";
7528: modal += "<div class=\"LCmodal-overlay\"></div>";
7529: 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;\">";
7530: modal += this.content;
7531: modal += "</div>";
7532:
7533: $(this.parent).append(modal);
7534:
7535: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7536: $(".LCclose-window").click(function(){modalWindow.close();});
7537: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7538: }
7539: };
1.1031 www 7540: var openMyModal = function(source,width,height,scrolling)
1.1030 www 7541: {
7542: modalWindow.windowId = "myModal";
7543: modalWindow.width = width;
7544: modalWindow.height = height;
1.1031 www 7545: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'></iframe>";
1.1030 www 7546: modalWindow.open();
7547: };
7548: // END LON-CAPA Internal -->
7549: // ]]>
7550: </script>
7551: ENDMODAL
7552: }
7553:
7554: sub modal_link {
1.1052 www 7555: my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030 www 7556: unless ($width) { $width=480; }
7557: unless ($height) { $height=400; }
1.1031 www 7558: unless ($scrolling) { $scrolling='yes'; }
1.1074 raeburn 7559: my $target_attr;
7560: if (defined($target)) {
7561: $target_attr = 'target="'.$target.'"';
7562: }
7563: return <<"ENDLINK";
7564: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
7565: $linktext</a>
7566: ENDLINK
1.1030 www 7567: }
7568:
1.1032 www 7569: sub modal_adhoc_script {
7570: my ($funcname,$width,$height,$content)=@_;
7571: return (<<ENDADHOC);
1.1046 raeburn 7572: <script type="text/javascript">
1.1032 www 7573: // <![CDATA[
7574: var $funcname = function()
7575: {
7576: modalWindow.windowId = "myModal";
7577: modalWindow.width = $width;
7578: modalWindow.height = $height;
7579: modalWindow.content = '$content';
7580: modalWindow.open();
7581: };
7582: // ]]>
7583: </script>
7584: ENDADHOC
7585: }
7586:
1.1041 www 7587: sub modal_adhoc_inner {
7588: my ($funcname,$width,$height,$content)=@_;
7589: my $innerwidth=$width-20;
7590: $content=&js_ready(
1.1042 www 7591: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041 www 7592: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
7593: $content.
7594: &end_scrollbox().
7595: &end_page()
7596: );
7597: return &modal_adhoc_script($funcname,$width,$height,$content);
7598: }
7599:
7600: sub modal_adhoc_window {
7601: my ($funcname,$width,$height,$content,$linktext)=@_;
7602: return &modal_adhoc_inner($funcname,$width,$height,$content).
7603: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7604: }
7605:
7606: sub modal_adhoc_launch {
7607: my ($funcname,$width,$height,$content)=@_;
7608: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7609: <script type="text/javascript">
7610: // <![CDATA[
7611: $funcname();
7612: // ]]>
7613: </script>
7614: ENDLAUNCH
7615: }
7616:
7617: sub modal_adhoc_close {
7618: return (<<ENDCLOSE);
7619: <script type="text/javascript">
7620: // <![CDATA[
7621: modalWindow.close();
7622: // ]]>
7623: </script>
7624: ENDCLOSE
7625: }
7626:
1.1038 www 7627: sub togglebox_script {
7628: return(<<ENDTOGGLE);
7629: <script type="text/javascript">
7630: // <![CDATA[
7631: function LCtoggleDisplay(id,hidetext,showtext) {
7632: link = document.getElementById(id + "link").childNodes[0];
7633: with (document.getElementById(id).style) {
7634: if (display == "none" ) {
7635: display = "inline";
7636: link.nodeValue = hidetext;
7637: } else {
7638: display = "none";
7639: link.nodeValue = showtext;
7640: }
7641: }
7642: }
7643: // ]]>
7644: </script>
7645: ENDTOGGLE
7646: }
7647:
1.1039 www 7648: sub start_togglebox {
7649: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7650: unless ($heading) { $heading=''; } else { $heading.=' '; }
7651: unless ($showtext) { $showtext=&mt('show'); }
7652: unless ($hidetext) { $hidetext=&mt('hide'); }
7653: unless ($headerbg) { $headerbg='#FFFFFF'; }
7654: return &start_data_table().
7655: &start_data_table_header_row().
7656: '<td bgcolor="'.$headerbg.'">'.$heading.
7657: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7658: $showtext.'\')">'.$showtext.'</a>]</td>'.
7659: &end_data_table_header_row().
7660: '<tr id="'.$id.'" style="display:none""><td>';
7661: }
7662:
7663: sub end_togglebox {
7664: return '</td></tr>'.&end_data_table();
7665: }
7666:
1.1041 www 7667: sub LCprogressbar_script {
1.1045 www 7668: my ($id)=@_;
1.1041 www 7669: return(<<ENDPROGRESS);
7670: <script type="text/javascript">
7671: // <![CDATA[
1.1045 www 7672: \$('#progressbar$id').progressbar({
1.1041 www 7673: value: 0,
7674: change: function(event, ui) {
7675: var newVal = \$(this).progressbar('option', 'value');
7676: \$('.pblabel', this).text(LCprogressTxt);
7677: }
7678: });
7679: // ]]>
7680: </script>
7681: ENDPROGRESS
7682: }
7683:
7684: sub LCprogressbarUpdate_script {
7685: return(<<ENDPROGRESSUPDATE);
7686: <style type="text/css">
7687: .ui-progressbar { position:relative; }
7688: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7689: </style>
7690: <script type="text/javascript">
7691: // <![CDATA[
1.1045 www 7692: var LCprogressTxt='---';
7693:
7694: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7695: LCprogressTxt=progresstext;
1.1045 www 7696: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7697: }
7698: // ]]>
7699: </script>
7700: ENDPROGRESSUPDATE
7701: }
7702:
1.1042 www 7703: my $LClastpercent;
1.1045 www 7704: my $LCidcnt;
7705: my $LCcurrentid;
1.1042 www 7706:
1.1041 www 7707: sub LCprogressbar {
1.1042 www 7708: my ($r)=(@_);
7709: $LClastpercent=0;
1.1045 www 7710: $LCidcnt++;
7711: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7712: my $starting=&mt('Starting');
7713: my $content=(<<ENDPROGBAR);
7714: <p>
1.1045 www 7715: <div id="progressbar$LCcurrentid">
1.1041 www 7716: <span class="pblabel">$starting</span>
7717: </div>
7718: </p>
7719: ENDPROGBAR
1.1045 www 7720: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7721: }
7722:
7723: sub LCprogressbarUpdate {
1.1042 www 7724: my ($r,$val,$text)=@_;
7725: unless ($val) {
7726: if ($LClastpercent) {
7727: $val=$LClastpercent;
7728: } else {
7729: $val=0;
7730: }
7731: }
1.1041 www 7732: if ($val<0) { $val=0; }
7733: if ($val>100) { $val=0; }
1.1042 www 7734: $LClastpercent=$val;
1.1041 www 7735: unless ($text) { $text=$val.'%'; }
7736: $text=&js_ready($text);
1.1044 www 7737: &r_print($r,<<ENDUPDATE);
1.1041 www 7738: <script type="text/javascript">
7739: // <![CDATA[
1.1045 www 7740: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7741: // ]]>
7742: </script>
7743: ENDUPDATE
1.1035 www 7744: }
7745:
1.1042 www 7746: sub LCprogressbarClose {
7747: my ($r)=@_;
7748: $LClastpercent=0;
1.1044 www 7749: &r_print($r,<<ENDCLOSE);
1.1042 www 7750: <script type="text/javascript">
7751: // <![CDATA[
1.1045 www 7752: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7753: // ]]>
7754: </script>
7755: ENDCLOSE
1.1044 www 7756: }
7757:
7758: sub r_print {
7759: my ($r,$to_print)=@_;
7760: if ($r) {
7761: $r->print($to_print);
7762: $r->rflush();
7763: } else {
7764: print($to_print);
7765: }
1.1042 www 7766: }
7767:
1.320 albertel 7768: sub html_encode {
7769: my ($result) = @_;
7770:
1.322 albertel 7771: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7772:
7773: return $result;
7774: }
1.1044 www 7775:
1.317 albertel 7776: sub js_ready {
7777: my ($result) = @_;
7778:
1.323 albertel 7779: $result =~ s/[\n\r]/ /xmsg;
7780: $result =~ s/\\/\\\\/xmsg;
7781: $result =~ s/'/\\'/xmsg;
1.372 albertel 7782: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7783:
7784: return $result;
7785: }
7786:
1.315 albertel 7787: sub validate_page {
7788: if ( exists($env{'internal.start_page'})
1.316 albertel 7789: && $env{'internal.start_page'} > 1) {
7790: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7791: $env{'internal.start_page'}.' '.
1.316 albertel 7792: $ENV{'request.filename'});
1.315 albertel 7793: }
7794: if ( exists($env{'internal.end_page'})
1.316 albertel 7795: && $env{'internal.end_page'} > 1) {
7796: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7797: $env{'internal.end_page'}.' '.
1.316 albertel 7798: $env{'request.filename'});
1.315 albertel 7799: }
7800: if ( exists($env{'internal.start_page'})
7801: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7802: &Apache::lonnet::logthis('start_page called without end_page '.
7803: $env{'request.filename'});
1.315 albertel 7804: }
7805: if ( ! exists($env{'internal.start_page'})
7806: && exists($env{'internal.end_page'})) {
1.316 albertel 7807: &Apache::lonnet::logthis('end_page called without start_page'.
7808: $env{'request.filename'});
1.315 albertel 7809: }
1.306 albertel 7810: }
1.315 albertel 7811:
1.996 www 7812:
7813: sub start_scrollbox {
1.1075 raeburn 7814: my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998 raeburn 7815: unless ($outerwidth) { $outerwidth='520px'; }
7816: unless ($width) { $width='500px'; }
7817: unless ($height) { $height='200px'; }
1.1075 raeburn 7818: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 7819: if ($id ne '') {
1.1020 raeburn 7820: $table_id = " id='table_$id'";
7821: $div_id = " id='div_$id'";
1.1018 raeburn 7822: }
1.1075 raeburn 7823: if ($bgcolor ne '') {
7824: $tdcol = "background-color: $bgcolor;";
7825: }
7826: return <<"END";
7827: <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>
7828: END
1.996 www 7829: }
7830:
7831: sub end_scrollbox {
1.1036 www 7832: return '</div></td></tr></table>';
1.996 www 7833: }
7834:
1.318 albertel 7835: sub simple_error_page {
7836: my ($r,$title,$msg) = @_;
7837: my $page =
7838: &Apache::loncommon::start_page($title).
7839: &mt($msg).
7840: &Apache::loncommon::end_page();
7841: if (ref($r)) {
7842: $r->print($page);
1.327 albertel 7843: return;
1.318 albertel 7844: }
7845: return $page;
7846: }
1.347 albertel 7847:
7848: {
1.610 albertel 7849: my @row_count;
1.961 onken 7850:
7851: sub start_data_table_count {
7852: unshift(@row_count, 0);
7853: return;
7854: }
7855:
7856: sub end_data_table_count {
7857: shift(@row_count);
7858: return;
7859: }
7860:
1.347 albertel 7861: sub start_data_table {
1.1018 raeburn 7862: my ($add_class,$id) = @_;
1.422 albertel 7863: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 7864: my $table_id;
7865: if (defined($id)) {
7866: $table_id = ' id="'.$id.'"';
7867: }
1.961 onken 7868: &start_data_table_count();
1.1018 raeburn 7869: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 7870: }
7871:
7872: sub end_data_table {
1.961 onken 7873: &end_data_table_count();
1.389 albertel 7874: return '</table>'."\n";;
1.347 albertel 7875: }
7876:
7877: sub start_data_table_row {
1.974 wenzelju 7878: my ($add_class, $id) = @_;
1.610 albertel 7879: $row_count[0]++;
7880: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 7881: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 7882: $id = (' id="'.$id.'"') unless ($id eq '');
7883: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 7884: }
1.471 banghart 7885:
7886: sub continue_data_table_row {
1.974 wenzelju 7887: my ($add_class, $id) = @_;
1.610 albertel 7888: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 7889: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
7890: $id = (' id="'.$id.'"') unless ($id eq '');
7891: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 7892: }
1.347 albertel 7893:
7894: sub end_data_table_row {
1.389 albertel 7895: return '</tr>'."\n";;
1.347 albertel 7896: }
1.367 www 7897:
1.421 albertel 7898: sub start_data_table_empty_row {
1.707 bisitz 7899: # $row_count[0]++;
1.421 albertel 7900: return '<tr class="LC_empty_row" >'."\n";;
7901: }
7902:
7903: sub end_data_table_empty_row {
7904: return '</tr>'."\n";;
7905: }
7906:
1.367 www 7907: sub start_data_table_header_row {
1.389 albertel 7908: return '<tr class="LC_header_row">'."\n";;
1.367 www 7909: }
7910:
7911: sub end_data_table_header_row {
1.389 albertel 7912: return '</tr>'."\n";;
1.367 www 7913: }
1.890 droeschl 7914:
7915: sub data_table_caption {
7916: my $caption = shift;
7917: return "<caption class=\"LC_caption\">$caption</caption>";
7918: }
1.347 albertel 7919: }
7920:
1.548 albertel 7921: =pod
7922:
7923: =item * &inhibit_menu_check($arg)
7924:
7925: Checks for a inhibitmenu state and generates output to preserve it
7926:
7927: Inputs: $arg - can be any of
7928: - undef - in which case the return value is a string
7929: to add into arguments list of a uri
7930: - 'input' - in which case the return value is a HTML
7931: <form> <input> field of type hidden to
7932: preserve the value
7933: - a url - in which case the return value is the url with
7934: the neccesary cgi args added to preserve the
7935: inhibitmenu state
7936: - a ref to a url - no return value, but the string is
7937: updated to include the neccessary cgi
7938: args to preserve the inhibitmenu state
7939:
7940: =cut
7941:
7942: sub inhibit_menu_check {
7943: my ($arg) = @_;
7944: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
7945: if ($arg eq 'input') {
7946: if ($env{'form.inhibitmenu'}) {
7947: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
7948: } else {
7949: return
7950: }
7951: }
7952: if ($env{'form.inhibitmenu'}) {
7953: if (ref($arg)) {
7954: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
7955: } elsif ($arg eq '') {
7956: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
7957: } else {
7958: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
7959: }
7960: }
7961: if (!ref($arg)) {
7962: return $arg;
7963: }
7964: }
7965:
1.251 albertel 7966: ###############################################
1.182 matthew 7967:
7968: =pod
7969:
1.549 albertel 7970: =back
7971:
7972: =head1 User Information Routines
7973:
7974: =over 4
7975:
1.405 albertel 7976: =item * &get_users_function()
1.182 matthew 7977:
7978: Used by &bodytag to determine the current users primary role.
7979: Returns either 'student','coordinator','admin', or 'author'.
7980:
7981: =cut
7982:
7983: ###############################################
7984: sub get_users_function {
1.815 tempelho 7985: my $function = 'norole';
1.818 tempelho 7986: if ($env{'request.role'}=~/^(st)/) {
7987: $function='student';
7988: }
1.907 raeburn 7989: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 7990: $function='coordinator';
7991: }
1.258 albertel 7992: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 7993: $function='admin';
7994: }
1.826 bisitz 7995: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 7996: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 7997: $function='author';
7998: }
7999: return $function;
1.54 www 8000: }
1.99 www 8001:
8002: ###############################################
8003:
1.233 raeburn 8004: =pod
8005:
1.821 raeburn 8006: =item * &show_course()
8007:
8008: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8009: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8010:
8011: Inputs:
8012: None
8013:
8014: Outputs:
8015: Scalar: 1 if 'Course' to be used, 0 otherwise.
8016:
8017: =cut
8018:
8019: ###############################################
8020: sub show_course {
8021: my $course = !$env{'user.adv'};
8022: if (!$env{'user.adv'}) {
8023: foreach my $env (keys(%env)) {
8024: next if ($env !~ m/^user\.priv\./);
8025: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8026: $course = 0;
8027: last;
8028: }
8029: }
8030: }
8031: return $course;
8032: }
8033:
8034: ###############################################
8035:
8036: =pod
8037:
1.542 raeburn 8038: =item * &check_user_status()
1.274 raeburn 8039:
8040: Determines current status of supplied role for a
8041: specific user. Roles can be active, previous or future.
8042:
8043: Inputs:
8044: user's domain, user's username, course's domain,
1.375 raeburn 8045: course's number, optional section ID.
1.274 raeburn 8046:
8047: Outputs:
8048: role status: active, previous or future.
8049:
8050: =cut
8051:
8052: sub check_user_status {
1.412 raeburn 8053: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8054: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8055: my @uroles = keys %userinfo;
8056: my $srchstr;
8057: my $active_chk = 'none';
1.412 raeburn 8058: my $now = time;
1.274 raeburn 8059: if (@uroles > 0) {
1.908 raeburn 8060: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8061: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8062: } else {
1.412 raeburn 8063: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8064: }
8065: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8066: my $role_end = 0;
8067: my $role_start = 0;
8068: $active_chk = 'active';
1.412 raeburn 8069: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8070: $role_end = $1;
8071: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8072: $role_start = $1;
1.274 raeburn 8073: }
8074: }
8075: if ($role_start > 0) {
1.412 raeburn 8076: if ($now < $role_start) {
1.274 raeburn 8077: $active_chk = 'future';
8078: }
8079: }
8080: if ($role_end > 0) {
1.412 raeburn 8081: if ($now > $role_end) {
1.274 raeburn 8082: $active_chk = 'previous';
8083: }
8084: }
8085: }
8086: }
8087: return $active_chk;
8088: }
8089:
8090: ###############################################
8091:
8092: =pod
8093:
1.405 albertel 8094: =item * &get_sections()
1.233 raeburn 8095:
8096: Determines all the sections for a course including
8097: sections with students and sections containing other roles.
1.419 raeburn 8098: Incoming parameters:
8099:
8100: 1. domain
8101: 2. course number
8102: 3. reference to array containing roles for which sections should
8103: be gathered (optional).
8104: 4. reference to array containing status types for which sections
8105: should be gathered (optional).
8106:
8107: If the third argument is undefined, sections are gathered for any role.
8108: If the fourth argument is undefined, sections are gathered for any status.
8109: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8110:
1.374 raeburn 8111: Returns section hash (keys are section IDs, values are
8112: number of users in each section), subject to the
1.419 raeburn 8113: optional roles filter, optional status filter
1.233 raeburn 8114:
8115: =cut
8116:
8117: ###############################################
8118: sub get_sections {
1.419 raeburn 8119: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8120: if (!defined($cdom) || !defined($cnum)) {
8121: my $cid = $env{'request.course.id'};
8122:
8123: return if (!defined($cid));
8124:
8125: $cdom = $env{'course.'.$cid.'.domain'};
8126: $cnum = $env{'course.'.$cid.'.num'};
8127: }
8128:
8129: my %sectioncount;
1.419 raeburn 8130: my $now = time;
1.240 albertel 8131:
1.366 albertel 8132: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 8133: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8134: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8135: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8136: my $start_index = &Apache::loncoursedata::CL_START();
8137: my $end_index = &Apache::loncoursedata::CL_END();
8138: my $status;
1.366 albertel 8139: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8140: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8141: $data->[$status_index],
8142: $data->[$start_index],
8143: $data->[$end_index]);
8144: if ($stu_status eq 'Active') {
8145: $status = 'active';
8146: } elsif ($end < $now) {
8147: $status = 'previous';
8148: } elsif ($start > $now) {
8149: $status = 'future';
8150: }
8151: if ($section ne '-1' && $section !~ /^\s*$/) {
8152: if ((!defined($possible_status)) || (($status ne '') &&
8153: (grep/^\Q$status\E$/,@{$possible_status}))) {
8154: $sectioncount{$section}++;
8155: }
1.240 albertel 8156: }
8157: }
8158: }
8159: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8160: foreach my $user (sort(keys(%courseroles))) {
8161: if ($user !~ /^(\w{2})/) { next; }
8162: my ($role) = ($user =~ /^(\w{2})/);
8163: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8164: my ($section,$status);
1.240 albertel 8165: if ($role eq 'cr' &&
8166: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8167: $section=$1;
8168: }
8169: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8170: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8171: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8172: if ($end == -1 && $start == -1) {
8173: next; #deleted role
8174: }
8175: if (!defined($possible_status)) {
8176: $sectioncount{$section}++;
8177: } else {
8178: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8179: $status = 'active';
8180: } elsif ($end < $now) {
8181: $status = 'future';
8182: } elsif ($start > $now) {
8183: $status = 'previous';
8184: }
8185: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8186: $sectioncount{$section}++;
8187: }
8188: }
1.233 raeburn 8189: }
1.366 albertel 8190: return %sectioncount;
1.233 raeburn 8191: }
8192:
1.274 raeburn 8193: ###############################################
1.294 raeburn 8194:
8195: =pod
1.405 albertel 8196:
8197: =item * &get_course_users()
8198:
1.275 raeburn 8199: Retrieves usernames:domains for users in the specified course
8200: with specific role(s), and access status.
8201:
8202: Incoming parameters:
1.277 albertel 8203: 1. course domain
8204: 2. course number
8205: 3. access status: users must have - either active,
1.275 raeburn 8206: previous, future, or all.
1.277 albertel 8207: 4. reference to array of permissible roles
1.288 raeburn 8208: 5. reference to array of section restrictions (optional)
8209: 6. reference to results object (hash of hashes).
8210: 7. reference to optional userdata hash
1.609 raeburn 8211: 8. reference to optional statushash
1.630 raeburn 8212: 9. flag if privileged users (except those set to unhide in
8213: course settings) should be excluded
1.609 raeburn 8214: Keys of top level results hash are roles.
1.275 raeburn 8215: Keys of inner hashes are username:domain, with
8216: values set to access type.
1.288 raeburn 8217: Optional userdata hash returns an array with arguments in the
8218: same order as loncoursedata::get_classlist() for student data.
8219:
1.609 raeburn 8220: Optional statushash returns
8221:
1.288 raeburn 8222: Entries for end, start, section and status are blank because
8223: of the possibility of multiple values for non-student roles.
8224:
1.275 raeburn 8225: =cut
1.405 albertel 8226:
1.275 raeburn 8227: ###############################################
1.405 albertel 8228:
1.275 raeburn 8229: sub get_course_users {
1.630 raeburn 8230: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8231: my %idx = ();
1.419 raeburn 8232: my %seclists;
1.288 raeburn 8233:
8234: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8235: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8236: $idx{end} = &Apache::loncoursedata::CL_END();
8237: $idx{start} = &Apache::loncoursedata::CL_START();
8238: $idx{id} = &Apache::loncoursedata::CL_ID();
8239: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8240: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8241: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8242:
1.290 albertel 8243: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8244: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8245: my $now = time;
1.277 albertel 8246: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8247: my $match = 0;
1.412 raeburn 8248: my $secmatch = 0;
1.419 raeburn 8249: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8250: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8251: if ($section eq '') {
8252: $section = 'none';
8253: }
1.291 albertel 8254: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8255: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8256: $secmatch = 1;
8257: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8258: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8259: $secmatch = 1;
8260: }
8261: } else {
1.419 raeburn 8262: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8263: $secmatch = 1;
8264: }
1.290 albertel 8265: }
1.412 raeburn 8266: if (!$secmatch) {
8267: next;
8268: }
1.419 raeburn 8269: }
1.275 raeburn 8270: if (defined($$types{'active'})) {
1.288 raeburn 8271: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8272: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8273: $match = 1;
1.275 raeburn 8274: }
8275: }
8276: if (defined($$types{'previous'})) {
1.609 raeburn 8277: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8278: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8279: $match = 1;
1.275 raeburn 8280: }
8281: }
8282: if (defined($$types{'future'})) {
1.609 raeburn 8283: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8284: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8285: $match = 1;
1.275 raeburn 8286: }
8287: }
1.609 raeburn 8288: if ($match) {
8289: push(@{$seclists{$student}},$section);
8290: if (ref($userdata) eq 'HASH') {
8291: $$userdata{$student} = $$classlist{$student};
8292: }
8293: if (ref($statushash) eq 'HASH') {
8294: $statushash->{$student}{'st'}{$section} = $status;
8295: }
1.288 raeburn 8296: }
1.275 raeburn 8297: }
8298: }
1.412 raeburn 8299: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8300: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8301: my $now = time;
1.609 raeburn 8302: my %displaystatus = ( previous => 'Expired',
8303: active => 'Active',
8304: future => 'Future',
8305: );
1.630 raeburn 8306: my %nothide;
8307: if ($hidepriv) {
8308: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8309: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8310: if ($user !~ /:/) {
8311: $nothide{join(':',split(/[\@]/,$user))}=1;
8312: } else {
8313: $nothide{$user} = 1;
8314: }
8315: }
8316: }
1.439 raeburn 8317: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8318: my $match = 0;
1.412 raeburn 8319: my $secmatch = 0;
1.439 raeburn 8320: my $status;
1.412 raeburn 8321: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8322: $user =~ s/:$//;
1.439 raeburn 8323: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8324: if ($end == -1 || $start == -1) {
8325: next;
8326: }
8327: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8328: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8329: my ($uname,$udom) = split(/:/,$user);
8330: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8331: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8332: $secmatch = 1;
8333: } elsif ($usec eq '') {
1.420 albertel 8334: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8335: $secmatch = 1;
8336: }
8337: } else {
8338: if (grep(/^\Q$usec\E$/,@{$sections})) {
8339: $secmatch = 1;
8340: }
8341: }
8342: if (!$secmatch) {
8343: next;
8344: }
1.288 raeburn 8345: }
1.419 raeburn 8346: if ($usec eq '') {
8347: $usec = 'none';
8348: }
1.275 raeburn 8349: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8350: if ($hidepriv) {
8351: if ((&Apache::lonnet::privileged($uname,$udom)) &&
8352: (!$nothide{$uname.':'.$udom})) {
8353: next;
8354: }
8355: }
1.503 raeburn 8356: if ($end > 0 && $end < $now) {
1.439 raeburn 8357: $status = 'previous';
8358: } elsif ($start > $now) {
8359: $status = 'future';
8360: } else {
8361: $status = 'active';
8362: }
1.277 albertel 8363: foreach my $type (keys(%{$types})) {
1.275 raeburn 8364: if ($status eq $type) {
1.420 albertel 8365: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8366: push(@{$$users{$role}{$user}},$type);
8367: }
1.288 raeburn 8368: $match = 1;
8369: }
8370: }
1.419 raeburn 8371: if (($match) && (ref($userdata) eq 'HASH')) {
8372: if (!exists($$userdata{$uname.':'.$udom})) {
8373: &get_user_info($udom,$uname,\%idx,$userdata);
8374: }
1.420 albertel 8375: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8376: push(@{$seclists{$uname.':'.$udom}},$usec);
8377: }
1.609 raeburn 8378: if (ref($statushash) eq 'HASH') {
8379: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8380: }
1.275 raeburn 8381: }
8382: }
8383: }
8384: }
1.290 albertel 8385: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8386: if ((defined($cdom)) && (defined($cnum))) {
8387: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8388: if ( defined($csettings{'internal.courseowner'}) ) {
8389: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8390: next if ($owner eq '');
8391: my ($ownername,$ownerdom);
8392: if ($owner =~ /^([^:]+):([^:]+)$/) {
8393: $ownername = $1;
8394: $ownerdom = $2;
8395: } else {
8396: $ownername = $owner;
8397: $ownerdom = $cdom;
8398: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8399: }
8400: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8401: if (defined($userdata) &&
1.609 raeburn 8402: !exists($$userdata{$owner})) {
8403: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8404: if (!grep(/^none$/,@{$seclists{$owner}})) {
8405: push(@{$seclists{$owner}},'none');
8406: }
8407: if (ref($statushash) eq 'HASH') {
8408: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8409: }
1.290 albertel 8410: }
1.279 raeburn 8411: }
8412: }
8413: }
1.419 raeburn 8414: foreach my $user (keys(%seclists)) {
8415: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8416: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8417: }
1.275 raeburn 8418: }
8419: return;
8420: }
8421:
1.288 raeburn 8422: sub get_user_info {
8423: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8424: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8425: &plainname($uname,$udom,'lastname');
1.291 albertel 8426: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8427: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8428: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8429: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8430: return;
8431: }
1.275 raeburn 8432:
1.472 raeburn 8433: ###############################################
8434:
8435: =pod
8436:
8437: =item * &get_user_quota()
8438:
8439: Retrieves quota assigned for storage of portfolio files for a user
8440:
8441: Incoming parameters:
8442: 1. user's username
8443: 2. user's domain
8444:
8445: Returns:
1.536 raeburn 8446: 1. Disk quota (in Mb) assigned to student.
8447: 2. (Optional) Type of setting: custom or default
8448: (individually assigned or default for user's
8449: institutional status).
8450: 3. (Optional) - User's institutional status (e.g., faculty, staff
8451: or student - types as defined in localenroll::inst_usertypes
8452: for user's domain, which determines default quota for user.
8453: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8454:
8455: If a value has been stored in the user's environment,
1.536 raeburn 8456: it will return that, otherwise it returns the maximal default
8457: defined for the user's instituional status(es) in the domain.
1.472 raeburn 8458:
8459: =cut
8460:
8461: ###############################################
8462:
8463:
8464: sub get_user_quota {
8465: my ($uname,$udom) = @_;
1.536 raeburn 8466: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8467: if (!defined($udom)) {
8468: $udom = $env{'user.domain'};
8469: }
8470: if (!defined($uname)) {
8471: $uname = $env{'user.name'};
8472: }
8473: if (($udom eq '' || $uname eq '') ||
8474: ($udom eq 'public') && ($uname eq 'public')) {
8475: $quota = 0;
1.536 raeburn 8476: $quotatype = 'default';
8477: $defquota = 0;
1.472 raeburn 8478: } else {
1.536 raeburn 8479: my $inststatus;
1.472 raeburn 8480: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8481: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 8482: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 8483: } else {
1.536 raeburn 8484: my %userenv =
8485: &Apache::lonnet::get('environment',['portfolioquota',
8486: 'inststatus'],$udom,$uname);
1.472 raeburn 8487: my ($tmp) = keys(%userenv);
8488: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8489: $quota = $userenv{'portfolioquota'};
1.536 raeburn 8490: $inststatus = $userenv{'inststatus'};
1.472 raeburn 8491: } else {
8492: undef(%userenv);
8493: }
8494: }
1.536 raeburn 8495: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 8496: if ($quota eq '') {
1.536 raeburn 8497: $quota = $defquota;
8498: $quotatype = 'default';
8499: } else {
8500: $quotatype = 'custom';
1.472 raeburn 8501: }
8502: }
1.536 raeburn 8503: if (wantarray) {
8504: return ($quota,$quotatype,$settingstatus,$defquota);
8505: } else {
8506: return $quota;
8507: }
1.472 raeburn 8508: }
8509:
8510: ###############################################
8511:
8512: =pod
8513:
8514: =item * &default_quota()
8515:
1.536 raeburn 8516: Retrieves default quota assigned for storage of user portfolio files,
8517: given an (optional) user's institutional status.
1.472 raeburn 8518:
8519: Incoming parameters:
8520: 1. domain
1.536 raeburn 8521: 2. (Optional) institutional status(es). This is a : separated list of
8522: status types (e.g., faculty, staff, student etc.)
8523: which apply to the user for whom the default is being retrieved.
8524: If the institutional status string in undefined, the domain
8525: default quota will be returned.
1.472 raeburn 8526:
8527: Returns:
8528: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 8529: 2. (Optional) institutional type which determined the value of the
8530: default quota.
1.472 raeburn 8531:
8532: If a value has been stored in the domain's configuration db,
8533: it will return that, otherwise it returns 20 (for backwards
8534: compatibility with domains which have not set up a configuration
8535: db file; the original statically defined portfolio quota was 20 Mb).
8536:
1.536 raeburn 8537: If the user's status includes multiple types (e.g., staff and student),
8538: the largest default quota which applies to the user determines the
8539: default quota returned.
8540:
1.780 raeburn 8541: =back
8542:
1.472 raeburn 8543: =cut
8544:
8545: ###############################################
8546:
8547:
8548: sub default_quota {
1.536 raeburn 8549: my ($udom,$inststatus) = @_;
8550: my ($defquota,$settingstatus);
8551: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8552: ['quotas'],$udom);
8553: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8554: if ($inststatus ne '') {
1.765 raeburn 8555: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8556: foreach my $item (@statuses) {
1.711 raeburn 8557: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8558: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
8559: if ($defquota eq '') {
8560: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8561: $settingstatus = $item;
8562: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
8563: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8564: $settingstatus = $item;
8565: }
8566: }
8567: } else {
8568: if ($quotahash{'quotas'}{$item} ne '') {
8569: if ($defquota eq '') {
8570: $defquota = $quotahash{'quotas'}{$item};
8571: $settingstatus = $item;
8572: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8573: $defquota = $quotahash{'quotas'}{$item};
8574: $settingstatus = $item;
8575: }
1.536 raeburn 8576: }
8577: }
8578: }
8579: }
8580: if ($defquota eq '') {
1.711 raeburn 8581: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8582: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
8583: } else {
8584: $defquota = $quotahash{'quotas'}{'default'};
8585: }
1.536 raeburn 8586: $settingstatus = 'default';
8587: }
8588: } else {
8589: $settingstatus = 'default';
8590: $defquota = 20;
8591: }
8592: if (wantarray) {
8593: return ($defquota,$settingstatus);
1.472 raeburn 8594: } else {
1.536 raeburn 8595: return $defquota;
1.472 raeburn 8596: }
8597: }
8598:
1.384 raeburn 8599: sub get_secgrprole_info {
8600: my ($cdom,$cnum,$needroles,$type) = @_;
8601: my %sections_count = &get_sections($cdom,$cnum);
8602: my @sections = (sort {$a <=> $b} keys(%sections_count));
8603: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
8604: my @groups = sort(keys(%curr_groups));
8605: my $allroles = [];
8606: my $rolehash;
8607: my $accesshash = {
8608: active => 'Currently has access',
8609: future => 'Will have future access',
8610: previous => 'Previously had access',
8611: };
8612: if ($needroles) {
8613: $rolehash = {'all' => 'all'};
1.385 albertel 8614: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8615: if (&Apache::lonnet::error(%user_roles)) {
8616: undef(%user_roles);
8617: }
8618: foreach my $item (keys(%user_roles)) {
1.384 raeburn 8619: my ($role)=split(/\:/,$item,2);
8620: if ($role eq 'cr') { next; }
8621: if ($role =~ /^cr/) {
8622: $$rolehash{$role} = (split('/',$role))[3];
8623: } else {
8624: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
8625: }
8626: }
8627: foreach my $key (sort(keys(%{$rolehash}))) {
8628: push(@{$allroles},$key);
8629: }
8630: push (@{$allroles},'st');
8631: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
8632: }
8633: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
8634: }
8635:
1.555 raeburn 8636: sub user_picker {
1.994 raeburn 8637: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 8638: my $currdom = $dom;
8639: my %curr_selected = (
8640: srchin => 'dom',
1.580 raeburn 8641: srchby => 'lastname',
1.555 raeburn 8642: );
8643: my $srchterm;
1.625 raeburn 8644: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 8645: if ($srch->{'srchby'} ne '') {
8646: $curr_selected{'srchby'} = $srch->{'srchby'};
8647: }
8648: if ($srch->{'srchin'} ne '') {
8649: $curr_selected{'srchin'} = $srch->{'srchin'};
8650: }
8651: if ($srch->{'srchtype'} ne '') {
8652: $curr_selected{'srchtype'} = $srch->{'srchtype'};
8653: }
8654: if ($srch->{'srchdomain'} ne '') {
8655: $currdom = $srch->{'srchdomain'};
8656: }
8657: $srchterm = $srch->{'srchterm'};
8658: }
8659: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 8660: 'usr' => 'Search criteria',
1.563 raeburn 8661: 'doma' => 'Domain/institution to search',
1.558 albertel 8662: 'uname' => 'username',
8663: 'lastname' => 'last name',
1.555 raeburn 8664: 'lastfirst' => 'last name, first name',
1.558 albertel 8665: 'crs' => 'in this course',
1.576 raeburn 8666: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 8667: 'alc' => 'all LON-CAPA',
1.573 raeburn 8668: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 8669: 'exact' => 'is',
8670: 'contains' => 'contains',
1.569 raeburn 8671: 'begins' => 'begins with',
1.571 raeburn 8672: 'youm' => "You must include some text to search for.",
8673: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
8674: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
8675: 'yomc' => "You must choose a domain when using an institutional directory search.",
8676: 'ymcd' => "You must choose a domain when using a domain search.",
8677: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
8678: 'whse' => "When searching by last,first you must include at least one character in the first name.",
8679: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 8680: );
1.563 raeburn 8681: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
8682: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 8683:
8684: my @srchins = ('crs','dom','alc','instd');
8685:
8686: foreach my $option (@srchins) {
8687: # FIXME 'alc' option unavailable until
8688: # loncreateuser::print_user_query_page()
8689: # has been completed.
8690: next if ($option eq 'alc');
1.880 raeburn 8691: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 8692: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 8693: if ($curr_selected{'srchin'} eq $option) {
8694: $srchinsel .= '
8695: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8696: } else {
8697: $srchinsel .= '
8698: <option value="'.$option.'">'.$lt{$option}.'</option>';
8699: }
1.555 raeburn 8700: }
1.563 raeburn 8701: $srchinsel .= "\n </select>\n";
1.555 raeburn 8702:
8703: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 8704: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 8705: if ($curr_selected{'srchby'} eq $option) {
8706: $srchbysel .= '
8707: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8708: } else {
8709: $srchbysel .= '
8710: <option value="'.$option.'">'.$lt{$option}.'</option>';
8711: }
8712: }
8713: $srchbysel .= "\n </select>\n";
8714:
8715: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 8716: foreach my $option ('begins','contains','exact') {
1.555 raeburn 8717: if ($curr_selected{'srchtype'} eq $option) {
8718: $srchtypesel .= '
8719: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8720: } else {
8721: $srchtypesel .= '
8722: <option value="'.$option.'">'.$lt{$option}.'</option>';
8723: }
8724: }
8725: $srchtypesel .= "\n </select>\n";
8726:
1.558 albertel 8727: my ($newuserscript,$new_user_create);
1.994 raeburn 8728: my $context_dom = $env{'request.role.domain'};
8729: if ($context eq 'requestcrs') {
8730: if ($env{'form.coursedom'} ne '') {
8731: $context_dom = $env{'form.coursedom'};
8732: }
8733: }
1.556 raeburn 8734: if ($forcenewuser) {
1.576 raeburn 8735: if (ref($srch) eq 'HASH') {
1.994 raeburn 8736: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 8737: if ($cancreate) {
8738: $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>';
8739: } else {
1.799 bisitz 8740: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 8741: my %usertypetext = (
8742: official => 'institutional',
8743: unofficial => 'non-institutional',
8744: );
1.799 bisitz 8745: $new_user_create = '<p class="LC_warning">'
8746: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
8747: .' '
8748: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
8749: ,'<a href="'.$helplink.'">','</a>')
8750: .'</p><br />';
1.627 raeburn 8751: }
1.576 raeburn 8752: }
8753: }
8754:
1.556 raeburn 8755: $newuserscript = <<"ENDSCRIPT";
8756:
1.570 raeburn 8757: function setSearch(createnew,callingForm) {
1.556 raeburn 8758: if (createnew == 1) {
1.570 raeburn 8759: for (var i=0; i<callingForm.srchby.length; i++) {
8760: if (callingForm.srchby.options[i].value == 'uname') {
8761: callingForm.srchby.selectedIndex = i;
1.556 raeburn 8762: }
8763: }
1.570 raeburn 8764: for (var i=0; i<callingForm.srchin.length; i++) {
8765: if ( callingForm.srchin.options[i].value == 'dom') {
8766: callingForm.srchin.selectedIndex = i;
1.556 raeburn 8767: }
8768: }
1.570 raeburn 8769: for (var i=0; i<callingForm.srchtype.length; i++) {
8770: if (callingForm.srchtype.options[i].value == 'exact') {
8771: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 8772: }
8773: }
1.570 raeburn 8774: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 8775: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 8776: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 8777: }
8778: }
8779: }
8780: }
8781: ENDSCRIPT
1.558 albertel 8782:
1.556 raeburn 8783: }
8784:
1.555 raeburn 8785: my $output = <<"END_BLOCK";
1.556 raeburn 8786: <script type="text/javascript">
1.824 bisitz 8787: // <![CDATA[
1.570 raeburn 8788: function validateEntry(callingForm) {
1.558 albertel 8789:
1.556 raeburn 8790: var checkok = 1;
1.558 albertel 8791: var srchin;
1.570 raeburn 8792: for (var i=0; i<callingForm.srchin.length; i++) {
8793: if ( callingForm.srchin[i].checked ) {
8794: srchin = callingForm.srchin[i].value;
1.558 albertel 8795: }
8796: }
8797:
1.570 raeburn 8798: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
8799: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
8800: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
8801: var srchterm = callingForm.srchterm.value;
8802: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 8803: var msg = "";
8804:
8805: if (srchterm == "") {
8806: checkok = 0;
1.571 raeburn 8807: msg += "$lt{'youm'}\\n";
1.556 raeburn 8808: }
8809:
1.569 raeburn 8810: if (srchtype== 'begins') {
8811: if (srchterm.length < 2) {
8812: checkok = 0;
1.571 raeburn 8813: msg += "$lt{'thte'}\\n";
1.569 raeburn 8814: }
8815: }
8816:
1.556 raeburn 8817: if (srchtype== 'contains') {
8818: if (srchterm.length < 3) {
8819: checkok = 0;
1.571 raeburn 8820: msg += "$lt{'thet'}\\n";
1.556 raeburn 8821: }
8822: }
8823: if (srchin == 'instd') {
8824: if (srchdomain == '') {
8825: checkok = 0;
1.571 raeburn 8826: msg += "$lt{'yomc'}\\n";
1.556 raeburn 8827: }
8828: }
8829: if (srchin == 'dom') {
8830: if (srchdomain == '') {
8831: checkok = 0;
1.571 raeburn 8832: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 8833: }
8834: }
8835: if (srchby == 'lastfirst') {
8836: if (srchterm.indexOf(",") == -1) {
8837: checkok = 0;
1.571 raeburn 8838: msg += "$lt{'whus'}\\n";
1.556 raeburn 8839: }
8840: if (srchterm.indexOf(",") == srchterm.length -1) {
8841: checkok = 0;
1.571 raeburn 8842: msg += "$lt{'whse'}\\n";
1.556 raeburn 8843: }
8844: }
8845: if (checkok == 0) {
1.571 raeburn 8846: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 8847: return;
8848: }
8849: if (checkok == 1) {
1.570 raeburn 8850: callingForm.submit();
1.556 raeburn 8851: }
8852: }
8853:
8854: $newuserscript
8855:
1.824 bisitz 8856: // ]]>
1.556 raeburn 8857: </script>
1.558 albertel 8858:
8859: $new_user_create
8860:
1.555 raeburn 8861: END_BLOCK
1.558 albertel 8862:
1.876 raeburn 8863: $output .= &Apache::lonhtmlcommon::start_pick_box().
8864: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
8865: $domform.
8866: &Apache::lonhtmlcommon::row_closure().
8867: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
8868: $srchbysel.
8869: $srchtypesel.
8870: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
8871: $srchinsel.
8872: &Apache::lonhtmlcommon::row_closure(1).
8873: &Apache::lonhtmlcommon::end_pick_box().
8874: '<br />';
1.555 raeburn 8875: return $output;
8876: }
8877:
1.612 raeburn 8878: sub user_rule_check {
1.615 raeburn 8879: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 8880: my $response;
8881: if (ref($usershash) eq 'HASH') {
8882: foreach my $user (keys(%{$usershash})) {
8883: my ($uname,$udom) = split(/:/,$user);
8884: next if ($udom eq '' || $uname eq '');
1.615 raeburn 8885: my ($id,$newuser);
1.612 raeburn 8886: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 8887: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 8888: $id = $usershash->{$user}->{'id'};
8889: }
8890: my $inst_response;
8891: if (ref($checks) eq 'HASH') {
8892: if (defined($checks->{'username'})) {
1.615 raeburn 8893: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8894: &Apache::lonnet::get_instuser($udom,$uname);
8895: } elsif (defined($checks->{'id'})) {
1.615 raeburn 8896: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8897: &Apache::lonnet::get_instuser($udom,undef,$id);
8898: }
1.615 raeburn 8899: } else {
8900: ($inst_response,%{$inst_results->{$user}}) =
8901: &Apache::lonnet::get_instuser($udom,$uname);
8902: return;
1.612 raeburn 8903: }
1.615 raeburn 8904: if (!$got_rules->{$udom}) {
1.612 raeburn 8905: my %domconfig = &Apache::lonnet::get_dom('configuration',
8906: ['usercreation'],$udom);
8907: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 8908: foreach my $item ('username','id') {
1.612 raeburn 8909: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
8910: $$curr_rules{$udom}{$item} =
8911: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 8912: }
8913: }
8914: }
1.615 raeburn 8915: $got_rules->{$udom} = 1;
1.585 raeburn 8916: }
1.612 raeburn 8917: foreach my $item (keys(%{$checks})) {
8918: if (ref($$curr_rules{$udom}) eq 'HASH') {
8919: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
8920: if (@{$$curr_rules{$udom}{$item}} > 0) {
8921: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
8922: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
8923: if ($rule_check{$rule}) {
8924: $$rulematch{$user}{$item} = $rule;
8925: if ($inst_response eq 'ok') {
1.615 raeburn 8926: if (ref($inst_results) eq 'HASH') {
8927: if (ref($inst_results->{$user}) eq 'HASH') {
8928: if (keys(%{$inst_results->{$user}}) == 0) {
8929: $$alerts{$item}{$udom}{$uname} = 1;
8930: }
1.612 raeburn 8931: }
8932: }
1.615 raeburn 8933: }
8934: last;
1.585 raeburn 8935: }
8936: }
8937: }
8938: }
8939: }
8940: }
8941: }
8942: }
1.612 raeburn 8943: return;
8944: }
8945:
8946: sub user_rule_formats {
8947: my ($domain,$domdesc,$curr_rules,$check) = @_;
8948: my %text = (
8949: 'username' => 'Usernames',
8950: 'id' => 'IDs',
8951: );
8952: my $output;
8953: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
8954: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
8955: if (@{$ruleorder} > 0) {
8956: $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
8957: foreach my $rule (@{$ruleorder}) {
8958: if (ref($curr_rules) eq 'ARRAY') {
8959: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
8960: if (ref($rules->{$rule}) eq 'HASH') {
8961: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
8962: $rules->{$rule}{'desc'}.'</li>';
8963: }
8964: }
8965: }
8966: }
8967: $output .= '</ul>';
8968: }
8969: }
8970: return $output;
8971: }
8972:
8973: sub instrule_disallow_msg {
1.615 raeburn 8974: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 8975: my $response;
8976: my %text = (
8977: item => 'username',
8978: items => 'usernames',
8979: match => 'matches',
8980: do => 'does',
8981: action => 'a username',
8982: one => 'one',
8983: );
8984: if ($count > 1) {
8985: $text{'item'} = 'usernames';
8986: $text{'match'} ='match';
8987: $text{'do'} = 'do';
8988: $text{'action'} = 'usernames',
8989: $text{'one'} = 'ones';
8990: }
8991: if ($checkitem eq 'id') {
8992: $text{'items'} = 'IDs';
8993: $text{'item'} = 'ID';
8994: $text{'action'} = 'an ID';
1.615 raeburn 8995: if ($count > 1) {
8996: $text{'item'} = 'IDs';
8997: $text{'action'} = 'IDs';
8998: }
1.612 raeburn 8999: }
1.674 bisitz 9000: $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 9001: if ($mode eq 'upload') {
9002: if ($checkitem eq 'username') {
9003: $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'}.");
9004: } elsif ($checkitem eq 'id') {
1.674 bisitz 9005: $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 9006: }
1.669 raeburn 9007: } elsif ($mode eq 'selfcreate') {
9008: if ($checkitem eq 'id') {
9009: $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.");
9010: }
1.615 raeburn 9011: } else {
9012: if ($checkitem eq 'username') {
9013: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9014: } elsif ($checkitem eq 'id') {
9015: $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.");
9016: }
1.612 raeburn 9017: }
9018: return $response;
1.585 raeburn 9019: }
9020:
1.624 raeburn 9021: sub personal_data_fieldtitles {
9022: my %fieldtitles = &Apache::lonlocal::texthash (
9023: id => 'Student/Employee ID',
9024: permanentemail => 'E-mail address',
9025: lastname => 'Last Name',
9026: firstname => 'First Name',
9027: middlename => 'Middle Name',
9028: generation => 'Generation',
9029: gen => 'Generation',
1.765 raeburn 9030: inststatus => 'Affiliation',
1.624 raeburn 9031: );
9032: return %fieldtitles;
9033: }
9034:
1.642 raeburn 9035: sub sorted_inst_types {
9036: my ($dom) = @_;
9037: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9038: my $othertitle = &mt('All users');
9039: if ($env{'request.course.id'}) {
1.668 raeburn 9040: $othertitle = &mt('Any users');
1.642 raeburn 9041: }
9042: my @types;
9043: if (ref($order) eq 'ARRAY') {
9044: @types = @{$order};
9045: }
9046: if (@types == 0) {
9047: if (ref($usertypes) eq 'HASH') {
9048: @types = sort(keys(%{$usertypes}));
9049: }
9050: }
9051: if (keys(%{$usertypes}) > 0) {
9052: $othertitle = &mt('Other users');
9053: }
9054: return ($othertitle,$usertypes,\@types);
9055: }
9056:
1.645 raeburn 9057: sub get_institutional_codes {
9058: my ($settings,$allcourses,$LC_code) = @_;
9059: # Get complete list of course sections to update
9060: my @currsections = ();
9061: my @currxlists = ();
9062: my $coursecode = $$settings{'internal.coursecode'};
9063:
9064: if ($$settings{'internal.sectionnums'} ne '') {
9065: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9066: }
9067:
9068: if ($$settings{'internal.crosslistings'} ne '') {
9069: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9070: }
9071:
9072: if (@currxlists > 0) {
9073: foreach (@currxlists) {
9074: if (m/^([^:]+):(\w*)$/) {
9075: unless (grep/^$1$/,@{$allcourses}) {
9076: push @{$allcourses},$1;
9077: $$LC_code{$1} = $2;
9078: }
9079: }
9080: }
9081: }
9082:
9083: if (@currsections > 0) {
9084: foreach (@currsections) {
9085: if (m/^(\w+):(\w*)$/) {
9086: my $sec = $coursecode.$1;
9087: my $lc_sec = $2;
9088: unless (grep/^$sec$/,@{$allcourses}) {
9089: push @{$allcourses},$sec;
9090: $$LC_code{$sec} = $lc_sec;
9091: }
9092: }
9093: }
9094: }
9095: return;
9096: }
9097:
1.971 raeburn 9098: sub get_standard_codeitems {
9099: return ('Year','Semester','Department','Number','Section');
9100: }
9101:
1.112 bowersj2 9102: =pod
9103:
1.780 raeburn 9104: =head1 Slot Helpers
9105:
9106: =over 4
9107:
9108: =item * sorted_slots()
9109:
1.1040 raeburn 9110: Sorts an array of slot names in order of an optional sort key,
9111: default sort is by slot start time (earliest first).
1.780 raeburn 9112:
9113: Inputs:
9114:
9115: =over 4
9116:
9117: slotsarr - Reference to array of unsorted slot names.
9118:
9119: slots - Reference to hash of hash, where outer hash keys are slot names.
9120:
1.1040 raeburn 9121: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9122:
1.549 albertel 9123: =back
9124:
1.780 raeburn 9125: Returns:
9126:
9127: =over 4
9128:
1.1040 raeburn 9129: sorted - An array of slot names sorted by a specified sort key
9130: (default sort key is start time of the slot).
1.780 raeburn 9131:
9132: =back
9133:
9134: =cut
9135:
9136:
9137: sub sorted_slots {
1.1040 raeburn 9138: my ($slotsarr,$slots,$sortkey) = @_;
9139: if ($sortkey eq '') {
9140: $sortkey = 'starttime';
9141: }
1.780 raeburn 9142: my @sorted;
9143: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9144: @sorted =
9145: sort {
9146: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9147: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9148: }
9149: if (ref($slots->{$a})) { return -1;}
9150: if (ref($slots->{$b})) { return 1;}
9151: return 0;
9152: } @{$slotsarr};
9153: }
9154: return @sorted;
9155: }
9156:
1.1040 raeburn 9157: =pod
9158:
9159: =item * get_future_slots()
9160:
9161: Inputs:
9162:
9163: =over 4
9164:
9165: cnum - course number
9166:
9167: cdom - course domain
9168:
9169: now - current UNIX time
9170:
9171: symb - optional symb
9172:
9173: =back
9174:
9175: Returns:
9176:
9177: =over 4
9178:
9179: sorted_reservable - ref to array of student_schedulable slots currently
9180: reservable, ordered by end date of reservation period.
9181:
9182: reservable_now - ref to hash of student_schedulable slots currently
9183: reservable.
9184:
9185: Keys in inner hash are:
9186: (a) symb: either blank or symb to which slot use is restricted.
9187: (b) endreserve: end date of reservation period.
9188:
9189: sorted_future - ref to array of student_schedulable slots reservable in
9190: the future, ordered by start date of reservation period.
9191:
9192: future_reservable - ref to hash of student_schedulable slots reservable
9193: in the future.
9194:
9195: Keys in inner hash are:
9196: (a) symb: either blank or symb to which slot use is restricted.
9197: (b) startreserve: start date of reservation period.
9198:
9199: =back
9200:
9201: =cut
9202:
9203: sub get_future_slots {
9204: my ($cnum,$cdom,$now,$symb) = @_;
9205: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9206: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9207: foreach my $slot (keys(%slots)) {
9208: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9209: if ($symb) {
9210: next if (($slots{$slot}->{'symb'} ne '') &&
9211: ($slots{$slot}->{'symb'} ne $symb));
9212: }
9213: if (($slots{$slot}->{'starttime'} > $now) &&
9214: ($slots{$slot}->{'endtime'} > $now)) {
9215: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9216: my $userallowed = 0;
9217: if ($slots{$slot}->{'allowedsections'}) {
9218: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9219: if (!defined($env{'request.role.sec'})
9220: && grep(/^No section assigned$/,@allowed_sec)) {
9221: $userallowed=1;
9222: } else {
9223: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9224: $userallowed=1;
9225: }
9226: }
9227: unless ($userallowed) {
9228: if (defined($env{'request.course.groups'})) {
9229: my @groups = split(/:/,$env{'request.course.groups'});
9230: foreach my $group (@groups) {
9231: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9232: $userallowed=1;
9233: last;
9234: }
9235: }
9236: }
9237: }
9238: }
9239: if ($slots{$slot}->{'allowedusers'}) {
9240: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9241: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9242: if (grep(/^\Q$user\E$/,@allowed_users)) {
9243: $userallowed = 1;
9244: }
9245: }
9246: next unless($userallowed);
9247: }
9248: my $startreserve = $slots{$slot}->{'startreserve'};
9249: my $endreserve = $slots{$slot}->{'endreserve'};
9250: my $symb = $slots{$slot}->{'symb'};
9251: if (($startreserve < $now) &&
9252: (!$endreserve || $endreserve > $now)) {
9253: my $lastres = $endreserve;
9254: if (!$lastres) {
9255: $lastres = $slots{$slot}->{'starttime'};
9256: }
9257: $reservable_now{$slot} = {
9258: symb => $symb,
9259: endreserve => $lastres
9260: };
9261: } elsif (($startreserve > $now) &&
9262: (!$endreserve || $endreserve > $startreserve)) {
9263: $future_reservable{$slot} = {
9264: symb => $symb,
9265: startreserve => $startreserve
9266: };
9267: }
9268: }
9269: }
9270: my @unsorted_reservable = keys(%reservable_now);
9271: if (@unsorted_reservable > 0) {
9272: @sorted_reservable =
9273: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9274: }
9275: my @unsorted_future = keys(%future_reservable);
9276: if (@unsorted_future > 0) {
9277: @sorted_future =
9278: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9279: }
9280: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9281: }
1.780 raeburn 9282:
9283: =pod
9284:
1.1057 foxr 9285: =back
9286:
1.549 albertel 9287: =head1 HTTP Helpers
9288:
9289: =over 4
9290:
1.648 raeburn 9291: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9292:
1.258 albertel 9293: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9294: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9295: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9296:
9297: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9298: $possible_names is an ref to an array of form element names. As an example:
9299: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9300: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9301:
9302: =cut
1.1 albertel 9303:
1.6 albertel 9304: sub get_unprocessed_cgi {
1.25 albertel 9305: my ($query,$possible_names)= @_;
1.26 matthew 9306: # $Apache::lonxml::debug=1;
1.356 albertel 9307: foreach my $pair (split(/&/,$query)) {
9308: my ($name, $value) = split(/=/,$pair);
1.369 www 9309: $name = &unescape($name);
1.25 albertel 9310: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9311: $value =~ tr/+/ /;
9312: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9313: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9314: }
1.16 harris41 9315: }
1.6 albertel 9316: }
9317:
1.112 bowersj2 9318: =pod
9319:
1.648 raeburn 9320: =item * &cacheheader()
1.112 bowersj2 9321:
9322: returns cache-controlling header code
9323:
9324: =cut
9325:
1.7 albertel 9326: sub cacheheader {
1.258 albertel 9327: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9328: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9329: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9330: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9331: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9332: return $output;
1.7 albertel 9333: }
9334:
1.112 bowersj2 9335: =pod
9336:
1.648 raeburn 9337: =item * &no_cache($r)
1.112 bowersj2 9338:
9339: specifies header code to not have cache
9340:
9341: =cut
9342:
1.9 albertel 9343: sub no_cache {
1.216 albertel 9344: my ($r) = @_;
9345: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9346: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9347: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9348: $r->no_cache(1);
9349: $r->header_out("Expires" => $date);
9350: $r->header_out("Pragma" => "no-cache");
1.123 www 9351: }
9352:
9353: sub content_type {
1.181 albertel 9354: my ($r,$type,$charset) = @_;
1.299 foxr 9355: if ($r) {
9356: # Note that printout.pl calls this with undef for $r.
9357: &no_cache($r);
9358: }
1.258 albertel 9359: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9360: unless ($charset) {
9361: $charset=&Apache::lonlocal::current_encoding;
9362: }
9363: if ($charset) { $type.='; charset='.$charset; }
9364: if ($r) {
9365: $r->content_type($type);
9366: } else {
9367: print("Content-type: $type\n\n");
9368: }
1.9 albertel 9369: }
1.25 albertel 9370:
1.112 bowersj2 9371: =pod
9372:
1.648 raeburn 9373: =item * &add_to_env($name,$value)
1.112 bowersj2 9374:
1.258 albertel 9375: adds $name to the %env hash with value
1.112 bowersj2 9376: $value, if $name already exists, the entry is converted to an array
9377: reference and $value is added to the array.
9378:
9379: =cut
9380:
1.25 albertel 9381: sub add_to_env {
9382: my ($name,$value)=@_;
1.258 albertel 9383: if (defined($env{$name})) {
9384: if (ref($env{$name})) {
1.25 albertel 9385: #already have multiple values
1.258 albertel 9386: push(@{ $env{$name} },$value);
1.25 albertel 9387: } else {
9388: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9389: my $first=$env{$name};
9390: undef($env{$name});
9391: push(@{ $env{$name} },$first,$value);
1.25 albertel 9392: }
9393: } else {
1.258 albertel 9394: $env{$name}=$value;
1.25 albertel 9395: }
1.31 albertel 9396: }
1.149 albertel 9397:
9398: =pod
9399:
1.648 raeburn 9400: =item * &get_env_multiple($name)
1.149 albertel 9401:
1.258 albertel 9402: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9403: values may be defined and end up as an array ref.
9404:
9405: returns an array of values
9406:
9407: =cut
9408:
9409: sub get_env_multiple {
9410: my ($name) = @_;
9411: my @values;
1.258 albertel 9412: if (defined($env{$name})) {
1.149 albertel 9413: # exists is it an array
1.258 albertel 9414: if (ref($env{$name})) {
9415: @values=@{ $env{$name} };
1.149 albertel 9416: } else {
1.258 albertel 9417: $values[0]=$env{$name};
1.149 albertel 9418: }
9419: }
9420: return(@values);
9421: }
9422:
1.660 raeburn 9423: sub ask_for_embedded_content {
9424: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9425: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9426: %currsubfile,%unused,$rem);
1.1071 raeburn 9427: my $counter = 0;
9428: my $numnew = 0;
1.987 raeburn 9429: my $numremref = 0;
9430: my $numinvalid = 0;
9431: my $numpathchg = 0;
9432: my $numexisting = 0;
1.1071 raeburn 9433: my $numunused = 0;
9434: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
9435: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
9436: my $heading = &mt('Upload embedded files');
9437: my $buttontext = &mt('Upload');
9438:
1.1085 raeburn 9439: my $navmap;
9440: if ($env{'request.course.id'}) {
9441: $navmap = Apache::lonnavmaps::navmap->new();
9442: }
1.984 raeburn 9443: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9444: my $current_path='/';
9445: if ($env{'form.currentpath'}) {
9446: $current_path = $env{'form.currentpath'};
9447: }
9448: if ($actionurl eq '/adm/coursegrp_portfolio') {
9449: $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9450: $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
9451: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9452: } else {
9453: $udom = $env{'user.domain'};
9454: $uname = $env{'user.name'};
9455: $url = '/userfiles/portfolio';
9456: }
1.987 raeburn 9457: $toplevel = $url.'/';
1.984 raeburn 9458: $url .= $current_path;
9459: $getpropath = 1;
1.987 raeburn 9460: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9461: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9462: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9463: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9464: $toplevel = $url;
1.984 raeburn 9465: if ($rest ne '') {
1.987 raeburn 9466: $url .= $rest;
9467: }
9468: } elsif ($actionurl eq '/adm/coursedocs') {
9469: if (ref($args) eq 'HASH') {
1.1071 raeburn 9470: $url = $args->{'docs_url'};
9471: $toplevel = $url;
1.1084 raeburn 9472: if ($args->{'context'} eq 'paste') {
9473: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9474: ($path) =
9475: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9476: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9477: $fileloc =~ s{^/}{};
9478: }
1.1071 raeburn 9479: }
1.1084 raeburn 9480: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9481: if ($env{'request.course.id'} ne '') {
9482: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9483: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9484: if (ref($args) eq 'HASH') {
9485: $url = $args->{'docs_url'};
9486: $title = $args->{'docs_title'};
9487: $toplevel = "/$url";
1.1085 raeburn 9488: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071 raeburn 9489: ($path) =
9490: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9491: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9492: $fileloc =~ s{^/}{};
9493: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9494: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9495: }
1.987 raeburn 9496: }
9497: }
9498: my $now = time();
9499: foreach my $embed_file (keys(%{$allfiles})) {
9500: my $absolutepath;
9501: if ($embed_file =~ m{^\w+://}) {
9502: $newfiles{$embed_file} = 1;
9503: $mapping{$embed_file} = $embed_file;
9504: } else {
9505: if ($embed_file =~ m{^/}) {
9506: $absolutepath = $embed_file;
9507: $embed_file =~ s{^(/+)}{};
9508: }
9509: if ($embed_file =~ m{/}) {
9510: my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
9511: $path = &check_for_traversal($path,$url,$toplevel);
9512: my $item = $fname;
9513: if ($path ne '') {
9514: $item = $path.'/'.$fname;
9515: $subdependencies{$path}{$fname} = 1;
9516: } else {
9517: $dependencies{$item} = 1;
9518: }
9519: if ($absolutepath) {
9520: $mapping{$item} = $absolutepath;
9521: } else {
9522: $mapping{$item} = $embed_file;
9523: }
9524: } else {
9525: $dependencies{$embed_file} = 1;
9526: if ($absolutepath) {
9527: $mapping{$embed_file} = $absolutepath;
9528: } else {
9529: $mapping{$embed_file} = $embed_file;
9530: }
9531: }
1.984 raeburn 9532: }
9533: }
1.1071 raeburn 9534: my $dirptr = 16384;
1.984 raeburn 9535: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 9536: $currsubfile{$path} = {};
1.984 raeburn 9537: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9538: my ($sublistref,$listerror) =
9539: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
9540: if (ref($sublistref) eq 'ARRAY') {
9541: foreach my $line (@{$sublistref}) {
9542: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 9543: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 9544: }
1.984 raeburn 9545: }
1.987 raeburn 9546: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9547: if (opendir(my $dir,$url.'/'.$path)) {
9548: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 9549: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
9550: }
1.1084 raeburn 9551: } elsif (($actionurl eq '/adm/dependencies') ||
9552: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9553: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9554: if ($env{'request.course.id'} ne '') {
9555: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9556: if ($dir ne '') {
9557: my ($sublistref,$listerror) =
9558: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
9559: if (ref($sublistref) eq 'ARRAY') {
9560: foreach my $line (@{$sublistref}) {
9561: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
9562: undef,$mtime)=split(/\&/,$line,12);
9563: unless (($testdir&$dirptr) ||
9564: ($file_name =~ /^\.\.?$/)) {
9565: $currsubfile{$path}{$file_name} = [$size,$mtime];
9566: }
9567: }
9568: }
9569: }
1.984 raeburn 9570: }
9571: }
9572: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 9573: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 9574: my $item = $path.'/'.$file;
9575: unless ($mapping{$item} eq $item) {
9576: $pathchanges{$item} = 1;
9577: }
9578: $existing{$item} = 1;
9579: $numexisting ++;
9580: } else {
9581: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 9582: }
9583: }
1.1071 raeburn 9584: if ($actionurl eq '/adm/dependencies') {
9585: foreach my $path (keys(%currsubfile)) {
9586: if (ref($currsubfile{$path}) eq 'HASH') {
9587: foreach my $file (keys(%{$currsubfile{$path}})) {
9588: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 9589: next if (($rem ne '') &&
9590: (($env{"httpref.$rem"."$path/$file"} ne '') ||
9591: (ref($navmap) &&
9592: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
9593: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9594: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 9595: $unused{$path.'/'.$file} = 1;
9596: }
9597: }
9598: }
9599: }
9600: }
1.984 raeburn 9601: }
1.987 raeburn 9602: my %currfile;
1.984 raeburn 9603: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9604: my ($dirlistref,$listerror) =
9605: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
9606: if (ref($dirlistref) eq 'ARRAY') {
9607: foreach my $line (@{$dirlistref}) {
9608: my ($file_name,$rest) = split(/\&/,$line,2);
9609: $currfile{$file_name} = 1;
9610: }
1.984 raeburn 9611: }
1.987 raeburn 9612: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9613: if (opendir(my $dir,$url)) {
1.987 raeburn 9614: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 9615: map {$currfile{$_} = 1;} @dir_list;
9616: }
1.1084 raeburn 9617: } elsif (($actionurl eq '/adm/dependencies') ||
9618: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9619: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9620: if ($env{'request.course.id'} ne '') {
9621: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9622: if ($dir ne '') {
9623: my ($dirlistref,$listerror) =
9624: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
9625: if (ref($dirlistref) eq 'ARRAY') {
9626: foreach my $line (@{$dirlistref}) {
9627: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
9628: $size,undef,$mtime)=split(/\&/,$line,12);
9629: unless (($testdir&$dirptr) ||
9630: ($file_name =~ /^\.\.?$/)) {
9631: $currfile{$file_name} = [$size,$mtime];
9632: }
9633: }
9634: }
9635: }
9636: }
1.984 raeburn 9637: }
9638: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 9639: if (exists($currfile{$file})) {
1.987 raeburn 9640: unless ($mapping{$file} eq $file) {
9641: $pathchanges{$file} = 1;
9642: }
9643: $existing{$file} = 1;
9644: $numexisting ++;
9645: } else {
1.984 raeburn 9646: $newfiles{$file} = 1;
9647: }
9648: }
1.1071 raeburn 9649: foreach my $file (keys(%currfile)) {
9650: unless (($file eq $filename) ||
9651: ($file eq $filename.'.bak') ||
9652: ($dependencies{$file})) {
1.1085 raeburn 9653: if ($actionurl eq '/adm/dependencies') {
9654: next if (($rem ne '') &&
9655: (($env{"httpref.$rem".$file} ne '') ||
9656: (ref($navmap) &&
9657: (($navmap->getResourceByUrl($rem.$file) ne '') ||
9658: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9659: ($navmap->getResourceByUrl($rem.$1)))))));
9660: }
1.1071 raeburn 9661: $unused{$file} = 1;
9662: }
9663: }
1.1084 raeburn 9664: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9665: ($args->{'context'} eq 'paste')) {
9666: $counter = scalar(keys(%existing));
9667: $numpathchg = scalar(keys(%pathchanges));
9668: return ($output,$counter,$numpathchg,\%existing);
9669: }
1.984 raeburn 9670: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 9671: if ($actionurl eq '/adm/dependencies') {
9672: next if ($embed_file =~ m{^\w+://});
9673: }
1.660 raeburn 9674: $upload_output .= &start_data_table_row().
1.1071 raeburn 9675: '<td><img src="'.&icon($embed_file).'" /> '.
9676: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 9677: unless ($mapping{$embed_file} eq $embed_file) {
9678: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
9679: }
9680: $upload_output .= '</td><td>';
1.1071 raeburn 9681: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.660 raeburn 9682: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987 raeburn 9683: $numremref++;
1.660 raeburn 9684: } elsif ($args->{'error_on_invalid_names'}
9685: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987 raeburn 9686: $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
9687: $numinvalid++;
1.660 raeburn 9688: } else {
1.1071 raeburn 9689: $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 9690: $embed_file,\%mapping,
1.1071 raeburn 9691: $allfiles,$codebase,'upload');
9692: $counter ++;
9693: $numnew ++;
1.987 raeburn 9694: }
9695: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
9696: }
9697: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 9698: if ($actionurl eq '/adm/dependencies') {
9699: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
9700: $modify_output .= &start_data_table_row().
9701: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
9702: '<img src="'.&icon($embed_file).'" border="0" />'.
9703: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
9704: '<td>'.$size.'</td>'.
9705: '<td>'.$mtime.'</td>'.
9706: '<td><label><input type="checkbox" name="mod_upload_dep" '.
9707: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
9708: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
9709: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
9710: &embedded_file_element('upload_embedded',$counter,
9711: $embed_file,\%mapping,
9712: $allfiles,$codebase,'modify').
9713: '</div></td>'.
9714: &end_data_table_row()."\n";
9715: $counter ++;
9716: } else {
9717: $upload_output .= &start_data_table_row().
9718: '<td><span class="LC_filename">'.$embed_file.'</span></td>';
9719: '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
9720: &Apache::loncommon::end_data_table_row()."\n";
9721: }
9722: }
9723: my $delidx = $counter;
9724: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
9725: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
9726: $delete_output .= &start_data_table_row().
9727: '<td><img src="'.&icon($oldfile).'" />'.
9728: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
9729: '<td>'.$size.'</td>'.
9730: '<td>'.$mtime.'</td>'.
9731: '<td><label><input type="checkbox" name="del_upload_dep" '.
9732: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
9733: &embedded_file_element('upload_embedded',$delidx,
9734: $oldfile,\%mapping,$allfiles,
9735: $codebase,'delete').'</td>'.
9736: &end_data_table_row()."\n";
9737: $numunused ++;
9738: $delidx ++;
1.987 raeburn 9739: }
9740: if ($upload_output) {
9741: $upload_output = &start_data_table().
9742: $upload_output.
9743: &end_data_table()."\n";
9744: }
1.1071 raeburn 9745: if ($modify_output) {
9746: $modify_output = &start_data_table().
9747: &start_data_table_header_row().
9748: '<th>'.&mt('File').'</th>'.
9749: '<th>'.&mt('Size (KB)').'</th>'.
9750: '<th>'.&mt('Modified').'</th>'.
9751: '<th>'.&mt('Upload replacement?').'</th>'.
9752: &end_data_table_header_row().
9753: $modify_output.
9754: &end_data_table()."\n";
9755: }
9756: if ($delete_output) {
9757: $delete_output = &start_data_table().
9758: &start_data_table_header_row().
9759: '<th>'.&mt('File').'</th>'.
9760: '<th>'.&mt('Size (KB)').'</th>'.
9761: '<th>'.&mt('Modified').'</th>'.
9762: '<th>'.&mt('Delete?').'</th>'.
9763: &end_data_table_header_row().
9764: $delete_output.
9765: &end_data_table()."\n";
9766: }
1.987 raeburn 9767: my $applies = 0;
9768: if ($numremref) {
9769: $applies ++;
9770: }
9771: if ($numinvalid) {
9772: $applies ++;
9773: }
9774: if ($numexisting) {
9775: $applies ++;
9776: }
1.1071 raeburn 9777: if ($counter || $numunused) {
1.987 raeburn 9778: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
9779: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 9780: $state.'<h3>'.$heading.'</h3>';
9781: if ($actionurl eq '/adm/dependencies') {
9782: if ($numnew) {
9783: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
9784: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
9785: $upload_output.'<br />'."\n";
9786: }
9787: if ($numexisting) {
9788: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
9789: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
9790: $modify_output.'<br />'."\n";
9791: $buttontext = &mt('Save changes');
9792: }
9793: if ($numunused) {
9794: $output .= '<h4>'.&mt('Unused files').'</h4>'.
9795: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
9796: $delete_output.'<br />'."\n";
9797: $buttontext = &mt('Save changes');
9798: }
9799: } else {
9800: $output .= $upload_output.'<br />'."\n";
9801: }
9802: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
9803: $counter.'" />'."\n";
9804: if ($actionurl eq '/adm/dependencies') {
9805: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
9806: $numnew.'" />'."\n";
9807: } elsif ($actionurl eq '') {
1.987 raeburn 9808: $output .= '<input type="hidden" name="phase" value="three" />';
9809: }
9810: } elsif ($applies) {
9811: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
9812: if ($applies > 1) {
9813: $output .=
9814: &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
9815: if ($numremref) {
9816: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
9817: }
9818: if ($numinvalid) {
9819: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
9820: }
9821: if ($numexisting) {
9822: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
9823: }
9824: $output .= '</ul><br />';
9825: } elsif ($numremref) {
9826: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
9827: } elsif ($numinvalid) {
9828: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
9829: } elsif ($numexisting) {
9830: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
9831: }
9832: $output .= $upload_output.'<br />';
9833: }
9834: my ($pathchange_output,$chgcount);
1.1071 raeburn 9835: $chgcount = $counter;
1.987 raeburn 9836: if (keys(%pathchanges) > 0) {
9837: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 9838: if ($counter) {
1.987 raeburn 9839: $output .= &embedded_file_element('pathchange',$chgcount,
9840: $embed_file,\%mapping,
1.1071 raeburn 9841: $allfiles,$codebase,'change');
1.987 raeburn 9842: } else {
9843: $pathchange_output .=
9844: &start_data_table_row().
9845: '<td><input type ="checkbox" name="namechange" value="'.
9846: $chgcount.'" checked="checked" /></td>'.
9847: '<td>'.$mapping{$embed_file}.'</td>'.
9848: '<td>'.$embed_file.
9849: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 9850: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 9851: '</td>'.&end_data_table_row();
1.660 raeburn 9852: }
1.987 raeburn 9853: $numpathchg ++;
9854: $chgcount ++;
1.660 raeburn 9855: }
9856: }
1.1071 raeburn 9857: if ($counter) {
1.987 raeburn 9858: if ($numpathchg) {
9859: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
9860: $numpathchg.'" />'."\n";
9861: }
9862: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9863: ($actionurl eq '/adm/imsimport')) {
9864: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
9865: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
9866: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 9867: } elsif ($actionurl eq '/adm/dependencies') {
9868: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 9869: }
1.1071 raeburn 9870: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 9871: } elsif ($numpathchg) {
9872: my %pathchange = ();
9873: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
9874: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9875: $output .= '<p>'.&mt('or').'</p>';
9876: }
9877: }
1.1071 raeburn 9878: return ($output,$counter,$numpathchg);
1.987 raeburn 9879: }
9880:
9881: sub embedded_file_element {
1.1071 raeburn 9882: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 9883: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
9884: (ref($codebase) eq 'HASH'));
9885: my $output;
1.1071 raeburn 9886: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 9887: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
9888: }
9889: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
9890: &escape($embed_file).'" />';
9891: unless (($context eq 'upload_embedded') &&
9892: ($mapping->{$embed_file} eq $embed_file)) {
9893: $output .='
9894: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
9895: }
9896: my $attrib;
9897: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
9898: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
9899: }
9900: $output .=
9901: "\n\t\t".
9902: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
9903: $attrib.'" />';
9904: if (exists($codebase->{$mapping->{$embed_file}})) {
9905: $output .=
9906: "\n\t\t".
9907: '<input name="codebase_'.$num.'" type="hidden" value="'.
9908: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 9909: }
1.987 raeburn 9910: return $output;
1.660 raeburn 9911: }
9912:
1.1071 raeburn 9913: sub get_dependency_details {
9914: my ($currfile,$currsubfile,$embed_file) = @_;
9915: my ($size,$mtime,$showsize,$showmtime);
9916: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
9917: if ($embed_file =~ m{/}) {
9918: my ($path,$fname) = split(/\//,$embed_file);
9919: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
9920: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
9921: }
9922: } else {
9923: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
9924: ($size,$mtime) = @{$currfile->{$embed_file}};
9925: }
9926: }
9927: $showsize = $size/1024.0;
9928: $showsize = sprintf("%.1f",$showsize);
9929: if ($mtime > 0) {
9930: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
9931: }
9932: }
9933: return ($showsize,$showmtime);
9934: }
9935:
9936: sub ask_embedded_js {
9937: return <<"END";
9938: <script type="text/javascript"">
9939: // <![CDATA[
9940: function toggleBrowse(counter) {
9941: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
9942: var fileid = document.getElementById('embedded_item_'+counter);
9943: var uploaddivid = document.getElementById('moduploaddep_'+counter);
9944: if (chkboxid.checked == true) {
9945: uploaddivid.style.display='block';
9946: } else {
9947: uploaddivid.style.display='none';
9948: fileid.value = '';
9949: }
9950: }
9951: // ]]>
9952: </script>
9953:
9954: END
9955: }
9956:
1.661 raeburn 9957: sub upload_embedded {
9958: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 9959: $current_disk_usage,$hiddenstate,$actionurl) = @_;
9960: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 9961: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
9962: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
9963: my $orig_uploaded_filename =
9964: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 9965: foreach my $type ('orig','ref','attrib','codebase') {
9966: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
9967: $env{'form.embedded_'.$type.'_'.$i} =
9968: &unescape($env{'form.embedded_'.$type.'_'.$i});
9969: }
9970: }
1.661 raeburn 9971: my ($path,$fname) =
9972: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
9973: # no path, whole string is fname
9974: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
9975: $fname = &Apache::lonnet::clean_filename($fname);
9976: # See if there is anything left
9977: next if ($fname eq '');
9978:
9979: # Check if file already exists as a file or directory.
9980: my ($state,$msg);
9981: if ($context eq 'portfolio') {
9982: my $port_path = $dirpath;
9983: if ($group ne '') {
9984: $port_path = "groups/$group/$port_path";
9985: }
1.987 raeburn 9986: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
9987: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 9988: $dir_root,$port_path,$disk_quota,
9989: $current_disk_usage,$uname,$udom);
9990: if ($state eq 'will_exceed_quota'
1.984 raeburn 9991: || $state eq 'file_locked') {
1.661 raeburn 9992: $output .= $msg;
9993: next;
9994: }
9995: } elsif (($context eq 'author') || ($context eq 'testbank')) {
9996: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
9997: if ($state eq 'exists') {
9998: $output .= $msg;
9999: next;
10000: }
10001: }
10002: # Check if extension is valid
10003: if (($fname =~ /\.(\w+)$/) &&
10004: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987 raeburn 10005: $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 10006: next;
10007: } elsif (($fname =~ /\.(\w+)$/) &&
10008: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10009: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10010: next;
10011: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987 raeburn 10012: $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 10013: next;
10014: }
10015: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
10016: if ($context eq 'portfolio') {
1.984 raeburn 10017: my $result;
10018: if ($state eq 'existingfile') {
10019: $result=
10020: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987 raeburn 10021: $dirpath.$env{'form.currentpath'}.$path);
1.661 raeburn 10022: } else {
1.984 raeburn 10023: $result=
10024: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10025: $dirpath.
10026: $env{'form.currentpath'}.$path);
1.984 raeburn 10027: if ($result !~ m|^/uploaded/|) {
10028: $output .= '<span class="LC_error">'
10029: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10030: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10031: .'</span><br />';
10032: next;
10033: } else {
1.987 raeburn 10034: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10035: $path.$fname.'</span>').'<br />';
1.984 raeburn 10036: }
1.661 raeburn 10037: }
1.987 raeburn 10038: } elsif ($context eq 'coursedoc') {
10039: my $result =
10040: &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
10041: $dirpath.'/'.$path);
10042: if ($result !~ m|^/uploaded/|) {
10043: $output .= '<span class="LC_error">'
10044: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10045: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10046: .'</span><br />';
10047: next;
10048: } else {
10049: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10050: $path.$fname.'</span>').'<br />';
10051: }
1.661 raeburn 10052: } else {
10053: # Save the file
10054: my $target = $env{'form.embedded_item_'.$i};
10055: my $fullpath = $dir_root.$dirpath.'/'.$path;
10056: my $dest = $fullpath.$fname;
10057: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10058: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10059: my $count;
10060: my $filepath = $dir_root;
1.1027 raeburn 10061: foreach my $subdir (@parts) {
10062: $filepath .= "/$subdir";
10063: if (!-e $filepath) {
1.661 raeburn 10064: mkdir($filepath,0770);
10065: }
10066: }
10067: my $fh;
10068: if (!open($fh,'>'.$dest)) {
10069: &Apache::lonnet::logthis('Failed to create '.$dest);
10070: $output .= '<span class="LC_error">'.
1.1071 raeburn 10071: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10072: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10073: '</span><br />';
10074: } else {
10075: if (!print $fh $env{'form.embedded_item_'.$i}) {
10076: &Apache::lonnet::logthis('Failed to write to '.$dest);
10077: $output .= '<span class="LC_error">'.
1.1071 raeburn 10078: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10079: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10080: '</span><br />';
10081: } else {
1.987 raeburn 10082: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10083: $url.'</span>').'<br />';
10084: unless ($context eq 'testbank') {
10085: $footer .= &mt('View embedded file: [_1]',
10086: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10087: }
10088: }
10089: close($fh);
10090: }
10091: }
10092: if ($env{'form.embedded_ref_'.$i}) {
10093: $pathchange{$i} = 1;
10094: }
10095: }
10096: if ($output) {
10097: $output = '<p>'.$output.'</p>';
10098: }
10099: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10100: $returnflag = 'ok';
1.1071 raeburn 10101: my $numpathchgs = scalar(keys(%pathchange));
10102: if ($numpathchgs > 0) {
1.987 raeburn 10103: if ($context eq 'portfolio') {
10104: $output .= '<p>'.&mt('or').'</p>';
10105: } elsif ($context eq 'testbank') {
1.1071 raeburn 10106: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10107: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10108: $returnflag = 'modify_orightml';
10109: }
10110: }
1.1071 raeburn 10111: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10112: }
10113:
10114: sub modify_html_form {
10115: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10116: my $end = 0;
10117: my $modifyform;
10118: if ($context eq 'upload_embedded') {
10119: return unless (ref($pathchange) eq 'HASH');
10120: if ($env{'form.number_embedded_items'}) {
10121: $end += $env{'form.number_embedded_items'};
10122: }
10123: if ($env{'form.number_pathchange_items'}) {
10124: $end += $env{'form.number_pathchange_items'};
10125: }
10126: if ($end) {
10127: for (my $i=0; $i<$end; $i++) {
10128: if ($i < $env{'form.number_embedded_items'}) {
10129: next unless($pathchange->{$i});
10130: }
10131: $modifyform .=
10132: &start_data_table_row().
10133: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10134: 'checked="checked" /></td>'.
10135: '<td>'.$env{'form.embedded_ref_'.$i}.
10136: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10137: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10138: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10139: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10140: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10141: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10142: '<td>'.$env{'form.embedded_orig_'.$i}.
10143: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10144: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10145: &end_data_table_row();
1.1071 raeburn 10146: }
1.987 raeburn 10147: }
10148: } else {
10149: $modifyform = $pathchgtable;
10150: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10151: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10152: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10153: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10154: }
10155: }
10156: if ($modifyform) {
1.1071 raeburn 10157: if ($actionurl eq '/adm/dependencies') {
10158: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10159: }
1.987 raeburn 10160: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10161: '<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".
10162: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10163: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10164: '</ol></p>'."\n".'<p>'.
10165: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10166: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10167: &start_data_table()."\n".
10168: &start_data_table_header_row().
10169: '<th>'.&mt('Change?').'</th>'.
10170: '<th>'.&mt('Current reference').'</th>'.
10171: '<th>'.&mt('Required reference').'</th>'.
10172: &end_data_table_header_row()."\n".
10173: $modifyform.
10174: &end_data_table().'<br />'."\n".$hiddenstate.
10175: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10176: '</form>'."\n";
10177: }
10178: return;
10179: }
10180:
10181: sub modify_html_refs {
10182: my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
10183: my $container;
10184: if ($context eq 'portfolio') {
10185: $container = $env{'form.container'};
10186: } elsif ($context eq 'coursedoc') {
10187: $container = $env{'form.primaryurl'};
1.1071 raeburn 10188: } elsif ($context eq 'manage_dependencies') {
10189: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10190: $container = "/$container";
1.987 raeburn 10191: } else {
1.1027 raeburn 10192: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10193: }
10194: my (%allfiles,%codebase,$output,$content);
10195: my @changes = &get_env_multiple('form.namechange');
1.1071 raeburn 10196: unless (@changes > 0) {
10197: if (wantarray) {
10198: return ('',0,0);
10199: } else {
10200: return;
10201: }
10202: }
10203: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10204: ($context eq 'manage_dependencies')) {
10205: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10206: if (wantarray) {
10207: return ('',0,0);
10208: } else {
10209: return;
10210: }
10211: }
1.987 raeburn 10212: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10213: if ($content eq '-1') {
10214: if (wantarray) {
10215: return ('',0,0);
10216: } else {
10217: return;
10218: }
10219: }
1.987 raeburn 10220: } else {
1.1071 raeburn 10221: unless ($container =~ /^\Q$dir_root\E/) {
10222: if (wantarray) {
10223: return ('',0,0);
10224: } else {
10225: return;
10226: }
10227: }
1.987 raeburn 10228: if (open(my $fh,"<$container")) {
10229: $content = join('', <$fh>);
10230: close($fh);
10231: } else {
1.1071 raeburn 10232: if (wantarray) {
10233: return ('',0,0);
10234: } else {
10235: return;
10236: }
1.987 raeburn 10237: }
10238: }
10239: my ($count,$codebasecount) = (0,0);
10240: my $mm = new File::MMagic;
10241: my $mime_type = $mm->checktype_contents($content);
10242: if ($mime_type eq 'text/html') {
10243: my $parse_result =
10244: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10245: \%codebase,\$content);
10246: if ($parse_result eq 'ok') {
10247: foreach my $i (@changes) {
10248: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10249: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10250: if ($allfiles{$ref}) {
10251: my $newname = $orig;
10252: my ($attrib_regexp,$codebase);
1.1006 raeburn 10253: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10254: if ($attrib_regexp =~ /:/) {
10255: $attrib_regexp =~ s/\:/|/g;
10256: }
10257: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10258: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10259: $count += $numchg;
10260: }
10261: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10262: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10263: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10264: $codebasecount ++;
10265: }
10266: }
10267: }
10268: if ($count || $codebasecount) {
10269: my $saveresult;
1.1071 raeburn 10270: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10271: ($context eq 'manage_dependencies')) {
1.987 raeburn 10272: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10273: if ($url eq $container) {
10274: my ($fname) = ($container =~ m{/([^/]+)$});
10275: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10276: $count,'<span class="LC_filename">'.
1.1071 raeburn 10277: $fname.'</span>').'</p>';
1.987 raeburn 10278: } else {
10279: $output = '<p class="LC_error">'.
10280: &mt('Error: update failed for: [_1].',
10281: '<span class="LC_filename">'.
10282: $container.'</span>').'</p>';
10283: }
10284: } else {
10285: if (open(my $fh,">$container")) {
10286: print $fh $content;
10287: close($fh);
10288: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10289: $count,'<span class="LC_filename">'.
10290: $container.'</span>').'</p>';
1.661 raeburn 10291: } else {
1.987 raeburn 10292: $output = '<p class="LC_error">'.
10293: &mt('Error: could not update [_1].',
10294: '<span class="LC_filename">'.
10295: $container.'</span>').'</p>';
1.661 raeburn 10296: }
10297: }
10298: }
1.987 raeburn 10299: } else {
10300: &logthis('Failed to parse '.$container.
10301: ' to modify references: '.$parse_result);
1.661 raeburn 10302: }
10303: }
1.1071 raeburn 10304: if (wantarray) {
10305: return ($output,$count,$codebasecount);
10306: } else {
10307: return $output;
10308: }
1.661 raeburn 10309: }
10310:
10311: sub check_for_existing {
10312: my ($path,$fname,$element) = @_;
10313: my ($state,$msg);
10314: if (-d $path.'/'.$fname) {
10315: $state = 'exists';
10316: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10317: } elsif (-e $path.'/'.$fname) {
10318: $state = 'exists';
10319: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10320: }
10321: if ($state eq 'exists') {
10322: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10323: }
10324: return ($state,$msg);
10325: }
10326:
10327: sub check_for_upload {
10328: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10329: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10330: my $filesize = length($env{'form.'.$element});
10331: if (!$filesize) {
10332: my $msg = '<span class="LC_error">'.
10333: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10334: '<span class="LC_filename">'.$fname.'</span>',
10335: $filesize).'<br />'.
1.1007 raeburn 10336: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10337: '</span>';
10338: return ('zero_bytes',$msg);
10339: }
10340: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10341: my $getpropath = 1;
1.1021 raeburn 10342: my ($dirlistref,$listerror) =
10343: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10344: my $found_file = 0;
10345: my $locked_file = 0;
1.991 raeburn 10346: my @lockers;
10347: my $navmap;
10348: if ($env{'request.course.id'}) {
10349: $navmap = Apache::lonnavmaps::navmap->new();
10350: }
1.1021 raeburn 10351: if (ref($dirlistref) eq 'ARRAY') {
10352: foreach my $line (@{$dirlistref}) {
10353: my ($file_name,$rest)=split(/\&/,$line,2);
10354: if ($file_name eq $fname){
10355: $file_name = $path.$file_name;
10356: if ($group ne '') {
10357: $file_name = $group.$file_name;
10358: }
10359: $found_file = 1;
10360: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10361: foreach my $lock (@lockers) {
10362: if (ref($lock) eq 'ARRAY') {
10363: my ($symb,$crsid) = @{$lock};
10364: if ($crsid eq $env{'request.course.id'}) {
10365: if (ref($navmap)) {
10366: my $res = $navmap->getBySymb($symb);
10367: foreach my $part (@{$res->parts()}) {
10368: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10369: unless (($slot_status == $res->RESERVED) ||
10370: ($slot_status == $res->RESERVED_LOCATION)) {
10371: $locked_file = 1;
10372: }
1.991 raeburn 10373: }
1.1021 raeburn 10374: } else {
10375: $locked_file = 1;
1.991 raeburn 10376: }
10377: } else {
10378: $locked_file = 1;
10379: }
10380: }
1.1021 raeburn 10381: }
10382: } else {
10383: my @info = split(/\&/,$rest);
10384: my $currsize = $info[6]/1000;
10385: if ($currsize < $filesize) {
10386: my $extra = $filesize - $currsize;
10387: if (($current_disk_usage + $extra) > $disk_quota) {
10388: my $msg = '<span class="LC_error">'.
10389: &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.',
10390: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
10391: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
10392: $disk_quota,$current_disk_usage);
10393: return ('will_exceed_quota',$msg);
10394: }
1.984 raeburn 10395: }
10396: }
1.661 raeburn 10397: }
10398: }
10399: }
10400: if (($current_disk_usage + $filesize) > $disk_quota){
10401: my $msg = '<span class="LC_error">'.
10402: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
10403: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
10404: return ('will_exceed_quota',$msg);
10405: } elsif ($found_file) {
10406: if ($locked_file) {
10407: my $msg = '<span class="LC_error">';
10408: $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>');
10409: $msg .= '</span><br />';
10410: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
10411: return ('file_locked',$msg);
10412: } else {
10413: my $msg = '<span class="LC_error">';
1.984 raeburn 10414: $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 10415: $msg .= '</span>';
1.984 raeburn 10416: return ('existingfile',$msg);
1.661 raeburn 10417: }
10418: }
10419: }
10420:
1.987 raeburn 10421: sub check_for_traversal {
10422: my ($path,$url,$toplevel) = @_;
10423: my @parts=split(/\//,$path);
10424: my $cleanpath;
10425: my $fullpath = $url;
10426: for (my $i=0;$i<@parts;$i++) {
10427: next if ($parts[$i] eq '.');
10428: if ($parts[$i] eq '..') {
10429: $fullpath =~ s{([^/]+/)$}{};
10430: } else {
10431: $fullpath .= $parts[$i].'/';
10432: }
10433: }
10434: if ($fullpath =~ /^\Q$url\E(.*)$/) {
10435: $cleanpath = $1;
10436: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
10437: my $curr_toprel = $1;
10438: my @parts = split(/\//,$curr_toprel);
10439: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
10440: my @urlparts = split(/\//,$url_toprel);
10441: my $doubledots;
10442: my $startdiff = -1;
10443: for (my $i=0; $i<@urlparts; $i++) {
10444: if ($startdiff == -1) {
10445: unless ($urlparts[$i] eq $parts[$i]) {
10446: $startdiff = $i;
10447: $doubledots .= '../';
10448: }
10449: } else {
10450: $doubledots .= '../';
10451: }
10452: }
10453: if ($startdiff > -1) {
10454: $cleanpath = $doubledots;
10455: for (my $i=$startdiff; $i<@parts; $i++) {
10456: $cleanpath .= $parts[$i].'/';
10457: }
10458: }
10459: }
10460: $cleanpath =~ s{(/)$}{};
10461: return $cleanpath;
10462: }
1.31 albertel 10463:
1.1053 raeburn 10464: sub is_archive_file {
10465: my ($mimetype) = @_;
10466: if (($mimetype eq 'application/octet-stream') ||
10467: ($mimetype eq 'application/x-stuffit') ||
10468: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
10469: return 1;
10470: }
10471: return;
10472: }
10473:
10474: sub decompress_form {
1.1065 raeburn 10475: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 10476: my %lt = &Apache::lonlocal::texthash (
10477: this => 'This file is an archive file.',
1.1067 raeburn 10478: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 10479: itsc => 'Its contents are as follows:',
1.1053 raeburn 10480: youm => 'You may wish to extract its contents.',
10481: extr => 'Extract contents',
1.1067 raeburn 10482: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
10483: proa => 'Process automatically?',
1.1053 raeburn 10484: yes => 'Yes',
10485: no => 'No',
1.1067 raeburn 10486: fold => 'Title for folder containing movie',
10487: movi => 'Title for page containing embedded movie',
1.1053 raeburn 10488: );
1.1065 raeburn 10489: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 10490: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 10491: my $info = &list_archive_contents($fileloc,\@paths);
10492: if (@paths) {
10493: foreach my $path (@paths) {
10494: $path =~ s{^/}{};
1.1067 raeburn 10495: if ($path =~ m{^([^/]+)/$}) {
10496: $topdir = $1;
10497: }
1.1065 raeburn 10498: if ($path =~ m{^([^/]+)/}) {
10499: $toplevel{$1} = $path;
10500: } else {
10501: $toplevel{$path} = $path;
10502: }
10503: }
10504: }
1.1067 raeburn 10505: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
10506: my @camtasia = ("$topdir/","$topdir/index.html",
10507: "$topdir/media/",
10508: "$topdir/media/$topdir.mp4",
10509: "$topdir/media/FirstFrame.png",
10510: "$topdir/media/player.swf",
10511: "$topdir/media/swfobject.js",
10512: "$topdir/media/expressInstall.swf");
10513: my @diffs = &compare_arrays(\@paths,\@camtasia);
10514: if (@diffs == 0) {
10515: $is_camtasia = 1;
10516: }
10517: }
10518: my $output;
10519: if ($is_camtasia) {
10520: $output = <<"ENDCAM";
10521: <script type="text/javascript" language="Javascript">
10522: // <![CDATA[
10523:
10524: function camtasiaToggle() {
10525: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
10526: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
10527: if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
10528:
10529: document.getElementById('camtasia_titles').style.display='block';
10530: } else {
10531: document.getElementById('camtasia_titles').style.display='none';
10532: }
10533: }
10534: }
10535: return;
10536: }
10537:
10538: // ]]>
10539: </script>
10540: <p>$lt{'camt'}</p>
10541: ENDCAM
1.1065 raeburn 10542: } else {
1.1067 raeburn 10543: $output = '<p>'.$lt{'this'};
10544: if ($info eq '') {
10545: $output .= ' '.$lt{'youm'}.'</p>'."\n";
10546: } else {
10547: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
10548: '<div><pre>'.$info.'</pre></div>';
10549: }
1.1065 raeburn 10550: }
1.1067 raeburn 10551: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 10552: my $duplicates;
10553: my $num = 0;
10554: if (ref($dirlist) eq 'ARRAY') {
10555: foreach my $item (@{$dirlist}) {
10556: if (ref($item) eq 'ARRAY') {
10557: if (exists($toplevel{$item->[0]})) {
10558: $duplicates .=
10559: &start_data_table_row().
10560: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
10561: 'value="0" checked="checked" />'.&mt('No').'</label>'.
10562: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
10563: 'value="1" />'.&mt('Yes').'</label>'.
10564: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
10565: '<td>'.$item->[0].'</td>';
10566: if ($item->[2]) {
10567: $duplicates .= '<td>'.&mt('Directory').'</td>';
10568: } else {
10569: $duplicates .= '<td>'.&mt('File').'</td>';
10570: }
10571: $duplicates .= '<td>'.$item->[3].'</td>'.
10572: '<td>'.
10573: &Apache::lonlocal::locallocaltime($item->[4]).
10574: '</td>'.
10575: &end_data_table_row();
10576: $num ++;
10577: }
10578: }
10579: }
10580: }
10581: my $itemcount;
10582: if (@paths > 0) {
10583: $itemcount = scalar(@paths);
10584: } else {
10585: $itemcount = 1;
10586: }
1.1067 raeburn 10587: if ($is_camtasia) {
10588: $output .= $lt{'auto'}.'<br />'.
10589: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
10590: '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
10591: $lt{'yes'}.'</label> <label>'.
10592: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
10593: $lt{'no'}.'</label></span><br />'.
10594: '<div id="camtasia_titles" style="display:block">'.
10595: &Apache::lonhtmlcommon::start_pick_box().
10596: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
10597: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
10598: &Apache::lonhtmlcommon::row_closure().
10599: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
10600: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
10601: &Apache::lonhtmlcommon::row_closure(1).
10602: &Apache::lonhtmlcommon::end_pick_box().
10603: '</div>';
10604: }
1.1065 raeburn 10605: $output .=
10606: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 10607: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
10608: "\n";
1.1065 raeburn 10609: if ($duplicates ne '') {
10610: $output .= '<p><span class="LC_warning">'.
10611: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
10612: &start_data_table().
10613: &start_data_table_header_row().
10614: '<th>'.&mt('Overwrite?').'</th>'.
10615: '<th>'.&mt('Name').'</th>'.
10616: '<th>'.&mt('Type').'</th>'.
10617: '<th>'.&mt('Size').'</th>'.
10618: '<th>'.&mt('Last modified').'</th>'.
10619: &end_data_table_header_row().
10620: $duplicates.
10621: &end_data_table().
10622: '</p>';
10623: }
1.1067 raeburn 10624: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 10625: if (ref($hiddenelements) eq 'HASH') {
10626: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
10627: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
10628: }
10629: }
10630: $output .= <<"END";
1.1067 raeburn 10631: <br />
1.1053 raeburn 10632: <input type="submit" name="decompress" value="$lt{'extr'}" />
10633: </form>
10634: $noextract
10635: END
10636: return $output;
10637: }
10638:
1.1065 raeburn 10639: sub decompression_utility {
10640: my ($program) = @_;
10641: my @utilities = ('tar','gunzip','bunzip2','unzip');
10642: my $location;
10643: if (grep(/^\Q$program\E$/,@utilities)) {
10644: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
10645: '/usr/sbin/') {
10646: if (-x $dir.$program) {
10647: $location = $dir.$program;
10648: last;
10649: }
10650: }
10651: }
10652: return $location;
10653: }
10654:
10655: sub list_archive_contents {
10656: my ($file,$pathsref) = @_;
10657: my (@cmd,$output);
10658: my $needsregexp;
10659: if ($file =~ /\.zip$/) {
10660: @cmd = (&decompression_utility('unzip'),"-l");
10661: $needsregexp = 1;
10662: } elsif (($file =~ m/\.tar\.gz$/) ||
10663: ($file =~ /\.tgz$/)) {
10664: @cmd = (&decompression_utility('tar'),"-ztf");
10665: } elsif ($file =~ /\.tar\.bz2$/) {
10666: @cmd = (&decompression_utility('tar'),"-jtf");
10667: } elsif ($file =~ m|\.tar$|) {
10668: @cmd = (&decompression_utility('tar'),"-tf");
10669: }
10670: if (@cmd) {
10671: undef($!);
10672: undef($@);
10673: if (open(my $fh,"-|", @cmd, $file)) {
10674: while (my $line = <$fh>) {
10675: $output .= $line;
10676: chomp($line);
10677: my $item;
10678: if ($needsregexp) {
10679: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
10680: } else {
10681: $item = $line;
10682: }
10683: if ($item ne '') {
10684: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
10685: push(@{$pathsref},$item);
10686: }
10687: }
10688: }
10689: close($fh);
10690: }
10691: }
10692: return $output;
10693: }
10694:
1.1053 raeburn 10695: sub decompress_uploaded_file {
10696: my ($file,$dir) = @_;
10697: &Apache::lonnet::appenv({'cgi.file' => $file});
10698: &Apache::lonnet::appenv({'cgi.dir' => $dir});
10699: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
10700: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
10701: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
10702: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
10703: my $decompressed = $env{'cgi.decompressed'};
10704: &Apache::lonnet::delenv('cgi.file');
10705: &Apache::lonnet::delenv('cgi.dir');
10706: &Apache::lonnet::delenv('cgi.decompressed');
10707: return ($decompressed,$result);
10708: }
10709:
1.1055 raeburn 10710: sub process_decompression {
10711: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
10712: my ($dir,$error,$warning,$output);
10713: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
10714: $error = &mt('File name not a supported archive file type.').
10715: '<br />'.&mt('File name should end with one of: [_1].',
10716: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
10717: } else {
10718: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
10719: if ($docuhome eq 'no_host') {
10720: $error = &mt('Could not determine home server for course.');
10721: } else {
10722: my @ids=&Apache::lonnet::current_machine_ids();
10723: my $currdir = "$dir_root/$destination";
10724: if (grep(/^\Q$docuhome\E$/,@ids)) {
10725: $dir = &LONCAPA::propath($docudom,$docuname).
10726: "$dir_root/$destination";
10727: } else {
10728: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
10729: "$dir_root/$docudom/$docuname/$destination";
10730: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
10731: $error = &mt('Archive file not found.');
10732: }
10733: }
1.1065 raeburn 10734: my (@to_overwrite,@to_skip);
10735: if ($env{'form.archive_overwrite_total'} > 0) {
10736: my $total = $env{'form.archive_overwrite_total'};
10737: for (my $i=0; $i<$total; $i++) {
10738: if ($env{'form.archive_overwrite_'.$i} == 1) {
10739: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
10740: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
10741: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
10742: }
10743: }
10744: }
10745: my $numskip = scalar(@to_skip);
10746: if (($numskip > 0) &&
10747: ($numskip == $env{'form.archive_itemcount'})) {
10748: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
10749: } elsif ($dir eq '') {
1.1055 raeburn 10750: $error = &mt('Directory containing archive file unavailable.');
10751: } elsif (!$error) {
1.1065 raeburn 10752: my ($decompressed,$display);
10753: if ($numskip > 0) {
10754: my $tempdir = time.'_'.$$.int(rand(10000));
10755: mkdir("$dir/$tempdir",0755);
10756: system("mv $dir/$file $dir/$tempdir/$file");
10757: ($decompressed,$display) =
10758: &decompress_uploaded_file($file,"$dir/$tempdir");
10759: foreach my $item (@to_skip) {
10760: if (($item ne '') && ($item !~ /\.\./)) {
10761: if (-f "$dir/$tempdir/$item") {
10762: unlink("$dir/$tempdir/$item");
10763: } elsif (-d "$dir/$tempdir/$item") {
10764: system("rm -rf $dir/$tempdir/$item");
10765: }
10766: }
10767: }
10768: system("mv $dir/$tempdir/* $dir");
10769: rmdir("$dir/$tempdir");
10770: } else {
10771: ($decompressed,$display) =
10772: &decompress_uploaded_file($file,$dir);
10773: }
1.1055 raeburn 10774: if ($decompressed eq 'ok') {
1.1065 raeburn 10775: $output = '<p class="LC_info">'.
10776: &mt('Files extracted successfully from archive.').
10777: '</p>'."\n";
1.1055 raeburn 10778: my ($warning,$result,@contents);
10779: my ($newdirlistref,$newlisterror) =
10780: &Apache::lonnet::dirlist($currdir,$docudom,
10781: $docuname,1);
10782: my (%is_dir,%changes,@newitems);
10783: my $dirptr = 16384;
1.1065 raeburn 10784: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 10785: foreach my $dir_line (@{$newdirlistref}) {
10786: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 10787: unless (($item =~ /^\.+$/) || ($item eq $file) ||
10788: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 10789: push(@newitems,$item);
10790: if ($dirptr&$testdir) {
10791: $is_dir{$item} = 1;
10792: }
10793: $changes{$item} = 1;
10794: }
10795: }
10796: }
10797: if (keys(%changes) > 0) {
10798: foreach my $item (sort(@newitems)) {
10799: if ($changes{$item}) {
10800: push(@contents,$item);
10801: }
10802: }
10803: }
10804: if (@contents > 0) {
1.1067 raeburn 10805: my $wantform;
10806: unless ($env{'form.autoextract_camtasia'}) {
10807: $wantform = 1;
10808: }
1.1056 raeburn 10809: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 10810: my ($count,$datatable) = &get_extracted($docudom,$docuname,
10811: $currdir,\%is_dir,
10812: \%children,\%parent,
1.1056 raeburn 10813: \@contents,\%dirorder,
10814: \%titles,$wantform);
1.1055 raeburn 10815: if ($datatable ne '') {
10816: $output .= &archive_options_form('decompressed',$datatable,
10817: $count,$hiddenelem);
1.1065 raeburn 10818: my $startcount = 6;
1.1055 raeburn 10819: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 10820: \%titles,\%children);
1.1055 raeburn 10821: }
1.1067 raeburn 10822: if ($env{'form.autoextract_camtasia'}) {
10823: my %displayed;
10824: my $total = 1;
10825: $env{'form.archive_directory'} = [];
10826: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
10827: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
10828: $path =~ s{/$}{};
10829: my $item;
10830: if ($path ne '') {
10831: $item = "$path/$titles{$i}";
10832: } else {
10833: $item = $titles{$i};
10834: }
10835: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
10836: if ($item eq $contents[0]) {
10837: push(@{$env{'form.archive_directory'}},$i);
10838: $env{'form.archive_'.$i} = 'display';
10839: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
10840: $displayed{'folder'} = $i;
10841: } elsif ($item eq "$contents[0]/index.html") {
10842: $env{'form.archive_'.$i} = 'display';
10843: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
10844: $displayed{'web'} = $i;
10845: } else {
10846: if ($item eq "$contents[0]/media") {
10847: push(@{$env{'form.archive_directory'}},$i);
10848: }
10849: $env{'form.archive_'.$i} = 'dependency';
10850: }
10851: $total ++;
10852: }
10853: for (my $i=1; $i<$total; $i++) {
10854: next if ($i == $displayed{'web'});
10855: next if ($i == $displayed{'folder'});
10856: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
10857: }
10858: $env{'form.phase'} = 'decompress_cleanup';
10859: $env{'form.archivedelete'} = 1;
10860: $env{'form.archive_count'} = $total-1;
10861: $output .=
10862: &process_extracted_files('coursedocs',$docudom,
10863: $docuname,$destination,
10864: $dir_root,$hiddenelem);
10865: }
1.1055 raeburn 10866: } else {
10867: $warning = &mt('No new items extracted from archive file.');
10868: }
10869: } else {
10870: $output = $display;
10871: $error = &mt('An error occurred during extraction from the archive file.');
10872: }
10873: }
10874: }
10875: }
10876: if ($error) {
10877: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
10878: $error.'</p>'."\n";
10879: }
10880: if ($warning) {
10881: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
10882: }
10883: return $output;
10884: }
10885:
10886: sub get_extracted {
1.1056 raeburn 10887: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
10888: $titles,$wantform) = @_;
1.1055 raeburn 10889: my $count = 0;
10890: my $depth = 0;
10891: my $datatable;
1.1056 raeburn 10892: my @hierarchy;
1.1055 raeburn 10893: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 10894: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
10895: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 10896: foreach my $item (@{$contents}) {
10897: $count ++;
1.1056 raeburn 10898: @{$dirorder->{$count}} = @hierarchy;
10899: $titles->{$count} = $item;
1.1055 raeburn 10900: &archive_hierarchy($depth,$count,$parent,$children);
10901: if ($wantform) {
10902: $datatable .= &archive_row($is_dir->{$item},$item,
10903: $currdir,$depth,$count);
10904: }
10905: if ($is_dir->{$item}) {
10906: $depth ++;
1.1056 raeburn 10907: push(@hierarchy,$count);
10908: $parent->{$depth} = $count;
1.1055 raeburn 10909: $datatable .=
10910: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 10911: \$depth,\$count,\@hierarchy,$dirorder,
10912: $children,$parent,$titles,$wantform);
1.1055 raeburn 10913: $depth --;
1.1056 raeburn 10914: pop(@hierarchy);
1.1055 raeburn 10915: }
10916: }
10917: return ($count,$datatable);
10918: }
10919:
10920: sub recurse_extracted_archive {
1.1056 raeburn 10921: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
10922: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 10923: my $result='';
1.1056 raeburn 10924: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
10925: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
10926: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 10927: return $result;
10928: }
10929: my $dirptr = 16384;
10930: my ($newdirlistref,$newlisterror) =
10931: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
10932: if (ref($newdirlistref) eq 'ARRAY') {
10933: foreach my $dir_line (@{$newdirlistref}) {
10934: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
10935: unless ($item =~ /^\.+$/) {
10936: $$count ++;
1.1056 raeburn 10937: @{$dirorder->{$$count}} = @{$hierarchy};
10938: $titles->{$$count} = $item;
1.1055 raeburn 10939: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 10940:
1.1055 raeburn 10941: my $is_dir;
10942: if ($dirptr&$testdir) {
10943: $is_dir = 1;
10944: }
10945: if ($wantform) {
10946: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
10947: }
10948: if ($is_dir) {
10949: $$depth ++;
1.1056 raeburn 10950: push(@{$hierarchy},$$count);
10951: $parent->{$$depth} = $$count;
1.1055 raeburn 10952: $result .=
10953: &recurse_extracted_archive("$currdir/$item",$docudom,
10954: $docuname,$depth,$count,
1.1056 raeburn 10955: $hierarchy,$dirorder,$children,
10956: $parent,$titles,$wantform);
1.1055 raeburn 10957: $$depth --;
1.1056 raeburn 10958: pop(@{$hierarchy});
1.1055 raeburn 10959: }
10960: }
10961: }
10962: }
10963: return $result;
10964: }
10965:
10966: sub archive_hierarchy {
10967: my ($depth,$count,$parent,$children) =@_;
10968: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
10969: if (exists($parent->{$depth})) {
10970: $children->{$parent->{$depth}} .= $count.':';
10971: }
10972: }
10973: return;
10974: }
10975:
10976: sub archive_row {
10977: my ($is_dir,$item,$currdir,$depth,$count) = @_;
10978: my ($name) = ($item =~ m{([^/]+)$});
10979: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 10980: 'display' => 'Add as file',
1.1055 raeburn 10981: 'dependency' => 'Include as dependency',
10982: 'discard' => 'Discard',
10983: );
10984: if ($is_dir) {
1.1059 raeburn 10985: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 10986: }
1.1056 raeburn 10987: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
10988: my $offset = 0;
1.1055 raeburn 10989: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 10990: $offset ++;
1.1065 raeburn 10991: if ($action ne 'display') {
10992: $offset ++;
10993: }
1.1055 raeburn 10994: $output .= '<td><span class="LC_nobreak">'.
10995: '<label><input type="radio" name="archive_'.$count.
10996: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
10997: my $text = $choices{$action};
10998: if ($is_dir) {
10999: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11000: if ($action eq 'display') {
1.1059 raeburn 11001: $text = &mt('Add as folder');
1.1055 raeburn 11002: }
1.1056 raeburn 11003: } else {
11004: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11005:
11006: }
11007: $output .= ' /> '.$choices{$action}.'</label></span>';
11008: if ($action eq 'dependency') {
11009: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11010: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11011: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11012: '<option value=""></option>'."\n".
11013: '</select>'."\n".
11014: '</div>';
1.1059 raeburn 11015: } elsif ($action eq 'display') {
11016: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11017: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11018: '</div>';
1.1055 raeburn 11019: }
1.1056 raeburn 11020: $output .= '</td>';
1.1055 raeburn 11021: }
11022: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11023: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11024: for (my $i=0; $i<$depth; $i++) {
11025: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11026: }
11027: if ($is_dir) {
11028: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11029: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11030: } else {
11031: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11032: }
11033: $output .= ' '.$name.'</td>'."\n".
11034: &end_data_table_row();
11035: return $output;
11036: }
11037:
11038: sub archive_options_form {
1.1065 raeburn 11039: my ($form,$display,$count,$hiddenelem) = @_;
11040: my %lt = &Apache::lonlocal::texthash(
11041: perm => 'Permanently remove archive file?',
11042: hows => 'How should each extracted item be incorporated in the course?',
11043: cont => 'Content actions for all',
11044: addf => 'Add as folder/file',
11045: incd => 'Include as dependency for a displayed file',
11046: disc => 'Discard',
11047: no => 'No',
11048: yes => 'Yes',
11049: save => 'Save',
11050: );
11051: my $output = <<"END";
11052: <form name="$form" method="post" action="">
11053: <p><span class="LC_nobreak">$lt{'perm'}
11054: <label>
11055: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11056: </label>
11057:
11058: <label>
11059: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11060: </span>
11061: </p>
11062: <input type="hidden" name="phase" value="decompress_cleanup" />
11063: <br />$lt{'hows'}
11064: <div class="LC_columnSection">
11065: <fieldset>
11066: <legend>$lt{'cont'}</legend>
11067: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11068: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11069: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11070: </fieldset>
11071: </div>
11072: END
11073: return $output.
1.1055 raeburn 11074: &start_data_table()."\n".
1.1065 raeburn 11075: $display."\n".
1.1055 raeburn 11076: &end_data_table()."\n".
11077: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11078: $hiddenelem.
1.1065 raeburn 11079: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11080: '</form>';
11081: }
11082:
11083: sub archive_javascript {
1.1056 raeburn 11084: my ($startcount,$numitems,$titles,$children) = @_;
11085: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11086: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11087: my $scripttag = <<START;
11088: <script type="text/javascript">
11089: // <![CDATA[
11090:
11091: function checkAll(form,prefix) {
11092: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11093: for (var i=0; i < form.elements.length; i++) {
11094: var id = form.elements[i].id;
11095: if ((id != '') && (id != undefined)) {
11096: if (idstr.test(id)) {
11097: if (form.elements[i].type == 'radio') {
11098: form.elements[i].checked = true;
1.1056 raeburn 11099: var nostart = i-$startcount;
1.1059 raeburn 11100: var offset = nostart%7;
11101: var count = (nostart-offset)/7;
1.1056 raeburn 11102: dependencyCheck(form,count,offset);
1.1055 raeburn 11103: }
11104: }
11105: }
11106: }
11107: }
11108:
11109: function propagateCheck(form,count) {
11110: if (count > 0) {
1.1059 raeburn 11111: var startelement = $startcount + ((count-1) * 7);
11112: for (var j=1; j<6; j++) {
11113: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11114: var item = startelement + j;
11115: if (form.elements[item].type == 'radio') {
11116: if (form.elements[item].checked) {
11117: containerCheck(form,count,j);
11118: break;
11119: }
1.1055 raeburn 11120: }
11121: }
11122: }
11123: }
11124: }
11125:
11126: numitems = $numitems
1.1056 raeburn 11127: var titles = new Array(numitems);
11128: var parents = new Array(numitems);
1.1055 raeburn 11129: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11130: parents[i] = new Array;
1.1055 raeburn 11131: }
1.1059 raeburn 11132: var maintitle = '$maintitle';
1.1055 raeburn 11133:
11134: START
11135:
1.1056 raeburn 11136: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11137: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11138: for (my $i=0; $i<@contents; $i ++) {
11139: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11140: }
11141: }
11142:
1.1056 raeburn 11143: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11144: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11145: }
11146:
1.1055 raeburn 11147: $scripttag .= <<END;
11148:
11149: function containerCheck(form,count,offset) {
11150: if (count > 0) {
1.1056 raeburn 11151: dependencyCheck(form,count,offset);
1.1059 raeburn 11152: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11153: form.elements[item].checked = true;
11154: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11155: if (parents[count].length > 0) {
11156: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11157: containerCheck(form,parents[count][j],offset);
11158: }
11159: }
11160: }
11161: }
11162: }
11163:
11164: function dependencyCheck(form,count,offset) {
11165: if (count > 0) {
1.1059 raeburn 11166: var chosen = (offset+$startcount)+7*(count-1);
11167: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11168: var currtype = form.elements[depitem].type;
11169: if (form.elements[chosen].value == 'dependency') {
11170: document.getElementById('arc_depon_'+count).style.display='block';
11171: form.elements[depitem].options.length = 0;
11172: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11173: for (var i=1; i<=numitems; i++) {
11174: if (i == count) {
11175: continue;
11176: }
1.1059 raeburn 11177: var startelement = $startcount + (i-1) * 7;
11178: for (var j=1; j<6; j++) {
11179: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11180: var item = startelement + j;
11181: if (form.elements[item].type == 'radio') {
11182: if (form.elements[item].checked) {
11183: if (form.elements[item].value == 'display') {
11184: var n = form.elements[depitem].options.length;
11185: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11186: }
11187: }
11188: }
11189: }
11190: }
11191: }
11192: } else {
11193: document.getElementById('arc_depon_'+count).style.display='none';
11194: form.elements[depitem].options.length = 0;
11195: form.elements[depitem].options[0] = new Option('Select','',true,true);
11196: }
1.1059 raeburn 11197: titleCheck(form,count,offset);
1.1056 raeburn 11198: }
11199: }
11200:
11201: function propagateSelect(form,count,offset) {
11202: if (count > 0) {
1.1065 raeburn 11203: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11204: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11205: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11206: if (parents[count].length > 0) {
11207: for (var j=0; j<parents[count].length; j++) {
11208: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11209: }
11210: }
11211: }
11212: }
11213: }
1.1056 raeburn 11214:
11215: function containerSelect(form,count,offset,picked) {
11216: if (count > 0) {
1.1065 raeburn 11217: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11218: if (form.elements[item].type == 'radio') {
11219: if (form.elements[item].value == 'dependency') {
11220: if (form.elements[item+1].type == 'select-one') {
11221: for (var i=0; i<form.elements[item+1].options.length; i++) {
11222: if (form.elements[item+1].options[i].value == picked) {
11223: form.elements[item+1].selectedIndex = i;
11224: break;
11225: }
11226: }
11227: }
11228: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11229: if (parents[count].length > 0) {
11230: for (var j=0; j<parents[count].length; j++) {
11231: containerSelect(form,parents[count][j],offset,picked);
11232: }
11233: }
11234: }
11235: }
11236: }
11237: }
11238: }
11239:
1.1059 raeburn 11240: function titleCheck(form,count,offset) {
11241: if (count > 0) {
11242: var chosen = (offset+$startcount)+7*(count-1);
11243: var depitem = $startcount + ((count-1) * 7) + 2;
11244: var currtype = form.elements[depitem].type;
11245: if (form.elements[chosen].value == 'display') {
11246: document.getElementById('arc_title_'+count).style.display='block';
11247: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11248: document.getElementById('archive_title_'+count).value=maintitle;
11249: }
11250: } else {
11251: document.getElementById('arc_title_'+count).style.display='none';
11252: if (currtype == 'text') {
11253: document.getElementById('archive_title_'+count).value='';
11254: }
11255: }
11256: }
11257: return;
11258: }
11259:
1.1055 raeburn 11260: // ]]>
11261: </script>
11262: END
11263: return $scripttag;
11264: }
11265:
11266: sub process_extracted_files {
1.1067 raeburn 11267: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11268: my $numitems = $env{'form.archive_count'};
11269: return unless ($numitems);
11270: my @ids=&Apache::lonnet::current_machine_ids();
11271: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11272: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11273: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11274: if (grep(/^\Q$docuhome\E$/,@ids)) {
11275: $prefix = &LONCAPA::propath($docudom,$docuname);
11276: $pathtocheck = "$dir_root/$destination";
11277: $dir = $dir_root;
11278: $ishome = 1;
11279: } else {
11280: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11281: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11282: $dir = "$dir_root/$docudom/$docuname";
11283: }
11284: my $currdir = "$dir_root/$destination";
11285: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11286: if ($env{'form.folderpath'}) {
11287: my @items = split('&',$env{'form.folderpath'});
11288: $folders{'0'} = $items[-2];
11289: $containers{'0'}='sequence';
11290: } elsif ($env{'form.pagepath'}) {
11291: my @items = split('&',$env{'form.pagepath'});
11292: $folders{'0'} = $items[-2];
11293: $containers{'0'}='page';
11294: }
11295: my @archdirs = &get_env_multiple('form.archive_directory');
11296: if ($numitems) {
11297: for (my $i=1; $i<=$numitems; $i++) {
11298: my $path = $env{'form.archive_content_'.$i};
11299: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11300: my $item = $1;
11301: $toplevelitems{$item} = $i;
11302: if (grep(/^\Q$i\E$/,@archdirs)) {
11303: $is_dir{$item} = 1;
11304: }
11305: }
11306: }
11307: }
1.1067 raeburn 11308: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11309: if (keys(%toplevelitems) > 0) {
11310: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11311: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11312: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11313: }
1.1066 raeburn 11314: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11315: if ($numitems) {
11316: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11317: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11318: my $path = $env{'form.archive_content_'.$i};
11319: if ($path =~ /^\Q$pathtocheck\E/) {
11320: if ($env{'form.archive_'.$i} eq 'discard') {
11321: if ($prefix ne '' && $path ne '') {
11322: if (-e $prefix.$path) {
1.1066 raeburn 11323: if ((@archdirs > 0) &&
11324: (grep(/^\Q$i\E$/,@archdirs))) {
11325: $todeletedir{$prefix.$path} = 1;
11326: } else {
11327: $todelete{$prefix.$path} = 1;
11328: }
1.1055 raeburn 11329: }
11330: }
11331: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 11332: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 11333: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 11334: $docstitle = $env{'form.archive_title_'.$i};
11335: if ($docstitle eq '') {
11336: $docstitle = $title;
11337: }
1.1055 raeburn 11338: $outer = 0;
1.1056 raeburn 11339: if (ref($dirorder{$i}) eq 'ARRAY') {
11340: if (@{$dirorder{$i}} > 0) {
11341: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 11342: if ($env{'form.archive_'.$item} eq 'display') {
11343: $outer = $item;
11344: last;
11345: }
11346: }
11347: }
11348: }
11349: my ($errtext,$fatal) =
11350: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
11351: '/'.$folders{$outer}.'.'.
11352: $containers{$outer});
11353: next if ($fatal);
11354: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
11355: if ($context eq 'coursedocs') {
1.1056 raeburn 11356: $mapinner{$i} = time;
1.1055 raeburn 11357: $folders{$i} = 'default_'.$mapinner{$i};
11358: $containers{$i} = 'sequence';
11359: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11360: $folders{$i}.'.'.$containers{$i};
11361: my $newidx = &LONCAPA::map::getresidx();
11362: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11363: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11364: push(@LONCAPA::map::order,$newidx);
11365: my ($outtext,$errtext) =
11366: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11367: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 11368: '.'.$containers{$outer},1,1);
1.1056 raeburn 11369: $newseqid{$i} = $newidx;
1.1067 raeburn 11370: unless ($errtext) {
11371: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
11372: }
1.1055 raeburn 11373: }
11374: } else {
11375: if ($context eq 'coursedocs') {
11376: my $newidx=&LONCAPA::map::getresidx();
11377: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11378: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
11379: $title;
11380: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
11381: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
11382: }
11383: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11384: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
11385: }
11386: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11387: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 11388: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 11389: unless ($ishome) {
11390: my $fetch = "$newdest{$i}/$title";
11391: $fetch =~ s/^\Q$prefix$dir\E//;
11392: $prompttofetch{$fetch} = 1;
11393: }
1.1055 raeburn 11394: }
11395: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11396: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11397: push(@LONCAPA::map::order, $newidx);
11398: my ($outtext,$errtext)=
11399: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11400: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 11401: '.'.$containers{$outer},1,1);
1.1067 raeburn 11402: unless ($errtext) {
11403: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
11404: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
11405: }
11406: }
1.1055 raeburn 11407: }
11408: }
1.1086 raeburn 11409: }
11410: } else {
11411: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11412: }
11413: }
11414: for (my $i=1; $i<=$numitems; $i++) {
11415: next unless ($env{'form.archive_'.$i} eq 'dependency');
11416: my $path = $env{'form.archive_content_'.$i};
11417: if ($path =~ /^\Q$pathtocheck\E/) {
11418: my ($title) = ($path =~ m{/([^/]+)$});
11419: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
11420: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
11421: if (ref($dirorder{$i}) eq 'ARRAY') {
11422: my ($itemidx,$fullpath,$relpath);
11423: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
11424: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 11425: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 11426: if ($dirorder{$i}->[$j] eq $container) {
11427: $itemidx = $j;
1.1056 raeburn 11428: }
11429: }
1.1086 raeburn 11430: }
11431: if ($itemidx eq '') {
11432: $itemidx = 0;
11433: }
11434: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
11435: if ($mapinner{$referrer{$i}}) {
11436: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
11437: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11438: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11439: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11440: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11441: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11442: if (!-e $fullpath) {
11443: mkdir($fullpath,0755);
1.1056 raeburn 11444: }
11445: }
1.1086 raeburn 11446: } else {
11447: last;
1.1056 raeburn 11448: }
1.1086 raeburn 11449: }
11450: }
11451: } elsif ($newdest{$referrer{$i}}) {
11452: $fullpath = $newdest{$referrer{$i}};
11453: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11454: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
11455: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
11456: last;
11457: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11458: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11459: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11460: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11461: if (!-e $fullpath) {
11462: mkdir($fullpath,0755);
1.1056 raeburn 11463: }
11464: }
1.1086 raeburn 11465: } else {
11466: last;
1.1056 raeburn 11467: }
1.1055 raeburn 11468: }
11469: }
1.1086 raeburn 11470: if ($fullpath ne '') {
11471: if (-e "$prefix$path") {
11472: system("mv $prefix$path $fullpath/$title");
11473: }
11474: if (-e "$fullpath/$title") {
11475: my $showpath;
11476: if ($relpath ne '') {
11477: $showpath = "$relpath/$title";
11478: } else {
11479: $showpath = "/$title";
11480: }
11481: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
11482: }
11483: unless ($ishome) {
11484: my $fetch = "$fullpath/$title";
11485: $fetch =~ s/^\Q$prefix$dir\E//;
11486: $prompttofetch{$fetch} = 1;
11487: }
11488: }
1.1055 raeburn 11489: }
1.1086 raeburn 11490: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
11491: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
11492: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 11493: }
11494: } else {
11495: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11496: }
11497: }
11498: if (keys(%todelete)) {
11499: foreach my $key (keys(%todelete)) {
11500: unlink($key);
1.1066 raeburn 11501: }
11502: }
11503: if (keys(%todeletedir)) {
11504: foreach my $key (keys(%todeletedir)) {
11505: rmdir($key);
11506: }
11507: }
11508: foreach my $dir (sort(keys(%is_dir))) {
11509: if (($pathtocheck ne '') && ($dir ne '')) {
11510: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 11511: }
11512: }
1.1067 raeburn 11513: if ($result ne '') {
11514: $output .= '<ul>'."\n".
11515: $result."\n".
11516: '</ul>';
11517: }
11518: unless ($ishome) {
11519: my $replicationfail;
11520: foreach my $item (keys(%prompttofetch)) {
11521: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
11522: unless ($fetchresult eq 'ok') {
11523: $replicationfail .= '<li>'.$item.'</li>'."\n";
11524: }
11525: }
11526: if ($replicationfail) {
11527: $output .= '<p class="LC_error">'.
11528: &mt('Course home server failed to retrieve:').'<ul>'.
11529: $replicationfail.
11530: '</ul></p>';
11531: }
11532: }
1.1055 raeburn 11533: } else {
11534: $warning = &mt('No items found in archive.');
11535: }
11536: if ($error) {
11537: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11538: $error.'</p>'."\n";
11539: }
11540: if ($warning) {
11541: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11542: }
11543: return $output;
11544: }
11545:
1.1066 raeburn 11546: sub cleanup_empty_dirs {
11547: my ($path) = @_;
11548: if (($path ne '') && (-d $path)) {
11549: if (opendir(my $dirh,$path)) {
11550: my @dircontents = grep(!/^\./,readdir($dirh));
11551: my $numitems = 0;
11552: foreach my $item (@dircontents) {
11553: if (-d "$path/$item") {
11554: &recurse_dirs("$path/$item");
11555: if (-e "$path/$item") {
11556: $numitems ++;
11557: }
11558: } else {
11559: $numitems ++;
11560: }
11561: }
11562: if ($numitems == 0) {
11563: rmdir($path);
11564: }
11565: closedir($dirh);
11566: }
11567: }
11568: return;
11569: }
11570:
1.41 ng 11571: =pod
1.45 matthew 11572:
1.1068 raeburn 11573: =item &get_folder_hierarchy()
11574:
11575: Provides hierarchy of names of folders/sub-folders containing the current
11576: item,
11577:
11578: Inputs: 3
11579: - $navmap - navmaps object
11580:
11581: - $map - url for map (either the trigger itself, or map containing
11582: the resource, which is the trigger).
11583:
11584: - $showitem - 1 => show title for map itself; 0 => do not show.
11585:
11586: Outputs: 1 @pathitems - array of folder/subfolder names.
11587:
11588: =cut
11589:
11590: sub get_folder_hierarchy {
11591: my ($navmap,$map,$showitem) = @_;
11592: my @pathitems;
11593: if (ref($navmap)) {
11594: my $mapres = $navmap->getResourceByUrl($map);
11595: if (ref($mapres)) {
11596: my $pcslist = $mapres->map_hierarchy();
11597: if ($pcslist ne '') {
11598: my @pcs = split(/,/,$pcslist);
11599: foreach my $pc (@pcs) {
11600: if ($pc == 1) {
11601: push(@pathitems,&mt('Main Course Documents'));
11602: } else {
11603: my $res = $navmap->getByMapPc($pc);
11604: if (ref($res)) {
11605: my $title = $res->compTitle();
11606: $title =~ s/\W+/_/g;
11607: if ($title ne '') {
11608: push(@pathitems,$title);
11609: }
11610: }
11611: }
11612: }
11613: }
1.1071 raeburn 11614: if ($showitem) {
11615: if ($mapres->{ID} eq '0.0') {
11616: push(@pathitems,&mt('Main Course Documents'));
11617: } else {
11618: my $maptitle = $mapres->compTitle();
11619: $maptitle =~ s/\W+/_/g;
11620: if ($maptitle ne '') {
11621: push(@pathitems,$maptitle);
11622: }
1.1068 raeburn 11623: }
11624: }
11625: }
11626: }
11627: return @pathitems;
11628: }
11629:
11630: =pod
11631:
1.1015 raeburn 11632: =item * &get_turnedin_filepath()
11633:
11634: Determines path in a user's portfolio file for storage of files uploaded
11635: to a specific essayresponse or dropbox item.
11636:
11637: Inputs: 3 required + 1 optional.
11638: $symb is symb for resource, $uname and $udom are for current user (required).
11639: $caller is optional (can be "submission", if routine is called when storing
11640: an upoaded file when "Submit Answer" button was pressed).
11641:
11642: Returns array containing $path and $multiresp.
11643: $path is path in portfolio. $multiresp is 1 if this resource contains more
11644: than one file upload item. Callers of routine should append partid as a
11645: subdirectory to $path in cases where $multiresp is 1.
11646:
11647: Called by: homework/essayresponse.pm and homework/structuretags.pm
11648:
11649: =cut
11650:
11651: sub get_turnedin_filepath {
11652: my ($symb,$uname,$udom,$caller) = @_;
11653: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
11654: my $turnindir;
11655: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
11656: $turnindir = $userhash{'turnindir'};
11657: my ($path,$multiresp);
11658: if ($turnindir eq '') {
11659: if ($caller eq 'submission') {
11660: $turnindir = &mt('turned in');
11661: $turnindir =~ s/\W+/_/g;
11662: my %newhash = (
11663: 'turnindir' => $turnindir,
11664: );
11665: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
11666: }
11667: }
11668: if ($turnindir ne '') {
11669: $path = '/'.$turnindir.'/';
11670: my ($multipart,$turnin,@pathitems);
11671: my $navmap = Apache::lonnavmaps::navmap->new();
11672: if (defined($navmap)) {
11673: my $mapres = $navmap->getResourceByUrl($map);
11674: if (ref($mapres)) {
11675: my $pcslist = $mapres->map_hierarchy();
11676: if ($pcslist ne '') {
11677: foreach my $pc (split(/,/,$pcslist)) {
11678: my $res = $navmap->getByMapPc($pc);
11679: if (ref($res)) {
11680: my $title = $res->compTitle();
11681: $title =~ s/\W+/_/g;
11682: if ($title ne '') {
11683: push(@pathitems,$title);
11684: }
11685: }
11686: }
11687: }
11688: my $maptitle = $mapres->compTitle();
11689: $maptitle =~ s/\W+/_/g;
11690: if ($maptitle ne '') {
11691: push(@pathitems,$maptitle);
11692: }
11693: unless ($env{'request.state'} eq 'construct') {
11694: my $res = $navmap->getBySymb($symb);
11695: if (ref($res)) {
11696: my $partlist = $res->parts();
11697: my $totaluploads = 0;
11698: if (ref($partlist) eq 'ARRAY') {
11699: foreach my $part (@{$partlist}) {
11700: my @types = $res->responseType($part);
11701: my @ids = $res->responseIds($part);
11702: for (my $i=0; $i < scalar(@ids); $i++) {
11703: if ($types[$i] eq 'essay') {
11704: my $partid = $part.'_'.$ids[$i];
11705: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
11706: $totaluploads ++;
11707: }
11708: }
11709: }
11710: }
11711: if ($totaluploads > 1) {
11712: $multiresp = 1;
11713: }
11714: }
11715: }
11716: }
11717: } else {
11718: return;
11719: }
11720: } else {
11721: return;
11722: }
11723: my $restitle=&Apache::lonnet::gettitle($symb);
11724: $restitle =~ s/\W+/_/g;
11725: if ($restitle eq '') {
11726: $restitle = ($resurl =~ m{/[^/]+$});
11727: if ($restitle eq '') {
11728: $restitle = time;
11729: }
11730: }
11731: push(@pathitems,$restitle);
11732: $path .= join('/',@pathitems);
11733: }
11734: return ($path,$multiresp);
11735: }
11736:
11737: =pod
11738:
1.464 albertel 11739: =back
1.41 ng 11740:
1.112 bowersj2 11741: =head1 CSV Upload/Handling functions
1.38 albertel 11742:
1.41 ng 11743: =over 4
11744:
1.648 raeburn 11745: =item * &upfile_store($r)
1.41 ng 11746:
11747: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 11748: needs $env{'form.upfile'}
1.41 ng 11749: returns $datatoken to be put into hidden field
11750:
11751: =cut
1.31 albertel 11752:
11753: sub upfile_store {
11754: my $r=shift;
1.258 albertel 11755: $env{'form.upfile'}=~s/\r/\n/gs;
11756: $env{'form.upfile'}=~s/\f/\n/gs;
11757: $env{'form.upfile'}=~s/\n+/\n/gs;
11758: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 11759:
1.258 albertel 11760: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
11761: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 11762: {
1.158 raeburn 11763: my $datafile = $r->dir_config('lonDaemons').
11764: '/tmp/'.$datatoken.'.tmp';
11765: if ( open(my $fh,">$datafile") ) {
1.258 albertel 11766: print $fh $env{'form.upfile'};
1.158 raeburn 11767: close($fh);
11768: }
1.31 albertel 11769: }
11770: return $datatoken;
11771: }
11772:
1.56 matthew 11773: =pod
11774:
1.648 raeburn 11775: =item * &load_tmp_file($r)
1.41 ng 11776:
11777: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 11778: needs $env{'form.datatoken'},
11779: sets $env{'form.upfile'} to the contents of the file
1.41 ng 11780:
11781: =cut
1.31 albertel 11782:
11783: sub load_tmp_file {
11784: my $r=shift;
11785: my @studentdata=();
11786: {
1.158 raeburn 11787: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 11788: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 11789: if ( open(my $fh,"<$studentfile") ) {
11790: @studentdata=<$fh>;
11791: close($fh);
11792: }
1.31 albertel 11793: }
1.258 albertel 11794: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 11795: }
11796:
1.56 matthew 11797: =pod
11798:
1.648 raeburn 11799: =item * &upfile_record_sep()
1.41 ng 11800:
11801: Separate uploaded file into records
11802: returns array of records,
1.258 albertel 11803: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 11804:
11805: =cut
1.31 albertel 11806:
11807: sub upfile_record_sep {
1.258 albertel 11808: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 11809: } else {
1.248 albertel 11810: my @records;
1.258 albertel 11811: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 11812: if ($line=~/^\s*$/) { next; }
11813: push(@records,$line);
11814: }
11815: return @records;
1.31 albertel 11816: }
11817: }
11818:
1.56 matthew 11819: =pod
11820:
1.648 raeburn 11821: =item * &record_sep($record)
1.41 ng 11822:
1.258 albertel 11823: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 11824:
11825: =cut
11826:
1.263 www 11827: sub takeleft {
11828: my $index=shift;
11829: return substr('0000'.$index,-4,4);
11830: }
11831:
1.31 albertel 11832: sub record_sep {
11833: my $record=shift;
11834: my %components=();
1.258 albertel 11835: if ($env{'form.upfiletype'} eq 'xml') {
11836: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 11837: my $i=0;
1.356 albertel 11838: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 11839: $field=~s/^(\"|\')//;
11840: $field=~s/(\"|\')$//;
1.263 www 11841: $components{&takeleft($i)}=$field;
1.31 albertel 11842: $i++;
11843: }
1.258 albertel 11844: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 11845: my $i=0;
1.356 albertel 11846: foreach my $field (split(/\t/,$record)) {
1.31 albertel 11847: $field=~s/^(\"|\')//;
11848: $field=~s/(\"|\')$//;
1.263 www 11849: $components{&takeleft($i)}=$field;
1.31 albertel 11850: $i++;
11851: }
11852: } else {
1.561 www 11853: my $separator=',';
1.480 banghart 11854: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 11855: $separator=';';
1.480 banghart 11856: }
1.31 albertel 11857: my $i=0;
1.561 www 11858: # the character we are looking for to indicate the end of a quote or a record
11859: my $looking_for=$separator;
11860: # do not add the characters to the fields
11861: my $ignore=0;
11862: # we just encountered a separator (or the beginning of the record)
11863: my $just_found_separator=1;
11864: # store the field we are working on here
11865: my $field='';
11866: # work our way through all characters in record
11867: foreach my $character ($record=~/(.)/g) {
11868: if ($character eq $looking_for) {
11869: if ($character ne $separator) {
11870: # Found the end of a quote, again looking for separator
11871: $looking_for=$separator;
11872: $ignore=1;
11873: } else {
11874: # Found a separator, store away what we got
11875: $components{&takeleft($i)}=$field;
11876: $i++;
11877: $just_found_separator=1;
11878: $ignore=0;
11879: $field='';
11880: }
11881: next;
11882: }
11883: # single or double quotation marks after a separator indicate beginning of a quote
11884: # we are now looking for the end of the quote and need to ignore separators
11885: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
11886: $looking_for=$character;
11887: next;
11888: }
11889: # ignore would be true after we reached the end of a quote
11890: if ($ignore) { next; }
11891: if (($just_found_separator) && ($character=~/\s/)) { next; }
11892: $field.=$character;
11893: $just_found_separator=0;
1.31 albertel 11894: }
1.561 www 11895: # catch the very last entry, since we never encountered the separator
11896: $components{&takeleft($i)}=$field;
1.31 albertel 11897: }
11898: return %components;
11899: }
11900:
1.144 matthew 11901: ######################################################
11902: ######################################################
11903:
1.56 matthew 11904: =pod
11905:
1.648 raeburn 11906: =item * &upfile_select_html()
1.41 ng 11907:
1.144 matthew 11908: Return HTML code to select a file from the users machine and specify
11909: the file type.
1.41 ng 11910:
11911: =cut
11912:
1.144 matthew 11913: ######################################################
11914: ######################################################
1.31 albertel 11915: sub upfile_select_html {
1.144 matthew 11916: my %Types = (
11917: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 11918: semisv => &mt('Semicolon separated values'),
1.144 matthew 11919: space => &mt('Space separated'),
11920: tab => &mt('Tabulator separated'),
11921: # xml => &mt('HTML/XML'),
11922: );
11923: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 11924: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 11925: foreach my $type (sort(keys(%Types))) {
11926: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
11927: }
11928: $Str .= "</select>\n";
11929: return $Str;
1.31 albertel 11930: }
11931:
1.301 albertel 11932: sub get_samples {
11933: my ($records,$toget) = @_;
11934: my @samples=({});
11935: my $got=0;
11936: foreach my $rec (@$records) {
11937: my %temp = &record_sep($rec);
11938: if (! grep(/\S/, values(%temp))) { next; }
11939: if (%temp) {
11940: $samples[$got]=\%temp;
11941: $got++;
11942: if ($got == $toget) { last; }
11943: }
11944: }
11945: return \@samples;
11946: }
11947:
1.144 matthew 11948: ######################################################
11949: ######################################################
11950:
1.56 matthew 11951: =pod
11952:
1.648 raeburn 11953: =item * &csv_print_samples($r,$records)
1.41 ng 11954:
11955: Prints a table of sample values from each column uploaded $r is an
11956: Apache Request ref, $records is an arrayref from
11957: &Apache::loncommon::upfile_record_sep
11958:
11959: =cut
11960:
1.144 matthew 11961: ######################################################
11962: ######################################################
1.31 albertel 11963: sub csv_print_samples {
11964: my ($r,$records) = @_;
1.662 bisitz 11965: my $samples = &get_samples($records,5);
1.301 albertel 11966:
1.594 raeburn 11967: $r->print(&mt('Samples').'<br />'.&start_data_table().
11968: &start_data_table_header_row());
1.356 albertel 11969: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 11970: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 11971: $r->print(&end_data_table_header_row());
1.301 albertel 11972: foreach my $hash (@$samples) {
1.594 raeburn 11973: $r->print(&start_data_table_row());
1.356 albertel 11974: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 11975: $r->print('<td>');
1.356 albertel 11976: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 11977: $r->print('</td>');
11978: }
1.594 raeburn 11979: $r->print(&end_data_table_row());
1.31 albertel 11980: }
1.594 raeburn 11981: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 11982: }
11983:
1.144 matthew 11984: ######################################################
11985: ######################################################
11986:
1.56 matthew 11987: =pod
11988:
1.648 raeburn 11989: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 11990:
11991: Prints a table to create associations between values and table columns.
1.144 matthew 11992:
1.41 ng 11993: $r is an Apache Request ref,
11994: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 11995: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 11996:
11997: =cut
11998:
1.144 matthew 11999: ######################################################
12000: ######################################################
1.31 albertel 12001: sub csv_print_select_table {
12002: my ($r,$records,$d) = @_;
1.301 albertel 12003: my $i=0;
12004: my $samples = &get_samples($records,1);
1.144 matthew 12005: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12006: &start_data_table().&start_data_table_header_row().
1.144 matthew 12007: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12008: '<th>'.&mt('Column').'</th>'.
12009: &end_data_table_header_row()."\n");
1.356 albertel 12010: foreach my $array_ref (@$d) {
12011: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12012: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12013:
1.875 bisitz 12014: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12015: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12016: $r->print('<option value="none"></option>');
1.356 albertel 12017: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12018: $r->print('<option value="'.$sample.'"'.
12019: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12020: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12021: }
1.594 raeburn 12022: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12023: $i++;
12024: }
1.594 raeburn 12025: $r->print(&end_data_table());
1.31 albertel 12026: $i--;
12027: return $i;
12028: }
1.56 matthew 12029:
1.144 matthew 12030: ######################################################
12031: ######################################################
12032:
1.56 matthew 12033: =pod
1.31 albertel 12034:
1.648 raeburn 12035: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12036:
12037: Prints a table of sample values from the upload and can make associate samples to internal names.
12038:
12039: $r is an Apache Request ref,
12040: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12041: $d is an array of 2 element arrays (internal name, displayed name)
12042:
12043: =cut
12044:
1.144 matthew 12045: ######################################################
12046: ######################################################
1.31 albertel 12047: sub csv_samples_select_table {
12048: my ($r,$records,$d) = @_;
12049: my $i=0;
1.144 matthew 12050: #
1.662 bisitz 12051: my $max_samples = 5;
12052: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12053: $r->print(&start_data_table().
12054: &start_data_table_header_row().'<th>'.
12055: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12056: &end_data_table_header_row());
1.301 albertel 12057:
12058: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12059: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12060: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12061: foreach my $option (@$d) {
12062: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12063: $r->print('<option value="'.$value.'"'.
1.253 albertel 12064: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12065: $display.'</option>');
1.31 albertel 12066: }
12067: $r->print('</select></td><td>');
1.662 bisitz 12068: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12069: if (defined($samples->[$line]{$key})) {
12070: $r->print($samples->[$line]{$key}."<br />\n");
12071: }
12072: }
1.594 raeburn 12073: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12074: $i++;
12075: }
1.594 raeburn 12076: $r->print(&end_data_table());
1.31 albertel 12077: $i--;
12078: return($i);
1.115 matthew 12079: }
12080:
1.144 matthew 12081: ######################################################
12082: ######################################################
12083:
1.115 matthew 12084: =pod
12085:
1.648 raeburn 12086: =item * &clean_excel_name($name)
1.115 matthew 12087:
12088: Returns a replacement for $name which does not contain any illegal characters.
12089:
12090: =cut
12091:
1.144 matthew 12092: ######################################################
12093: ######################################################
1.115 matthew 12094: sub clean_excel_name {
12095: my ($name) = @_;
12096: $name =~ s/[:\*\?\/\\]//g;
12097: if (length($name) > 31) {
12098: $name = substr($name,0,31);
12099: }
12100: return $name;
1.25 albertel 12101: }
1.84 albertel 12102:
1.85 albertel 12103: =pod
12104:
1.648 raeburn 12105: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12106:
12107: Returns either 1 or undef
12108:
12109: 1 if the part is to be hidden, undef if it is to be shown
12110:
12111: Arguments are:
12112:
12113: $id the id of the part to be checked
12114: $symb, optional the symb of the resource to check
12115: $udom, optional the domain of the user to check for
12116: $uname, optional the username of the user to check for
12117:
12118: =cut
1.84 albertel 12119:
12120: sub check_if_partid_hidden {
12121: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12122: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12123: $symb,$udom,$uname);
1.141 albertel 12124: my $truth=1;
12125: #if the string starts with !, then the list is the list to show not hide
12126: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12127: my @hiddenlist=split(/,/,$hiddenparts);
12128: foreach my $checkid (@hiddenlist) {
1.141 albertel 12129: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12130: }
1.141 albertel 12131: return !$truth;
1.84 albertel 12132: }
1.127 matthew 12133:
1.138 matthew 12134:
12135: ############################################################
12136: ############################################################
12137:
12138: =pod
12139:
1.157 matthew 12140: =back
12141:
1.138 matthew 12142: =head1 cgi-bin script and graphing routines
12143:
1.157 matthew 12144: =over 4
12145:
1.648 raeburn 12146: =item * &get_cgi_id()
1.138 matthew 12147:
12148: Inputs: none
12149:
12150: Returns an id which can be used to pass environment variables
12151: to various cgi-bin scripts. These environment variables will
12152: be removed from the users environment after a given time by
12153: the routine &Apache::lonnet::transfer_profile_to_env.
12154:
12155: =cut
12156:
12157: ############################################################
12158: ############################################################
1.152 albertel 12159: my $uniq=0;
1.136 matthew 12160: sub get_cgi_id {
1.154 albertel 12161: $uniq=($uniq+1)%100000;
1.280 albertel 12162: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12163: }
12164:
1.127 matthew 12165: ############################################################
12166: ############################################################
12167:
12168: =pod
12169:
1.648 raeburn 12170: =item * &DrawBarGraph()
1.127 matthew 12171:
1.138 matthew 12172: Facilitates the plotting of data in a (stacked) bar graph.
12173: Puts plot definition data into the users environment in order for
12174: graph.png to plot it. Returns an <img> tag for the plot.
12175: The bars on the plot are labeled '1','2',...,'n'.
12176:
12177: Inputs:
12178:
12179: =over 4
12180:
12181: =item $Title: string, the title of the plot
12182:
12183: =item $xlabel: string, text describing the X-axis of the plot
12184:
12185: =item $ylabel: string, text describing the Y-axis of the plot
12186:
12187: =item $Max: scalar, the maximum Y value to use in the plot
12188: If $Max is < any data point, the graph will not be rendered.
12189:
1.140 matthew 12190: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12191: they are plotted. If undefined, default values will be used.
12192:
1.178 matthew 12193: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12194:
1.138 matthew 12195: =item @Values: An array of array references. Each array reference holds data
12196: to be plotted in a stacked bar chart.
12197:
1.239 matthew 12198: =item If the final element of @Values is a hash reference the key/value
12199: pairs will be added to the graph definition.
12200:
1.138 matthew 12201: =back
12202:
12203: Returns:
12204:
12205: An <img> tag which references graph.png and the appropriate identifying
12206: information for the plot.
12207:
1.127 matthew 12208: =cut
12209:
12210: ############################################################
12211: ############################################################
1.134 matthew 12212: sub DrawBarGraph {
1.178 matthew 12213: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12214: #
12215: if (! defined($colors)) {
12216: $colors = ['#33ff00',
12217: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12218: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12219: ];
12220: }
1.228 matthew 12221: my $extra_settings = {};
12222: if (ref($Values[-1]) eq 'HASH') {
12223: $extra_settings = pop(@Values);
12224: }
1.127 matthew 12225: #
1.136 matthew 12226: my $identifier = &get_cgi_id();
12227: my $id = 'cgi.'.$identifier;
1.129 matthew 12228: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12229: return '';
12230: }
1.225 matthew 12231: #
12232: my @Labels;
12233: if (defined($labels)) {
12234: @Labels = @$labels;
12235: } else {
12236: for (my $i=0;$i<@{$Values[0]};$i++) {
12237: push (@Labels,$i+1);
12238: }
12239: }
12240: #
1.129 matthew 12241: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12242: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12243: my %ValuesHash;
12244: my $NumSets=1;
12245: foreach my $array (@Values) {
12246: next if (! ref($array));
1.136 matthew 12247: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12248: join(',',@$array);
1.129 matthew 12249: }
1.127 matthew 12250: #
1.136 matthew 12251: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12252: if ($NumBars < 3) {
12253: $width = 120+$NumBars*32;
1.220 matthew 12254: $xskip = 1;
1.225 matthew 12255: $bar_width = 30;
12256: } elsif ($NumBars < 5) {
12257: $width = 120+$NumBars*20;
12258: $xskip = 1;
12259: $bar_width = 20;
1.220 matthew 12260: } elsif ($NumBars < 10) {
1.136 matthew 12261: $width = 120+$NumBars*15;
12262: $xskip = 1;
12263: $bar_width = 15;
12264: } elsif ($NumBars <= 25) {
12265: $width = 120+$NumBars*11;
12266: $xskip = 5;
12267: $bar_width = 8;
12268: } elsif ($NumBars <= 50) {
12269: $width = 120+$NumBars*8;
12270: $xskip = 5;
12271: $bar_width = 4;
12272: } else {
12273: $width = 120+$NumBars*8;
12274: $xskip = 5;
12275: $bar_width = 4;
12276: }
12277: #
1.137 matthew 12278: $Max = 1 if ($Max < 1);
12279: if ( int($Max) < $Max ) {
12280: $Max++;
12281: $Max = int($Max);
12282: }
1.127 matthew 12283: $Title = '' if (! defined($Title));
12284: $xlabel = '' if (! defined($xlabel));
12285: $ylabel = '' if (! defined($ylabel));
1.369 www 12286: $ValuesHash{$id.'.title'} = &escape($Title);
12287: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12288: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12289: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12290: $ValuesHash{$id.'.NumBars'} = $NumBars;
12291: $ValuesHash{$id.'.NumSets'} = $NumSets;
12292: $ValuesHash{$id.'.PlotType'} = 'bar';
12293: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12294: $ValuesHash{$id.'.height'} = $height;
12295: $ValuesHash{$id.'.width'} = $width;
12296: $ValuesHash{$id.'.xskip'} = $xskip;
12297: $ValuesHash{$id.'.bar_width'} = $bar_width;
12298: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12299: #
1.228 matthew 12300: # Deal with other parameters
12301: while (my ($key,$value) = each(%$extra_settings)) {
12302: $ValuesHash{$id.'.'.$key} = $value;
12303: }
12304: #
1.646 raeburn 12305: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12306: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12307: }
12308:
12309: ############################################################
12310: ############################################################
12311:
12312: =pod
12313:
1.648 raeburn 12314: =item * &DrawXYGraph()
1.137 matthew 12315:
1.138 matthew 12316: Facilitates the plotting of data in an XY graph.
12317: Puts plot definition data into the users environment in order for
12318: graph.png to plot it. Returns an <img> tag for the plot.
12319:
12320: Inputs:
12321:
12322: =over 4
12323:
12324: =item $Title: string, the title of the plot
12325:
12326: =item $xlabel: string, text describing the X-axis of the plot
12327:
12328: =item $ylabel: string, text describing the Y-axis of the plot
12329:
12330: =item $Max: scalar, the maximum Y value to use in the plot
12331: If $Max is < any data point, the graph will not be rendered.
12332:
12333: =item $colors: Array ref containing the hex color codes for the data to be
12334: plotted in. If undefined, default values will be used.
12335:
12336: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12337:
12338: =item $Ydata: Array ref containing Array refs.
1.185 www 12339: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 12340:
12341: =item %Values: hash indicating or overriding any default values which are
12342: passed to graph.png.
12343: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12344:
12345: =back
12346:
12347: Returns:
12348:
12349: An <img> tag which references graph.png and the appropriate identifying
12350: information for the plot.
12351:
1.137 matthew 12352: =cut
12353:
12354: ############################################################
12355: ############################################################
12356: sub DrawXYGraph {
12357: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
12358: #
12359: # Create the identifier for the graph
12360: my $identifier = &get_cgi_id();
12361: my $id = 'cgi.'.$identifier;
12362: #
12363: $Title = '' if (! defined($Title));
12364: $xlabel = '' if (! defined($xlabel));
12365: $ylabel = '' if (! defined($ylabel));
12366: my %ValuesHash =
12367: (
1.369 www 12368: $id.'.title' => &escape($Title),
12369: $id.'.xlabel' => &escape($xlabel),
12370: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 12371: $id.'.y_max_value'=> $Max,
12372: $id.'.labels' => join(',',@$Xlabels),
12373: $id.'.PlotType' => 'XY',
12374: );
12375: #
12376: if (defined($colors) && ref($colors) eq 'ARRAY') {
12377: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12378: }
12379: #
12380: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
12381: return '';
12382: }
12383: my $NumSets=1;
1.138 matthew 12384: foreach my $array (@{$Ydata}){
1.137 matthew 12385: next if (! ref($array));
12386: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
12387: }
1.138 matthew 12388: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 12389: #
12390: # Deal with other parameters
12391: while (my ($key,$value) = each(%Values)) {
12392: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 12393: }
12394: #
1.646 raeburn 12395: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 12396: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12397: }
12398:
12399: ############################################################
12400: ############################################################
12401:
12402: =pod
12403:
1.648 raeburn 12404: =item * &DrawXYYGraph()
1.138 matthew 12405:
12406: Facilitates the plotting of data in an XY graph with two Y axes.
12407: Puts plot definition data into the users environment in order for
12408: graph.png to plot it. Returns an <img> tag for the plot.
12409:
12410: Inputs:
12411:
12412: =over 4
12413:
12414: =item $Title: string, the title of the plot
12415:
12416: =item $xlabel: string, text describing the X-axis of the plot
12417:
12418: =item $ylabel: string, text describing the Y-axis of the plot
12419:
12420: =item $colors: Array ref containing the hex color codes for the data to be
12421: plotted in. If undefined, default values will be used.
12422:
12423: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12424:
12425: =item $Ydata1: The first data set
12426:
12427: =item $Min1: The minimum value of the left Y-axis
12428:
12429: =item $Max1: The maximum value of the left Y-axis
12430:
12431: =item $Ydata2: The second data set
12432:
12433: =item $Min2: The minimum value of the right Y-axis
12434:
12435: =item $Max2: The maximum value of the left Y-axis
12436:
12437: =item %Values: hash indicating or overriding any default values which are
12438: passed to graph.png.
12439: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12440:
12441: =back
12442:
12443: Returns:
12444:
12445: An <img> tag which references graph.png and the appropriate identifying
12446: information for the plot.
1.136 matthew 12447:
12448: =cut
12449:
12450: ############################################################
12451: ############################################################
1.137 matthew 12452: sub DrawXYYGraph {
12453: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
12454: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 12455: #
12456: # Create the identifier for the graph
12457: my $identifier = &get_cgi_id();
12458: my $id = 'cgi.'.$identifier;
12459: #
12460: $Title = '' if (! defined($Title));
12461: $xlabel = '' if (! defined($xlabel));
12462: $ylabel = '' if (! defined($ylabel));
12463: my %ValuesHash =
12464: (
1.369 www 12465: $id.'.title' => &escape($Title),
12466: $id.'.xlabel' => &escape($xlabel),
12467: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 12468: $id.'.labels' => join(',',@$Xlabels),
12469: $id.'.PlotType' => 'XY',
12470: $id.'.NumSets' => 2,
1.137 matthew 12471: $id.'.two_axes' => 1,
12472: $id.'.y1_max_value' => $Max1,
12473: $id.'.y1_min_value' => $Min1,
12474: $id.'.y2_max_value' => $Max2,
12475: $id.'.y2_min_value' => $Min2,
1.136 matthew 12476: );
12477: #
1.137 matthew 12478: if (defined($colors) && ref($colors) eq 'ARRAY') {
12479: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12480: }
12481: #
12482: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
12483: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 12484: return '';
12485: }
12486: my $NumSets=1;
1.137 matthew 12487: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 12488: next if (! ref($array));
12489: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 12490: }
12491: #
12492: # Deal with other parameters
12493: while (my ($key,$value) = each(%Values)) {
12494: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 12495: }
12496: #
1.646 raeburn 12497: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 12498: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 12499: }
12500:
12501: ############################################################
12502: ############################################################
12503:
12504: =pod
12505:
1.157 matthew 12506: =back
12507:
1.139 matthew 12508: =head1 Statistics helper routines?
12509:
12510: Bad place for them but what the hell.
12511:
1.157 matthew 12512: =over 4
12513:
1.648 raeburn 12514: =item * &chartlink()
1.139 matthew 12515:
12516: Returns a link to the chart for a specific student.
12517:
12518: Inputs:
12519:
12520: =over 4
12521:
12522: =item $linktext: The text of the link
12523:
12524: =item $sname: The students username
12525:
12526: =item $sdomain: The students domain
12527:
12528: =back
12529:
1.157 matthew 12530: =back
12531:
1.139 matthew 12532: =cut
12533:
12534: ############################################################
12535: ############################################################
12536: sub chartlink {
12537: my ($linktext, $sname, $sdomain) = @_;
12538: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 12539: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 12540: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 12541: '">'.$linktext.'</a>';
1.153 matthew 12542: }
12543:
12544: #######################################################
12545: #######################################################
12546:
12547: =pod
12548:
12549: =head1 Course Environment Routines
1.157 matthew 12550:
12551: =over 4
1.153 matthew 12552:
1.648 raeburn 12553: =item * &restore_course_settings()
1.153 matthew 12554:
1.648 raeburn 12555: =item * &store_course_settings()
1.153 matthew 12556:
12557: Restores/Store indicated form parameters from the course environment.
12558: Will not overwrite existing values of the form parameters.
12559:
12560: Inputs:
12561: a scalar describing the data (e.g. 'chart', 'problem_analysis')
12562:
12563: a hash ref describing the data to be stored. For example:
12564:
12565: %Save_Parameters = ('Status' => 'scalar',
12566: 'chartoutputmode' => 'scalar',
12567: 'chartoutputdata' => 'scalar',
12568: 'Section' => 'array',
1.373 raeburn 12569: 'Group' => 'array',
1.153 matthew 12570: 'StudentData' => 'array',
12571: 'Maps' => 'array');
12572:
12573: Returns: both routines return nothing
12574:
1.631 raeburn 12575: =back
12576:
1.153 matthew 12577: =cut
12578:
12579: #######################################################
12580: #######################################################
12581: sub store_course_settings {
1.496 albertel 12582: return &store_settings($env{'request.course.id'},@_);
12583: }
12584:
12585: sub store_settings {
1.153 matthew 12586: # save to the environment
12587: # appenv the same items, just to be safe
1.300 albertel 12588: my $udom = $env{'user.domain'};
12589: my $uname = $env{'user.name'};
1.496 albertel 12590: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12591: my %SaveHash;
12592: my %AppHash;
12593: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 12594: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 12595: my $envname = 'environment.'.$basename;
1.258 albertel 12596: if (exists($env{'form.'.$setting})) {
1.153 matthew 12597: # Save this value away
12598: if ($type eq 'scalar' &&
1.258 albertel 12599: (! exists($env{$envname}) ||
12600: $env{$envname} ne $env{'form.'.$setting})) {
12601: $SaveHash{$basename} = $env{'form.'.$setting};
12602: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 12603: } elsif ($type eq 'array') {
12604: my $stored_form;
1.258 albertel 12605: if (ref($env{'form.'.$setting})) {
1.153 matthew 12606: $stored_form = join(',',
12607: map {
1.369 www 12608: &escape($_);
1.258 albertel 12609: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 12610: } else {
12611: $stored_form =
1.369 www 12612: &escape($env{'form.'.$setting});
1.153 matthew 12613: }
12614: # Determine if the array contents are the same.
1.258 albertel 12615: if ($stored_form ne $env{$envname}) {
1.153 matthew 12616: $SaveHash{$basename} = $stored_form;
12617: $AppHash{$envname} = $stored_form;
12618: }
12619: }
12620: }
12621: }
12622: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 12623: $udom,$uname);
1.153 matthew 12624: if ($put_result !~ /^(ok|delayed)/) {
12625: &Apache::lonnet::logthis('unable to save form parameters, '.
12626: 'got error:'.$put_result);
12627: }
12628: # Make sure these settings stick around in this session, too
1.646 raeburn 12629: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 12630: return;
12631: }
12632:
12633: sub restore_course_settings {
1.499 albertel 12634: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 12635: }
12636:
12637: sub restore_settings {
12638: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12639: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 12640: next if (exists($env{'form.'.$setting}));
1.496 albertel 12641: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 12642: '.'.$setting;
1.258 albertel 12643: if (exists($env{$envname})) {
1.153 matthew 12644: if ($type eq 'scalar') {
1.258 albertel 12645: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 12646: } elsif ($type eq 'array') {
1.258 albertel 12647: $env{'form.'.$setting} = [
1.153 matthew 12648: map {
1.369 www 12649: &unescape($_);
1.258 albertel 12650: } split(',',$env{$envname})
1.153 matthew 12651: ];
12652: }
12653: }
12654: }
1.127 matthew 12655: }
12656:
1.618 raeburn 12657: #######################################################
12658: #######################################################
12659:
12660: =pod
12661:
12662: =head1 Domain E-mail Routines
12663:
12664: =over 4
12665:
1.648 raeburn 12666: =item * &build_recipient_list()
1.618 raeburn 12667:
1.884 raeburn 12668: Build recipient lists for five types of e-mail:
1.766 raeburn 12669: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884 raeburn 12670: (d) Help requests, (e) Course requests needing approval, generated by
12671: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
12672: loncoursequeueadmin.pm respectively.
1.618 raeburn 12673:
12674: Inputs:
1.619 raeburn 12675: defmail (scalar - email address of default recipient),
1.618 raeburn 12676: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 12677: defdom (domain for which to retrieve configuration settings),
12678: origmail (scalar - email address of recipient from loncapa.conf,
12679: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 12680:
1.655 raeburn 12681: Returns: comma separated list of addresses to which to send e-mail.
12682:
12683: =back
1.618 raeburn 12684:
12685: =cut
12686:
12687: ############################################################
12688: ############################################################
12689: sub build_recipient_list {
1.619 raeburn 12690: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 12691: my @recipients;
12692: my $otheremails;
12693: my %domconfig =
12694: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
12695: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 12696: if (exists($domconfig{'contacts'}{$mailing})) {
12697: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
12698: my @contacts = ('adminemail','supportemail');
12699: foreach my $item (@contacts) {
12700: if ($domconfig{'contacts'}{$mailing}{$item}) {
12701: my $addr = $domconfig{'contacts'}{$item};
12702: if (!grep(/^\Q$addr\E$/,@recipients)) {
12703: push(@recipients,$addr);
12704: }
1.619 raeburn 12705: }
1.766 raeburn 12706: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 12707: }
12708: }
1.766 raeburn 12709: } elsif ($origmail ne '') {
12710: push(@recipients,$origmail);
1.618 raeburn 12711: }
1.619 raeburn 12712: } elsif ($origmail ne '') {
12713: push(@recipients,$origmail);
1.618 raeburn 12714: }
1.688 raeburn 12715: if (defined($defmail)) {
12716: if ($defmail ne '') {
12717: push(@recipients,$defmail);
12718: }
1.618 raeburn 12719: }
12720: if ($otheremails) {
1.619 raeburn 12721: my @others;
12722: if ($otheremails =~ /,/) {
12723: @others = split(/,/,$otheremails);
1.618 raeburn 12724: } else {
1.619 raeburn 12725: push(@others,$otheremails);
12726: }
12727: foreach my $addr (@others) {
12728: if (!grep(/^\Q$addr\E$/,@recipients)) {
12729: push(@recipients,$addr);
12730: }
1.618 raeburn 12731: }
12732: }
1.619 raeburn 12733: my $recipientlist = join(',',@recipients);
1.618 raeburn 12734: return $recipientlist;
12735: }
12736:
1.127 matthew 12737: ############################################################
12738: ############################################################
1.154 albertel 12739:
1.655 raeburn 12740: =pod
12741:
12742: =head1 Course Catalog Routines
12743:
12744: =over 4
12745:
12746: =item * &gather_categories()
12747:
12748: Converts category definitions - keys of categories hash stored in
12749: coursecategories in configuration.db on the primary library server in a
12750: domain - to an array. Also generates javascript and idx hash used to
12751: generate Domain Coordinator interface for editing Course Categories.
12752:
12753: Inputs:
1.663 raeburn 12754:
1.655 raeburn 12755: categories (reference to hash of category definitions).
1.663 raeburn 12756:
1.655 raeburn 12757: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12758: categories and subcategories).
1.663 raeburn 12759:
1.655 raeburn 12760: idx (reference to hash of counters used in Domain Coordinator interface for
12761: editing Course Categories).
1.663 raeburn 12762:
1.655 raeburn 12763: jsarray (reference to array of categories used to create Javascript arrays for
12764: Domain Coordinator interface for editing Course Categories).
12765:
12766: Returns: nothing
12767:
12768: Side effects: populates cats, idx and jsarray.
12769:
12770: =cut
12771:
12772: sub gather_categories {
12773: my ($categories,$cats,$idx,$jsarray) = @_;
12774: my %counters;
12775: my $num = 0;
12776: foreach my $item (keys(%{$categories})) {
12777: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
12778: if ($container eq '' && $depth == 0) {
12779: $cats->[$depth][$categories->{$item}] = $cat;
12780: } else {
12781: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
12782: }
12783: my ($escitem,$tail) = split(/:/,$item,2);
12784: if ($counters{$tail} eq '') {
12785: $counters{$tail} = $num;
12786: $num ++;
12787: }
12788: if (ref($idx) eq 'HASH') {
12789: $idx->{$item} = $counters{$tail};
12790: }
12791: if (ref($jsarray) eq 'ARRAY') {
12792: push(@{$jsarray->[$counters{$tail}]},$item);
12793: }
12794: }
12795: return;
12796: }
12797:
12798: =pod
12799:
12800: =item * &extract_categories()
12801:
12802: Used to generate breadcrumb trails for course categories.
12803:
12804: Inputs:
1.663 raeburn 12805:
1.655 raeburn 12806: categories (reference to hash of category definitions).
1.663 raeburn 12807:
1.655 raeburn 12808: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12809: categories and subcategories).
1.663 raeburn 12810:
1.655 raeburn 12811: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 12812:
1.655 raeburn 12813: allitems (reference to hash - key is category key
12814: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12815:
1.655 raeburn 12816: idx (reference to hash of counters used in Domain Coordinator interface for
12817: editing Course Categories).
1.663 raeburn 12818:
1.655 raeburn 12819: jsarray (reference to array of categories used to create Javascript arrays for
12820: Domain Coordinator interface for editing Course Categories).
12821:
1.665 raeburn 12822: subcats (reference to hash of arrays containing all subcategories within each
12823: category, -recursive)
12824:
1.655 raeburn 12825: Returns: nothing
12826:
12827: Side effects: populates trails and allitems hash references.
12828:
12829: =cut
12830:
12831: sub extract_categories {
1.665 raeburn 12832: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 12833: if (ref($categories) eq 'HASH') {
12834: &gather_categories($categories,$cats,$idx,$jsarray);
12835: if (ref($cats->[0]) eq 'ARRAY') {
12836: for (my $i=0; $i<@{$cats->[0]}; $i++) {
12837: my $name = $cats->[0][$i];
12838: my $item = &escape($name).'::0';
12839: my $trailstr;
12840: if ($name eq 'instcode') {
12841: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 12842: } elsif ($name eq 'communities') {
12843: $trailstr = &mt('Communities');
1.655 raeburn 12844: } else {
12845: $trailstr = $name;
12846: }
12847: if ($allitems->{$item} eq '') {
12848: push(@{$trails},$trailstr);
12849: $allitems->{$item} = scalar(@{$trails})-1;
12850: }
12851: my @parents = ($name);
12852: if (ref($cats->[1]{$name}) eq 'ARRAY') {
12853: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
12854: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 12855: if (ref($subcats) eq 'HASH') {
12856: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
12857: }
12858: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
12859: }
12860: } else {
12861: if (ref($subcats) eq 'HASH') {
12862: $subcats->{$item} = [];
1.655 raeburn 12863: }
12864: }
12865: }
12866: }
12867: }
12868: return;
12869: }
12870:
12871: =pod
12872:
12873: =item *&recurse_categories()
12874:
12875: Recursively used to generate breadcrumb trails for course categories.
12876:
12877: Inputs:
1.663 raeburn 12878:
1.655 raeburn 12879: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12880: categories and subcategories).
1.663 raeburn 12881:
1.655 raeburn 12882: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 12883:
12884: category (current course category, for which breadcrumb trail is being generated).
12885:
12886: trails (reference to array of breadcrumb trails for each category).
12887:
1.655 raeburn 12888: allitems (reference to hash - key is category key
12889: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12890:
1.655 raeburn 12891: parents (array containing containers directories for current category,
12892: back to top level).
12893:
12894: Returns: nothing
12895:
12896: Side effects: populates trails and allitems hash references
12897:
12898: =cut
12899:
12900: sub recurse_categories {
1.665 raeburn 12901: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 12902: my $shallower = $depth - 1;
12903: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
12904: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
12905: my $name = $cats->[$depth]{$category}[$k];
12906: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
12907: my $trailstr = join(' -> ',(@{$parents},$category));
12908: if ($allitems->{$item} eq '') {
12909: push(@{$trails},$trailstr);
12910: $allitems->{$item} = scalar(@{$trails})-1;
12911: }
12912: my $deeper = $depth+1;
12913: push(@{$parents},$category);
1.665 raeburn 12914: if (ref($subcats) eq 'HASH') {
12915: my $subcat = &escape($name).':'.$category.':'.$depth;
12916: for (my $j=@{$parents}; $j>=0; $j--) {
12917: my $higher;
12918: if ($j > 0) {
12919: $higher = &escape($parents->[$j]).':'.
12920: &escape($parents->[$j-1]).':'.$j;
12921: } else {
12922: $higher = &escape($parents->[$j]).'::'.$j;
12923: }
12924: push(@{$subcats->{$higher}},$subcat);
12925: }
12926: }
12927: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
12928: $subcats);
1.655 raeburn 12929: pop(@{$parents});
12930: }
12931: } else {
12932: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
12933: my $trailstr = join(' -> ',(@{$parents},$category));
12934: if ($allitems->{$item} eq '') {
12935: push(@{$trails},$trailstr);
12936: $allitems->{$item} = scalar(@{$trails})-1;
12937: }
12938: }
12939: return;
12940: }
12941:
1.663 raeburn 12942: =pod
12943:
12944: =item *&assign_categories_table()
12945:
12946: Create a datatable for display of hierarchical categories in a domain,
12947: with checkboxes to allow a course to be categorized.
12948:
12949: Inputs:
12950:
12951: cathash - reference to hash of categories defined for the domain (from
12952: configuration.db)
12953:
12954: currcat - scalar with an & separated list of categories assigned to a course.
12955:
1.919 raeburn 12956: type - scalar contains course type (Course or Community).
12957:
1.663 raeburn 12958: Returns: $output (markup to be displayed)
12959:
12960: =cut
12961:
12962: sub assign_categories_table {
1.919 raeburn 12963: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 12964: my $output;
12965: if (ref($cathash) eq 'HASH') {
12966: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
12967: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
12968: $maxdepth = scalar(@cats);
12969: if (@cats > 0) {
12970: my $itemcount = 0;
12971: if (ref($cats[0]) eq 'ARRAY') {
12972: my @currcategories;
12973: if ($currcat ne '') {
12974: @currcategories = split('&',$currcat);
12975: }
1.919 raeburn 12976: my $table;
1.663 raeburn 12977: for (my $i=0; $i<@{$cats[0]}; $i++) {
12978: my $parent = $cats[0][$i];
1.919 raeburn 12979: next if ($parent eq 'instcode');
12980: if ($type eq 'Community') {
12981: next unless ($parent eq 'communities');
12982: } else {
12983: next if ($parent eq 'communities');
12984: }
1.663 raeburn 12985: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
12986: my $item = &escape($parent).'::0';
12987: my $checked = '';
12988: if (@currcategories > 0) {
12989: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 12990: $checked = ' checked="checked"';
1.663 raeburn 12991: }
12992: }
1.919 raeburn 12993: my $parent_title = $parent;
12994: if ($parent eq 'communities') {
12995: $parent_title = &mt('Communities');
12996: }
12997: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
12998: '<input type="checkbox" name="usecategory" value="'.
12999: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13000: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13001: my $depth = 1;
13002: push(@path,$parent);
1.919 raeburn 13003: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13004: pop(@path);
1.919 raeburn 13005: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13006: $itemcount ++;
13007: }
1.919 raeburn 13008: if ($itemcount) {
13009: $output = &Apache::loncommon::start_data_table().
13010: $table.
13011: &Apache::loncommon::end_data_table();
13012: }
1.663 raeburn 13013: }
13014: }
13015: }
13016: return $output;
13017: }
13018:
13019: =pod
13020:
13021: =item *&assign_category_rows()
13022:
13023: Create a datatable row for display of nested categories in a domain,
13024: with checkboxes to allow a course to be categorized,called recursively.
13025:
13026: Inputs:
13027:
13028: itemcount - track row number for alternating colors
13029:
13030: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13031: categories and subcategories.
13032:
13033: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13034:
13035: parent - parent of current category item
13036:
13037: path - Array containing all categories back up through the hierarchy from the
13038: current category to the top level.
13039:
13040: currcategories - reference to array of current categories assigned to the course
13041:
13042: Returns: $output (markup to be displayed).
13043:
13044: =cut
13045:
13046: sub assign_category_rows {
13047: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13048: my ($text,$name,$item,$chgstr);
13049: if (ref($cats) eq 'ARRAY') {
13050: my $maxdepth = scalar(@{$cats});
13051: if (ref($cats->[$depth]) eq 'HASH') {
13052: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13053: my $numchildren = @{$cats->[$depth]{$parent}};
13054: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13055: $text .= '<td><table class="LC_datatable">';
13056: for (my $j=0; $j<$numchildren; $j++) {
13057: $name = $cats->[$depth]{$parent}[$j];
13058: $item = &escape($name).':'.&escape($parent).':'.$depth;
13059: my $deeper = $depth+1;
13060: my $checked = '';
13061: if (ref($currcategories) eq 'ARRAY') {
13062: if (@{$currcategories} > 0) {
13063: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13064: $checked = ' checked="checked"';
1.663 raeburn 13065: }
13066: }
13067: }
1.664 raeburn 13068: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13069: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13070: $item.'"'.$checked.' />'.$name.'</label></span>'.
13071: '<input type="hidden" name="catname" value="'.$name.'" />'.
13072: '</td><td>';
1.663 raeburn 13073: if (ref($path) eq 'ARRAY') {
13074: push(@{$path},$name);
13075: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13076: pop(@{$path});
13077: }
13078: $text .= '</td></tr>';
13079: }
13080: $text .= '</table></td>';
13081: }
13082: }
13083: }
13084: return $text;
13085: }
13086:
1.655 raeburn 13087: ############################################################
13088: ############################################################
13089:
13090:
1.443 albertel 13091: sub commit_customrole {
1.664 raeburn 13092: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13093: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13094: ($start?', '.&mt('starting').' '.localtime($start):'').
13095: ($end?', ending '.localtime($end):'').': <b>'.
13096: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13097: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13098: '</b><br />';
13099: return $output;
13100: }
13101:
13102: sub commit_standardrole {
1.541 raeburn 13103: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
13104: my ($output,$logmsg,$linefeed);
13105: if ($context eq 'auto') {
13106: $linefeed = "\n";
13107: } else {
13108: $linefeed = "<br />\n";
13109: }
1.443 albertel 13110: if ($three eq 'st') {
1.541 raeburn 13111: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
13112: $one,$two,$sec,$context);
13113: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13114: ($result eq 'unknown_course') || ($result eq 'refused')) {
13115: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13116: } else {
1.541 raeburn 13117: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13118: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13119: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13120: if ($context eq 'auto') {
13121: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13122: } else {
13123: $output .= '<b>'.$result.'</b>'.$linefeed.
13124: &mt('Add to classlist').': <b>ok</b>';
13125: }
13126: $output .= $linefeed;
1.443 albertel 13127: }
13128: } else {
13129: $output = &mt('Assigning').' '.$three.' in '.$url.
13130: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13131: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13132: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13133: if ($context eq 'auto') {
13134: $output .= $result.$linefeed;
13135: } else {
13136: $output .= '<b>'.$result.'</b>'.$linefeed;
13137: }
1.443 albertel 13138: }
13139: return $output;
13140: }
13141:
13142: sub commit_studentrole {
1.541 raeburn 13143: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 13144: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13145: if ($context eq 'auto') {
13146: $linefeed = "\n";
13147: } else {
13148: $linefeed = '<br />'."\n";
13149: }
1.443 albertel 13150: if (defined($one) && defined($two)) {
13151: my $cid=$one.'_'.$two;
13152: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13153: my $secchange = 0;
13154: my $expire_role_result;
13155: my $modify_section_result;
1.628 raeburn 13156: if ($oldsec ne '-1') {
13157: if ($oldsec ne $sec) {
1.443 albertel 13158: $secchange = 1;
1.628 raeburn 13159: my $now = time;
1.443 albertel 13160: my $uurl='/'.$cid;
13161: $uurl=~s/\_/\//g;
13162: if ($oldsec) {
13163: $uurl.='/'.$oldsec;
13164: }
1.626 raeburn 13165: $oldsecurl = $uurl;
1.628 raeburn 13166: $expire_role_result =
1.652 raeburn 13167: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13168: if ($env{'request.course.sec'} ne '') {
13169: if ($expire_role_result eq 'refused') {
13170: my @roles = ('st');
13171: my @statuses = ('previous');
13172: my @roledoms = ($one);
13173: my $withsec = 1;
13174: my %roleshash =
13175: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13176: \@statuses,\@roles,\@roledoms,$withsec);
13177: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13178: my ($oldstart,$oldend) =
13179: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13180: if ($oldend > 0 && $oldend <= $now) {
13181: $expire_role_result = 'ok';
13182: }
13183: }
13184: }
13185: }
1.443 albertel 13186: $result = $expire_role_result;
13187: }
13188: }
13189: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 13190: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 13191: if ($modify_section_result =~ /^ok/) {
13192: if ($secchange == 1) {
1.628 raeburn 13193: if ($sec eq '') {
13194: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13195: } else {
13196: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13197: }
1.443 albertel 13198: } elsif ($oldsec eq '-1') {
1.628 raeburn 13199: if ($sec eq '') {
13200: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13201: } else {
13202: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13203: }
1.443 albertel 13204: } else {
1.628 raeburn 13205: if ($sec eq '') {
13206: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13207: } else {
13208: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13209: }
1.443 albertel 13210: }
13211: } else {
1.628 raeburn 13212: if ($secchange) {
13213: $$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;
13214: } else {
13215: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13216: }
1.443 albertel 13217: }
13218: $result = $modify_section_result;
13219: } elsif ($secchange == 1) {
1.628 raeburn 13220: if ($oldsec eq '') {
13221: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
13222: } else {
13223: $$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;
13224: }
1.626 raeburn 13225: if ($expire_role_result eq 'refused') {
13226: my $newsecurl = '/'.$cid;
13227: $newsecurl =~ s/\_/\//g;
13228: if ($sec ne '') {
13229: $newsecurl.='/'.$sec;
13230: }
13231: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13232: if ($sec eq '') {
13233: $$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;
13234: } else {
13235: $$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;
13236: }
13237: }
13238: }
1.443 albertel 13239: }
13240: } else {
1.626 raeburn 13241: $$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 13242: $result = "error: incomplete course id\n";
13243: }
13244: return $result;
13245: }
13246:
13247: ############################################################
13248: ############################################################
13249:
1.566 albertel 13250: sub check_clone {
1.578 raeburn 13251: my ($args,$linefeed) = @_;
1.566 albertel 13252: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13253: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13254: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13255: my $clonemsg;
13256: my $can_clone = 0;
1.944 raeburn 13257: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13258: if ($lctype ne 'community') {
13259: $lctype = 'course';
13260: }
1.566 albertel 13261: if ($clonehome eq 'no_host') {
1.944 raeburn 13262: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13263: $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'});
13264: } else {
13265: $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'});
13266: }
1.566 albertel 13267: } else {
13268: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13269: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13270: if ($clonedesc{'type'} ne 'Community') {
13271: $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'});
13272: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13273: }
13274: }
1.882 raeburn 13275: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13276: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13277: $can_clone = 1;
13278: } else {
13279: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13280: $args->{'clonedomain'},$args->{'clonecourse'});
13281: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 13282: if (grep(/^\*$/,@cloners)) {
13283: $can_clone = 1;
13284: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
13285: $can_clone = 1;
13286: } else {
1.908 raeburn 13287: my $ccrole = 'cc';
1.944 raeburn 13288: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13289: $ccrole = 'co';
13290: }
1.578 raeburn 13291: my %roleshash =
13292: &Apache::lonnet::get_my_roles($args->{'ccuname'},
13293: $args->{'ccdomain'},
1.908 raeburn 13294: 'userroles',['active'],[$ccrole],
1.578 raeburn 13295: [$args->{'clonedomain'}]);
1.908 raeburn 13296: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 13297: $can_clone = 1;
13298: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
13299: $can_clone = 1;
13300: } else {
1.944 raeburn 13301: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13302: $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'});
13303: } else {
13304: $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'});
13305: }
1.578 raeburn 13306: }
1.566 albertel 13307: }
1.578 raeburn 13308: }
1.566 albertel 13309: }
13310: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13311: }
13312:
1.444 albertel 13313: sub construct_course {
1.885 raeburn 13314: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 13315: my $outcome;
1.541 raeburn 13316: my $linefeed = '<br />'."\n";
13317: if ($context eq 'auto') {
13318: $linefeed = "\n";
13319: }
1.566 albertel 13320:
13321: #
13322: # Are we cloning?
13323: #
13324: my ($can_clone, $clonemsg, $cloneid, $clonehome);
13325: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 13326: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 13327: if ($context ne 'auto') {
1.578 raeburn 13328: if ($clonemsg ne '') {
13329: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
13330: }
1.566 albertel 13331: }
13332: $outcome .= $clonemsg.$linefeed;
13333:
13334: if (!$can_clone) {
13335: return (0,$outcome);
13336: }
13337: }
13338:
1.444 albertel 13339: #
13340: # Open course
13341: #
13342: my $crstype = lc($args->{'crstype'});
13343: my %cenv=();
13344: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
13345: $args->{'cdescr'},
13346: $args->{'curl'},
13347: $args->{'course_home'},
13348: $args->{'nonstandard'},
13349: $args->{'crscode'},
13350: $args->{'ccuname'}.':'.
13351: $args->{'ccdomain'},
1.882 raeburn 13352: $args->{'crstype'},
1.885 raeburn 13353: $cnum,$context,$category);
1.444 albertel 13354:
13355: # Note: The testing routines depend on this being output; see
13356: # Utils::Course. This needs to at least be output as a comment
13357: # if anyone ever decides to not show this, and Utils::Course::new
13358: # will need to be suitably modified.
1.541 raeburn 13359: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 13360: if ($$courseid =~ /^error:/) {
13361: return (0,$outcome);
13362: }
13363:
1.444 albertel 13364: #
13365: # Check if created correctly
13366: #
1.479 albertel 13367: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 13368: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 13369: if ($crsuhome eq 'no_host') {
13370: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
13371: return (0,$outcome);
13372: }
1.541 raeburn 13373: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 13374:
1.444 albertel 13375: #
1.566 albertel 13376: # Do the cloning
13377: #
13378: if ($can_clone && $cloneid) {
13379: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
13380: if ($context ne 'auto') {
13381: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
13382: }
13383: $outcome .= $clonemsg.$linefeed;
13384: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 13385: # Copy all files
1.637 www 13386: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 13387: # Restore URL
1.566 albertel 13388: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 13389: # Restore title
1.566 albertel 13390: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 13391: # Restore creation date, creator and creation context.
13392: $cenv{'internal.created'}=$oldcenv{'internal.created'};
13393: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
13394: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 13395: # Mark as cloned
1.566 albertel 13396: $cenv{'clonedfrom'}=$cloneid;
1.638 www 13397: # Need to clone grading mode
13398: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
13399: $cenv{'grading'}=$newenv{'grading'};
13400: # Do not clone these environment entries
13401: &Apache::lonnet::del('environment',
13402: ['default_enrollment_start_date',
13403: 'default_enrollment_end_date',
13404: 'question.email',
13405: 'policy.email',
13406: 'comment.email',
13407: 'pch.users.denied',
1.725 raeburn 13408: 'plc.users.denied',
13409: 'hidefromcat',
13410: 'categories'],
1.638 www 13411: $$crsudom,$$crsunum);
1.444 albertel 13412: }
1.566 albertel 13413:
1.444 albertel 13414: #
13415: # Set environment (will override cloned, if existing)
13416: #
13417: my @sections = ();
13418: my @xlists = ();
13419: if ($args->{'crstype'}) {
13420: $cenv{'type'}=$args->{'crstype'};
13421: }
13422: if ($args->{'crsid'}) {
13423: $cenv{'courseid'}=$args->{'crsid'};
13424: }
13425: if ($args->{'crscode'}) {
13426: $cenv{'internal.coursecode'}=$args->{'crscode'};
13427: }
13428: if ($args->{'crsquota'} ne '') {
13429: $cenv{'internal.coursequota'}=$args->{'crsquota'};
13430: } else {
13431: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
13432: }
13433: if ($args->{'ccuname'}) {
13434: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
13435: ':'.$args->{'ccdomain'};
13436: } else {
13437: $cenv{'internal.courseowner'} = $args->{'curruser'};
13438: }
13439: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
13440: if ($args->{'crssections'}) {
13441: $cenv{'internal.sectionnums'} = '';
13442: if ($args->{'crssections'} =~ m/,/) {
13443: @sections = split/,/,$args->{'crssections'};
13444: } else {
13445: $sections[0] = $args->{'crssections'};
13446: }
13447: if (@sections > 0) {
13448: foreach my $item (@sections) {
13449: my ($sec,$gp) = split/:/,$item;
13450: my $class = $args->{'crscode'}.$sec;
13451: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
13452: $cenv{'internal.sectionnums'} .= $item.',';
13453: unless ($addcheck eq 'ok') {
13454: push @badclasses, $class;
13455: }
13456: }
13457: $cenv{'internal.sectionnums'} =~ s/,$//;
13458: }
13459: }
13460: # do not hide course coordinator from staff listing,
13461: # even if privileged
13462: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13463: # add crosslistings
13464: if ($args->{'crsxlist'}) {
13465: $cenv{'internal.crosslistings'}='';
13466: if ($args->{'crsxlist'} =~ m/,/) {
13467: @xlists = split/,/,$args->{'crsxlist'};
13468: } else {
13469: $xlists[0] = $args->{'crsxlist'};
13470: }
13471: if (@xlists > 0) {
13472: foreach my $item (@xlists) {
13473: my ($xl,$gp) = split/:/,$item;
13474: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
13475: $cenv{'internal.crosslistings'} .= $item.',';
13476: unless ($addcheck eq 'ok') {
13477: push @badclasses, $xl;
13478: }
13479: }
13480: $cenv{'internal.crosslistings'} =~ s/,$//;
13481: }
13482: }
13483: if ($args->{'autoadds'}) {
13484: $cenv{'internal.autoadds'}=$args->{'autoadds'};
13485: }
13486: if ($args->{'autodrops'}) {
13487: $cenv{'internal.autodrops'}=$args->{'autodrops'};
13488: }
13489: # check for notification of enrollment changes
13490: my @notified = ();
13491: if ($args->{'notify_owner'}) {
13492: if ($args->{'ccuname'} ne '') {
13493: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
13494: }
13495: }
13496: if ($args->{'notify_dc'}) {
13497: if ($uname ne '') {
1.630 raeburn 13498: push(@notified,$uname.':'.$udom);
1.444 albertel 13499: }
13500: }
13501: if (@notified > 0) {
13502: my $notifylist;
13503: if (@notified > 1) {
13504: $notifylist = join(',',@notified);
13505: } else {
13506: $notifylist = $notified[0];
13507: }
13508: $cenv{'internal.notifylist'} = $notifylist;
13509: }
13510: if (@badclasses > 0) {
13511: my %lt=&Apache::lonlocal::texthash(
13512: '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',
13513: 'dnhr' => 'does not have rights to access enrollment in these classes',
13514: 'adby' => 'as determined by the policies of your institution on access to official classlists'
13515: );
1.541 raeburn 13516: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
13517: ' ('.$lt{'adby'}.')';
13518: if ($context eq 'auto') {
13519: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 13520: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 13521: foreach my $item (@badclasses) {
13522: if ($context eq 'auto') {
13523: $outcome .= " - $item\n";
13524: } else {
13525: $outcome .= "<li>$item</li>\n";
13526: }
13527: }
13528: if ($context eq 'auto') {
13529: $outcome .= $linefeed;
13530: } else {
1.566 albertel 13531: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 13532: }
13533: }
1.444 albertel 13534: }
13535: if ($args->{'no_end_date'}) {
13536: $args->{'endaccess'} = 0;
13537: }
13538: $cenv{'internal.autostart'}=$args->{'enrollstart'};
13539: $cenv{'internal.autoend'}=$args->{'enrollend'};
13540: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
13541: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
13542: if ($args->{'showphotos'}) {
13543: $cenv{'internal.showphotos'}=$args->{'showphotos'};
13544: }
13545: $cenv{'internal.authtype'} = $args->{'authtype'};
13546: $cenv{'internal.autharg'} = $args->{'autharg'};
13547: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
13548: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 13549: 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');
13550: if ($context eq 'auto') {
13551: $outcome .= $krb_msg;
13552: } else {
1.566 albertel 13553: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 13554: }
13555: $outcome .= $linefeed;
1.444 albertel 13556: }
13557: }
13558: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
13559: if ($args->{'setpolicy'}) {
13560: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13561: }
13562: if ($args->{'setcontent'}) {
13563: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13564: }
13565: }
13566: if ($args->{'reshome'}) {
13567: $cenv{'reshome'}=$args->{'reshome'}.'/';
13568: $cenv{'reshome'}=~s/\/+$/\//;
13569: }
13570: #
13571: # course has keyed access
13572: #
13573: if ($args->{'setkeys'}) {
13574: $cenv{'keyaccess'}='yes';
13575: }
13576: # if specified, key authority is not course, but user
13577: # only active if keyaccess is yes
13578: if ($args->{'keyauth'}) {
1.487 albertel 13579: my ($user,$domain) = split(':',$args->{'keyauth'});
13580: $user = &LONCAPA::clean_username($user);
13581: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 13582: if ($user ne '' && $domain ne '') {
1.487 albertel 13583: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 13584: }
13585: }
13586:
13587: if ($args->{'disresdis'}) {
13588: $cenv{'pch.roles.denied'}='st';
13589: }
13590: if ($args->{'disablechat'}) {
13591: $cenv{'plc.roles.denied'}='st';
13592: }
13593:
13594: # Record we've not yet viewed the Course Initialization Helper for this
13595: # course
13596: $cenv{'course.helper.not.run'} = 1;
13597: #
13598: # Use new Randomseed
13599: #
13600: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
13601: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
13602: #
13603: # The encryption code and receipt prefix for this course
13604: #
13605: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
13606: $cenv{'internal.encpref'}=100+int(9*rand(99));
13607: #
13608: # By default, use standard grading
13609: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
13610:
1.541 raeburn 13611: $outcome .= $linefeed.&mt('Setting environment').': '.
13612: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13613: #
13614: # Open all assignments
13615: #
13616: if ($args->{'openall'}) {
13617: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
13618: my %storecontent = ($storeunder => time,
13619: $storeunder.'.type' => 'date_start');
13620:
13621: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 13622: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13623: }
13624: #
13625: # Set first page
13626: #
13627: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
13628: || ($cloneid)) {
1.445 albertel 13629: use LONCAPA::map;
1.444 albertel 13630: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 13631:
13632: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
13633: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
13634:
1.444 albertel 13635: $outcome .= ($fatal?$errtext:'read ok').' - ';
13636: my $title; my $url;
13637: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 13638: $title=&mt('Syllabus');
1.444 albertel 13639: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
13640: } else {
1.963 raeburn 13641: $title=&mt('Table of Contents');
1.444 albertel 13642: $url='/adm/navmaps';
13643: }
1.445 albertel 13644:
13645: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
13646: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
13647:
13648: if ($errtext) { $fatal=2; }
1.541 raeburn 13649: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 13650: }
1.566 albertel 13651:
13652: return (1,$outcome);
1.444 albertel 13653: }
13654:
13655: ############################################################
13656: ############################################################
13657:
1.953 droeschl 13658: #SD
13659: # only Community and Course, or anything else?
1.378 raeburn 13660: sub course_type {
13661: my ($cid) = @_;
13662: if (!defined($cid)) {
13663: $cid = $env{'request.course.id'};
13664: }
1.404 albertel 13665: if (defined($env{'course.'.$cid.'.type'})) {
13666: return $env{'course.'.$cid.'.type'};
1.378 raeburn 13667: } else {
13668: return 'Course';
1.377 raeburn 13669: }
13670: }
1.156 albertel 13671:
1.406 raeburn 13672: sub group_term {
13673: my $crstype = &course_type();
13674: my %names = (
13675: 'Course' => 'group',
1.865 raeburn 13676: 'Community' => 'group',
1.406 raeburn 13677: );
13678: return $names{$crstype};
13679: }
13680:
1.902 raeburn 13681: sub course_types {
13682: my @types = ('official','unofficial','community');
13683: my %typename = (
13684: official => 'Official course',
13685: unofficial => 'Unofficial course',
13686: community => 'Community',
13687: );
13688: return (\@types,\%typename);
13689: }
13690:
1.156 albertel 13691: sub icon {
13692: my ($file)=@_;
1.505 albertel 13693: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 13694: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 13695: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 13696: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
13697: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
13698: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13699: $curfext.".gif") {
13700: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13701: $curfext.".gif";
13702: }
13703: }
1.249 albertel 13704: return &lonhttpdurl($iconname);
1.154 albertel 13705: }
1.84 albertel 13706:
1.575 albertel 13707: sub lonhttpdurl {
1.692 www 13708: #
13709: # Had been used for "small fry" static images on separate port 8080.
13710: # Modify here if lightweight http functionality desired again.
13711: # Currently eliminated due to increasing firewall issues.
13712: #
1.575 albertel 13713: my ($url)=@_;
1.692 www 13714: return $url;
1.215 albertel 13715: }
13716:
1.213 albertel 13717: sub connection_aborted {
13718: my ($r)=@_;
13719: $r->print(" ");$r->rflush();
13720: my $c = $r->connection;
13721: return $c->aborted();
13722: }
13723:
1.221 foxr 13724: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 13725: # strings as 'strings'.
13726: sub escape_single {
1.221 foxr 13727: my ($input) = @_;
1.223 albertel 13728: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 13729: $input =~ s/\'/\\\'/g; # Esacpe the 's....
13730: return $input;
13731: }
1.223 albertel 13732:
1.222 foxr 13733: # Same as escape_single, but escape's "'s This
13734: # can be used for "strings"
13735: sub escape_double {
13736: my ($input) = @_;
13737: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
13738: $input =~ s/\"/\\\"/g; # Esacpe the "s....
13739: return $input;
13740: }
1.223 albertel 13741:
1.222 foxr 13742: # Escapes the last element of a full URL.
13743: sub escape_url {
13744: my ($url) = @_;
1.238 raeburn 13745: my @urlslices = split(/\//, $url,-1);
1.369 www 13746: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 13747: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 13748: }
1.462 albertel 13749:
1.820 raeburn 13750: sub compare_arrays {
13751: my ($arrayref1,$arrayref2) = @_;
13752: my (@difference,%count);
13753: @difference = ();
13754: %count = ();
13755: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
13756: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
13757: foreach my $element (keys(%count)) {
13758: if ($count{$element} == 1) {
13759: push(@difference,$element);
13760: }
13761: }
13762: }
13763: return @difference;
13764: }
13765:
1.817 bisitz 13766: # -------------------------------------------------------- Initialize user login
1.462 albertel 13767: sub init_user_environment {
1.463 albertel 13768: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 13769: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
13770:
13771: my $public=($username eq 'public' && $domain eq 'public');
13772:
13773: # See if old ID present, if so, remove
13774:
1.1062 raeburn 13775: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 13776: my $now=time;
13777:
13778: if ($public) {
13779: my $max_public=100;
13780: my $oldest;
13781: my $oldest_time=0;
13782: for(my $next=1;$next<=$max_public;$next++) {
13783: if (-e $lonids."/publicuser_$next.id") {
13784: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
13785: if ($mtime<$oldest_time || !$oldest_time) {
13786: $oldest_time=$mtime;
13787: $oldest=$next;
13788: }
13789: } else {
13790: $cookie="publicuser_$next";
13791: last;
13792: }
13793: }
13794: if (!$cookie) { $cookie="publicuser_$oldest"; }
13795: } else {
1.463 albertel 13796: # if this isn't a robot, kill any existing non-robot sessions
13797: if (!$args->{'robot'}) {
13798: opendir(DIR,$lonids);
13799: while ($filename=readdir(DIR)) {
13800: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
13801: unlink($lonids.'/'.$filename);
13802: }
1.462 albertel 13803: }
1.463 albertel 13804: closedir(DIR);
1.462 albertel 13805: }
13806: # Give them a new cookie
1.463 albertel 13807: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 13808: : $now.$$.int(rand(10000)));
1.463 albertel 13809: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 13810:
13811: # Initialize roles
13812:
1.1062 raeburn 13813: ($userroles,$firstaccenv,$timerintenv) =
13814: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 13815: }
13816: # ------------------------------------ Check browser type and MathML capability
13817:
13818: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
13819: $clientunicode,$clientos) = &decode_user_agent($r);
13820:
13821: # ------------------------------------------------------------- Get environment
13822:
13823: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
13824: my ($tmp) = keys(%userenv);
13825: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
13826: } else {
13827: undef(%userenv);
13828: }
13829: if (($userenv{'interface'}) && (!$form->{'interface'})) {
13830: $form->{'interface'}=$userenv{'interface'};
13831: }
13832: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
13833:
13834: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 13835: foreach my $option ('interface','localpath','localres') {
13836: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 13837: }
13838: # --------------------------------------------------------- Write first profile
13839:
13840: {
13841: my %initial_env =
13842: ("user.name" => $username,
13843: "user.domain" => $domain,
13844: "user.home" => $authhost,
13845: "browser.type" => $clientbrowser,
13846: "browser.version" => $clientversion,
13847: "browser.mathml" => $clientmathml,
13848: "browser.unicode" => $clientunicode,
13849: "browser.os" => $clientos,
13850: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
13851: "request.course.fn" => '',
13852: "request.course.uri" => '',
13853: "request.course.sec" => '',
13854: "request.role" => 'cm',
13855: "request.role.adv" => $env{'user.adv'},
13856: "request.host" => $ENV{'REMOTE_ADDR'},);
13857:
13858: if ($form->{'localpath'}) {
13859: $initial_env{"browser.localpath"} = $form->{'localpath'};
13860: $initial_env{"browser.localres"} = $form->{'localres'};
13861: }
13862:
13863: if ($form->{'interface'}) {
13864: $form->{'interface'}=~s/\W//gs;
13865: $initial_env{"browser.interface"} = $form->{'interface'};
13866: $env{'browser.interface'}=$form->{'interface'};
13867: }
13868:
1.981 raeburn 13869: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 13870: my %domdef;
13871: unless ($domain eq 'public') {
13872: %domdef = &Apache::lonnet::get_domain_defaults($domain);
13873: }
1.980 raeburn 13874:
1.1081 raeburn 13875: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 13876: $userenv{'availabletools.'.$tool} =
1.980 raeburn 13877: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
13878: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 13879: }
13880:
1.864 raeburn 13881: foreach my $crstype ('official','unofficial','community') {
1.765 raeburn 13882: $userenv{'canrequest.'.$crstype} =
13883: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 13884: 'reload','requestcourses',
13885: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 13886: }
13887:
1.462 albertel 13888: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 13889:
1.462 albertel 13890: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
13891: &GDBM_WRCREAT(),0640)) {
13892: &_add_to_env(\%disk_env,\%initial_env);
13893: &_add_to_env(\%disk_env,\%userenv,'environment.');
13894: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 13895: if (ref($firstaccenv) eq 'HASH') {
13896: &_add_to_env(\%disk_env,$firstaccenv);
13897: }
13898: if (ref($timerintenv) eq 'HASH') {
13899: &_add_to_env(\%disk_env,$timerintenv);
13900: }
1.463 albertel 13901: if (ref($args->{'extra_env'})) {
13902: &_add_to_env(\%disk_env,$args->{'extra_env'});
13903: }
1.462 albertel 13904: untie(%disk_env);
13905: } else {
1.705 tempelho 13906: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
13907: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 13908: return 'error: '.$!;
13909: }
13910: }
13911: $env{'request.role'}='cm';
13912: $env{'request.role.adv'}=$env{'user.adv'};
13913: $env{'browser.type'}=$clientbrowser;
13914:
13915: return $cookie;
13916:
13917: }
13918:
13919: sub _add_to_env {
13920: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 13921: if (ref($env_data) eq 'HASH') {
13922: while (my ($key,$value) = each(%$env_data)) {
13923: $idf->{$prefix.$key} = $value;
13924: $env{$prefix.$key} = $value;
13925: }
1.462 albertel 13926: }
13927: }
13928:
1.685 tempelho 13929: # --- Get the symbolic name of a problem and the url
13930: sub get_symb {
13931: my ($request,$silent) = @_;
1.726 raeburn 13932: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 13933: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
13934: if ($symb eq '') {
13935: if (!$silent) {
1.1071 raeburn 13936: if (ref($request)) {
13937: $request->print("Unable to handle ambiguous references:$url:.");
13938: }
1.685 tempelho 13939: return ();
13940: }
13941: }
13942: &Apache::lonenc::check_decrypt(\$symb);
13943: return ($symb);
13944: }
13945:
13946: # --------------------------------------------------------------Get annotation
13947:
13948: sub get_annotation {
13949: my ($symb,$enc) = @_;
13950:
13951: my $key = $symb;
13952: if (!$enc) {
13953: $key =
13954: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
13955: }
13956: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
13957: return $annotation{$key};
13958: }
13959:
13960: sub clean_symb {
1.731 raeburn 13961: my ($symb,$delete_enc) = @_;
1.685 tempelho 13962:
13963: &Apache::lonenc::check_decrypt(\$symb);
13964: my $enc = $env{'request.enc'};
1.731 raeburn 13965: if ($delete_enc) {
1.730 raeburn 13966: delete($env{'request.enc'});
13967: }
1.685 tempelho 13968:
13969: return ($symb,$enc);
13970: }
1.462 albertel 13971:
1.990 raeburn 13972: sub build_release_hashes {
13973: my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
13974: return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
13975: (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
13976: (ref($randomizetry) eq 'HASH'));
13977: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
13978: my ($item,$name,$value) = split(/:/,$key);
13979: if ($item eq 'parameter') {
13980: if (ref($checkparms->{$name}) eq 'ARRAY') {
13981: unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
13982: push(@{$checkparms->{$name}},$value);
13983: }
13984: } else {
13985: push(@{$checkparms->{$name}},$value);
13986: }
13987: } elsif ($item eq 'resourcetag') {
13988: if ($name eq 'responsetype') {
13989: $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
13990: }
13991: } elsif ($item eq 'course') {
13992: if ($name eq 'crstype') {
13993: $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
13994: }
13995: }
13996: }
13997: ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
13998: ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
13999: return;
14000: }
14001:
1.1083 raeburn 14002: sub update_content_constraints {
14003: my ($cdom,$cnum,$chome,$cid) = @_;
14004: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
14005: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
14006: my %checkresponsetypes;
14007: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14008: my ($item,$name,$value) = split(/:/,$key);
14009: if ($item eq 'resourcetag') {
14010: if ($name eq 'responsetype') {
14011: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
14012: }
14013: }
14014: }
14015: my $navmap = Apache::lonnavmaps::navmap->new();
14016: if (defined($navmap)) {
14017: my %allresponses;
14018: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
14019: my %responses = $res->responseTypes();
14020: foreach my $key (keys(%responses)) {
14021: next unless(exists($checkresponsetypes{$key}));
14022: $allresponses{$key} += $responses{$key};
14023: }
14024: }
14025: foreach my $key (keys(%allresponses)) {
14026: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
14027: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
14028: ($reqdmajor,$reqdminor) = ($major,$minor);
14029: }
14030: }
14031: undef($navmap);
14032: }
14033: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
14034: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
14035: }
14036: return;
14037: }
14038:
14039: sub parse_supplemental_title {
14040: my ($title) = @_;
14041:
14042: my ($foldertitle,$renametitle);
14043: if ($title =~ /&&&/) {
14044: $title = &HTML::Entites::decode($title);
14045: }
14046: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
14047: $renametitle=$4;
14048: my ($time,$uname,$udom) = ($1,$2,$3);
14049: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
14050: my $name = &plainname($uname,$udom);
14051: $name = &HTML::Entities::encode($name,'"<>&\'');
14052: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
14053: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
14054: $name.': <br />'.$foldertitle;
14055: }
14056: if (wantarray) {
14057: return ($title,$foldertitle,$renametitle);
14058: }
14059: return $title;
14060: }
14061:
1.41 ng 14062: =pod
14063:
14064: =back
14065:
1.112 bowersj2 14066: =cut
1.41 ng 14067:
1.112 bowersj2 14068: 1;
14069: __END__;
1.41 ng 14070:
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