Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.68
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1075.2.68! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.67 2014/02/22 00:02:13 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1075.2.25 raeburn 70: use Apache::lonuserutils();
1.1075.2.27 raeburn 71: use Apache::lonuserstate();
1.479 albertel 72: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 73: use DateTime::TimeZone;
1.687 raeburn 74: use DateTime::Locale::Catalog;
1.1075.2.14 raeburn 75: use Authen::Captcha;
76: use Captcha::reCAPTCHA;
1.1075.2.64 raeburn 77: use Crypt::DES;
78: use DynaLoader; # for Crypt::DES version
1.117 www 79:
1.517 raeburn 80: # ---------------------------------------------- Designs
81: use vars qw(%defaultdesign);
82:
1.22 www 83: my $readit;
84:
1.517 raeburn 85:
1.157 matthew 86: ##
87: ## Global Variables
88: ##
1.46 matthew 89:
1.643 foxr 90:
91: # ----------------------------------------------- SSI with retries:
92: #
93:
94: =pod
95:
1.648 raeburn 96: =head1 Server Side include with retries:
1.643 foxr 97:
98: =over 4
99:
1.648 raeburn 100: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 101:
102: Performs an ssi with some number of retries. Retries continue either
103: until the result is ok or until the retry count supplied by the
104: caller is exhausted.
105:
106: Inputs:
1.648 raeburn 107:
108: =over 4
109:
1.643 foxr 110: resource - Identifies the resource to insert.
1.648 raeburn 111:
1.643 foxr 112: retries - Count of the number of retries allowed.
1.648 raeburn 113:
1.643 foxr 114: form - Hash that identifies the rendering options.
115:
1.648 raeburn 116: =back
117:
118: Returns:
119:
120: =over 4
121:
1.643 foxr 122: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 123:
1.643 foxr 124: response - The response from the last attempt (which may or may not have been successful.
125:
1.648 raeburn 126: =back
127:
128: =back
129:
1.643 foxr 130: =cut
131:
132: sub ssi_with_retries {
133: my ($resource, $retries, %form) = @_;
134:
135:
136: my $ok = 0; # True if we got a good response.
137: my $content;
138: my $response;
139:
140: # Try to get the ssi done. within the retries count:
141:
142: do {
143: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
144: $ok = $response->is_success;
1.650 www 145: if (!$ok) {
146: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
147: }
1.643 foxr 148: $retries--;
149: } while (!$ok && ($retries > 0));
150:
151: if (!$ok) {
152: $content = ''; # On error return an empty content.
153: }
154: return ($content, $response);
155:
156: }
157:
158:
159:
1.20 www 160: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 161: my %language;
1.124 www 162: my %supported_language;
1.1048 foxr 163: my %latex_language; # For choosing hyphenation in <transl..>
164: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 165: my %cprtag;
1.192 taceyjo1 166: my %scprtag;
1.351 www 167: my %fe; my %fd; my %fm;
1.41 ng 168: my %category_extensions;
1.12 harris41 169:
1.46 matthew 170: # ---------------------------------------------- Thesaurus variables
1.144 matthew 171: #
172: # %Keywords:
173: # A hash used by &keyword to determine if a word is considered a keyword.
174: # $thesaurus_db_file
175: # Scalar containing the full path to the thesaurus database.
1.46 matthew 176:
177: my %Keywords;
178: my $thesaurus_db_file;
179:
1.144 matthew 180: #
181: # Initialize values from language.tab, copyright.tab, filetypes.tab,
182: # thesaurus.tab, and filecategories.tab.
183: #
1.18 www 184: BEGIN {
1.46 matthew 185: # Variable initialization
186: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
187: #
1.22 www 188: unless ($readit) {
1.12 harris41 189: # ------------------------------------------------------------------- languages
190: {
1.158 raeburn 191: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
192: '/language.tab';
193: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 194: while (my $line = <$fh>) {
195: next if ($line=~/^\#/);
196: chomp($line);
1.1048 foxr 197: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 198: $language{$key}=$val.' - '.$enc;
199: if ($sup) {
200: $supported_language{$key}=$sup;
201: }
1.1048 foxr 202: if ($latex) {
203: $latex_language_bykey{$key} = $latex;
204: $latex_language{$two} = $latex;
205: }
1.158 raeburn 206: }
207: close($fh);
208: }
1.12 harris41 209: }
210: # ------------------------------------------------------------------ copyrights
211: {
1.158 raeburn 212: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
213: '/copyright.tab';
214: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 215: while (my $line = <$fh>) {
216: next if ($line=~/^\#/);
217: chomp($line);
218: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 219: $cprtag{$key}=$val;
220: }
221: close($fh);
222: }
1.12 harris41 223: }
1.351 www 224: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 225: {
226: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
227: '/source_copyright.tab';
228: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 229: while (my $line = <$fh>) {
230: next if ($line =~ /^\#/);
231: chomp($line);
232: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 233: $scprtag{$key}=$val;
234: }
235: close($fh);
236: }
237: }
1.63 www 238:
1.517 raeburn 239: # -------------------------------------------------------------- default domain designs
1.63 www 240: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 241: my $designfile = $designdir.'/default.tab';
242: if ( open (my $fh,"<$designfile") ) {
243: while (my $line = <$fh>) {
244: next if ($line =~ /^\#/);
245: chomp($line);
246: my ($key,$val)=(split(/\=/,$line));
247: if ($val) { $defaultdesign{$key}=$val; }
248: }
249: close($fh);
1.63 www 250: }
251:
1.15 harris41 252: # ------------------------------------------------------------- file categories
253: {
1.158 raeburn 254: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
255: '/filecategories.tab';
256: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 257: while (my $line = <$fh>) {
258: next if ($line =~ /^\#/);
259: chomp($line);
260: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 261: push @{$category_extensions{lc($category)}},$extension;
262: }
263: close($fh);
264: }
265:
1.15 harris41 266: }
1.12 harris41 267: # ------------------------------------------------------------------ file types
268: {
1.158 raeburn 269: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
270: '/filetypes.tab';
271: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 272: while (my $line = <$fh>) {
273: next if ($line =~ /^\#/);
274: chomp($line);
275: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 276: if ($descr ne '') {
277: $fe{$ending}=lc($emb);
278: $fd{$ending}=$descr;
1.351 www 279: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 280: }
281: }
282: close($fh);
283: }
1.12 harris41 284: }
1.22 www 285: &Apache::lonnet::logthis(
1.705 tempelho 286: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 287: $readit=1;
1.46 matthew 288: } # end of unless($readit)
1.32 matthew 289:
290: }
1.112 bowersj2 291:
1.42 matthew 292: ###############################################################
293: ## HTML and Javascript Helper Functions ##
294: ###############################################################
295:
296: =pod
297:
1.112 bowersj2 298: =head1 HTML and Javascript Functions
1.42 matthew 299:
1.112 bowersj2 300: =over 4
301:
1.648 raeburn 302: =item * &browser_and_searcher_javascript()
1.112 bowersj2 303:
304: X<browsing, javascript>X<searching, javascript>Returns a string
305: containing javascript with two functions, C<openbrowser> and
306: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
307: tags.
1.42 matthew 308:
1.648 raeburn 309: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 310:
311: inputs: formname, elementname, only, omit
312:
313: formname and elementname indicate the name of the html form and name of
314: the element that the results of the browsing selection are to be placed in.
315:
316: Specifying 'only' will restrict the browser to displaying only files
1.185 www 317: with the given extension. Can be a comma separated list.
1.42 matthew 318:
319: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 320: with the given extension. Can be a comma separated list.
1.42 matthew 321:
1.648 raeburn 322: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 323:
324: Inputs: formname, elementname
325:
326: formname and elementname specify the name of the html form and the name
327: of the element the selection from the search results will be placed in.
1.542 raeburn 328:
1.42 matthew 329: =cut
330:
331: sub browser_and_searcher_javascript {
1.199 albertel 332: my ($mode)=@_;
333: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 334: my $resurl=&escape_single(&lastresurl());
1.42 matthew 335: return <<END;
1.219 albertel 336: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 337: var editbrowser = null;
1.135 albertel 338: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 339: var url = '$resurl/?';
1.42 matthew 340: if (editbrowser == null) {
341: url += 'launch=1&';
342: }
343: url += 'catalogmode=interactive&';
1.199 albertel 344: url += 'mode=$mode&';
1.611 albertel 345: url += 'inhibitmenu=yes&';
1.42 matthew 346: url += 'form=' + formname + '&';
347: if (only != null) {
348: url += 'only=' + only + '&';
1.217 albertel 349: } else {
350: url += 'only=&';
351: }
1.42 matthew 352: if (omit != null) {
353: url += 'omit=' + omit + '&';
1.217 albertel 354: } else {
355: url += 'omit=&';
356: }
1.135 albertel 357: if (titleelement != null) {
358: url += 'titleelement=' + titleelement + '&';
1.217 albertel 359: } else {
360: url += 'titleelement=&';
361: }
1.42 matthew 362: url += 'element=' + elementname + '';
363: var title = 'Browser';
1.435 albertel 364: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 365: options += ',width=700,height=600';
366: editbrowser = open(url,title,options,'1');
367: editbrowser.focus();
368: }
369: var editsearcher;
1.135 albertel 370: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 371: var url = '/adm/searchcat?';
372: if (editsearcher == null) {
373: url += 'launch=1&';
374: }
375: url += 'catalogmode=interactive&';
1.199 albertel 376: url += 'mode=$mode&';
1.42 matthew 377: url += 'form=' + formname + '&';
1.135 albertel 378: if (titleelement != null) {
379: url += 'titleelement=' + titleelement + '&';
1.217 albertel 380: } else {
381: url += 'titleelement=&';
382: }
1.42 matthew 383: url += 'element=' + elementname + '';
384: var title = 'Search';
1.435 albertel 385: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 386: options += ',width=700,height=600';
387: editsearcher = open(url,title,options,'1');
388: editsearcher.focus();
389: }
1.219 albertel 390: // END LON-CAPA Internal -->
1.42 matthew 391: END
1.170 www 392: }
393:
394: sub lastresurl {
1.258 albertel 395: if ($env{'environment.lastresurl'}) {
396: return $env{'environment.lastresurl'}
1.170 www 397: } else {
398: return '/res';
399: }
400: }
401:
402: sub storeresurl {
403: my $resurl=&Apache::lonnet::clutter(shift);
404: unless ($resurl=~/^\/res/) { return 0; }
405: $resurl=~s/\/$//;
406: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 407: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 408: return 1;
1.42 matthew 409: }
410:
1.74 www 411: sub studentbrowser_javascript {
1.111 www 412: unless (
1.258 albertel 413: (($env{'request.course.id'}) &&
1.302 albertel 414: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
415: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
416: '/'.$env{'request.course.sec'})
417: ))
1.258 albertel 418: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 419: ) { return ''; }
1.74 www 420: return (<<'ENDSTDBRW');
1.776 bisitz 421: <script type="text/javascript" language="Javascript">
1.824 bisitz 422: // <![CDATA[
1.74 www 423: var stdeditbrowser;
1.999 www 424: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 425: var url = '/adm/pickstudent?';
426: var filter;
1.558 albertel 427: if (!ignorefilter) {
428: eval('filter=document.'+formname+'.'+uname+'.value;');
429: }
1.74 www 430: if (filter != null) {
431: if (filter != '') {
432: url += 'filter='+filter+'&';
433: }
434: }
435: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 436: '&udomelement='+udom+
437: '&clicker='+clicker;
1.111 www 438: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 439: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 440: var title = 'Student_Browser';
1.74 www 441: var options = 'scrollbars=1,resizable=1,menubar=0';
442: options += ',width=700,height=600';
443: stdeditbrowser = open(url,title,options,'1');
444: stdeditbrowser.focus();
445: }
1.824 bisitz 446: // ]]>
1.74 www 447: </script>
448: ENDSTDBRW
449: }
1.42 matthew 450:
1.1003 www 451: sub resourcebrowser_javascript {
452: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 453: return (<<'ENDRESBRW');
1.1003 www 454: <script type="text/javascript" language="Javascript">
455: // <![CDATA[
456: var reseditbrowser;
1.1004 www 457: function openresbrowser(formname,reslink) {
1.1005 www 458: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 459: var title = 'Resource_Browser';
460: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 461: options += ',width=700,height=500';
1.1004 www 462: reseditbrowser = open(url,title,options,'1');
463: reseditbrowser.focus();
1.1003 www 464: }
465: // ]]>
466: </script>
1.1004 www 467: ENDRESBRW
1.1003 www 468: }
469:
1.74 www 470: sub selectstudent_link {
1.999 www 471: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
472: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
473: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
474: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 475: if ($env{'request.course.id'}) {
1.302 albertel 476: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
477: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
478: '/'.$env{'request.course.sec'})) {
1.111 www 479: return '';
480: }
1.999 www 481: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 482: if ($courseadvonly) {
483: $callargs .= ",'',1,1";
484: }
485: return '<span class="LC_nobreak">'.
486: '<a href="javascript:openstdbrowser('.$callargs.');">'.
487: &mt('Select User').'</a></span>';
1.74 www 488: }
1.258 albertel 489: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 490: $callargs .= ",'',1";
1.793 raeburn 491: return '<span class="LC_nobreak">'.
492: '<a href="javascript:openstdbrowser('.$callargs.');">'.
493: &mt('Select User').'</a></span>';
1.111 www 494: }
495: return '';
1.91 www 496: }
497:
1.1004 www 498: sub selectresource_link {
499: my ($form,$reslink,$arg)=@_;
500:
501: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
502: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
503: unless ($env{'request.course.id'}) { return $arg; }
504: return '<span class="LC_nobreak">'.
505: '<a href="javascript:openresbrowser('.$callargs.');">'.
506: $arg.'</a></span>';
507: }
508:
509:
510:
1.653 raeburn 511: sub authorbrowser_javascript {
512: return <<"ENDAUTHORBRW";
1.776 bisitz 513: <script type="text/javascript" language="JavaScript">
1.824 bisitz 514: // <![CDATA[
1.653 raeburn 515: var stdeditbrowser;
516:
517: function openauthorbrowser(formname,udom) {
518: var url = '/adm/pickauthor?';
519: url += 'form='+formname+'&roledom='+udom;
520: var title = 'Author_Browser';
521: var options = 'scrollbars=1,resizable=1,menubar=0';
522: options += ',width=700,height=600';
523: stdeditbrowser = open(url,title,options,'1');
524: stdeditbrowser.focus();
525: }
526:
1.824 bisitz 527: // ]]>
1.653 raeburn 528: </script>
529: ENDAUTHORBRW
530: }
531:
1.91 www 532: sub coursebrowser_javascript {
1.1075.2.31 raeburn 533: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
534: $credits_element) = @_;
1.932 raeburn 535: my $wintitle = 'Course_Browser';
1.931 raeburn 536: if ($crstype eq 'Community') {
1.932 raeburn 537: $wintitle = 'Community_Browser';
1.909 raeburn 538: }
1.876 raeburn 539: my $id_functions = &javascript_index_functions();
540: my $output = '
1.776 bisitz 541: <script type="text/javascript" language="JavaScript">
1.824 bisitz 542: // <![CDATA[
1.468 raeburn 543: var stdeditbrowser;'."\n";
1.876 raeburn 544:
545: $output .= <<"ENDSTDBRW";
1.909 raeburn 546: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 547: var url = '/adm/pickcourse?';
1.895 raeburn 548: var formid = getFormIdByName(formname);
1.876 raeburn 549: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 550: if (domainfilter != null) {
551: if (domainfilter != '') {
552: url += 'domainfilter='+domainfilter+'&';
553: }
554: }
1.91 www 555: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 556: '&cdomelement='+udom+
557: '&cnameelement='+desc;
1.468 raeburn 558: if (extra_element !=null && extra_element != '') {
1.594 raeburn 559: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 560: url += '&roleelement='+extra_element;
561: if (domainfilter == null || domainfilter == '') {
562: url += '&domainfilter='+extra_element;
563: }
1.234 raeburn 564: }
1.468 raeburn 565: else {
566: if (formname == 'portform') {
567: url += '&setroles='+extra_element;
1.800 raeburn 568: } else {
569: if (formname == 'rules') {
570: url += '&fixeddom='+extra_element;
571: }
1.468 raeburn 572: }
573: }
1.230 raeburn 574: }
1.909 raeburn 575: if (type != null && type != '') {
576: url += '&type='+type;
577: }
578: if (type_elem != null && type_elem != '') {
579: url += '&typeelement='+type_elem;
580: }
1.872 raeburn 581: if (formname == 'ccrs') {
582: var ownername = document.forms[formid].ccuname.value;
583: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
584: url += '&cloner='+ownername+':'+ownerdom;
585: }
1.293 raeburn 586: if (multflag !=null && multflag != '') {
587: url += '&multiple='+multflag;
588: }
1.909 raeburn 589: var title = '$wintitle';
1.91 www 590: var options = 'scrollbars=1,resizable=1,menubar=0';
591: options += ',width=700,height=600';
592: stdeditbrowser = open(url,title,options,'1');
593: stdeditbrowser.focus();
594: }
1.876 raeburn 595: $id_functions
596: ENDSTDBRW
1.1075.2.31 raeburn 597: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
598: $output .= &setsec_javascript($sec_element,$formname,$role_element,
599: $credits_element);
1.876 raeburn 600: }
601: $output .= '
602: // ]]>
603: </script>';
604: return $output;
605: }
606:
607: sub javascript_index_functions {
608: return <<"ENDJS";
609:
610: function getFormIdByName(formname) {
611: for (var i=0;i<document.forms.length;i++) {
612: if (document.forms[i].name == formname) {
613: return i;
614: }
615: }
616: return -1;
617: }
618:
619: function getIndexByName(formid,item) {
620: for (var i=0;i<document.forms[formid].elements.length;i++) {
621: if (document.forms[formid].elements[i].name == item) {
622: return i;
623: }
624: }
625: return -1;
626: }
1.468 raeburn 627:
1.876 raeburn 628: function getDomainFromSelectbox(formname,udom) {
629: var userdom;
630: var formid = getFormIdByName(formname);
631: if (formid > -1) {
632: var domid = getIndexByName(formid,udom);
633: if (domid > -1) {
634: if (document.forms[formid].elements[domid].type == 'select-one') {
635: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
636: }
637: if (document.forms[formid].elements[domid].type == 'hidden') {
638: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 639: }
640: }
641: }
1.876 raeburn 642: return userdom;
643: }
644:
645: ENDJS
1.468 raeburn 646:
1.876 raeburn 647: }
648:
1.1017 raeburn 649: sub javascript_array_indexof {
1.1018 raeburn 650: return <<ENDJS;
1.1017 raeburn 651: <script type="text/javascript" language="JavaScript">
652: // <![CDATA[
653:
654: if (!Array.prototype.indexOf) {
655: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
656: "use strict";
657: if (this === void 0 || this === null) {
658: throw new TypeError();
659: }
660: var t = Object(this);
661: var len = t.length >>> 0;
662: if (len === 0) {
663: return -1;
664: }
665: var n = 0;
666: if (arguments.length > 0) {
667: n = Number(arguments[1]);
668: if (n !== n) { // shortcut for verifying if it's NaN
669: n = 0;
670: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
671: n = (n > 0 || -1) * Math.floor(Math.abs(n));
672: }
673: }
674: if (n >= len) {
675: return -1;
676: }
677: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
678: for (; k < len; k++) {
679: if (k in t && t[k] === searchElement) {
680: return k;
681: }
682: }
683: return -1;
684: }
685: }
686:
687: // ]]>
688: </script>
689:
690: ENDJS
691:
692: }
693:
1.876 raeburn 694: sub userbrowser_javascript {
695: my $id_functions = &javascript_index_functions();
696: return <<"ENDUSERBRW";
697:
1.888 raeburn 698: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 699: var url = '/adm/pickuser?';
700: var userdom = getDomainFromSelectbox(formname,udom);
701: if (userdom != null) {
702: if (userdom != '') {
703: url += 'srchdom='+userdom+'&';
704: }
705: }
706: url += 'form=' + formname + '&unameelement='+uname+
707: '&udomelement='+udom+
708: '&ulastelement='+ulast+
709: '&ufirstelement='+ufirst+
710: '&uemailelement='+uemail+
1.881 raeburn 711: '&hideudomelement='+hideudom+
712: '&coursedom='+crsdom;
1.888 raeburn 713: if ((caller != null) && (caller != undefined)) {
714: url += '&caller='+caller;
715: }
1.876 raeburn 716: var title = 'User_Browser';
717: var options = 'scrollbars=1,resizable=1,menubar=0';
718: options += ',width=700,height=600';
719: var stdeditbrowser = open(url,title,options,'1');
720: stdeditbrowser.focus();
721: }
722:
1.888 raeburn 723: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 724: var formid = getFormIdByName(formname);
725: if (formid > -1) {
1.888 raeburn 726: var unameid = getIndexByName(formid,uname);
1.876 raeburn 727: var domid = getIndexByName(formid,udom);
728: var hidedomid = getIndexByName(formid,origdom);
729: if (hidedomid > -1) {
730: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 731: var unameval = document.forms[formid].elements[unameid].value;
732: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
733: if (domid > -1) {
734: var slct = document.forms[formid].elements[domid];
735: if (slct.type == 'select-one') {
736: var i;
737: for (i=0;i<slct.length;i++) {
738: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
739: }
740: }
741: if (slct.type == 'hidden') {
742: slct.value = fixeddom;
1.876 raeburn 743: }
744: }
1.468 raeburn 745: }
746: }
747: }
1.876 raeburn 748: return;
749: }
750:
751: $id_functions
752: ENDUSERBRW
1.468 raeburn 753: }
754:
755: sub setsec_javascript {
1.1075.2.31 raeburn 756: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 757: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
758: $communityrolestr);
759: if ($role_element ne '') {
760: my @allroles = ('st','ta','ep','in','ad');
761: foreach my $crstype ('Course','Community') {
762: if ($crstype eq 'Community') {
763: foreach my $role (@allroles) {
764: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
765: }
766: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
767: } else {
768: foreach my $role (@allroles) {
769: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
770: }
771: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
772: }
773: }
774: $rolestr = '"'.join('","',@allroles).'"';
775: $courserolestr = '"'.join('","',@courserolenames).'"';
776: $communityrolestr = '"'.join('","',@communityrolenames).'"';
777: }
1.468 raeburn 778: my $setsections = qq|
779: function setSect(sectionlist) {
1.629 raeburn 780: var sectionsArray = new Array();
781: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
782: sectionsArray = sectionlist.split(",");
783: }
1.468 raeburn 784: var numSections = sectionsArray.length;
785: document.$formname.$sec_element.length = 0;
786: if (numSections == 0) {
787: document.$formname.$sec_element.multiple=false;
788: document.$formname.$sec_element.size=1;
789: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
790: } else {
791: if (numSections == 1) {
792: document.$formname.$sec_element.multiple=false;
793: document.$formname.$sec_element.size=1;
794: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
795: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
796: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
797: } else {
798: for (var i=0; i<numSections; i++) {
799: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
800: }
801: document.$formname.$sec_element.multiple=true
802: if (numSections < 3) {
803: document.$formname.$sec_element.size=numSections;
804: } else {
805: document.$formname.$sec_element.size=3;
806: }
807: document.$formname.$sec_element.options[0].selected = false
808: }
809: }
1.91 www 810: }
1.905 raeburn 811:
812: function setRole(crstype) {
1.468 raeburn 813: |;
1.905 raeburn 814: if ($role_element eq '') {
815: $setsections .= ' return;
816: }
817: ';
818: } else {
819: $setsections .= qq|
820: var elementLength = document.$formname.$role_element.length;
821: var allroles = Array($rolestr);
822: var courserolenames = Array($courserolestr);
823: var communityrolenames = Array($communityrolestr);
824: if (elementLength != undefined) {
825: if (document.$formname.$role_element.options[5].value == 'cc') {
826: if (crstype == 'Course') {
827: return;
828: } else {
829: allroles[5] = 'co';
830: for (var i=0; i<6; i++) {
831: document.$formname.$role_element.options[i].value = allroles[i];
832: document.$formname.$role_element.options[i].text = communityrolenames[i];
833: }
834: }
835: } else {
836: if (crstype == 'Community') {
837: return;
838: } else {
839: allroles[5] = 'cc';
840: for (var i=0; i<6; i++) {
841: document.$formname.$role_element.options[i].value = allroles[i];
842: document.$formname.$role_element.options[i].text = courserolenames[i];
843: }
844: }
845: }
846: }
847: return;
848: }
849: |;
850: }
1.1075.2.31 raeburn 851: if ($credits_element) {
852: $setsections .= qq|
853: function setCredits(defaultcredits) {
854: document.$formname.$credits_element.value = defaultcredits;
855: return;
856: }
857: |;
858: }
1.468 raeburn 859: return $setsections;
860: }
861:
1.91 www 862: sub selectcourse_link {
1.909 raeburn 863: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
864: $typeelement) = @_;
865: my $type = $selecttype;
1.871 raeburn 866: my $linktext = &mt('Select Course');
867: if ($selecttype eq 'Community') {
1.909 raeburn 868: $linktext = &mt('Select Community');
1.906 raeburn 869: } elsif ($selecttype eq 'Course/Community') {
870: $linktext = &mt('Select Course/Community');
1.909 raeburn 871: $type = '';
1.1019 raeburn 872: } elsif ($selecttype eq 'Select') {
873: $linktext = &mt('Select');
874: $type = '';
1.871 raeburn 875: }
1.787 bisitz 876: return '<span class="LC_nobreak">'
877: ."<a href='"
878: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
879: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 880: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 881: ."'>".$linktext.'</a>'
1.787 bisitz 882: .'</span>';
1.74 www 883: }
1.42 matthew 884:
1.653 raeburn 885: sub selectauthor_link {
886: my ($form,$udom)=@_;
887: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
888: &mt('Select Author').'</a>';
889: }
890:
1.876 raeburn 891: sub selectuser_link {
1.881 raeburn 892: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 893: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 894: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 895: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 896: ');">'.$linktext.'</a>';
1.876 raeburn 897: }
898:
1.273 raeburn 899: sub check_uncheck_jscript {
900: my $jscript = <<"ENDSCRT";
901: function checkAll(field) {
902: if (field.length > 0) {
903: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 904: if (!field[i].disabled) {
905: field[i].checked = true;
906: }
1.273 raeburn 907: }
908: } else {
1.1075.2.14 raeburn 909: if (!field.disabled) {
910: field.checked = true;
911: }
1.273 raeburn 912: }
913: }
914:
915: function uncheckAll(field) {
916: if (field.length > 0) {
917: for (i = 0; i < field.length; i++) {
918: field[i].checked = false ;
1.543 albertel 919: }
920: } else {
1.273 raeburn 921: field.checked = false ;
922: }
923: }
924: ENDSCRT
925: return $jscript;
926: }
927:
1.656 www 928: sub select_timezone {
1.659 raeburn 929: my ($name,$selected,$onchange,$includeempty)=@_;
930: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
931: if ($includeempty) {
932: $output .= '<option value=""';
933: if (($selected eq '') || ($selected eq 'local')) {
934: $output .= ' selected="selected" ';
935: }
936: $output .= '> </option>';
937: }
1.657 raeburn 938: my @timezones = DateTime::TimeZone->all_names;
939: foreach my $tzone (@timezones) {
940: $output.= '<option value="'.$tzone.'"';
941: if ($tzone eq $selected) {
942: $output.=' selected="selected"';
943: }
944: $output.=">$tzone</option>\n";
1.656 www 945: }
946: $output.="</select>";
947: return $output;
948: }
1.273 raeburn 949:
1.687 raeburn 950: sub select_datelocale {
951: my ($name,$selected,$onchange,$includeempty)=@_;
952: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
953: if ($includeempty) {
954: $output .= '<option value=""';
955: if ($selected eq '') {
956: $output .= ' selected="selected" ';
957: }
958: $output .= '> </option>';
959: }
960: my (@possibles,%locale_names);
961: my @locales = DateTime::Locale::Catalog::Locales;
962: foreach my $locale (@locales) {
963: if (ref($locale) eq 'HASH') {
964: my $id = $locale->{'id'};
965: if ($id ne '') {
966: my $en_terr = $locale->{'en_territory'};
967: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 968: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 969: if (grep(/^en$/,@languages) || !@languages) {
970: if ($en_terr ne '') {
971: $locale_names{$id} = '('.$en_terr.')';
972: } elsif ($native_terr ne '') {
973: $locale_names{$id} = $native_terr;
974: }
975: } else {
976: if ($native_terr ne '') {
977: $locale_names{$id} = $native_terr.' ';
978: } elsif ($en_terr ne '') {
979: $locale_names{$id} = '('.$en_terr.')';
980: }
981: }
982: push (@possibles,$id);
983: }
984: }
985: }
986: foreach my $item (sort(@possibles)) {
987: $output.= '<option value="'.$item.'"';
988: if ($item eq $selected) {
989: $output.=' selected="selected"';
990: }
991: $output.=">$item";
992: if ($locale_names{$item} ne '') {
993: $output.=" $locale_names{$item}</option>\n";
994: }
995: $output.="</option>\n";
996: }
997: $output.="</select>";
998: return $output;
999: }
1000:
1.792 raeburn 1001: sub select_language {
1002: my ($name,$selected,$includeempty) = @_;
1003: my %langchoices;
1004: if ($includeempty) {
1.1075.2.32 raeburn 1005: %langchoices = ('' => 'No language preference');
1.792 raeburn 1006: }
1007: foreach my $id (&languageids()) {
1008: my $code = &supportedlanguagecode($id);
1009: if ($code) {
1010: $langchoices{$code} = &plainlanguagedescription($id);
1011: }
1012: }
1.1075.2.32 raeburn 1013: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1014: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1015: }
1016:
1.42 matthew 1017: =pod
1.36 matthew 1018:
1.648 raeburn 1019: =item * &linked_select_forms(...)
1.36 matthew 1020:
1021: linked_select_forms returns a string containing a <script></script> block
1022: and html for two <select> menus. The select menus will be linked in that
1023: changing the value of the first menu will result in new values being placed
1024: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1025: order unless a defined order is provided.
1.36 matthew 1026:
1027: linked_select_forms takes the following ordered inputs:
1028:
1029: =over 4
1030:
1.112 bowersj2 1031: =item * $formname, the name of the <form> tag
1.36 matthew 1032:
1.112 bowersj2 1033: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1034:
1.112 bowersj2 1035: =item * $firstdefault, the default value for the first menu
1.36 matthew 1036:
1.112 bowersj2 1037: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1038:
1.112 bowersj2 1039: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1040:
1.112 bowersj2 1041: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1042:
1.609 raeburn 1043: =item * $menuorder, the order of values in the first menu
1044:
1.1075.2.31 raeburn 1045: =item * $onchangefirst, additional javascript call to execute for an onchange
1046: event for the first <select> tag
1047:
1048: =item * $onchangesecond, additional javascript call to execute for an onchange
1049: event for the second <select> tag
1050:
1.41 ng 1051: =back
1052:
1.36 matthew 1053: Below is an example of such a hash. Only the 'text', 'default', and
1054: 'select2' keys must appear as stated. keys(%menu) are the possible
1055: values for the first select menu. The text that coincides with the
1.41 ng 1056: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1057: and text for the second menu are given in the hash pointed to by
1058: $menu{$choice1}->{'select2'}.
1059:
1.112 bowersj2 1060: my %menu = ( A1 => { text =>"Choice A1" ,
1061: default => "B3",
1062: select2 => {
1063: B1 => "Choice B1",
1064: B2 => "Choice B2",
1065: B3 => "Choice B3",
1066: B4 => "Choice B4"
1.609 raeburn 1067: },
1068: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1069: },
1070: A2 => { text =>"Choice A2" ,
1071: default => "C2",
1072: select2 => {
1073: C1 => "Choice C1",
1074: C2 => "Choice C2",
1075: C3 => "Choice C3"
1.609 raeburn 1076: },
1077: order => ['C2','C1','C3'],
1.112 bowersj2 1078: },
1079: A3 => { text =>"Choice A3" ,
1080: default => "D6",
1081: select2 => {
1082: D1 => "Choice D1",
1083: D2 => "Choice D2",
1084: D3 => "Choice D3",
1085: D4 => "Choice D4",
1086: D5 => "Choice D5",
1087: D6 => "Choice D6",
1088: D7 => "Choice D7"
1.609 raeburn 1089: },
1090: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1091: }
1092: );
1.36 matthew 1093:
1094: =cut
1095:
1096: sub linked_select_forms {
1097: my ($formname,
1098: $middletext,
1099: $firstdefault,
1100: $firstselectname,
1101: $secondselectname,
1.609 raeburn 1102: $hashref,
1103: $menuorder,
1.1075.2.31 raeburn 1104: $onchangefirst,
1105: $onchangesecond
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
1.1075.2.31 raeburn 1162: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\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;
1.1075.2.31 raeburn 1175: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1176: if ($onchangesecond) {
1177: $result .= ' onchange="'.$onchangesecond.'"';
1178: }
1179: $result .= ">\n";
1.36 matthew 1180: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1181:
1182: my @secondorder = sort(keys(%select2));
1183: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1184: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1185: }
1186: foreach my $value (@secondorder) {
1.36 matthew 1187: $result.=" <option value=\"$value\" ";
1.253 albertel 1188: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1189: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1190: }
1191: $result .= "</select>\n";
1192: # return $debug;
1193: return $result;
1194: } # end of sub linked_select_forms {
1195:
1.45 matthew 1196: =pod
1.44 bowersj2 1197:
1.973 raeburn 1198: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1199:
1.112 bowersj2 1200: Returns a string corresponding to an HTML link to the given help
1201: $topic, where $topic corresponds to the name of a .tex file in
1202: /home/httpd/html/adm/help/tex, with underscores replaced by
1203: spaces.
1204:
1205: $text will optionally be linked to the same topic, allowing you to
1206: link text in addition to the graphic. If you do not want to link
1207: text, but wish to specify one of the later parameters, pass an
1208: empty string.
1209:
1210: $stayOnPage is a value that will be interpreted as a boolean. If true,
1211: the link will not open a new window. If false, the link will open
1212: a new window using Javascript. (Default is false.)
1213:
1214: $width and $height are optional numerical parameters that will
1215: override the width and height of the popped up window, which may
1.973 raeburn 1216: be useful for certain help topics with big pictures included.
1217:
1218: $imgid is the id of the img tag used for the help icon. This may be
1219: used in a javascript call to switch the image src. See
1220: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1221:
1222: =cut
1223:
1224: sub help_open_topic {
1.973 raeburn 1225: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1226: $text = "" if (not defined $text);
1.44 bowersj2 1227: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1228: $width = 500 if (not defined $width);
1.44 bowersj2 1229: $height = 400 if (not defined $height);
1230: my $filename = $topic;
1231: $filename =~ s/ /_/g;
1232:
1.48 bowersj2 1233: my $template = "";
1234: my $link;
1.572 banghart 1235:
1.159 www 1236: $topic=~s/\W/\_/g;
1.44 bowersj2 1237:
1.572 banghart 1238: if (!$stayOnPage) {
1.1075.2.50 raeburn 1239: if ($env{'browser.mobile'}) {
1240: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1241: } else {
1242: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1243: }
1.1037 www 1244: } elsif ($stayOnPage eq 'popup') {
1245: $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 1246: } else {
1.48 bowersj2 1247: $link = "/adm/help/${filename}.hlp";
1248: }
1249:
1250: # Add the text
1.755 neumanie 1251: if ($text ne "") {
1.763 bisitz 1252: $template.='<span class="LC_help_open_topic">'
1253: .'<a target="_top" href="'.$link.'">'
1254: .$text.'</a>';
1.48 bowersj2 1255: }
1256:
1.763 bisitz 1257: # (Always) Add the graphic
1.179 matthew 1258: my $title = &mt('Online Help');
1.667 raeburn 1259: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1260: if ($imgid ne '') {
1261: $imgid = ' id="'.$imgid.'"';
1262: }
1.763 bisitz 1263: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1264: .'<img src="'.$helpicon.'" border="0"'
1265: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1266: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1267: .' /></a>';
1268: if ($text ne "") {
1269: $template.='</span>';
1270: }
1.44 bowersj2 1271: return $template;
1272:
1.106 bowersj2 1273: }
1274:
1275: # This is a quicky function for Latex cheatsheet editing, since it
1276: # appears in at least four places
1277: sub helpLatexCheatsheet {
1.1037 www 1278: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1279: my $out;
1.106 bowersj2 1280: my $addOther = '';
1.732 raeburn 1281: if ($topic) {
1.1037 www 1282: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1283: }
1284: $out = '<span>' # Start cheatsheet
1285: .$addOther
1286: .'<span>'
1.1037 www 1287: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1288: .'</span> <span>'
1.1037 www 1289: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1290: .'</span>';
1.732 raeburn 1291: unless ($not_author) {
1.763 bisitz 1292: $out .= ' <span>'
1.1037 www 1293: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763 bisitz 1294: .'</span>';
1.732 raeburn 1295: }
1.763 bisitz 1296: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1297: return $out;
1.172 www 1298: }
1299:
1.430 albertel 1300: sub general_help {
1301: my $helptopic='Student_Intro';
1302: if ($env{'request.role'}=~/^(ca|au)/) {
1303: $helptopic='Authoring_Intro';
1.907 raeburn 1304: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1305: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1306: } elsif ($env{'request.role'}=~/^dc/) {
1307: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1308: }
1309: return $helptopic;
1310: }
1311:
1312: sub update_help_link {
1313: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1314: my $origurl = $ENV{'REQUEST_URI'};
1315: $origurl=~s|^/~|/priv/|;
1316: my $timestamp = time;
1317: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1318: $$datum = &escape($$datum);
1319: }
1320:
1321: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1322: my $output .= <<"ENDOUTPUT";
1323: <script type="text/javascript">
1.824 bisitz 1324: // <![CDATA[
1.430 albertel 1325: banner_link = '$banner_link';
1.824 bisitz 1326: // ]]>
1.430 albertel 1327: </script>
1328: ENDOUTPUT
1329: return $output;
1330: }
1331:
1332: # now just updates the help link and generates a blue icon
1.193 raeburn 1333: sub help_open_menu {
1.430 albertel 1334: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1335: = @_;
1.949 droeschl 1336: $stayOnPage = 1;
1.430 albertel 1337: my $output;
1338: if ($component_help) {
1339: if (!$text) {
1340: $output=&help_open_topic($component_help,undef,$stayOnPage,
1341: $width,$height);
1342: } else {
1343: my $help_text;
1344: $help_text=&unescape($topic);
1345: $output='<table><tr><td>'.
1346: &help_open_topic($component_help,$help_text,$stayOnPage,
1347: $width,$height).'</td></tr></table>';
1348: }
1349: }
1350: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1351: return $output.$banner_link;
1352: }
1353:
1354: sub top_nav_help {
1355: my ($text) = @_;
1.436 albertel 1356: $text = &mt($text);
1.1075.2.60 raeburn 1357: my $stay_on_page;
1358: unless ($env{'environment.remote'} eq 'on') {
1359: $stay_on_page = 1;
1360: }
1.1075.2.61 raeburn 1361: my ($link,$banner_link);
1362: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1363: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1364: : "javascript:helpMenu('open')";
1365: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1366: }
1.201 raeburn 1367: my $title = &mt('Get help');
1.1075.2.61 raeburn 1368: if ($link) {
1369: return <<"END";
1.436 albertel 1370: $banner_link
1.1075.2.56 raeburn 1371: <a href="$link" title="$title">$text</a>
1.436 albertel 1372: END
1.1075.2.61 raeburn 1373: } else {
1374: return ' '.$text.' ';
1375: }
1.436 albertel 1376: }
1377:
1378: sub help_menu_js {
1.1075.2.52 raeburn 1379: my ($httphost) = @_;
1.949 droeschl 1380: my $stayOnPage = 1;
1.436 albertel 1381: my $width = 620;
1382: my $height = 600;
1.430 albertel 1383: my $helptopic=&general_help();
1.1075.2.52 raeburn 1384: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1385: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1386: my $start_page =
1387: &Apache::loncommon::start_page('Help Menu', undef,
1388: {'frameset' => 1,
1389: 'js_ready' => 1,
1.1075.2.52 raeburn 1390: 'use_absolute' => $httphost,
1.331 albertel 1391: 'add_entries' => {
1392: 'border' => '0',
1.579 raeburn 1393: 'rows' => "110,*",},});
1.331 albertel 1394: my $end_page =
1395: &Apache::loncommon::end_page({'frameset' => 1,
1396: 'js_ready' => 1,});
1397:
1.436 albertel 1398: my $template .= <<"ENDTEMPLATE";
1399: <script type="text/javascript">
1.877 bisitz 1400: // <![CDATA[
1.253 albertel 1401: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1402: var banner_link = '';
1.243 raeburn 1403: function helpMenu(target) {
1404: var caller = this;
1405: if (target == 'open') {
1406: var newWindow = null;
1407: try {
1.262 albertel 1408: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1409: }
1410: catch(error) {
1411: writeHelp(caller);
1412: return;
1413: }
1414: if (newWindow) {
1415: caller = newWindow;
1416: }
1.193 raeburn 1417: }
1.243 raeburn 1418: writeHelp(caller);
1419: return;
1420: }
1421: function writeHelp(caller) {
1.1075.2.61 raeburn 1422: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1423: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1424: caller.document.close();
1425: caller.focus();
1.193 raeburn 1426: }
1.877 bisitz 1427: // END LON-CAPA Internal -->
1.253 albertel 1428: // ]]>
1.436 albertel 1429: </script>
1.193 raeburn 1430: ENDTEMPLATE
1431: return $template;
1432: }
1433:
1.172 www 1434: sub help_open_bug {
1435: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1436: unless ($env{'user.adv'}) { return ''; }
1.172 www 1437: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1438: $text = "" if (not defined $text);
1439: $stayOnPage=1;
1.184 albertel 1440: $width = 600 if (not defined $width);
1441: $height = 600 if (not defined $height);
1.172 www 1442:
1443: $topic=~s/\W+/\+/g;
1444: my $link='';
1445: my $template='';
1.379 albertel 1446: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1447: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1448: if (!$stayOnPage)
1449: {
1450: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1451: }
1452: else
1453: {
1454: $link = $url;
1455: }
1456: # Add the text
1457: if ($text ne "")
1458: {
1459: $template .=
1460: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1461: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1462: }
1463:
1464: # Add the graphic
1.179 matthew 1465: my $title = &mt('Report a Bug');
1.215 albertel 1466: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1467: $template .= <<"ENDTEMPLATE";
1.436 albertel 1468: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1469: ENDTEMPLATE
1470: if ($text ne '') { $template.='</td></tr></table>' };
1471: return $template;
1472:
1473: }
1474:
1475: sub help_open_faq {
1476: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1477: unless ($env{'user.adv'}) { return ''; }
1.172 www 1478: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1479: $text = "" if (not defined $text);
1480: $stayOnPage=1;
1481: $width = 350 if (not defined $width);
1482: $height = 400 if (not defined $height);
1483:
1484: $topic=~s/\W+/\+/g;
1485: my $link='';
1486: my $template='';
1487: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1488: if (!$stayOnPage)
1489: {
1490: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1491: }
1492: else
1493: {
1494: $link = $url;
1495: }
1496:
1497: # Add the text
1498: if ($text ne "")
1499: {
1500: $template .=
1.173 www 1501: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1502: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1503: }
1504:
1505: # Add the graphic
1.179 matthew 1506: my $title = &mt('View the FAQ');
1.215 albertel 1507: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1508: $template .= <<"ENDTEMPLATE";
1.436 albertel 1509: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1510: ENDTEMPLATE
1511: if ($text ne '') { $template.='</td></tr></table>' };
1512: return $template;
1513:
1.44 bowersj2 1514: }
1.37 matthew 1515:
1.180 matthew 1516: ###############################################################
1517: ###############################################################
1518:
1.45 matthew 1519: =pod
1520:
1.648 raeburn 1521: =item * &change_content_javascript():
1.256 matthew 1522:
1523: This and the next function allow you to create small sections of an
1524: otherwise static HTML page that you can update on the fly with
1525: Javascript, even in Netscape 4.
1526:
1527: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1528: must be written to the HTML page once. It will prove the Javascript
1529: function "change(name, content)". Calling the change function with the
1530: name of the section
1531: you want to update, matching the name passed to C<changable_area>, and
1532: the new content you want to put in there, will put the content into
1533: that area.
1534:
1535: B<Note>: Netscape 4 only reserves enough space for the changable area
1536: to contain room for the original contents. You need to "make space"
1537: for whatever changes you wish to make, and be B<sure> to check your
1538: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1539: it's adequate for updating a one-line status display, but little more.
1540: This script will set the space to 100% width, so you only need to
1541: worry about height in Netscape 4.
1542:
1543: Modern browsers are much less limiting, and if you can commit to the
1544: user not using Netscape 4, this feature may be used freely with
1545: pretty much any HTML.
1546:
1547: =cut
1548:
1549: sub change_content_javascript {
1550: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1551: if ($env{'browser.type'} eq 'netscape' &&
1552: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1553: return (<<NETSCAPE4);
1554: function change(name, content) {
1555: doc = document.layers[name+"___escape"].layers[0].document;
1556: doc.open();
1557: doc.write(content);
1558: doc.close();
1559: }
1560: NETSCAPE4
1561: } else {
1562: # Otherwise, we need to use semi-standards-compliant code
1563: # (technically, "innerHTML" isn't standard but the equivalent
1564: # is really scary, and every useful browser supports it
1565: return (<<DOMBASED);
1566: function change(name, content) {
1567: element = document.getElementById(name);
1568: element.innerHTML = content;
1569: }
1570: DOMBASED
1571: }
1572: }
1573:
1574: =pod
1575:
1.648 raeburn 1576: =item * &changable_area($name,$origContent):
1.256 matthew 1577:
1578: This provides a "changable area" that can be modified on the fly via
1579: the Javascript code provided in C<change_content_javascript>. $name is
1580: the name you will use to reference the area later; do not repeat the
1581: same name on a given HTML page more then once. $origContent is what
1582: the area will originally contain, which can be left blank.
1583:
1584: =cut
1585:
1586: sub changable_area {
1587: my ($name, $origContent) = @_;
1588:
1.258 albertel 1589: if ($env{'browser.type'} eq 'netscape' &&
1590: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1591: # If this is netscape 4, we need to use the Layer tag
1592: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1593: } else {
1594: return "<span id='$name'>$origContent</span>";
1595: }
1596: }
1597:
1598: =pod
1599:
1.648 raeburn 1600: =item * &viewport_geometry_js
1.590 raeburn 1601:
1602: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1603:
1604: =cut
1605:
1606:
1607: sub viewport_geometry_js {
1608: return <<"GEOMETRY";
1609: var Geometry = {};
1610: function init_geometry() {
1611: if (Geometry.init) { return };
1612: Geometry.init=1;
1613: if (window.innerHeight) {
1614: Geometry.getViewportHeight = function() { return window.innerHeight; };
1615: Geometry.getViewportWidth = function() { return window.innerWidth; };
1616: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1617: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1618: }
1619: else if (document.documentElement && document.documentElement.clientHeight) {
1620: Geometry.getViewportHeight =
1621: function() { return document.documentElement.clientHeight; };
1622: Geometry.getViewportWidth =
1623: function() { return document.documentElement.clientWidth; };
1624:
1625: Geometry.getHorizontalScroll =
1626: function() { return document.documentElement.scrollLeft; };
1627: Geometry.getVerticalScroll =
1628: function() { return document.documentElement.scrollTop; };
1629: }
1630: else if (document.body.clientHeight) {
1631: Geometry.getViewportHeight =
1632: function() { return document.body.clientHeight; };
1633: Geometry.getViewportWidth =
1634: function() { return document.body.clientWidth; };
1635: Geometry.getHorizontalScroll =
1636: function() { return document.body.scrollLeft; };
1637: Geometry.getVerticalScroll =
1638: function() { return document.body.scrollTop; };
1639: }
1640: }
1641:
1642: GEOMETRY
1643: }
1644:
1645: =pod
1646:
1.648 raeburn 1647: =item * &viewport_size_js()
1.590 raeburn 1648:
1649: 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.
1650:
1651: =cut
1652:
1653: sub viewport_size_js {
1654: my $geometry = &viewport_geometry_js();
1655: return <<"DIMS";
1656:
1657: $geometry
1658:
1659: function getViewportDims(width,height) {
1660: init_geometry();
1661: width.value = Geometry.getViewportWidth();
1662: height.value = Geometry.getViewportHeight();
1663: return;
1664: }
1665:
1666: DIMS
1667: }
1668:
1669: =pod
1670:
1.648 raeburn 1671: =item * &resize_textarea_js()
1.565 albertel 1672:
1673: emits the needed javascript to resize a textarea to be as big as possible
1674:
1675: creates a function resize_textrea that takes two IDs first should be
1676: the id of the element to resize, second should be the id of a div that
1677: surrounds everything that comes after the textarea, this routine needs
1678: to be attached to the <body> for the onload and onresize events.
1679:
1.648 raeburn 1680: =back
1.565 albertel 1681:
1682: =cut
1683:
1684: sub resize_textarea_js {
1.590 raeburn 1685: my $geometry = &viewport_geometry_js();
1.565 albertel 1686: return <<"RESIZE";
1687: <script type="text/javascript">
1.824 bisitz 1688: // <![CDATA[
1.590 raeburn 1689: $geometry
1.565 albertel 1690:
1.588 albertel 1691: function getX(element) {
1692: var x = 0;
1693: while (element) {
1694: x += element.offsetLeft;
1695: element = element.offsetParent;
1696: }
1697: return x;
1698: }
1699: function getY(element) {
1700: var y = 0;
1701: while (element) {
1702: y += element.offsetTop;
1703: element = element.offsetParent;
1704: }
1705: return y;
1706: }
1707:
1708:
1.565 albertel 1709: function resize_textarea(textarea_id,bottom_id) {
1710: init_geometry();
1711: var textarea = document.getElementById(textarea_id);
1712: //alert(textarea);
1713:
1.588 albertel 1714: var textarea_top = getY(textarea);
1.565 albertel 1715: var textarea_height = textarea.offsetHeight;
1716: var bottom = document.getElementById(bottom_id);
1.588 albertel 1717: var bottom_top = getY(bottom);
1.565 albertel 1718: var bottom_height = bottom.offsetHeight;
1719: var window_height = Geometry.getViewportHeight();
1.588 albertel 1720: var fudge = 23;
1.565 albertel 1721: var new_height = window_height-fudge-textarea_top-bottom_height;
1722: if (new_height < 300) {
1723: new_height = 300;
1724: }
1725: textarea.style.height=new_height+'px';
1726: }
1.824 bisitz 1727: // ]]>
1.565 albertel 1728: </script>
1729: RESIZE
1730:
1731: }
1732:
1733: =pod
1734:
1.256 matthew 1735: =head1 Excel and CSV file utility routines
1736:
1737: =cut
1738:
1739: ###############################################################
1740: ###############################################################
1741:
1742: =pod
1743:
1.1075.2.56 raeburn 1744: =over 4
1745:
1.648 raeburn 1746: =item * &csv_translate($text)
1.37 matthew 1747:
1.185 www 1748: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1749: format.
1750:
1751: =cut
1752:
1.180 matthew 1753: ###############################################################
1754: ###############################################################
1.37 matthew 1755: sub csv_translate {
1756: my $text = shift;
1757: $text =~ s/\"/\"\"/g;
1.209 albertel 1758: $text =~ s/\n/ /g;
1.37 matthew 1759: return $text;
1760: }
1.180 matthew 1761:
1762: ###############################################################
1763: ###############################################################
1764:
1765: =pod
1766:
1.648 raeburn 1767: =item * &define_excel_formats()
1.180 matthew 1768:
1769: Define some commonly used Excel cell formats.
1770:
1771: Currently supported formats:
1772:
1773: =over 4
1774:
1775: =item header
1776:
1777: =item bold
1778:
1779: =item h1
1780:
1781: =item h2
1782:
1783: =item h3
1784:
1.256 matthew 1785: =item h4
1786:
1787: =item i
1788:
1.180 matthew 1789: =item date
1790:
1791: =back
1792:
1793: Inputs: $workbook
1794:
1795: Returns: $format, a hash reference.
1796:
1.1057 foxr 1797:
1.180 matthew 1798: =cut
1799:
1800: ###############################################################
1801: ###############################################################
1802: sub define_excel_formats {
1803: my ($workbook) = @_;
1804: my $format;
1805: $format->{'header'} = $workbook->add_format(bold => 1,
1806: bottom => 1,
1807: align => 'center');
1808: $format->{'bold'} = $workbook->add_format(bold=>1);
1809: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1810: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1811: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1812: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1813: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1814: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1815: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1816: return $format;
1817: }
1818:
1819: ###############################################################
1820: ###############################################################
1.113 bowersj2 1821:
1822: =pod
1823:
1.648 raeburn 1824: =item * &create_workbook()
1.255 matthew 1825:
1826: Create an Excel worksheet. If it fails, output message on the
1827: request object and return undefs.
1828:
1829: Inputs: Apache request object
1830:
1831: Returns (undef) on failure,
1832: Excel worksheet object, scalar with filename, and formats
1833: from &Apache::loncommon::define_excel_formats on success
1834:
1835: =cut
1836:
1837: ###############################################################
1838: ###############################################################
1839: sub create_workbook {
1840: my ($r) = @_;
1841: #
1842: # Create the excel spreadsheet
1843: my $filename = '/prtspool/'.
1.258 albertel 1844: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1845: time.'_'.rand(1000000000).'.xls';
1846: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1847: if (! defined($workbook)) {
1848: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1849: $r->print(
1850: '<p class="LC_error">'
1851: .&mt('Problems occurred in creating the new Excel file.')
1852: .' '.&mt('This error has been logged.')
1853: .' '.&mt('Please alert your LON-CAPA administrator.')
1854: .'</p>'
1855: );
1.255 matthew 1856: return (undef);
1857: }
1858: #
1.1014 foxr 1859: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1860: #
1861: my $format = &Apache::loncommon::define_excel_formats($workbook);
1862: return ($workbook,$filename,$format);
1863: }
1864:
1865: ###############################################################
1866: ###############################################################
1867:
1868: =pod
1869:
1.648 raeburn 1870: =item * &create_text_file()
1.113 bowersj2 1871:
1.542 raeburn 1872: Create a file to write to and eventually make available to the user.
1.256 matthew 1873: If file creation fails, outputs an error message on the request object and
1874: return undefs.
1.113 bowersj2 1875:
1.256 matthew 1876: Inputs: Apache request object, and file suffix
1.113 bowersj2 1877:
1.256 matthew 1878: Returns (undef) on failure,
1879: Filehandle and filename on success.
1.113 bowersj2 1880:
1881: =cut
1882:
1.256 matthew 1883: ###############################################################
1884: ###############################################################
1885: sub create_text_file {
1886: my ($r,$suffix) = @_;
1887: if (! defined($suffix)) { $suffix = 'txt'; };
1888: my $fh;
1889: my $filename = '/prtspool/'.
1.258 albertel 1890: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1891: time.'_'.rand(1000000000).'.'.$suffix;
1892: $fh = Apache::File->new('>/home/httpd'.$filename);
1893: if (! defined($fh)) {
1894: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1895: $r->print(
1896: '<p class="LC_error">'
1897: .&mt('Problems occurred in creating the output file.')
1898: .' '.&mt('This error has been logged.')
1899: .' '.&mt('Please alert your LON-CAPA administrator.')
1900: .'</p>'
1901: );
1.113 bowersj2 1902: }
1.256 matthew 1903: return ($fh,$filename)
1.113 bowersj2 1904: }
1905:
1906:
1.256 matthew 1907: =pod
1.113 bowersj2 1908:
1909: =back
1910:
1911: =cut
1.37 matthew 1912:
1913: ###############################################################
1.33 matthew 1914: ## Home server <option> list generating code ##
1915: ###############################################################
1.35 matthew 1916:
1.169 www 1917: # ------------------------------------------
1918:
1919: sub domain_select {
1920: my ($name,$value,$multiple)=@_;
1921: my %domains=map {
1.514 albertel 1922: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1923: } &Apache::lonnet::all_domains();
1.169 www 1924: if ($multiple) {
1925: $domains{''}=&mt('Any domain');
1.550 albertel 1926: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1927: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1928: } else {
1.550 albertel 1929: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1930: return &select_form($name,$value,\%domains);
1.169 www 1931: }
1932: }
1933:
1.282 albertel 1934: #-------------------------------------------
1935:
1936: =pod
1937:
1.519 raeburn 1938: =head1 Routines for form select boxes
1939:
1940: =over 4
1941:
1.648 raeburn 1942: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1943:
1944: Returns a string containing a <select> element int multiple mode
1945:
1946:
1947: Args:
1948: $name - name of the <select> element
1.506 raeburn 1949: $value - scalar or array ref of values that should already be selected
1.282 albertel 1950: $size - number of rows long the select element is
1.283 albertel 1951: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1952: (shown text should already have been &mt())
1.506 raeburn 1953: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1954:
1.282 albertel 1955: =cut
1956:
1957: #-------------------------------------------
1.169 www 1958: sub multiple_select_form {
1.284 albertel 1959: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1960: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1961: my $output='';
1.191 matthew 1962: if (! defined($size)) {
1963: $size = 4;
1.283 albertel 1964: if (scalar(keys(%$hash))<4) {
1965: $size = scalar(keys(%$hash));
1.191 matthew 1966: }
1967: }
1.734 bisitz 1968: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1969: my @order;
1.506 raeburn 1970: if (ref($order) eq 'ARRAY') {
1971: @order = @{$order};
1972: } else {
1973: @order = sort(keys(%$hash));
1.501 banghart 1974: }
1975: if (exists($$hash{'select_form_order'})) {
1976: @order = @{$$hash{'select_form_order'}};
1977: }
1978:
1.284 albertel 1979: foreach my $key (@order) {
1.356 albertel 1980: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1981: $output.='selected="selected" ' if ($selected{$key});
1982: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1983: }
1984: $output.="</select>\n";
1985: return $output;
1986: }
1987:
1.88 www 1988: #-------------------------------------------
1989:
1990: =pod
1991:
1.970 raeburn 1992: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 1993:
1994: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 1995: allow a user to select options from a ref to a hash containing:
1996: option_name => displayed text. An optional $onchange can include
1997: a javascript onchange item, e.g., onchange="this.form.submit();"
1998:
1.88 www 1999: See lonrights.pm for an example invocation and use.
2000:
2001: =cut
2002:
2003: #-------------------------------------------
2004: sub select_form {
1.970 raeburn 2005: my ($def,$name,$hashref,$onchange) = @_;
2006: return unless (ref($hashref) eq 'HASH');
2007: if ($onchange) {
2008: $onchange = ' onchange="'.$onchange.'"';
2009: }
2010: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2011: my @keys;
1.970 raeburn 2012: if (exists($hashref->{'select_form_order'})) {
2013: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2014: } else {
1.970 raeburn 2015: @keys=sort(keys(%{$hashref}));
1.128 albertel 2016: }
1.356 albertel 2017: foreach my $key (@keys) {
2018: $selectform.=
2019: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2020: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2021: ">".$hashref->{$key}."</option>\n";
1.88 www 2022: }
2023: $selectform.="</select>";
2024: return $selectform;
2025: }
2026:
1.475 www 2027: # For display filters
2028:
2029: sub display_filter {
1.1074 raeburn 2030: my ($context) = @_;
1.475 www 2031: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2032: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2033: my $phraseinput = 'hidden';
2034: my $includeinput = 'hidden';
2035: my ($checked,$includetypestext);
2036: if ($env{'form.displayfilter'} eq 'containing') {
2037: $phraseinput = 'text';
2038: if ($context eq 'parmslog') {
2039: $includeinput = 'checkbox';
2040: if ($env{'form.includetypes'}) {
2041: $checked = ' checked="checked"';
2042: }
2043: $includetypestext = &mt('Include parameter types');
2044: }
2045: } else {
2046: $includetypestext = ' ';
2047: }
2048: my ($additional,$secondid,$thirdid);
2049: if ($context eq 'parmslog') {
2050: $additional =
2051: '<label><input type="'.$includeinput.'" name="includetypes"'.
2052: $checked.' name="includetypes" value="1" id="includetypes" />'.
2053: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2054: '</label>';
2055: $secondid = 'includetypes';
2056: $thirdid = 'includetypestext';
2057: }
2058: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2059: '$secondid','$thirdid')";
2060: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2061: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2062: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2063: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2064: &mt('Filter: [_1]',
1.477 www 2065: &select_form($env{'form.displayfilter'},
2066: 'displayfilter',
1.970 raeburn 2067: {'currentfolder' => 'Current folder/page',
1.477 www 2068: 'containing' => 'Containing phrase',
1.1074 raeburn 2069: 'none' => 'None'},$onchange)).' '.
2070: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2071: &HTML::Entities::encode($env{'form.containingphrase'}).
2072: '" />'.$additional;
2073: }
2074:
2075: sub display_filter_js {
2076: my $includetext = &mt('Include parameter types');
2077: return <<"ENDJS";
2078:
2079: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2080: var firstType = 'hidden';
2081: if (setter.options[setter.selectedIndex].value == 'containing') {
2082: firstType = 'text';
2083: }
2084: firstObject = document.getElementById(firstid);
2085: if (typeof(firstObject) == 'object') {
2086: if (firstObject.type != firstType) {
2087: changeInputType(firstObject,firstType);
2088: }
2089: }
2090: if (context == 'parmslog') {
2091: var secondType = 'hidden';
2092: if (firstType == 'text') {
2093: secondType = 'checkbox';
2094: }
2095: secondObject = document.getElementById(secondid);
2096: if (typeof(secondObject) == 'object') {
2097: if (secondObject.type != secondType) {
2098: changeInputType(secondObject,secondType);
2099: }
2100: }
2101: var textItem = document.getElementById(thirdid);
2102: var currtext = textItem.innerHTML;
2103: var newtext;
2104: if (firstType == 'text') {
2105: newtext = '$includetext';
2106: } else {
2107: newtext = ' ';
2108: }
2109: if (currtext != newtext) {
2110: textItem.innerHTML = newtext;
2111: }
2112: }
2113: return;
2114: }
2115:
2116: function changeInputType(oldObject,newType) {
2117: var newObject = document.createElement('input');
2118: newObject.type = newType;
2119: if (oldObject.size) {
2120: newObject.size = oldObject.size;
2121: }
2122: if (oldObject.value) {
2123: newObject.value = oldObject.value;
2124: }
2125: if (oldObject.name) {
2126: newObject.name = oldObject.name;
2127: }
2128: if (oldObject.id) {
2129: newObject.id = oldObject.id;
2130: }
2131: oldObject.parentNode.replaceChild(newObject,oldObject);
2132: return;
2133: }
2134:
2135: ENDJS
1.475 www 2136: }
2137:
1.167 www 2138: sub gradeleveldescription {
2139: my $gradelevel=shift;
2140: my %gradelevels=(0 => 'Not specified',
2141: 1 => 'Grade 1',
2142: 2 => 'Grade 2',
2143: 3 => 'Grade 3',
2144: 4 => 'Grade 4',
2145: 5 => 'Grade 5',
2146: 6 => 'Grade 6',
2147: 7 => 'Grade 7',
2148: 8 => 'Grade 8',
2149: 9 => 'Grade 9',
2150: 10 => 'Grade 10',
2151: 11 => 'Grade 11',
2152: 12 => 'Grade 12',
2153: 13 => 'Grade 13',
2154: 14 => '100 Level',
2155: 15 => '200 Level',
2156: 16 => '300 Level',
2157: 17 => '400 Level',
2158: 18 => 'Graduate Level');
2159: return &mt($gradelevels{$gradelevel});
2160: }
2161:
1.163 www 2162: sub select_level_form {
2163: my ($deflevel,$name)=@_;
2164: unless ($deflevel) { $deflevel=0; }
1.167 www 2165: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2166: for (my $i=0; $i<=18; $i++) {
2167: $selectform.="<option value=\"$i\" ".
1.253 albertel 2168: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2169: ">".&gradeleveldescription($i)."</option>\n";
2170: }
2171: $selectform.="</select>";
2172: return $selectform;
1.163 www 2173: }
1.167 www 2174:
1.35 matthew 2175: #-------------------------------------------
2176:
1.45 matthew 2177: =pod
2178:
1.1075.2.42 raeburn 2179: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2180:
2181: Returns a string containing a <select name='$name' size='1'> form to
2182: allow a user to select the domain to preform an operation in.
2183: See loncreateuser.pm for an example invocation and use.
2184:
1.90 www 2185: If the $includeempty flag is set, it also includes an empty choice ("no domain
2186: selected");
2187:
1.743 raeburn 2188: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2189:
1.910 raeburn 2190: 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.
2191:
1.1075.2.36 raeburn 2192: The optional $incdoms is a reference to an array of domains which will be the only available options.
2193:
2194: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2195:
1.35 matthew 2196: =cut
2197:
2198: #-------------------------------------------
1.34 matthew 2199: sub select_dom_form {
1.1075.2.36 raeburn 2200: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2201: if ($onchange) {
1.874 raeburn 2202: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2203: }
1.1075.2.36 raeburn 2204: my (@domains,%exclude);
1.910 raeburn 2205: if (ref($incdoms) eq 'ARRAY') {
2206: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2207: } else {
2208: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2209: }
1.90 www 2210: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2211: if (ref($excdoms) eq 'ARRAY') {
2212: map { $exclude{$_} = 1; } @{$excdoms};
2213: }
1.743 raeburn 2214: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2215: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2216: next if ($exclude{$dom});
1.356 albertel 2217: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2218: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2219: if ($showdomdesc) {
2220: if ($dom ne '') {
2221: my $domdesc = &Apache::lonnet::domain($dom,'description');
2222: if ($domdesc ne '') {
2223: $selectdomain .= ' ('.$domdesc.')';
2224: }
2225: }
2226: }
2227: $selectdomain .= "</option>\n";
1.34 matthew 2228: }
2229: $selectdomain.="</select>";
2230: return $selectdomain;
2231: }
2232:
1.35 matthew 2233: #-------------------------------------------
2234:
1.45 matthew 2235: =pod
2236:
1.648 raeburn 2237: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2238:
1.586 raeburn 2239: input: 4 arguments (two required, two optional) -
2240: $domain - domain of new user
2241: $name - name of form element
2242: $default - Value of 'default' causes a default item to be first
2243: option, and selected by default.
2244: $hide - Value of 'hide' causes hiding of the name of the server,
2245: if 1 server found, or default, if 0 found.
1.594 raeburn 2246: output: returns 2 items:
1.586 raeburn 2247: (a) form element which contains either:
2248: (i) <select name="$name">
2249: <option value="$hostid1">$hostid $servers{$hostid}</option>
2250: <option value="$hostid2">$hostid $servers{$hostid}</option>
2251: </select>
2252: form item if there are multiple library servers in $domain, or
2253: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2254: if there is only one library server in $domain.
2255:
2256: (b) number of library servers found.
2257:
2258: See loncreateuser.pm for example of use.
1.35 matthew 2259:
2260: =cut
2261:
2262: #-------------------------------------------
1.586 raeburn 2263: sub home_server_form_item {
2264: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2265: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2266: my $result;
2267: my $numlib = keys(%servers);
2268: if ($numlib > 1) {
2269: $result .= '<select name="'.$name.'" />'."\n";
2270: if ($default) {
1.804 bisitz 2271: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2272: '</option>'."\n";
2273: }
2274: foreach my $hostid (sort(keys(%servers))) {
2275: $result.= '<option value="'.$hostid.'">'.
2276: $hostid.' '.$servers{$hostid}."</option>\n";
2277: }
2278: $result .= '</select>'."\n";
2279: } elsif ($numlib == 1) {
2280: my $hostid;
2281: foreach my $item (keys(%servers)) {
2282: $hostid = $item;
2283: }
2284: $result .= '<input type="hidden" name="'.$name.'" value="'.
2285: $hostid.'" />';
2286: if (!$hide) {
2287: $result .= $hostid.' '.$servers{$hostid};
2288: }
2289: $result .= "\n";
2290: } elsif ($default) {
2291: $result .= '<input type="hidden" name="'.$name.
2292: '" value="default" />';
2293: if (!$hide) {
2294: $result .= &mt('default');
2295: }
2296: $result .= "\n";
1.33 matthew 2297: }
1.586 raeburn 2298: return ($result,$numlib);
1.33 matthew 2299: }
1.112 bowersj2 2300:
2301: =pod
2302:
1.534 albertel 2303: =back
2304:
1.112 bowersj2 2305: =cut
1.87 matthew 2306:
2307: ###############################################################
1.112 bowersj2 2308: ## Decoding User Agent ##
1.87 matthew 2309: ###############################################################
2310:
2311: =pod
2312:
1.112 bowersj2 2313: =head1 Decoding the User Agent
2314:
2315: =over 4
2316:
2317: =item * &decode_user_agent()
1.87 matthew 2318:
2319: Inputs: $r
2320:
2321: Outputs:
2322:
2323: =over 4
2324:
1.112 bowersj2 2325: =item * $httpbrowser
1.87 matthew 2326:
1.112 bowersj2 2327: =item * $clientbrowser
1.87 matthew 2328:
1.112 bowersj2 2329: =item * $clientversion
1.87 matthew 2330:
1.112 bowersj2 2331: =item * $clientmathml
1.87 matthew 2332:
1.112 bowersj2 2333: =item * $clientunicode
1.87 matthew 2334:
1.112 bowersj2 2335: =item * $clientos
1.87 matthew 2336:
1.1075.2.42 raeburn 2337: =item * $clientmobile
2338:
2339: =item * $clientinfo
2340:
1.87 matthew 2341: =back
2342:
1.157 matthew 2343: =back
2344:
1.87 matthew 2345: =cut
2346:
2347: ###############################################################
2348: ###############################################################
2349: sub decode_user_agent {
1.247 albertel 2350: my ($r)=@_;
1.87 matthew 2351: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2352: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2353: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2354: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2355: my $clientbrowser='unknown';
2356: my $clientversion='0';
2357: my $clientmathml='';
2358: my $clientunicode='0';
1.1075.2.42 raeburn 2359: my $clientmobile=0;
1.87 matthew 2360: for (my $i=0;$i<=$#browsertype;$i++) {
2361: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2362: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2363: $clientbrowser=$bname;
2364: $httpbrowser=~/$vreg/i;
2365: $clientversion=$1;
2366: $clientmathml=($clientversion>=$minv);
2367: $clientunicode=($clientversion>=$univ);
2368: }
2369: }
2370: my $clientos='unknown';
1.1075.2.42 raeburn 2371: my $clientinfo;
1.87 matthew 2372: if (($httpbrowser=~/linux/i) ||
2373: ($httpbrowser=~/unix/i) ||
2374: ($httpbrowser=~/ux/i) ||
2375: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2376: if (($httpbrowser=~/vax/i) ||
2377: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2378: if ($httpbrowser=~/next/i) { $clientos='next'; }
2379: if (($httpbrowser=~/mac/i) ||
2380: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2381: if ($httpbrowser=~/win/i) { $clientos='win'; }
2382: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2383: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2384: $clientmobile=lc($1);
2385: }
2386: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2387: $clientinfo = 'firefox-'.$1;
2388: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2389: $clientinfo = 'chromeframe-'.$1;
2390: }
1.87 matthew 2391: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42 raeburn 2392: $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87 matthew 2393: }
2394:
1.32 matthew 2395: ###############################################################
2396: ## Authentication changing form generation subroutines ##
2397: ###############################################################
2398: ##
2399: ## All of the authform_xxxxxxx subroutines take their inputs in a
2400: ## hash, and have reasonable default values.
2401: ##
2402: ## formname = the name given in the <form> tag.
1.35 matthew 2403: #-------------------------------------------
2404:
1.45 matthew 2405: =pod
2406:
1.112 bowersj2 2407: =head1 Authentication Routines
2408:
2409: =over 4
2410:
1.648 raeburn 2411: =item * &authform_xxxxxx()
1.35 matthew 2412:
2413: The authform_xxxxxx subroutines provide javascript and html forms which
2414: handle some of the conveniences required for authentication forms.
2415: This is not an optimal method, but it works.
2416:
2417: =over 4
2418:
1.112 bowersj2 2419: =item * authform_header
1.35 matthew 2420:
1.112 bowersj2 2421: =item * authform_authorwarning
1.35 matthew 2422:
1.112 bowersj2 2423: =item * authform_nochange
1.35 matthew 2424:
1.112 bowersj2 2425: =item * authform_kerberos
1.35 matthew 2426:
1.112 bowersj2 2427: =item * authform_internal
1.35 matthew 2428:
1.112 bowersj2 2429: =item * authform_filesystem
1.35 matthew 2430:
2431: =back
2432:
1.648 raeburn 2433: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2434:
1.35 matthew 2435: =cut
2436:
2437: #-------------------------------------------
1.32 matthew 2438: sub authform_header{
2439: my %in = (
2440: formname => 'cu',
1.80 albertel 2441: kerb_def_dom => '',
1.32 matthew 2442: @_,
2443: );
2444: $in{'formname'} = 'document.' . $in{'formname'};
2445: my $result='';
1.80 albertel 2446:
2447: #---------------------------------------------- Code for upper case translation
2448: my $Javascript_toUpperCase;
2449: unless ($in{kerb_def_dom}) {
2450: $Javascript_toUpperCase =<<"END";
2451: switch (choice) {
2452: case 'krb': currentform.elements[choicearg].value =
2453: currentform.elements[choicearg].value.toUpperCase();
2454: break;
2455: default:
2456: }
2457: END
2458: } else {
2459: $Javascript_toUpperCase = "";
2460: }
2461:
1.165 raeburn 2462: my $radioval = "'nochange'";
1.591 raeburn 2463: if (defined($in{'curr_authtype'})) {
2464: if ($in{'curr_authtype'} ne '') {
2465: $radioval = "'".$in{'curr_authtype'}."arg'";
2466: }
1.174 matthew 2467: }
1.165 raeburn 2468: my $argfield = 'null';
1.591 raeburn 2469: if (defined($in{'mode'})) {
1.165 raeburn 2470: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2471: if (defined($in{'curr_autharg'})) {
2472: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2473: $argfield = "'$in{'curr_autharg'}'";
2474: }
2475: }
2476: }
2477: }
2478:
1.32 matthew 2479: $result.=<<"END";
2480: var current = new Object();
1.165 raeburn 2481: current.radiovalue = $radioval;
2482: current.argfield = $argfield;
1.32 matthew 2483:
2484: function changed_radio(choice,currentform) {
2485: var choicearg = choice + 'arg';
2486: // If a radio button in changed, we need to change the argfield
2487: if (current.radiovalue != choice) {
2488: current.radiovalue = choice;
2489: if (current.argfield != null) {
2490: currentform.elements[current.argfield].value = '';
2491: }
2492: if (choice == 'nochange') {
2493: current.argfield = null;
2494: } else {
2495: current.argfield = choicearg;
2496: switch(choice) {
2497: case 'krb':
2498: currentform.elements[current.argfield].value =
2499: "$in{'kerb_def_dom'}";
2500: break;
2501: default:
2502: break;
2503: }
2504: }
2505: }
2506: return;
2507: }
1.22 www 2508:
1.32 matthew 2509: function changed_text(choice,currentform) {
2510: var choicearg = choice + 'arg';
2511: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2512: $Javascript_toUpperCase
1.32 matthew 2513: // clear old field
2514: if ((current.argfield != choicearg) && (current.argfield != null)) {
2515: currentform.elements[current.argfield].value = '';
2516: }
2517: current.argfield = choicearg;
2518: }
2519: set_auth_radio_buttons(choice,currentform);
2520: return;
1.20 www 2521: }
1.32 matthew 2522:
2523: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2524: var numauthchoices = currentform.login.length;
2525: if (typeof numauthchoices == "undefined") {
2526: return;
2527: }
1.32 matthew 2528: var i=0;
1.986 raeburn 2529: while (i < numauthchoices) {
1.32 matthew 2530: if (currentform.login[i].value == newvalue) { break; }
2531: i++;
2532: }
1.986 raeburn 2533: if (i == numauthchoices) {
1.32 matthew 2534: return;
2535: }
2536: current.radiovalue = newvalue;
2537: currentform.login[i].checked = true;
2538: return;
2539: }
2540: END
2541: return $result;
2542: }
2543:
1.1075.2.20 raeburn 2544: sub authform_authorwarning {
1.32 matthew 2545: my $result='';
1.144 matthew 2546: $result='<i>'.
2547: &mt('As a general rule, only authors or co-authors should be '.
2548: 'filesystem authenticated '.
2549: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2550: return $result;
2551: }
2552:
1.1075.2.20 raeburn 2553: sub authform_nochange {
1.32 matthew 2554: my %in = (
2555: formname => 'document.cu',
2556: kerb_def_dom => 'MSU.EDU',
2557: @_,
2558: );
1.1075.2.20 raeburn 2559: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2560: my $result;
1.1075.2.20 raeburn 2561: if (!$authnum) {
2562: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2563: } else {
2564: $result = '<label>'.&mt('[_1] Do not change login data',
2565: '<input type="radio" name="login" value="nochange" '.
2566: 'checked="checked" onclick="'.
1.281 albertel 2567: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2568: '</label>';
1.586 raeburn 2569: }
1.32 matthew 2570: return $result;
2571: }
2572:
1.591 raeburn 2573: sub authform_kerberos {
1.32 matthew 2574: my %in = (
2575: formname => 'document.cu',
2576: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2577: kerb_def_auth => 'krb4',
1.32 matthew 2578: @_,
2579: );
1.586 raeburn 2580: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2581: $autharg,$jscall);
1.1075.2.20 raeburn 2582: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2583: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2584: $check5 = ' checked="checked"';
1.80 albertel 2585: } else {
1.772 bisitz 2586: $check4 = ' checked="checked"';
1.80 albertel 2587: }
1.165 raeburn 2588: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2589: if (defined($in{'curr_authtype'})) {
2590: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2591: $krbcheck = ' checked="checked"';
1.623 raeburn 2592: if (defined($in{'mode'})) {
2593: if ($in{'mode'} eq 'modifyuser') {
2594: $krbcheck = '';
2595: }
2596: }
1.591 raeburn 2597: if (defined($in{'curr_kerb_ver'})) {
2598: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2599: $check5 = ' checked="checked"';
1.591 raeburn 2600: $check4 = '';
2601: } else {
1.772 bisitz 2602: $check4 = ' checked="checked"';
1.591 raeburn 2603: $check5 = '';
2604: }
1.586 raeburn 2605: }
1.591 raeburn 2606: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2607: $krbarg = $in{'curr_autharg'};
2608: }
1.586 raeburn 2609: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2610: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2611: $result =
2612: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2613: $in{'curr_autharg'},$krbver);
2614: } else {
2615: $result =
2616: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2617: }
2618: return $result;
2619: }
2620: }
2621: } else {
2622: if ($authnum == 1) {
1.784 bisitz 2623: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2624: }
2625: }
1.586 raeburn 2626: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2627: return;
1.587 raeburn 2628: } elsif ($authtype eq '') {
1.591 raeburn 2629: if (defined($in{'mode'})) {
1.587 raeburn 2630: if ($in{'mode'} eq 'modifycourse') {
2631: if ($authnum == 1) {
1.1075.2.20 raeburn 2632: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2633: }
2634: }
2635: }
1.586 raeburn 2636: }
2637: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2638: if ($authtype eq '') {
2639: $authtype = '<input type="radio" name="login" value="krb" '.
2640: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2641: $krbcheck.' />';
2642: }
2643: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2644: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2645: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2646: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2647: $in{'curr_authtype'} eq 'krb4')) {
2648: $result .= &mt
1.144 matthew 2649: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2650: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2651: '<label>'.$authtype,
1.281 albertel 2652: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2653: 'value="'.$krbarg.'" '.
1.144 matthew 2654: 'onchange="'.$jscall.'" />',
1.281 albertel 2655: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2656: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2657: '</label>');
1.586 raeburn 2658: } elsif ($can_assign{'krb4'}) {
2659: $result .= &mt
2660: ('[_1] Kerberos authenticated with domain [_2] '.
2661: '[_3] Version 4 [_4]',
2662: '<label>'.$authtype,
2663: '</label><input type="text" size="10" name="krbarg" '.
2664: 'value="'.$krbarg.'" '.
2665: 'onchange="'.$jscall.'" />',
2666: '<label><input type="hidden" name="krbver" value="4" />',
2667: '</label>');
2668: } elsif ($can_assign{'krb5'}) {
2669: $result .= &mt
2670: ('[_1] Kerberos authenticated with domain [_2] '.
2671: '[_3] Version 5 [_4]',
2672: '<label>'.$authtype,
2673: '</label><input type="text" size="10" name="krbarg" '.
2674: 'value="'.$krbarg.'" '.
2675: 'onchange="'.$jscall.'" />',
2676: '<label><input type="hidden" name="krbver" value="5" />',
2677: '</label>');
2678: }
1.32 matthew 2679: return $result;
2680: }
2681:
1.1075.2.20 raeburn 2682: sub authform_internal {
1.586 raeburn 2683: my %in = (
1.32 matthew 2684: formname => 'document.cu',
2685: kerb_def_dom => 'MSU.EDU',
2686: @_,
2687: );
1.586 raeburn 2688: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2689: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2690: if (defined($in{'curr_authtype'})) {
2691: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2692: if ($can_assign{'int'}) {
1.772 bisitz 2693: $intcheck = 'checked="checked" ';
1.623 raeburn 2694: if (defined($in{'mode'})) {
2695: if ($in{'mode'} eq 'modifyuser') {
2696: $intcheck = '';
2697: }
2698: }
1.591 raeburn 2699: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2700: $intarg = $in{'curr_autharg'};
2701: }
2702: } else {
2703: $result = &mt('Currently internally authenticated.');
2704: return $result;
1.165 raeburn 2705: }
2706: }
1.586 raeburn 2707: } else {
2708: if ($authnum == 1) {
1.784 bisitz 2709: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2710: }
2711: }
2712: if (!$can_assign{'int'}) {
2713: return;
1.587 raeburn 2714: } elsif ($authtype eq '') {
1.591 raeburn 2715: if (defined($in{'mode'})) {
1.587 raeburn 2716: if ($in{'mode'} eq 'modifycourse') {
2717: if ($authnum == 1) {
1.1075.2.20 raeburn 2718: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2719: }
2720: }
2721: }
1.165 raeburn 2722: }
1.586 raeburn 2723: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2724: if ($authtype eq '') {
2725: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2726: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2727: }
1.605 bisitz 2728: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2729: $intarg.'" onchange="'.$jscall.'" />';
2730: $result = &mt
1.144 matthew 2731: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2732: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2733: $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 2734: return $result;
2735: }
2736:
1.1075.2.20 raeburn 2737: sub authform_local {
1.32 matthew 2738: my %in = (
2739: formname => 'document.cu',
2740: kerb_def_dom => 'MSU.EDU',
2741: @_,
2742: );
1.586 raeburn 2743: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2744: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2745: if (defined($in{'curr_authtype'})) {
2746: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2747: if ($can_assign{'loc'}) {
1.772 bisitz 2748: $loccheck = 'checked="checked" ';
1.623 raeburn 2749: if (defined($in{'mode'})) {
2750: if ($in{'mode'} eq 'modifyuser') {
2751: $loccheck = '';
2752: }
2753: }
1.591 raeburn 2754: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2755: $locarg = $in{'curr_autharg'};
2756: }
2757: } else {
2758: $result = &mt('Currently using local (institutional) authentication.');
2759: return $result;
1.165 raeburn 2760: }
2761: }
1.586 raeburn 2762: } else {
2763: if ($authnum == 1) {
1.784 bisitz 2764: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2765: }
2766: }
2767: if (!$can_assign{'loc'}) {
2768: return;
1.587 raeburn 2769: } elsif ($authtype eq '') {
1.591 raeburn 2770: if (defined($in{'mode'})) {
1.587 raeburn 2771: if ($in{'mode'} eq 'modifycourse') {
2772: if ($authnum == 1) {
1.1075.2.20 raeburn 2773: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2774: }
2775: }
2776: }
1.165 raeburn 2777: }
1.586 raeburn 2778: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2779: if ($authtype eq '') {
2780: $authtype = '<input type="radio" name="login" value="loc" '.
2781: $loccheck.' onchange="'.$jscall.'" onclick="'.
2782: $jscall.'" />';
2783: }
2784: $autharg = '<input type="text" size="10" name="locarg" value="'.
2785: $locarg.'" onchange="'.$jscall.'" />';
2786: $result = &mt('[_1] Local Authentication with argument [_2]',
2787: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2788: return $result;
2789: }
2790:
1.1075.2.20 raeburn 2791: sub authform_filesystem {
1.32 matthew 2792: my %in = (
2793: formname => 'document.cu',
2794: kerb_def_dom => 'MSU.EDU',
2795: @_,
2796: );
1.586 raeburn 2797: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2798: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2799: if (defined($in{'curr_authtype'})) {
2800: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2801: if ($can_assign{'fsys'}) {
1.772 bisitz 2802: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2803: if (defined($in{'mode'})) {
2804: if ($in{'mode'} eq 'modifyuser') {
2805: $fsyscheck = '';
2806: }
2807: }
1.586 raeburn 2808: } else {
2809: $result = &mt('Currently Filesystem Authenticated.');
2810: return $result;
2811: }
2812: }
2813: } else {
2814: if ($authnum == 1) {
1.784 bisitz 2815: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2816: }
2817: }
2818: if (!$can_assign{'fsys'}) {
2819: return;
1.587 raeburn 2820: } elsif ($authtype eq '') {
1.591 raeburn 2821: if (defined($in{'mode'})) {
1.587 raeburn 2822: if ($in{'mode'} eq 'modifycourse') {
2823: if ($authnum == 1) {
1.1075.2.20 raeburn 2824: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2825: }
2826: }
2827: }
1.586 raeburn 2828: }
2829: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2830: if ($authtype eq '') {
2831: $authtype = '<input type="radio" name="login" value="fsys" '.
2832: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2833: $jscall.'" />';
2834: }
2835: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2836: ' onchange="'.$jscall.'" />';
2837: $result = &mt
1.144 matthew 2838: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2839: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2840: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2841: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2842: 'onchange="'.$jscall.'" />');
1.32 matthew 2843: return $result;
2844: }
2845:
1.586 raeburn 2846: sub get_assignable_auth {
2847: my ($dom) = @_;
2848: if ($dom eq '') {
2849: $dom = $env{'request.role.domain'};
2850: }
2851: my %can_assign = (
2852: krb4 => 1,
2853: krb5 => 1,
2854: int => 1,
2855: loc => 1,
2856: );
2857: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2858: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2859: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2860: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2861: my $context;
2862: if ($env{'request.role'} =~ /^au/) {
2863: $context = 'author';
2864: } elsif ($env{'request.role'} =~ /^dc/) {
2865: $context = 'domain';
2866: } elsif ($env{'request.course.id'}) {
2867: $context = 'course';
2868: }
2869: if ($context) {
2870: if (ref($authhash->{$context}) eq 'HASH') {
2871: %can_assign = %{$authhash->{$context}};
2872: }
2873: }
2874: }
2875: }
2876: my $authnum = 0;
2877: foreach my $key (keys(%can_assign)) {
2878: if ($can_assign{$key}) {
2879: $authnum ++;
2880: }
2881: }
2882: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2883: $authnum --;
2884: }
2885: return ($authnum,%can_assign);
2886: }
2887:
1.80 albertel 2888: ###############################################################
2889: ## Get Kerberos Defaults for Domain ##
2890: ###############################################################
2891: ##
2892: ## Returns default kerberos version and an associated argument
2893: ## as listed in file domain.tab. If not listed, provides
2894: ## appropriate default domain and kerberos version.
2895: ##
2896: #-------------------------------------------
2897:
2898: =pod
2899:
1.648 raeburn 2900: =item * &get_kerberos_defaults()
1.80 albertel 2901:
2902: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2903: version and domain. If not found, it defaults to version 4 and the
2904: domain of the server.
1.80 albertel 2905:
1.648 raeburn 2906: =over 4
2907:
1.80 albertel 2908: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2909:
1.648 raeburn 2910: =back
2911:
2912: =back
2913:
1.80 albertel 2914: =cut
2915:
2916: #-------------------------------------------
2917: sub get_kerberos_defaults {
2918: my $domain=shift;
1.641 raeburn 2919: my ($krbdef,$krbdefdom);
2920: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2921: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2922: $krbdef = $domdefaults{'auth_def'};
2923: $krbdefdom = $domdefaults{'auth_arg_def'};
2924: } else {
1.80 albertel 2925: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2926: my $krbdefdom=$1;
2927: $krbdefdom=~tr/a-z/A-Z/;
2928: $krbdef = "krb4";
2929: }
2930: return ($krbdef,$krbdefdom);
2931: }
1.112 bowersj2 2932:
1.32 matthew 2933:
1.46 matthew 2934: ###############################################################
2935: ## Thesaurus Functions ##
2936: ###############################################################
1.20 www 2937:
1.46 matthew 2938: =pod
1.20 www 2939:
1.112 bowersj2 2940: =head1 Thesaurus Functions
2941:
2942: =over 4
2943:
1.648 raeburn 2944: =item * &initialize_keywords()
1.46 matthew 2945:
2946: Initializes the package variable %Keywords if it is empty. Uses the
2947: package variable $thesaurus_db_file.
2948:
2949: =cut
2950:
2951: ###################################################
2952:
2953: sub initialize_keywords {
2954: return 1 if (scalar keys(%Keywords));
2955: # If we are here, %Keywords is empty, so fill it up
2956: # Make sure the file we need exists...
2957: if (! -e $thesaurus_db_file) {
2958: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2959: " failed because it does not exist");
2960: return 0;
2961: }
2962: # Set up the hash as a database
2963: my %thesaurus_db;
2964: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2965: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2966: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2967: $thesaurus_db_file);
2968: return 0;
2969: }
2970: # Get the average number of appearances of a word.
2971: my $avecount = $thesaurus_db{'average.count'};
2972: # Put keywords (those that appear > average) into %Keywords
2973: while (my ($word,$data)=each (%thesaurus_db)) {
2974: my ($count,undef) = split /:/,$data;
2975: $Keywords{$word}++ if ($count > $avecount);
2976: }
2977: untie %thesaurus_db;
2978: # Remove special values from %Keywords.
1.356 albertel 2979: foreach my $value ('total.count','average.count') {
2980: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2981: }
1.46 matthew 2982: return 1;
2983: }
2984:
2985: ###################################################
2986:
2987: =pod
2988:
1.648 raeburn 2989: =item * &keyword($word)
1.46 matthew 2990:
2991: Returns true if $word is a keyword. A keyword is a word that appears more
2992: than the average number of times in the thesaurus database. Calls
2993: &initialize_keywords
2994:
2995: =cut
2996:
2997: ###################################################
1.20 www 2998:
2999: sub keyword {
1.46 matthew 3000: return if (!&initialize_keywords());
3001: my $word=lc(shift());
3002: $word=~s/\W//g;
3003: return exists($Keywords{$word});
1.20 www 3004: }
1.46 matthew 3005:
3006: ###############################################################
3007:
3008: =pod
1.20 www 3009:
1.648 raeburn 3010: =item * &get_related_words()
1.46 matthew 3011:
1.160 matthew 3012: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3013: an array of words. If the keyword is not in the thesaurus, an empty array
3014: will be returned. The order of the words returned is determined by the
3015: database which holds them.
3016:
3017: Uses global $thesaurus_db_file.
3018:
1.1057 foxr 3019:
1.46 matthew 3020: =cut
3021:
3022: ###############################################################
3023: sub get_related_words {
3024: my $keyword = shift;
3025: my %thesaurus_db;
3026: if (! -e $thesaurus_db_file) {
3027: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3028: "failed because the file does not exist");
3029: return ();
3030: }
3031: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3032: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3033: return ();
3034: }
3035: my @Words=();
1.429 www 3036: my $count=0;
1.46 matthew 3037: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3038: # The first element is the number of times
3039: # the word appears. We do not need it now.
1.429 www 3040: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3041: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3042: my $threshold=$mostfrequentcount/10;
3043: foreach my $possibleword (@RelatedWords) {
3044: my ($word,$wordcount)=split(/\,/,$possibleword);
3045: if ($wordcount>$threshold) {
3046: push(@Words,$word);
3047: $count++;
3048: if ($count>10) { last; }
3049: }
1.20 www 3050: }
3051: }
1.46 matthew 3052: untie %thesaurus_db;
3053: return @Words;
1.14 harris41 3054: }
1.46 matthew 3055:
1.112 bowersj2 3056: =pod
3057:
3058: =back
3059:
3060: =cut
1.61 www 3061:
3062: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3063: =pod
3064:
1.112 bowersj2 3065: =head1 User Name Functions
3066:
3067: =over 4
3068:
1.648 raeburn 3069: =item * &plainname($uname,$udom,$first)
1.81 albertel 3070:
1.112 bowersj2 3071: Takes a users logon name and returns it as a string in
1.226 albertel 3072: "first middle last generation" form
3073: if $first is set to 'lastname' then it returns it as
3074: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3075:
3076: =cut
1.61 www 3077:
1.295 www 3078:
1.81 albertel 3079: ###############################################################
1.61 www 3080: sub plainname {
1.226 albertel 3081: my ($uname,$udom,$first)=@_;
1.537 albertel 3082: return if (!defined($uname) || !defined($udom));
1.295 www 3083: my %names=&getnames($uname,$udom);
1.226 albertel 3084: my $name=&Apache::lonnet::format_name($names{'firstname'},
3085: $names{'middlename'},
3086: $names{'lastname'},
3087: $names{'generation'},$first);
3088: $name=~s/^\s+//;
1.62 www 3089: $name=~s/\s+$//;
3090: $name=~s/\s+/ /g;
1.353 albertel 3091: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3092: return $name;
1.61 www 3093: }
1.66 www 3094:
3095: # -------------------------------------------------------------------- Nickname
1.81 albertel 3096: =pod
3097:
1.648 raeburn 3098: =item * &nickname($uname,$udom)
1.81 albertel 3099:
3100: Gets a users name and returns it as a string as
3101:
3102: ""nickname""
1.66 www 3103:
1.81 albertel 3104: if the user has a nickname or
3105:
3106: "first middle last generation"
3107:
3108: if the user does not
3109:
3110: =cut
1.66 www 3111:
3112: sub nickname {
3113: my ($uname,$udom)=@_;
1.537 albertel 3114: return if (!defined($uname) || !defined($udom));
1.295 www 3115: my %names=&getnames($uname,$udom);
1.68 albertel 3116: my $name=$names{'nickname'};
1.66 www 3117: if ($name) {
3118: $name='"'.$name.'"';
3119: } else {
3120: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3121: $names{'lastname'}.' '.$names{'generation'};
3122: $name=~s/\s+$//;
3123: $name=~s/\s+/ /g;
3124: }
3125: return $name;
3126: }
3127:
1.295 www 3128: sub getnames {
3129: my ($uname,$udom)=@_;
1.537 albertel 3130: return if (!defined($uname) || !defined($udom));
1.433 albertel 3131: if ($udom eq 'public' && $uname eq 'public') {
3132: return ('lastname' => &mt('Public'));
3133: }
1.295 www 3134: my $id=$uname.':'.$udom;
3135: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3136: if ($cached) {
3137: return %{$names};
3138: } else {
3139: my %loadnames=&Apache::lonnet::get('environment',
3140: ['firstname','middlename','lastname','generation','nickname'],
3141: $udom,$uname);
3142: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3143: return %loadnames;
3144: }
3145: }
1.61 www 3146:
1.542 raeburn 3147: # -------------------------------------------------------------------- getemails
1.648 raeburn 3148:
1.542 raeburn 3149: =pod
3150:
1.648 raeburn 3151: =item * &getemails($uname,$udom)
1.542 raeburn 3152:
3153: Gets a user's email information and returns it as a hash with keys:
3154: notification, critnotification, permanentemail
3155:
3156: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3157: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3158:
1.648 raeburn 3159:
1.542 raeburn 3160: =cut
3161:
1.648 raeburn 3162:
1.466 albertel 3163: sub getemails {
3164: my ($uname,$udom)=@_;
3165: if ($udom eq 'public' && $uname eq 'public') {
3166: return;
3167: }
1.467 www 3168: if (!$udom) { $udom=$env{'user.domain'}; }
3169: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3170: my $id=$uname.':'.$udom;
3171: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3172: if ($cached) {
3173: return %{$names};
3174: } else {
3175: my %loadnames=&Apache::lonnet::get('environment',
3176: ['notification','critnotification',
3177: 'permanentemail'],
3178: $udom,$uname);
3179: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3180: return %loadnames;
3181: }
3182: }
3183:
1.551 albertel 3184: sub flush_email_cache {
3185: my ($uname,$udom)=@_;
3186: if (!$udom) { $udom =$env{'user.domain'}; }
3187: if (!$uname) { $uname=$env{'user.name'}; }
3188: return if ($udom eq 'public' && $uname eq 'public');
3189: my $id=$uname.':'.$udom;
3190: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3191: }
3192:
1.728 raeburn 3193: # -------------------------------------------------------------------- getlangs
3194:
3195: =pod
3196:
3197: =item * &getlangs($uname,$udom)
3198:
3199: Gets a user's language preference and returns it as a hash with key:
3200: language.
3201:
3202: =cut
3203:
3204:
3205: sub getlangs {
3206: my ($uname,$udom) = @_;
3207: if (!$udom) { $udom =$env{'user.domain'}; }
3208: if (!$uname) { $uname=$env{'user.name'}; }
3209: my $id=$uname.':'.$udom;
3210: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3211: if ($cached) {
3212: return %{$langs};
3213: } else {
3214: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3215: $udom,$uname);
3216: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3217: return %loadlangs;
3218: }
3219: }
3220:
3221: sub flush_langs_cache {
3222: my ($uname,$udom)=@_;
3223: if (!$udom) { $udom =$env{'user.domain'}; }
3224: if (!$uname) { $uname=$env{'user.name'}; }
3225: return if ($udom eq 'public' && $uname eq 'public');
3226: my $id=$uname.':'.$udom;
3227: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3228: }
3229:
1.61 www 3230: # ------------------------------------------------------------------ Screenname
1.81 albertel 3231:
3232: =pod
3233:
1.648 raeburn 3234: =item * &screenname($uname,$udom)
1.81 albertel 3235:
3236: Gets a users screenname and returns it as a string
3237:
3238: =cut
1.61 www 3239:
3240: sub screenname {
3241: my ($uname,$udom)=@_;
1.258 albertel 3242: if ($uname eq $env{'user.name'} &&
3243: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3244: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3245: return $names{'screenname'};
1.62 www 3246: }
3247:
1.212 albertel 3248:
1.802 bisitz 3249: # ------------------------------------------------------------- Confirm Wrapper
3250: =pod
3251:
1.1075.2.42 raeburn 3252: =item * &confirmwrapper($message)
1.802 bisitz 3253:
3254: Wrap messages about completion of operation in box
3255:
3256: =cut
3257:
3258: sub confirmwrapper {
3259: my ($message)=@_;
3260: if ($message) {
3261: return "\n".'<div class="LC_confirm_box">'."\n"
3262: .$message."\n"
3263: .'</div>'."\n";
3264: } else {
3265: return $message;
3266: }
3267: }
3268:
1.62 www 3269: # ------------------------------------------------------------- Message Wrapper
3270:
3271: sub messagewrapper {
1.369 www 3272: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3273: return
1.441 albertel 3274: '<a href="/adm/email?compose=individual&'.
3275: 'recname='.$username.'&recdom='.$domain.
3276: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3277: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3278: }
1.802 bisitz 3279:
1.74 www 3280: # --------------------------------------------------------------- Notes Wrapper
3281:
3282: sub noteswrapper {
3283: my ($link,$un,$do)=@_;
3284: return
1.896 amueller 3285: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3286: }
1.802 bisitz 3287:
1.62 www 3288: # ------------------------------------------------------------- Aboutme Wrapper
3289:
3290: sub aboutmewrapper {
1.1070 raeburn 3291: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3292: if (!defined($username) && !defined($domain)) {
3293: return;
3294: }
1.1075.2.15 raeburn 3295: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3296: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3297: }
3298:
3299: # ------------------------------------------------------------ Syllabus Wrapper
3300:
3301: sub syllabuswrapper {
1.707 bisitz 3302: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3303: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3304: }
1.14 harris41 3305:
1.802 bisitz 3306: # -----------------------------------------------------------------------------
3307:
1.208 matthew 3308: sub track_student_link {
1.887 raeburn 3309: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3310: my $link ="/adm/trackstudent?";
1.208 matthew 3311: my $title = 'View recent activity';
3312: if (defined($sname) && $sname !~ /^\s*$/ &&
3313: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3314: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3315: $title .= ' of this student';
1.268 albertel 3316: }
1.208 matthew 3317: if (defined($target) && $target !~ /^\s*$/) {
3318: $target = qq{target="$target"};
3319: } else {
3320: $target = '';
3321: }
1.268 albertel 3322: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3323: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3324: $title = &mt($title);
3325: $linktext = &mt($linktext);
1.448 albertel 3326: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3327: &help_open_topic('View_recent_activity');
1.208 matthew 3328: }
3329:
1.781 raeburn 3330: sub slot_reservations_link {
3331: my ($linktext,$sname,$sdom,$target) = @_;
3332: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3333: my $title = 'View slot reservation history';
3334: if (defined($sname) && $sname !~ /^\s*$/ &&
3335: defined($sdom) && $sdom !~ /^\s*$/) {
3336: $link .= "&uname=$sname&udom=$sdom";
3337: $title .= ' of this student';
3338: }
3339: if (defined($target) && $target !~ /^\s*$/) {
3340: $target = qq{target="$target"};
3341: } else {
3342: $target = '';
3343: }
3344: $title = &mt($title);
3345: $linktext = &mt($linktext);
3346: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3347: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3348:
3349: }
3350:
1.508 www 3351: # ===================================================== Display a student photo
3352:
3353:
1.509 albertel 3354: sub student_image_tag {
1.508 www 3355: my ($domain,$user)=@_;
3356: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3357: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3358: return '<img src="'.$imgsrc.'" align="right" />';
3359: } else {
3360: return '';
3361: }
3362: }
3363:
1.112 bowersj2 3364: =pod
3365:
3366: =back
3367:
3368: =head1 Access .tab File Data
3369:
3370: =over 4
3371:
1.648 raeburn 3372: =item * &languageids()
1.112 bowersj2 3373:
3374: returns list of all language ids
3375:
3376: =cut
3377:
1.14 harris41 3378: sub languageids {
1.16 harris41 3379: return sort(keys(%language));
1.14 harris41 3380: }
3381:
1.112 bowersj2 3382: =pod
3383:
1.648 raeburn 3384: =item * &languagedescription()
1.112 bowersj2 3385:
3386: returns description of a specified language id
3387:
3388: =cut
3389:
1.14 harris41 3390: sub languagedescription {
1.125 www 3391: my $code=shift;
3392: return ($supported_language{$code}?'* ':'').
3393: $language{$code}.
1.126 www 3394: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3395: }
3396:
1.1048 foxr 3397: =pod
3398:
3399: =item * &plainlanguagedescription
3400:
3401: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3402: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3403:
3404: =cut
3405:
1.145 www 3406: sub plainlanguagedescription {
3407: my $code=shift;
3408: return $language{$code};
3409: }
3410:
1.1048 foxr 3411: =pod
3412:
3413: =item * &supportedlanguagecode
3414:
3415: Returns the supported language code (e.g. sptutf maps to pt) given a language
3416: code.
3417:
3418: =cut
3419:
1.145 www 3420: sub supportedlanguagecode {
3421: my $code=shift;
3422: return $supported_language{$code};
1.97 www 3423: }
3424:
1.112 bowersj2 3425: =pod
3426:
1.1048 foxr 3427: =item * &latexlanguage()
3428:
3429: Given a language key code returns the correspondnig language to use
3430: to select the correct hyphenation on LaTeX printouts. This is undef if there
3431: is no supported hyphenation for the language code.
3432:
3433: =cut
3434:
3435: sub latexlanguage {
3436: my $code = shift;
3437: return $latex_language{$code};
3438: }
3439:
3440: =pod
3441:
3442: =item * &latexhyphenation()
3443:
3444: Same as above but what's supplied is the language as it might be stored
3445: in the metadata.
3446:
3447: =cut
3448:
3449: sub latexhyphenation {
3450: my $key = shift;
3451: return $latex_language_bykey{$key};
3452: }
3453:
3454: =pod
3455:
1.648 raeburn 3456: =item * ©rightids()
1.112 bowersj2 3457:
3458: returns list of all copyrights
3459:
3460: =cut
3461:
3462: sub copyrightids {
3463: return sort(keys(%cprtag));
3464: }
3465:
3466: =pod
3467:
1.648 raeburn 3468: =item * ©rightdescription()
1.112 bowersj2 3469:
3470: returns description of a specified copyright id
3471:
3472: =cut
3473:
3474: sub copyrightdescription {
1.166 www 3475: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3476: }
1.197 matthew 3477:
3478: =pod
3479:
1.648 raeburn 3480: =item * &source_copyrightids()
1.192 taceyjo1 3481:
3482: returns list of all source copyrights
3483:
3484: =cut
3485:
3486: sub source_copyrightids {
3487: return sort(keys(%scprtag));
3488: }
3489:
3490: =pod
3491:
1.648 raeburn 3492: =item * &source_copyrightdescription()
1.192 taceyjo1 3493:
3494: returns description of a specified source copyright id
3495:
3496: =cut
3497:
3498: sub source_copyrightdescription {
3499: return &mt($scprtag{shift(@_)});
3500: }
1.112 bowersj2 3501:
3502: =pod
3503:
1.648 raeburn 3504: =item * &filecategories()
1.112 bowersj2 3505:
3506: returns list of all file categories
3507:
3508: =cut
3509:
3510: sub filecategories {
3511: return sort(keys(%category_extensions));
3512: }
3513:
3514: =pod
3515:
1.648 raeburn 3516: =item * &filecategorytypes()
1.112 bowersj2 3517:
3518: returns list of file types belonging to a given file
3519: category
3520:
3521: =cut
3522:
3523: sub filecategorytypes {
1.356 albertel 3524: my ($cat) = @_;
3525: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3526: }
3527:
3528: =pod
3529:
1.648 raeburn 3530: =item * &fileembstyle()
1.112 bowersj2 3531:
3532: returns embedding style for a specified file type
3533:
3534: =cut
3535:
3536: sub fileembstyle {
3537: return $fe{lc(shift(@_))};
1.169 www 3538: }
3539:
1.351 www 3540: sub filemimetype {
3541: return $fm{lc(shift(@_))};
3542: }
3543:
1.169 www 3544:
3545: sub filecategoryselect {
3546: my ($name,$value)=@_;
1.189 matthew 3547: return &select_form($value,$name,
1.970 raeburn 3548: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3549: }
3550:
3551: =pod
3552:
1.648 raeburn 3553: =item * &filedescription()
1.112 bowersj2 3554:
3555: returns description for a specified file type
3556:
3557: =cut
3558:
3559: sub filedescription {
1.188 matthew 3560: my $file_description = $fd{lc(shift())};
3561: $file_description =~ s:([\[\]]):~$1:g;
3562: return &mt($file_description);
1.112 bowersj2 3563: }
3564:
3565: =pod
3566:
1.648 raeburn 3567: =item * &filedescriptionex()
1.112 bowersj2 3568:
3569: returns description for a specified file type with
3570: extra formatting
3571:
3572: =cut
3573:
3574: sub filedescriptionex {
3575: my $ex=shift;
1.188 matthew 3576: my $file_description = $fd{lc($ex)};
3577: $file_description =~ s:([\[\]]):~$1:g;
3578: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3579: }
3580:
3581: # End of .tab access
3582: =pod
3583:
3584: =back
3585:
3586: =cut
3587:
3588: # ------------------------------------------------------------------ File Types
3589: sub fileextensions {
3590: return sort(keys(%fe));
3591: }
3592:
1.97 www 3593: # ----------------------------------------------------------- Display Languages
3594: # returns a hash with all desired display languages
3595: #
3596:
3597: sub display_languages {
3598: my %languages=();
1.695 raeburn 3599: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3600: $languages{$lang}=1;
1.97 www 3601: }
3602: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3603: if ($env{'form.displaylanguage'}) {
1.356 albertel 3604: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3605: $languages{$lang}=1;
1.97 www 3606: }
3607: }
3608: return %languages;
1.14 harris41 3609: }
3610:
1.582 albertel 3611: sub languages {
3612: my ($possible_langs) = @_;
1.695 raeburn 3613: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3614: if (!ref($possible_langs)) {
3615: if( wantarray ) {
3616: return @preferred_langs;
3617: } else {
3618: return $preferred_langs[0];
3619: }
3620: }
3621: my %possibilities = map { $_ => 1 } (@$possible_langs);
3622: my @preferred_possibilities;
3623: foreach my $preferred_lang (@preferred_langs) {
3624: if (exists($possibilities{$preferred_lang})) {
3625: push(@preferred_possibilities, $preferred_lang);
3626: }
3627: }
3628: if( wantarray ) {
3629: return @preferred_possibilities;
3630: }
3631: return $preferred_possibilities[0];
3632: }
3633:
1.742 raeburn 3634: sub user_lang {
3635: my ($touname,$toudom,$fromcid) = @_;
3636: my @userlangs;
3637: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3638: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3639: $env{'course.'.$fromcid.'.languages'}));
3640: } else {
3641: my %langhash = &getlangs($touname,$toudom);
3642: if ($langhash{'languages'} ne '') {
3643: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3644: } else {
3645: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3646: if ($domdefs{'lang_def'} ne '') {
3647: @userlangs = ($domdefs{'lang_def'});
3648: }
3649: }
3650: }
3651: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3652: my $user_lh = Apache::localize->get_handle(@languages);
3653: return $user_lh;
3654: }
3655:
3656:
1.112 bowersj2 3657: ###############################################################
3658: ## Student Answer Attempts ##
3659: ###############################################################
3660:
3661: =pod
3662:
3663: =head1 Alternate Problem Views
3664:
3665: =over 4
3666:
1.648 raeburn 3667: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3668: $getattempt, $regexp, $gradesub)
3669:
3670: Return string with previous attempt on problem. Arguments:
3671:
3672: =over 4
3673:
3674: =item * $symb: Problem, including path
3675:
3676: =item * $username: username of the desired student
3677:
3678: =item * $domain: domain of the desired student
1.14 harris41 3679:
1.112 bowersj2 3680: =item * $course: Course ID
1.14 harris41 3681:
1.112 bowersj2 3682: =item * $getattempt: Leave blank for all attempts, otherwise put
3683: something
1.14 harris41 3684:
1.112 bowersj2 3685: =item * $regexp: if string matches this regexp, the string will be
3686: sent to $gradesub
1.14 harris41 3687:
1.112 bowersj2 3688: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3689:
1.112 bowersj2 3690: =back
1.14 harris41 3691:
1.112 bowersj2 3692: The output string is a table containing all desired attempts, if any.
1.16 harris41 3693:
1.112 bowersj2 3694: =cut
1.1 albertel 3695:
3696: sub get_previous_attempt {
1.43 ng 3697: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3698: my $prevattempts='';
1.43 ng 3699: no strict 'refs';
1.1 albertel 3700: if ($symb) {
1.3 albertel 3701: my (%returnhash)=
3702: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3703: if ($returnhash{'version'}) {
3704: my %lasthash=();
3705: my $version;
3706: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3707: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3708: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3709: }
1.1 albertel 3710: }
1.596 albertel 3711: $prevattempts=&start_data_table().&start_data_table_header_row();
3712: $prevattempts.='<th>'.&mt('History').'</th>';
1.978 raeburn 3713: my (%typeparts,%lasthidden);
1.945 raeburn 3714: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3715: foreach my $key (sort(keys(%lasthash))) {
3716: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3717: if ($#parts > 0) {
1.31 albertel 3718: my $data=$parts[-1];
1.989 raeburn 3719: next if ($data eq 'foilorder');
1.31 albertel 3720: pop(@parts);
1.1010 www 3721: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3722: if ($data eq 'type') {
3723: unless ($showsurv) {
3724: my $id = join(',',@parts);
3725: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3726: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3727: $lasthidden{$ign.'.'.$id} = 1;
3728: }
1.945 raeburn 3729: }
1.1010 www 3730: }
1.31 albertel 3731: } else {
1.41 ng 3732: if ($#parts == 0) {
3733: $prevattempts.='<th>'.$parts[0].'</th>';
3734: } else {
3735: $prevattempts.='<th>'.$ign.'</th>';
3736: }
1.31 albertel 3737: }
1.16 harris41 3738: }
1.596 albertel 3739: $prevattempts.=&end_data_table_header_row();
1.40 ng 3740: if ($getattempt eq '') {
3741: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945 raeburn 3742: my @hidden;
3743: if (%typeparts) {
3744: foreach my $id (keys(%typeparts)) {
3745: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
3746: push(@hidden,$id);
3747: }
3748: }
3749: }
3750: $prevattempts.=&start_data_table_row().
3751: '<td>'.&mt('Transaction [_1]',$version).'</td>';
3752: if (@hidden) {
3753: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3754: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3755: my $hide;
3756: foreach my $id (@hidden) {
3757: if ($key =~ /^\Q$id\E/) {
3758: $hide = 1;
3759: last;
3760: }
3761: }
3762: if ($hide) {
3763: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3764: if (($data eq 'award') || ($data eq 'awarddetail')) {
3765: my $value = &format_previous_attempt_value($key,
3766: $returnhash{$version.':'.$key});
3767: $prevattempts.='<td>'.$value.' </td>';
3768: } else {
3769: $prevattempts.='<td> </td>';
3770: }
3771: } else {
3772: if ($key =~ /\./) {
3773: my $value = &format_previous_attempt_value($key,
3774: $returnhash{$version.':'.$key});
3775: $prevattempts.='<td>'.$value.' </td>';
3776: } else {
3777: $prevattempts.='<td> </td>';
3778: }
3779: }
3780: }
3781: } else {
3782: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3783: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3784: my $value = &format_previous_attempt_value($key,
3785: $returnhash{$version.':'.$key});
3786: $prevattempts.='<td>'.$value.' </td>';
3787: }
3788: }
3789: $prevattempts.=&end_data_table_row();
1.40 ng 3790: }
1.1 albertel 3791: }
1.945 raeburn 3792: my @currhidden = keys(%lasthidden);
1.596 albertel 3793: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3794: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3795: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3796: if (%typeparts) {
3797: my $hidden;
3798: foreach my $id (@currhidden) {
3799: if ($key =~ /^\Q$id\E/) {
3800: $hidden = 1;
3801: last;
3802: }
3803: }
3804: if ($hidden) {
3805: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3806: if (($data eq 'award') || ($data eq 'awarddetail')) {
3807: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3808: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3809: $value = &$gradesub($value);
3810: }
3811: $prevattempts.='<td>'.$value.' </td>';
3812: } else {
3813: $prevattempts.='<td> </td>';
3814: }
3815: } else {
3816: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3817: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3818: $value = &$gradesub($value);
3819: }
3820: $prevattempts.='<td>'.$value.' </td>';
3821: }
3822: } else {
3823: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3824: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3825: $value = &$gradesub($value);
3826: }
3827: $prevattempts.='<td>'.$value.' </td>';
3828: }
1.16 harris41 3829: }
1.596 albertel 3830: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3831: } else {
1.596 albertel 3832: $prevattempts=
3833: &start_data_table().&start_data_table_row().
3834: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3835: &end_data_table_row().&end_data_table();
1.1 albertel 3836: }
3837: } else {
1.596 albertel 3838: $prevattempts=
3839: &start_data_table().&start_data_table_row().
3840: '<td>'.&mt('No data.').'</td>'.
3841: &end_data_table_row().&end_data_table();
1.1 albertel 3842: }
1.10 albertel 3843: }
3844:
1.581 albertel 3845: sub format_previous_attempt_value {
3846: my ($key,$value) = @_;
1.1011 www 3847: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3848: $value = &Apache::lonlocal::locallocaltime($value);
3849: } elsif (ref($value) eq 'ARRAY') {
3850: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3851: } elsif ($key =~ /answerstring$/) {
3852: my %answers = &Apache::lonnet::str2hash($value);
3853: my @anskeys = sort(keys(%answers));
3854: if (@anskeys == 1) {
3855: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3856: if ($answer =~ m{\0}) {
3857: $answer =~ s{\0}{,}g;
1.988 raeburn 3858: }
3859: my $tag_internal_answer_name = 'INTERNAL';
3860: if ($anskeys[0] eq $tag_internal_answer_name) {
3861: $value = $answer;
3862: } else {
3863: $value = $anskeys[0].'='.$answer;
3864: }
3865: } else {
3866: foreach my $ans (@anskeys) {
3867: my $answer = $answers{$ans};
1.1001 raeburn 3868: if ($answer =~ m{\0}) {
3869: $answer =~ s{\0}{,}g;
1.988 raeburn 3870: }
3871: $value .= $ans.'='.$answer.'<br />';;
3872: }
3873: }
1.581 albertel 3874: } else {
3875: $value = &unescape($value);
3876: }
3877: return $value;
3878: }
3879:
3880:
1.107 albertel 3881: sub relative_to_absolute {
3882: my ($url,$output)=@_;
3883: my $parser=HTML::TokeParser->new(\$output);
3884: my $token;
3885: my $thisdir=$url;
3886: my @rlinks=();
3887: while ($token=$parser->get_token) {
3888: if ($token->[0] eq 'S') {
3889: if ($token->[1] eq 'a') {
3890: if ($token->[2]->{'href'}) {
3891: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3892: }
3893: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3894: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3895: } elsif ($token->[1] eq 'base') {
3896: $thisdir=$token->[2]->{'href'};
3897: }
3898: }
3899: }
3900: $thisdir=~s-/[^/]*$--;
1.356 albertel 3901: foreach my $link (@rlinks) {
1.726 raeburn 3902: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3903: ($link=~/^\//) ||
3904: ($link=~/^javascript:/i) ||
3905: ($link=~/^mailto:/i) ||
3906: ($link=~/^\#/)) {
3907: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3908: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3909: }
3910: }
3911: # -------------------------------------------------- Deal with Applet codebases
3912: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3913: return $output;
3914: }
3915:
1.112 bowersj2 3916: =pod
3917:
1.648 raeburn 3918: =item * &get_student_view()
1.112 bowersj2 3919:
3920: show a snapshot of what student was looking at
3921:
3922: =cut
3923:
1.10 albertel 3924: sub get_student_view {
1.186 albertel 3925: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3926: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3927: my (%form);
1.10 albertel 3928: my @elements=('symb','courseid','domain','username');
3929: foreach my $element (@elements) {
1.186 albertel 3930: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3931: }
1.186 albertel 3932: if (defined($moreenv)) {
3933: %form=(%form,%{$moreenv});
3934: }
1.236 albertel 3935: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3936: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3937: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3938: $userview=~s/\<body[^\>]*\>//gi;
3939: $userview=~s/\<\/body\>//gi;
3940: $userview=~s/\<html\>//gi;
3941: $userview=~s/\<\/html\>//gi;
3942: $userview=~s/\<head\>//gi;
3943: $userview=~s/\<\/head\>//gi;
3944: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3945: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3946: if (wantarray) {
3947: return ($userview,$response);
3948: } else {
3949: return $userview;
3950: }
3951: }
3952:
3953: sub get_student_view_with_retries {
3954: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3955:
3956: my $ok = 0; # True if we got a good response.
3957: my $content;
3958: my $response;
3959:
3960: # Try to get the student_view done. within the retries count:
3961:
3962: do {
3963: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3964: $ok = $response->is_success;
3965: if (!$ok) {
3966: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3967: }
3968: $retries--;
3969: } while (!$ok && ($retries > 0));
3970:
3971: if (!$ok) {
3972: $content = ''; # On error return an empty content.
3973: }
1.651 www 3974: if (wantarray) {
3975: return ($content, $response);
3976: } else {
3977: return $content;
3978: }
1.11 albertel 3979: }
3980:
1.112 bowersj2 3981: =pod
3982:
1.648 raeburn 3983: =item * &get_student_answers()
1.112 bowersj2 3984:
3985: show a snapshot of how student was answering problem
3986:
3987: =cut
3988:
1.11 albertel 3989: sub get_student_answers {
1.100 sakharuk 3990: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3991: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3992: my (%moreenv);
1.11 albertel 3993: my @elements=('symb','courseid','domain','username');
3994: foreach my $element (@elements) {
1.186 albertel 3995: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3996: }
1.186 albertel 3997: $moreenv{'grade_target'}='answer';
3998: %moreenv=(%form,%moreenv);
1.497 raeburn 3999: $feedurl = &Apache::lonnet::clutter($feedurl);
4000: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4001: return $userview;
1.1 albertel 4002: }
1.116 albertel 4003:
4004: =pod
4005:
4006: =item * &submlink()
4007:
1.242 albertel 4008: Inputs: $text $uname $udom $symb $target
1.116 albertel 4009:
4010: Returns: A link to grades.pm such as to see the SUBM view of a student
4011:
4012: =cut
4013:
4014: ###############################################
4015: sub submlink {
1.242 albertel 4016: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4017: if (!($uname && $udom)) {
4018: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4019: &Apache::lonnet::whichuser($symb);
1.116 albertel 4020: if (!$symb) { $symb=$cursymb; }
4021: }
1.254 matthew 4022: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4023: $symb=&escape($symb);
1.960 bisitz 4024: if ($target) { $target=" target=\"$target\""; }
4025: return
4026: '<a href="/adm/grades?command=submission'.
4027: '&symb='.$symb.
4028: '&student='.$uname.
4029: '&userdom='.$udom.'"'.
4030: $target.'>'.$text.'</a>';
1.242 albertel 4031: }
4032: ##############################################
4033:
4034: =pod
4035:
4036: =item * &pgrdlink()
4037:
4038: Inputs: $text $uname $udom $symb $target
4039:
4040: Returns: A link to grades.pm such as to see the PGRD view of a student
4041:
4042: =cut
4043:
4044: ###############################################
4045: sub pgrdlink {
4046: my $link=&submlink(@_);
4047: $link=~s/(&command=submission)/$1&showgrading=yes/;
4048: return $link;
4049: }
4050: ##############################################
4051:
4052: =pod
4053:
4054: =item * &pprmlink()
4055:
4056: Inputs: $text $uname $udom $symb $target
4057:
4058: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4059: student and a specific resource
1.242 albertel 4060:
4061: =cut
4062:
4063: ###############################################
4064: sub pprmlink {
4065: my ($text,$uname,$udom,$symb,$target)=@_;
4066: if (!($uname && $udom)) {
4067: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4068: &Apache::lonnet::whichuser($symb);
1.242 albertel 4069: if (!$symb) { $symb=$cursymb; }
4070: }
1.254 matthew 4071: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4072: $symb=&escape($symb);
1.242 albertel 4073: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4074: return '<a href="/adm/parmset?command=set&'.
4075: 'symb='.$symb.'&uname='.$uname.
4076: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4077: }
4078: ##############################################
1.37 matthew 4079:
1.112 bowersj2 4080: =pod
4081:
4082: =back
4083:
4084: =cut
4085:
1.37 matthew 4086: ###############################################
1.51 www 4087:
4088:
4089: sub timehash {
1.687 raeburn 4090: my ($thistime) = @_;
4091: my $timezone = &Apache::lonlocal::gettimezone();
4092: my $dt = DateTime->from_epoch(epoch => $thistime)
4093: ->set_time_zone($timezone);
4094: my $wday = $dt->day_of_week();
4095: if ($wday == 7) { $wday = 0; }
4096: return ( 'second' => $dt->second(),
4097: 'minute' => $dt->minute(),
4098: 'hour' => $dt->hour(),
4099: 'day' => $dt->day_of_month(),
4100: 'month' => $dt->month(),
4101: 'year' => $dt->year(),
4102: 'weekday' => $wday,
4103: 'dayyear' => $dt->day_of_year(),
4104: 'dlsav' => $dt->is_dst() );
1.51 www 4105: }
4106:
1.370 www 4107: sub utc_string {
4108: my ($date)=@_;
1.371 www 4109: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4110: }
4111:
1.51 www 4112: sub maketime {
4113: my %th=@_;
1.687 raeburn 4114: my ($epoch_time,$timezone,$dt);
4115: $timezone = &Apache::lonlocal::gettimezone();
4116: eval {
4117: $dt = DateTime->new( year => $th{'year'},
4118: month => $th{'month'},
4119: day => $th{'day'},
4120: hour => $th{'hour'},
4121: minute => $th{'minute'},
4122: second => $th{'second'},
4123: time_zone => $timezone,
4124: );
4125: };
4126: if (!$@) {
4127: $epoch_time = $dt->epoch;
4128: if ($epoch_time) {
4129: return $epoch_time;
4130: }
4131: }
1.51 www 4132: return POSIX::mktime(
4133: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4134: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4135: }
4136:
4137: #########################################
1.51 www 4138:
4139: sub findallcourses {
1.482 raeburn 4140: my ($roles,$uname,$udom) = @_;
1.355 albertel 4141: my %roles;
4142: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4143: my %courses;
1.51 www 4144: my $now=time;
1.482 raeburn 4145: if (!defined($uname)) {
4146: $uname = $env{'user.name'};
4147: }
4148: if (!defined($udom)) {
4149: $udom = $env{'user.domain'};
4150: }
4151: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4152: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4153: if (!%roles) {
4154: %roles = (
4155: cc => 1,
1.907 raeburn 4156: co => 1,
1.482 raeburn 4157: in => 1,
4158: ep => 1,
4159: ta => 1,
4160: cr => 1,
4161: st => 1,
4162: );
4163: }
4164: foreach my $entry (keys(%roleshash)) {
4165: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4166: if ($trole =~ /^cr/) {
4167: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4168: } else {
4169: next if (!exists($roles{$trole}));
4170: }
4171: if ($tend) {
4172: next if ($tend < $now);
4173: }
4174: if ($tstart) {
4175: next if ($tstart > $now);
4176: }
1.1058 raeburn 4177: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4178: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4179: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4180: if ($secpart eq '') {
4181: ($cnum,$role) = split(/_/,$cnumpart);
4182: $sec = 'none';
1.1058 raeburn 4183: $value .= $cnum.'/';
1.482 raeburn 4184: } else {
4185: $cnum = $cnumpart;
4186: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4187: $value .= $cnum.'/'.$sec;
4188: }
4189: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4190: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4191: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4192: }
4193: } else {
4194: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4195: }
1.482 raeburn 4196: }
4197: } else {
4198: foreach my $key (keys(%env)) {
1.483 albertel 4199: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4200: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4201: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4202: next if ($role eq 'ca' || $role eq 'aa');
4203: next if (%roles && !exists($roles{$role}));
4204: my ($starttime,$endtime)=split(/\./,$env{$key});
4205: my $active=1;
4206: if ($starttime) {
4207: if ($now<$starttime) { $active=0; }
4208: }
4209: if ($endtime) {
4210: if ($now>$endtime) { $active=0; }
4211: }
4212: if ($active) {
1.1058 raeburn 4213: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4214: if ($sec eq '') {
4215: $sec = 'none';
1.1058 raeburn 4216: } else {
4217: $value .= $sec;
4218: }
4219: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4220: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4221: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4222: }
4223: } else {
4224: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4225: }
1.474 raeburn 4226: }
4227: }
1.51 www 4228: }
4229: }
1.474 raeburn 4230: return %courses;
1.51 www 4231: }
1.37 matthew 4232:
1.54 www 4233: ###############################################
1.474 raeburn 4234:
4235: sub blockcheck {
1.1062 raeburn 4236: my ($setters,$activity,$uname,$udom,$url) = @_;
1.490 raeburn 4237:
4238: if (!defined($udom)) {
4239: $udom = $env{'user.domain'};
4240: }
4241: if (!defined($uname)) {
4242: $uname = $env{'user.name'};
4243: }
4244:
4245: # If uname and udom are for a course, check for blocks in the course.
4246:
4247: if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062 raeburn 4248: my ($startblock,$endblock,$triggerblock) =
4249: &get_blocks($setters,$activity,$udom,$uname,$url);
4250: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4251: }
1.474 raeburn 4252:
1.502 raeburn 4253: my $startblock = 0;
4254: my $endblock = 0;
1.1062 raeburn 4255: my $triggerblock = '';
1.482 raeburn 4256: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4257:
1.490 raeburn 4258: # If uname is for a user, and activity is course-specific, i.e.,
4259: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4260:
1.490 raeburn 4261: if (($activity eq 'boards' || $activity eq 'chat' ||
4262: $activity eq 'groups') && ($env{'request.course.id'})) {
4263: foreach my $key (keys(%live_courses)) {
4264: if ($key ne $env{'request.course.id'}) {
4265: delete($live_courses{$key});
4266: }
4267: }
4268: }
4269:
4270: my $otheruser = 0;
4271: my %own_courses;
4272: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4273: # Resource belongs to user other than current user.
4274: $otheruser = 1;
4275: # Gather courses for current user
4276: %own_courses =
4277: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4278: }
4279:
4280: # Gather active course roles - course coordinator, instructor,
4281: # exam proctor, ta, student, or custom role.
1.474 raeburn 4282:
4283: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4284: my ($cdom,$cnum);
4285: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4286: $cdom = $env{'course.'.$course.'.domain'};
4287: $cnum = $env{'course.'.$course.'.num'};
4288: } else {
1.490 raeburn 4289: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4290: }
4291: my $no_ownblock = 0;
4292: my $no_userblock = 0;
1.533 raeburn 4293: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4294: # Check if current user has 'evb' priv for this
4295: if (defined($own_courses{$course})) {
4296: foreach my $sec (keys(%{$own_courses{$course}})) {
4297: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4298: if ($sec ne 'none') {
4299: $checkrole .= '/'.$sec;
4300: }
4301: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4302: $no_ownblock = 1;
4303: last;
4304: }
4305: }
4306: }
4307: # if they have 'evb' priv and are currently not playing student
4308: next if (($no_ownblock) &&
4309: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4310: }
1.474 raeburn 4311: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4312: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4313: if ($sec ne 'none') {
1.482 raeburn 4314: $checkrole .= '/'.$sec;
1.474 raeburn 4315: }
1.490 raeburn 4316: if ($otheruser) {
4317: # Resource belongs to user other than current user.
4318: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4319: my (%allroles,%userroles);
4320: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4321: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4322: my ($trole,$tdom,$tnum,$tsec);
4323: if ($entry =~ /^cr/) {
4324: ($trole,$tdom,$tnum,$tsec) =
4325: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4326: } else {
4327: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4328: }
4329: my ($spec,$area,$trest);
4330: $area = '/'.$tdom.'/'.$tnum;
4331: $trest = $tnum;
4332: if ($tsec ne '') {
4333: $area .= '/'.$tsec;
4334: $trest .= '/'.$tsec;
4335: }
4336: $spec = $trole.'.'.$area;
4337: if ($trole =~ /^cr/) {
4338: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4339: $tdom,$spec,$trest,$area);
4340: } else {
4341: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4342: $tdom,$spec,$trest,$area);
4343: }
4344: }
4345: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4346: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4347: if ($1) {
4348: $no_userblock = 1;
4349: last;
4350: }
1.486 raeburn 4351: }
4352: }
1.490 raeburn 4353: } else {
4354: # Resource belongs to current user
4355: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4356: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4357: $no_ownblock = 1;
4358: last;
4359: }
1.474 raeburn 4360: }
4361: }
4362: # if they have the evb priv and are currently not playing student
1.482 raeburn 4363: next if (($no_ownblock) &&
1.491 albertel 4364: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4365: next if ($no_userblock);
1.474 raeburn 4366:
1.866 kalberla 4367: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4368: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4369:
1.1062 raeburn 4370: my ($start,$end,$trigger) =
4371: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4372: if (($start != 0) &&
4373: (($startblock == 0) || ($startblock > $start))) {
4374: $startblock = $start;
1.1062 raeburn 4375: if ($trigger ne '') {
4376: $triggerblock = $trigger;
4377: }
1.502 raeburn 4378: }
4379: if (($end != 0) &&
4380: (($endblock == 0) || ($endblock < $end))) {
4381: $endblock = $end;
1.1062 raeburn 4382: if ($trigger ne '') {
4383: $triggerblock = $trigger;
4384: }
1.502 raeburn 4385: }
1.490 raeburn 4386: }
1.1062 raeburn 4387: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4388: }
4389:
4390: sub get_blocks {
1.1062 raeburn 4391: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4392: my $startblock = 0;
4393: my $endblock = 0;
1.1062 raeburn 4394: my $triggerblock = '';
1.490 raeburn 4395: my $course = $cdom.'_'.$cnum;
4396: $setters->{$course} = {};
4397: $setters->{$course}{'staff'} = [];
4398: $setters->{$course}{'times'} = [];
1.1062 raeburn 4399: $setters->{$course}{'triggers'} = [];
4400: my (@blockers,%triggered);
4401: my $now = time;
4402: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4403: if ($activity eq 'docs') {
4404: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4405: foreach my $block (@blockers) {
4406: if ($block =~ /^firstaccess____(.+)$/) {
4407: my $item = $1;
4408: my $type = 'map';
4409: my $timersymb = $item;
4410: if ($item eq 'course') {
4411: $type = 'course';
4412: } elsif ($item =~ /___\d+___/) {
4413: $type = 'resource';
4414: } else {
4415: $timersymb = &Apache::lonnet::symbread($item);
4416: }
4417: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4418: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4419: $triggered{$block} = {
4420: start => $start,
4421: end => $end,
4422: type => $type,
4423: };
4424: }
4425: }
4426: } else {
4427: foreach my $block (keys(%commblocks)) {
4428: if ($block =~ m/^(\d+)____(\d+)$/) {
4429: my ($start,$end) = ($1,$2);
4430: if ($start <= time && $end >= time) {
4431: if (ref($commblocks{$block}) eq 'HASH') {
4432: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4433: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4434: unless(grep(/^\Q$block\E$/,@blockers)) {
4435: push(@blockers,$block);
4436: }
4437: }
4438: }
4439: }
4440: }
4441: } elsif ($block =~ /^firstaccess____(.+)$/) {
4442: my $item = $1;
4443: my $timersymb = $item;
4444: my $type = 'map';
4445: if ($item eq 'course') {
4446: $type = 'course';
4447: } elsif ($item =~ /___\d+___/) {
4448: $type = 'resource';
4449: } else {
4450: $timersymb = &Apache::lonnet::symbread($item);
4451: }
4452: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4453: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4454: if ($start && $end) {
4455: if (($start <= time) && ($end >= time)) {
4456: unless (grep(/^\Q$block\E$/,@blockers)) {
4457: push(@blockers,$block);
4458: $triggered{$block} = {
4459: start => $start,
4460: end => $end,
4461: type => $type,
4462: };
4463: }
4464: }
1.490 raeburn 4465: }
1.1062 raeburn 4466: }
4467: }
4468: }
4469: foreach my $blocker (@blockers) {
4470: my ($staff_name,$staff_dom,$title,$blocks) =
4471: &parse_block_record($commblocks{$blocker});
4472: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4473: my ($start,$end,$triggertype);
4474: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4475: ($start,$end) = ($1,$2);
4476: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4477: $start = $triggered{$blocker}{'start'};
4478: $end = $triggered{$blocker}{'end'};
4479: $triggertype = $triggered{$blocker}{'type'};
4480: }
4481: if ($start) {
4482: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4483: if ($triggertype) {
4484: push(@{$$setters{$course}{'triggers'}},$triggertype);
4485: } else {
4486: push(@{$$setters{$course}{'triggers'}},0);
4487: }
4488: if ( ($startblock == 0) || ($startblock > $start) ) {
4489: $startblock = $start;
4490: if ($triggertype) {
4491: $triggerblock = $blocker;
1.474 raeburn 4492: }
4493: }
1.1062 raeburn 4494: if ( ($endblock == 0) || ($endblock < $end) ) {
4495: $endblock = $end;
4496: if ($triggertype) {
4497: $triggerblock = $blocker;
4498: }
4499: }
1.474 raeburn 4500: }
4501: }
1.1062 raeburn 4502: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4503: }
4504:
4505: sub parse_block_record {
4506: my ($record) = @_;
4507: my ($setuname,$setudom,$title,$blocks);
4508: if (ref($record) eq 'HASH') {
4509: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4510: $title = &unescape($record->{'event'});
4511: $blocks = $record->{'blocks'};
4512: } else {
4513: my @data = split(/:/,$record,3);
4514: if (scalar(@data) eq 2) {
4515: $title = $data[1];
4516: ($setuname,$setudom) = split(/@/,$data[0]);
4517: } else {
4518: ($setuname,$setudom,$title) = @data;
4519: }
4520: $blocks = { 'com' => 'on' };
4521: }
4522: return ($setuname,$setudom,$title,$blocks);
4523: }
4524:
1.854 kalberla 4525: sub blocking_status {
1.1062 raeburn 4526: my ($activity,$uname,$udom,$url) = @_;
1.1061 raeburn 4527: my %setters;
1.890 droeschl 4528:
1.1061 raeburn 4529: # check for active blocking
1.1062 raeburn 4530: my ($startblock,$endblock,$triggerblock) =
4531: &blockcheck(\%setters,$activity,$uname,$udom,$url);
4532: my $blocked = 0;
4533: if ($startblock && $endblock) {
4534: $blocked = 1;
4535: }
1.890 droeschl 4536:
1.1061 raeburn 4537: # caller just wants to know whether a block is active
4538: if (!wantarray) { return $blocked; }
4539:
4540: # build a link to a popup window containing the details
4541: my $querystring = "?activity=$activity";
4542: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4543: if ($activity eq 'port') {
4544: $querystring .= "&udom=$udom" if $udom;
4545: $querystring .= "&uname=$uname" if $uname;
4546: } elsif ($activity eq 'docs') {
4547: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4548: }
1.1061 raeburn 4549:
4550: my $output .= <<'END_MYBLOCK';
4551: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4552: var options = "width=" + w + ",height=" + h + ",";
4553: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4554: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4555: var newWin = window.open(url, wdwName, options);
4556: newWin.focus();
4557: }
1.890 droeschl 4558: END_MYBLOCK
1.854 kalberla 4559:
1.1061 raeburn 4560: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4561:
1.1061 raeburn 4562: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4563: my $text = &mt('Communication Blocked');
4564: if ($activity eq 'docs') {
4565: $text = &mt('Content Access Blocked');
1.1063 raeburn 4566: } elsif ($activity eq 'printout') {
4567: $text = &mt('Printing Blocked');
1.1062 raeburn 4568: }
1.1061 raeburn 4569: $output .= <<"END_BLOCK";
1.867 kalberla 4570: <div class='LC_comblock'>
1.869 kalberla 4571: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4572: title='$text'>
4573: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4574: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4575: title='$text'>$text</a>
1.867 kalberla 4576: </div>
4577:
4578: END_BLOCK
1.474 raeburn 4579:
1.1061 raeburn 4580: return ($blocked, $output);
1.854 kalberla 4581: }
1.490 raeburn 4582:
1.60 matthew 4583: ###############################################
4584:
1.682 raeburn 4585: sub check_ip_acc {
4586: my ($acc)=@_;
4587: &Apache::lonxml::debug("acc is $acc");
4588: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4589: return 1;
4590: }
4591: my $allowed=0;
4592: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4593:
4594: my $name;
4595: foreach my $pattern (split(',',$acc)) {
4596: $pattern =~ s/^\s*//;
4597: $pattern =~ s/\s*$//;
4598: if ($pattern =~ /\*$/) {
4599: #35.8.*
4600: $pattern=~s/\*//;
4601: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4602: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4603: #35.8.3.[34-56]
4604: my $low=$2;
4605: my $high=$3;
4606: $pattern=$1;
4607: if ($ip =~ /^\Q$pattern\E/) {
4608: my $last=(split(/\./,$ip))[3];
4609: if ($last <=$high && $last >=$low) { $allowed=1; }
4610: }
4611: } elsif ($pattern =~ /^\*/) {
4612: #*.msu.edu
4613: $pattern=~s/\*//;
4614: if (!defined($name)) {
4615: use Socket;
4616: my $netaddr=inet_aton($ip);
4617: ($name)=gethostbyaddr($netaddr,AF_INET);
4618: }
4619: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4620: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4621: #127.0.0.1
4622: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4623: } else {
4624: #some.name.com
4625: if (!defined($name)) {
4626: use Socket;
4627: my $netaddr=inet_aton($ip);
4628: ($name)=gethostbyaddr($netaddr,AF_INET);
4629: }
4630: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4631: }
4632: if ($allowed) { last; }
4633: }
4634: return $allowed;
4635: }
4636:
4637: ###############################################
4638:
1.60 matthew 4639: =pod
4640:
1.112 bowersj2 4641: =head1 Domain Template Functions
4642:
4643: =over 4
4644:
4645: =item * &determinedomain()
1.60 matthew 4646:
4647: Inputs: $domain (usually will be undef)
4648:
1.63 www 4649: Returns: Determines which domain should be used for designs
1.60 matthew 4650:
4651: =cut
1.54 www 4652:
1.60 matthew 4653: ###############################################
1.63 www 4654: sub determinedomain {
4655: my $domain=shift;
1.531 albertel 4656: if (! $domain) {
1.60 matthew 4657: # Determine domain if we have not been given one
1.893 raeburn 4658: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4659: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4660: if ($env{'request.role.domain'}) {
4661: $domain=$env{'request.role.domain'};
1.60 matthew 4662: }
4663: }
1.63 www 4664: return $domain;
4665: }
4666: ###############################################
1.517 raeburn 4667:
1.518 albertel 4668: sub devalidate_domconfig_cache {
4669: my ($udom)=@_;
4670: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4671: }
4672:
4673: # ---------------------- Get domain configuration for a domain
4674: sub get_domainconf {
4675: my ($udom) = @_;
4676: my $cachetime=1800;
4677: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4678: if (defined($cached)) { return %{$result}; }
4679:
4680: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4681: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4682: my (%designhash,%legacy);
1.518 albertel 4683: if (keys(%domconfig) > 0) {
4684: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4685: if (keys(%{$domconfig{'login'}})) {
4686: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4687: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4688: if ($key eq 'loginvia') {
4689: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4690: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4691: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4692: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4693: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4694: $designhash{$udom.'.login.loginvia'} = $server;
4695: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4696:
4697: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4698: } else {
1.1013 raeburn 4699: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4700: }
4701: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4702: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4703: }
1.946 raeburn 4704: }
4705: }
4706: }
4707: }
4708: } else {
4709: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4710: $designhash{$udom.'.login.'.$key.'_'.$img} =
4711: $domconfig{'login'}{$key}{$img};
4712: }
1.699 raeburn 4713: }
4714: } else {
4715: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4716: }
1.632 raeburn 4717: }
4718: } else {
4719: $legacy{'login'} = 1;
1.518 albertel 4720: }
1.632 raeburn 4721: } else {
4722: $legacy{'login'} = 1;
1.518 albertel 4723: }
4724: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4725: if (keys(%{$domconfig{'rolecolors'}})) {
4726: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4727: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4728: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4729: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4730: }
1.518 albertel 4731: }
4732: }
1.632 raeburn 4733: } else {
4734: $legacy{'rolecolors'} = 1;
1.518 albertel 4735: }
1.632 raeburn 4736: } else {
4737: $legacy{'rolecolors'} = 1;
1.518 albertel 4738: }
1.948 raeburn 4739: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4740: if ($domconfig{'autoenroll'}{'co-owners'}) {
4741: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4742: }
4743: }
1.632 raeburn 4744: if (keys(%legacy) > 0) {
4745: my %legacyhash = &get_legacy_domconf($udom);
4746: foreach my $item (keys(%legacyhash)) {
4747: if ($item =~ /^\Q$udom\E\.login/) {
4748: if ($legacy{'login'}) {
4749: $designhash{$item} = $legacyhash{$item};
4750: }
4751: } else {
4752: if ($legacy{'rolecolors'}) {
4753: $designhash{$item} = $legacyhash{$item};
4754: }
1.518 albertel 4755: }
4756: }
4757: }
1.632 raeburn 4758: } else {
4759: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4760: }
4761: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4762: $cachetime);
4763: return %designhash;
4764: }
4765:
1.632 raeburn 4766: sub get_legacy_domconf {
4767: my ($udom) = @_;
4768: my %legacyhash;
4769: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4770: my $designfile = $designdir.'/'.$udom.'.tab';
4771: if (-e $designfile) {
4772: if ( open (my $fh,"<$designfile") ) {
4773: while (my $line = <$fh>) {
4774: next if ($line =~ /^\#/);
4775: chomp($line);
4776: my ($key,$val)=(split(/\=/,$line));
4777: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4778: }
4779: close($fh);
4780: }
4781: }
1.1026 raeburn 4782: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4783: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4784: }
4785: return %legacyhash;
4786: }
4787:
1.63 www 4788: =pod
4789:
1.112 bowersj2 4790: =item * &domainlogo()
1.63 www 4791:
4792: Inputs: $domain (usually will be undef)
4793:
4794: Returns: A link to a domain logo, if the domain logo exists.
4795: If the domain logo does not exist, a description of the domain.
4796:
4797: =cut
1.112 bowersj2 4798:
1.63 www 4799: ###############################################
4800: sub domainlogo {
1.517 raeburn 4801: my $domain = &determinedomain(shift);
1.518 albertel 4802: my %designhash = &get_domainconf($domain);
1.517 raeburn 4803: # See if there is a logo
4804: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4805: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4806: if ($imgsrc =~ m{^/(adm|res)/}) {
4807: if ($imgsrc =~ m{^/res/}) {
4808: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4809: &Apache::lonnet::repcopy($local_name);
4810: }
4811: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4812: }
4813: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4814: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4815: return &Apache::lonnet::domain($domain,'description');
1.59 www 4816: } else {
1.60 matthew 4817: return '';
1.59 www 4818: }
4819: }
1.63 www 4820: ##############################################
4821:
4822: =pod
4823:
1.112 bowersj2 4824: =item * &designparm()
1.63 www 4825:
4826: Inputs: $which parameter; $domain (usually will be undef)
4827:
4828: Returns: value of designparamter $which
4829:
4830: =cut
1.112 bowersj2 4831:
1.397 albertel 4832:
1.400 albertel 4833: ##############################################
1.397 albertel 4834: sub designparm {
4835: my ($which,$domain)=@_;
4836: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4837: return $env{'environment.color.'.$which};
1.96 www 4838: }
1.63 www 4839: $domain=&determinedomain($domain);
1.1016 raeburn 4840: my %domdesign;
4841: unless ($domain eq 'public') {
4842: %domdesign = &get_domainconf($domain);
4843: }
1.520 raeburn 4844: my $output;
1.517 raeburn 4845: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4846: $output = $domdesign{$domain.'.'.$which};
1.63 www 4847: } else {
1.520 raeburn 4848: $output = $defaultdesign{$which};
4849: }
4850: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4851: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4852: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4853: if ($output =~ m{^/res/}) {
4854: my $local_name = &Apache::lonnet::filelocation('',$output);
4855: &Apache::lonnet::repcopy($local_name);
4856: }
1.520 raeburn 4857: $output = &lonhttpdurl($output);
4858: }
1.63 www 4859: }
1.520 raeburn 4860: return $output;
1.63 www 4861: }
1.59 www 4862:
1.822 bisitz 4863: ##############################################
4864: =pod
4865:
1.832 bisitz 4866: =item * &authorspace()
4867:
1.1028 raeburn 4868: Inputs: $url (usually will be undef).
1.832 bisitz 4869:
1.1075.2.40 raeburn 4870: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4871: directory being viewed (or for which action is being taken).
4872: If $url is provided, and begins /priv/<domain>/<uname>
4873: the path will be that portion of the $context argument.
4874: Otherwise the path will be for the author space of the current
4875: user when the current role is author, or for that of the
4876: co-author/assistant co-author space when the current role
4877: is co-author or assistant co-author.
1.832 bisitz 4878:
4879: =cut
4880:
4881: sub authorspace {
1.1028 raeburn 4882: my ($url) = @_;
4883: if ($url ne '') {
4884: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4885: return $1;
4886: }
4887: }
1.832 bisitz 4888: my $caname = '';
1.1024 www 4889: my $cadom = '';
1.1028 raeburn 4890: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4891: ($cadom,$caname) =
1.832 bisitz 4892: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4893: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4894: $caname = $env{'user.name'};
1.1024 www 4895: $cadom = $env{'user.domain'};
1.832 bisitz 4896: }
1.1028 raeburn 4897: if (($caname ne '') && ($cadom ne '')) {
4898: return "/priv/$cadom/$caname/";
4899: }
4900: return;
1.832 bisitz 4901: }
4902:
4903: ##############################################
4904: =pod
4905:
1.822 bisitz 4906: =item * &head_subbox()
4907:
4908: Inputs: $content (contains HTML code with page functions, etc.)
4909:
4910: Returns: HTML div with $content
4911: To be included in page header
4912:
4913: =cut
4914:
4915: sub head_subbox {
4916: my ($content)=@_;
4917: my $output =
1.993 raeburn 4918: '<div class="LC_head_subbox">'
1.822 bisitz 4919: .$content
4920: .'</div>'
4921: }
4922:
4923: ##############################################
4924: =pod
4925:
4926: =item * &CSTR_pageheader()
4927:
1.1026 raeburn 4928: Input: (optional) filename from which breadcrumb trail is built.
4929: In most cases no input as needed, as $env{'request.filename'}
4930: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 4931:
4932: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 4933: To be included on Authoring Space pages
1.822 bisitz 4934:
4935: =cut
4936:
4937: sub CSTR_pageheader {
1.1026 raeburn 4938: my ($trailfile) = @_;
4939: if ($trailfile eq '') {
4940: $trailfile = $env{'request.filename'};
4941: }
4942:
4943: # this is for resources; directories have customtitle, and crumbs
4944: # and select recent are created in lonpubdir.pm
4945:
4946: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 4947: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 4948: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 4949: my $formaction = "/priv/$udom/$uname/$thisdisfn";
4950: $formaction =~ s{/+}{/}g;
1.822 bisitz 4951:
4952: my $parentpath = '';
4953: my $lastitem = '';
4954: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4955: $parentpath = $1;
4956: $lastitem = $2;
4957: } else {
4958: $lastitem = $thisdisfn;
4959: }
1.921 bisitz 4960:
4961: my $output =
1.822 bisitz 4962: '<div>'
4963: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 4964: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 4965: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 4966: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 4967: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 4968:
4969: if ($lastitem) {
4970: $output .=
4971: '<span class="LC_filename">'
4972: .$lastitem
4973: .'</span>';
4974: }
4975: $output .=
4976: '<br />'
1.822 bisitz 4977: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
4978: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4979: .'</form>'
4980: .&Apache::lonmenu::constspaceform()
4981: .'</div>';
1.921 bisitz 4982:
4983: return $output;
1.822 bisitz 4984: }
4985:
1.60 matthew 4986: ###############################################
4987: ###############################################
4988:
4989: =pod
4990:
1.112 bowersj2 4991: =back
4992:
1.549 albertel 4993: =head1 HTML Helpers
1.112 bowersj2 4994:
4995: =over 4
4996:
4997: =item * &bodytag()
1.60 matthew 4998:
4999: Returns a uniform header for LON-CAPA web pages.
5000:
5001: Inputs:
5002:
1.112 bowersj2 5003: =over 4
5004:
5005: =item * $title, A title to be displayed on the page.
5006:
5007: =item * $function, the current role (can be undef).
5008:
5009: =item * $addentries, extra parameters for the <body> tag.
5010:
5011: =item * $bodyonly, if defined, only return the <body> tag.
5012:
5013: =item * $domain, if defined, force a given domain.
5014:
5015: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5016: text interface only)
1.60 matthew 5017:
1.814 bisitz 5018: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5019: navigational links
1.317 albertel 5020:
1.338 albertel 5021: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5022:
1.1075.2.12 raeburn 5023: =item * $no_inline_link, if true and in remote mode, don't show the
5024: 'Switch To Inline Menu' link
5025:
1.460 albertel 5026: =item * $args, optional argument valid values are
5027: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5028: inherit_jsmath -> when creating popup window in a page,
5029: should it have jsmath forced on by the
5030: current page
1.460 albertel 5031:
1.1075.2.15 raeburn 5032: =item * $advtoolsref, optional argument, ref to an array containing
5033: inlineremote items to be added in "Functions" menu below
5034: breadcrumbs.
5035:
1.112 bowersj2 5036: =back
5037:
1.60 matthew 5038: Returns: A uniform header for LON-CAPA web pages.
5039: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5040: If $bodyonly is undef or zero, an html string containing a <body> tag and
5041: other decorations will be returned.
5042:
5043: =cut
5044:
1.54 www 5045: sub bodytag {
1.831 bisitz 5046: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5047: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5048:
1.954 raeburn 5049: my $public;
5050: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5051: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5052: $public = 1;
5053: }
1.460 albertel 5054: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5055: my $httphost = $args->{'use_absolute'};
1.339 albertel 5056:
1.183 matthew 5057: $function = &get_users_function() if (!$function);
1.339 albertel 5058: my $img = &designparm($function.'.img',$domain);
5059: my $font = &designparm($function.'.font',$domain);
5060: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5061:
1.803 bisitz 5062: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5063: 'bgcolor' => $pgbg,
1.339 albertel 5064: 'text' => $font,
5065: 'alink' => &designparm($function.'.alink',$domain),
5066: 'vlink' => &designparm($function.'.vlink',$domain),
5067: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5068: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5069:
1.63 www 5070: # role and realm
1.1075.2.68! raeburn 5071: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
! 5072: if ($realm) {
! 5073: $realm = '/'.$realm;
! 5074: }
1.378 raeburn 5075: if ($role eq 'ca') {
1.479 albertel 5076: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5077: $realm = &plainname($rname,$rdom);
1.378 raeburn 5078: }
1.55 www 5079: # realm
1.258 albertel 5080: if ($env{'request.course.id'}) {
1.378 raeburn 5081: if ($env{'request.role'} !~ /^cr/) {
5082: $role = &Apache::lonnet::plaintext($role,&course_type());
5083: }
1.898 raeburn 5084: if ($env{'request.course.sec'}) {
5085: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5086: }
1.359 albertel 5087: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5088: } else {
5089: $role = &Apache::lonnet::plaintext($role);
1.54 www 5090: }
1.433 albertel 5091:
1.359 albertel 5092: if (!$realm) { $realm=' '; }
1.330 albertel 5093:
1.438 albertel 5094: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5095:
1.101 www 5096: # construct main body tag
1.359 albertel 5097: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5098: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5099:
1.1075.2.38 raeburn 5100: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5101:
5102: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5103: return $bodytag;
1.1075.2.38 raeburn 5104: }
1.359 albertel 5105:
1.954 raeburn 5106: if ($public) {
1.433 albertel 5107: undef($role);
5108: }
1.359 albertel 5109:
1.762 bisitz 5110: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5111: #
5112: # Extra info if you are the DC
5113: my $dc_info = '';
5114: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5115: $env{'course.'.$env{'request.course.id'}.
5116: '.domain'}.'/'})) {
5117: my $cid = $env{'request.course.id'};
1.917 raeburn 5118: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5119: $dc_info =~ s/\s+$//;
1.359 albertel 5120: }
5121:
1.898 raeburn 5122: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903 droeschl 5123:
1.1075.2.13 raeburn 5124: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5125:
1.1075.2.38 raeburn 5126:
5127:
1.1075.2.21 raeburn 5128: my $funclist;
5129: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5130: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5131: Apache::lonmenu::serverform();
5132: my $forbodytag;
5133: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5134: $forcereg,$args->{'group'},
5135: $args->{'bread_crumbs'},
5136: $advtoolsref,'',\$forbodytag);
5137: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5138: $funclist = $forbodytag;
5139: }
5140: } else {
1.903 droeschl 5141:
5142: # if ($env{'request.state'} eq 'construct') {
5143: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5144: # }
5145:
1.1075.2.38 raeburn 5146: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5147: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5148:
1.1075.2.38 raeburn 5149: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5150:
1.916 droeschl 5151: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5152: if ($dc_info) {
5153: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5154: }
1.1075.2.38 raeburn 5155: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5156: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5157: return $bodytag;
5158: }
1.894 droeschl 5159:
1.927 raeburn 5160: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5161: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5162: }
1.916 droeschl 5163:
1.1075.2.38 raeburn 5164: $bodytag .= $right;
1.852 droeschl 5165:
1.917 raeburn 5166: if ($dc_info) {
5167: $dc_info = &dc_courseid_toggle($dc_info);
5168: }
5169: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5170:
1.1075.2.61 raeburn 5171: #if directed to not display the secondary menu, don't.
5172: if ($args->{'no_secondary_menu'}) {
5173: return $bodytag;
5174: }
1.903 droeschl 5175: #don't show menus for public users
1.954 raeburn 5176: if (!$public){
1.1075.2.52 raeburn 5177: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5178: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5179: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5180: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5181: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5182: $args->{'bread_crumbs'});
5183: } elsif ($forcereg) {
1.1075.2.22 raeburn 5184: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5185: $args->{'group'});
1.1075.2.15 raeburn 5186: } else {
1.1075.2.21 raeburn 5187: my $forbodytag;
5188: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5189: $forcereg,$args->{'group'},
5190: $args->{'bread_crumbs'},
5191: $advtoolsref,'',\$forbodytag);
5192: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5193: $bodytag .= $forbodytag;
5194: }
1.920 raeburn 5195: }
1.903 droeschl 5196: }else{
5197: # this is to seperate menu from content when there's no secondary
5198: # menu. Especially needed for public accessible ressources.
5199: $bodytag .= '<hr style="clear:both" />';
5200: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5201: }
1.903 droeschl 5202:
1.235 raeburn 5203: return $bodytag;
1.1075.2.12 raeburn 5204: }
5205:
5206: #
5207: # Top frame rendering, Remote is up
5208: #
5209:
5210: my $imgsrc = $img;
5211: if ($img =~ /^\/adm/) {
5212: $imgsrc = &lonhttpdurl($img);
5213: }
5214: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5215:
1.1075.2.60 raeburn 5216: my $help=($no_inline_link?''
5217: :&Apache::loncommon::top_nav_help('Help'));
5218:
1.1075.2.12 raeburn 5219: # Explicit link to get inline menu
5220: my $menu= ($no_inline_link?''
5221: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5222:
5223: if ($dc_info) {
5224: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5225: }
5226:
1.1075.2.38 raeburn 5227: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5228: unless ($public) {
5229: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5230: undef,'LC_menubuttons_link');
5231: }
5232:
1.1075.2.12 raeburn 5233: unless ($env{'form.inhibitmenu'}) {
5234: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5235: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5236: <li>$help</li>
1.1075.2.12 raeburn 5237: <li>$menu</li>
5238: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5239: }
1.1075.2.13 raeburn 5240: if ($env{'request.state'} eq 'construct') {
5241: if (!$public){
5242: if ($env{'request.state'} eq 'construct') {
5243: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5244: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5245: &Apache::lonhtmlcommon::scripttag('','end').
5246: &Apache::lonmenu::innerregister($forcereg,
5247: $args->{'bread_crumbs'});
5248: }
5249: }
5250: }
1.1075.2.21 raeburn 5251: return $bodytag."\n".$funclist;
1.182 matthew 5252: }
5253:
1.917 raeburn 5254: sub dc_courseid_toggle {
5255: my ($dc_info) = @_;
1.980 raeburn 5256: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5257: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5258: &mt('(More ...)').'</a></span>'.
5259: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5260: }
5261:
1.330 albertel 5262: sub make_attr_string {
5263: my ($register,$attr_ref) = @_;
5264:
5265: if ($attr_ref && !ref($attr_ref)) {
5266: die("addentries Must be a hash ref ".
5267: join(':',caller(1))." ".
5268: join(':',caller(0))." ");
5269: }
5270:
5271: if ($register) {
1.339 albertel 5272: my ($on_load,$on_unload);
5273: foreach my $key (keys(%{$attr_ref})) {
5274: if (lc($key) eq 'onload') {
5275: $on_load.=$attr_ref->{$key}.';';
5276: delete($attr_ref->{$key});
5277:
5278: } elsif (lc($key) eq 'onunload') {
5279: $on_unload.=$attr_ref->{$key}.';';
5280: delete($attr_ref->{$key});
5281: }
5282: }
1.1075.2.12 raeburn 5283: if ($env{'environment.remote'} eq 'on') {
5284: $attr_ref->{'onload'} =
5285: &Apache::lonmenu::loadevents(). $on_load;
5286: $attr_ref->{'onunload'}=
5287: &Apache::lonmenu::unloadevents().$on_unload;
5288: } else {
5289: $attr_ref->{'onload'} = $on_load;
5290: $attr_ref->{'onunload'}= $on_unload;
5291: }
1.330 albertel 5292: }
1.339 albertel 5293:
1.330 albertel 5294: my $attr_string;
1.1075.2.56 raeburn 5295: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5296: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5297: }
5298: return $attr_string;
5299: }
5300:
5301:
1.182 matthew 5302: ###############################################
1.251 albertel 5303: ###############################################
5304:
5305: =pod
5306:
5307: =item * &endbodytag()
5308:
5309: Returns a uniform footer for LON-CAPA web pages.
5310:
1.635 raeburn 5311: Inputs: 1 - optional reference to an args hash
5312: If in the hash, key for noredirectlink has a value which evaluates to true,
5313: a 'Continue' link is not displayed if the page contains an
5314: internal redirect in the <head></head> section,
5315: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5316:
5317: =cut
5318:
5319: sub endbodytag {
1.635 raeburn 5320: my ($args) = @_;
1.1075.2.6 raeburn 5321: my $endbodytag;
5322: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5323: $endbodytag='</body>';
5324: }
1.269 albertel 5325: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5326: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5327: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5328: $endbodytag=
5329: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5330: &mt('Continue').'</a>'.
5331: $endbodytag;
5332: }
1.315 albertel 5333: }
1.251 albertel 5334: return $endbodytag;
5335: }
5336:
1.352 albertel 5337: =pod
5338:
5339: =item * &standard_css()
5340:
5341: Returns a style sheet
5342:
5343: Inputs: (all optional)
5344: domain -> force to color decorate a page for a specific
5345: domain
5346: function -> force usage of a specific rolish color scheme
5347: bgcolor -> override the default page bgcolor
5348:
5349: =cut
5350:
1.343 albertel 5351: sub standard_css {
1.345 albertel 5352: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5353: $function = &get_users_function() if (!$function);
5354: my $img = &designparm($function.'.img', $domain);
5355: my $tabbg = &designparm($function.'.tabbg', $domain);
5356: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5357: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5358: #second colour for later usage
1.345 albertel 5359: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5360: my $pgbg_or_bgcolor =
5361: $bgcolor ||
1.352 albertel 5362: &designparm($function.'.pgbg', $domain);
1.382 albertel 5363: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5364: my $alink = &designparm($function.'.alink', $domain);
5365: my $vlink = &designparm($function.'.vlink', $domain);
5366: my $link = &designparm($function.'.link', $domain);
5367:
1.602 albertel 5368: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5369: my $mono = 'monospace';
1.850 bisitz 5370: my $data_table_head = $sidebg;
5371: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5372: my $data_table_dark = '#E0E0E0';
1.470 banghart 5373: my $data_table_darker = '#CCCCCC';
1.349 albertel 5374: my $data_table_highlight = '#FFFF00';
1.352 albertel 5375: my $mail_new = '#FFBB77';
5376: my $mail_new_hover = '#DD9955';
5377: my $mail_read = '#BBBB77';
5378: my $mail_read_hover = '#999944';
5379: my $mail_replied = '#AAAA88';
5380: my $mail_replied_hover = '#888855';
5381: my $mail_other = '#99BBBB';
5382: my $mail_other_hover = '#669999';
1.391 albertel 5383: my $table_header = '#DDDDDD';
1.489 raeburn 5384: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5385: my $lg_border_color = '#C8C8C8';
1.952 onken 5386: my $button_hover = '#BF2317';
1.392 albertel 5387:
1.608 albertel 5388: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5389: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5390: : '0 3px 0 4px';
1.448 albertel 5391:
1.523 albertel 5392:
1.343 albertel 5393: return <<END;
1.947 droeschl 5394:
5395: /* needed for iframe to allow 100% height in FF */
5396: body, html {
5397: margin: 0;
5398: padding: 0 0.5%;
5399: height: 99%; /* to avoid scrollbars */
5400: }
5401:
1.795 www 5402: body {
1.911 bisitz 5403: font-family: $sans;
5404: line-height:130%;
5405: font-size:0.83em;
5406: color:$font;
1.795 www 5407: }
5408:
1.959 onken 5409: a:focus,
5410: a:focus img {
1.795 www 5411: color: red;
5412: }
1.698 harmsja 5413:
1.911 bisitz 5414: form, .inline {
5415: display: inline;
1.795 www 5416: }
1.721 harmsja 5417:
1.795 www 5418: .LC_right {
1.911 bisitz 5419: text-align:right;
1.795 www 5420: }
5421:
5422: .LC_middle {
1.911 bisitz 5423: vertical-align:middle;
1.795 www 5424: }
1.721 harmsja 5425:
1.1075.2.38 raeburn 5426: .LC_floatleft {
5427: float: left;
5428: }
5429:
5430: .LC_floatright {
5431: float: right;
5432: }
5433:
1.911 bisitz 5434: .LC_400Box {
5435: width:400px;
5436: }
1.721 harmsja 5437:
1.947 droeschl 5438: .LC_iframecontainer {
5439: width: 98%;
5440: margin: 0;
5441: position: fixed;
5442: top: 8.5em;
5443: bottom: 0;
5444: }
5445:
5446: .LC_iframecontainer iframe{
5447: border: none;
5448: width: 100%;
5449: height: 100%;
5450: }
5451:
1.778 bisitz 5452: .LC_filename {
5453: font-family: $mono;
5454: white-space:pre;
1.921 bisitz 5455: font-size: 120%;
1.778 bisitz 5456: }
5457:
5458: .LC_fileicon {
5459: border: none;
5460: height: 1.3em;
5461: vertical-align: text-bottom;
5462: margin-right: 0.3em;
5463: text-decoration:none;
5464: }
5465:
1.1008 www 5466: .LC_setting {
5467: text-decoration:underline;
5468: }
5469:
1.350 albertel 5470: .LC_error {
5471: color: red;
5472: }
1.795 www 5473:
1.1075.2.15 raeburn 5474: .LC_warning {
5475: color: darkorange;
5476: }
5477:
1.457 albertel 5478: .LC_diff_removed {
1.733 bisitz 5479: color: red;
1.394 albertel 5480: }
1.532 albertel 5481:
5482: .LC_info,
1.457 albertel 5483: .LC_success,
5484: .LC_diff_added {
1.350 albertel 5485: color: green;
5486: }
1.795 www 5487:
1.802 bisitz 5488: div.LC_confirm_box {
5489: background-color: #FAFAFA;
5490: border: 1px solid $lg_border_color;
5491: margin-right: 0;
5492: padding: 5px;
5493: }
5494:
5495: div.LC_confirm_box .LC_error img,
5496: div.LC_confirm_box .LC_success img {
5497: vertical-align: middle;
5498: }
5499:
1.440 albertel 5500: .LC_icon {
1.771 droeschl 5501: border: none;
1.790 droeschl 5502: vertical-align: middle;
1.771 droeschl 5503: }
5504:
1.543 albertel 5505: .LC_docs_spacer {
5506: width: 25px;
5507: height: 1px;
1.771 droeschl 5508: border: none;
1.543 albertel 5509: }
1.346 albertel 5510:
1.532 albertel 5511: .LC_internal_info {
1.735 bisitz 5512: color: #999999;
1.532 albertel 5513: }
5514:
1.794 www 5515: .LC_discussion {
1.1050 www 5516: background: $data_table_dark;
1.911 bisitz 5517: border: 1px solid black;
5518: margin: 2px;
1.794 www 5519: }
5520:
5521: .LC_disc_action_left {
1.1050 www 5522: background: $sidebg;
1.911 bisitz 5523: text-align: left;
1.1050 www 5524: padding: 4px;
5525: margin: 2px;
1.794 www 5526: }
5527:
5528: .LC_disc_action_right {
1.1050 www 5529: background: $sidebg;
1.911 bisitz 5530: text-align: right;
1.1050 www 5531: padding: 4px;
5532: margin: 2px;
1.794 www 5533: }
5534:
5535: .LC_disc_new_item {
1.911 bisitz 5536: background: white;
5537: border: 2px solid red;
1.1050 www 5538: margin: 4px;
5539: padding: 4px;
1.794 www 5540: }
5541:
5542: .LC_disc_old_item {
1.911 bisitz 5543: background: white;
1.1050 www 5544: margin: 4px;
5545: padding: 4px;
1.794 www 5546: }
5547:
1.458 albertel 5548: table.LC_pastsubmission {
5549: border: 1px solid black;
5550: margin: 2px;
5551: }
5552:
1.924 bisitz 5553: table#LC_menubuttons {
1.345 albertel 5554: width: 100%;
5555: background: $pgbg;
1.392 albertel 5556: border: 2px;
1.402 albertel 5557: border-collapse: separate;
1.803 bisitz 5558: padding: 0;
1.345 albertel 5559: }
1.392 albertel 5560:
1.801 tempelho 5561: table#LC_title_bar a {
5562: color: $fontmenu;
5563: }
1.836 bisitz 5564:
1.807 droeschl 5565: table#LC_title_bar {
1.819 tempelho 5566: clear: both;
1.836 bisitz 5567: display: none;
1.807 droeschl 5568: }
5569:
1.795 www 5570: table#LC_title_bar,
1.933 droeschl 5571: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5572: table#LC_title_bar.LC_with_remote {
1.359 albertel 5573: width: 100%;
1.392 albertel 5574: border-color: $pgbg;
5575: border-style: solid;
5576: border-width: $border;
1.379 albertel 5577: background: $pgbg;
1.801 tempelho 5578: color: $fontmenu;
1.392 albertel 5579: border-collapse: collapse;
1.803 bisitz 5580: padding: 0;
1.819 tempelho 5581: margin: 0;
1.359 albertel 5582: }
1.795 www 5583:
1.933 droeschl 5584: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5585: margin: 0;
5586: padding: 0;
1.933 droeschl 5587: position: relative;
5588: list-style: none;
1.913 droeschl 5589: }
1.933 droeschl 5590: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5591: display: inline;
5592: }
1.933 droeschl 5593:
5594: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5595: padding: 0;
1.933 droeschl 5596: margin: 0;
5597: float: left;
1.913 droeschl 5598: }
1.933 droeschl 5599: .LC_breadcrumb_tools_tools {
5600: padding: 0;
5601: margin: 0;
1.913 droeschl 5602: float: right;
5603: }
5604:
1.359 albertel 5605: table#LC_title_bar td {
5606: background: $tabbg;
5607: }
1.795 www 5608:
1.911 bisitz 5609: table#LC_menubuttons img {
1.803 bisitz 5610: border: none;
1.346 albertel 5611: }
1.795 www 5612:
1.842 droeschl 5613: .LC_breadcrumbs_component {
1.911 bisitz 5614: float: right;
5615: margin: 0 1em;
1.357 albertel 5616: }
1.842 droeschl 5617: .LC_breadcrumbs_component img {
1.911 bisitz 5618: vertical-align: middle;
1.777 tempelho 5619: }
1.795 www 5620:
1.383 albertel 5621: td.LC_table_cell_checkbox {
5622: text-align: center;
5623: }
1.795 www 5624:
5625: .LC_fontsize_small {
1.911 bisitz 5626: font-size: 70%;
1.705 tempelho 5627: }
5628:
1.844 bisitz 5629: #LC_breadcrumbs {
1.911 bisitz 5630: clear:both;
5631: background: $sidebg;
5632: border-bottom: 1px solid $lg_border_color;
5633: line-height: 2.5em;
1.933 droeschl 5634: overflow: hidden;
1.911 bisitz 5635: margin: 0;
5636: padding: 0;
1.995 raeburn 5637: text-align: left;
1.819 tempelho 5638: }
1.862 bisitz 5639:
1.1075.2.16 raeburn 5640: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5641: clear:both;
5642: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5643: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5644: margin: 0 0 10px 0;
1.966 bisitz 5645: padding: 3px;
1.995 raeburn 5646: text-align: left;
1.822 bisitz 5647: }
5648:
1.795 www 5649: .LC_fontsize_medium {
1.911 bisitz 5650: font-size: 85%;
1.705 tempelho 5651: }
5652:
1.795 www 5653: .LC_fontsize_large {
1.911 bisitz 5654: font-size: 120%;
1.705 tempelho 5655: }
5656:
1.346 albertel 5657: .LC_menubuttons_inline_text {
5658: color: $font;
1.698 harmsja 5659: font-size: 90%;
1.701 harmsja 5660: padding-left:3px;
1.346 albertel 5661: }
5662:
1.934 droeschl 5663: .LC_menubuttons_inline_text img{
5664: vertical-align: middle;
5665: }
5666:
1.1051 www 5667: li.LC_menubuttons_inline_text img {
1.951 onken 5668: cursor:pointer;
1.1002 droeschl 5669: text-decoration: none;
1.951 onken 5670: }
5671:
1.526 www 5672: .LC_menubuttons_link {
5673: text-decoration: none;
5674: }
1.795 www 5675:
1.522 albertel 5676: .LC_menubuttons_category {
1.521 www 5677: color: $font;
1.526 www 5678: background: $pgbg;
1.521 www 5679: font-size: larger;
5680: font-weight: bold;
5681: }
5682:
1.346 albertel 5683: td.LC_menubuttons_text {
1.911 bisitz 5684: color: $font;
1.346 albertel 5685: }
1.706 harmsja 5686:
1.346 albertel 5687: .LC_current_location {
5688: background: $tabbg;
5689: }
1.795 www 5690:
1.938 bisitz 5691: table.LC_data_table {
1.347 albertel 5692: border: 1px solid #000000;
1.402 albertel 5693: border-collapse: separate;
1.426 albertel 5694: border-spacing: 1px;
1.610 albertel 5695: background: $pgbg;
1.347 albertel 5696: }
1.795 www 5697:
1.422 albertel 5698: .LC_data_table_dense {
5699: font-size: small;
5700: }
1.795 www 5701:
1.507 raeburn 5702: table.LC_nested_outer {
5703: border: 1px solid #000000;
1.589 raeburn 5704: border-collapse: collapse;
1.803 bisitz 5705: border-spacing: 0;
1.507 raeburn 5706: width: 100%;
5707: }
1.795 www 5708:
1.879 raeburn 5709: table.LC_innerpickbox,
1.507 raeburn 5710: table.LC_nested {
1.803 bisitz 5711: border: none;
1.589 raeburn 5712: border-collapse: collapse;
1.803 bisitz 5713: border-spacing: 0;
1.507 raeburn 5714: width: 100%;
5715: }
1.795 www 5716:
1.911 bisitz 5717: table.LC_data_table tr th,
5718: table.LC_calendar tr th,
1.879 raeburn 5719: table.LC_prior_tries tr th,
5720: table.LC_innerpickbox tr th {
1.349 albertel 5721: font-weight: bold;
5722: background-color: $data_table_head;
1.801 tempelho 5723: color:$fontmenu;
1.701 harmsja 5724: font-size:90%;
1.347 albertel 5725: }
1.795 www 5726:
1.879 raeburn 5727: table.LC_innerpickbox tr th,
5728: table.LC_innerpickbox tr td {
5729: vertical-align: top;
5730: }
5731:
1.711 raeburn 5732: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5733: background-color: #CCCCCC;
1.711 raeburn 5734: font-weight: bold;
5735: text-align: left;
5736: }
1.795 www 5737:
1.912 bisitz 5738: table.LC_data_table tr.LC_odd_row > td {
5739: background-color: $data_table_light;
5740: padding: 2px;
5741: vertical-align: top;
5742: }
5743:
1.809 bisitz 5744: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5745: background-color: $data_table_light;
1.912 bisitz 5746: vertical-align: top;
5747: }
5748:
5749: table.LC_data_table tr.LC_even_row > td {
5750: background-color: $data_table_dark;
1.425 albertel 5751: padding: 2px;
1.900 bisitz 5752: vertical-align: top;
1.347 albertel 5753: }
1.795 www 5754:
1.809 bisitz 5755: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5756: background-color: $data_table_dark;
1.900 bisitz 5757: vertical-align: top;
1.347 albertel 5758: }
1.795 www 5759:
1.425 albertel 5760: table.LC_data_table tr.LC_data_table_highlight td {
5761: background-color: $data_table_darker;
5762: }
1.795 www 5763:
1.639 raeburn 5764: table.LC_data_table tr td.LC_leftcol_header {
5765: background-color: $data_table_head;
5766: font-weight: bold;
5767: }
1.795 www 5768:
1.451 albertel 5769: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5770: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5771: font-weight: bold;
5772: font-style: italic;
5773: text-align: center;
5774: padding: 8px;
1.347 albertel 5775: }
1.795 www 5776:
1.1075.2.30 raeburn 5777: table.LC_data_table tr.LC_empty_row td,
5778: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5779: background-color: $sidebg;
5780: }
5781:
5782: table.LC_nested tr.LC_empty_row td {
5783: background-color: #FFFFFF;
5784: }
5785:
1.890 droeschl 5786: table.LC_caption {
5787: }
5788:
1.507 raeburn 5789: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5790: padding: 4ex
5791: }
1.795 www 5792:
1.507 raeburn 5793: table.LC_nested_outer tr th {
5794: font-weight: bold;
1.801 tempelho 5795: color:$fontmenu;
1.507 raeburn 5796: background-color: $data_table_head;
1.701 harmsja 5797: font-size: small;
1.507 raeburn 5798: border-bottom: 1px solid #000000;
5799: }
1.795 www 5800:
1.507 raeburn 5801: table.LC_nested_outer tr td.LC_subheader {
5802: background-color: $data_table_head;
5803: font-weight: bold;
5804: font-size: small;
5805: border-bottom: 1px solid #000000;
5806: text-align: right;
1.451 albertel 5807: }
1.795 www 5808:
1.507 raeburn 5809: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5810: background-color: #CCCCCC;
1.451 albertel 5811: font-weight: bold;
5812: font-size: small;
1.507 raeburn 5813: text-align: center;
5814: }
1.795 www 5815:
1.589 raeburn 5816: table.LC_nested tr.LC_info_row td.LC_left_item,
5817: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5818: text-align: left;
1.451 albertel 5819: }
1.795 www 5820:
1.507 raeburn 5821: table.LC_nested td {
1.735 bisitz 5822: background-color: #FFFFFF;
1.451 albertel 5823: font-size: small;
1.507 raeburn 5824: }
1.795 www 5825:
1.507 raeburn 5826: table.LC_nested_outer tr th.LC_right_item,
5827: table.LC_nested tr.LC_info_row td.LC_right_item,
5828: table.LC_nested tr.LC_odd_row td.LC_right_item,
5829: table.LC_nested tr td.LC_right_item {
1.451 albertel 5830: text-align: right;
5831: }
5832:
1.507 raeburn 5833: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5834: background-color: #EEEEEE;
1.451 albertel 5835: }
5836:
1.473 raeburn 5837: table.LC_createuser {
5838: }
5839:
5840: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5841: font-size: small;
1.473 raeburn 5842: }
5843:
5844: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5845: background-color: #CCCCCC;
1.473 raeburn 5846: font-weight: bold;
5847: text-align: center;
5848: }
5849:
1.349 albertel 5850: table.LC_calendar {
5851: border: 1px solid #000000;
5852: border-collapse: collapse;
1.917 raeburn 5853: width: 98%;
1.349 albertel 5854: }
1.795 www 5855:
1.349 albertel 5856: table.LC_calendar_pickdate {
5857: font-size: xx-small;
5858: }
1.795 www 5859:
1.349 albertel 5860: table.LC_calendar tr td {
5861: border: 1px solid #000000;
5862: vertical-align: top;
1.917 raeburn 5863: width: 14%;
1.349 albertel 5864: }
1.795 www 5865:
1.349 albertel 5866: table.LC_calendar tr td.LC_calendar_day_empty {
5867: background-color: $data_table_dark;
5868: }
1.795 www 5869:
1.779 bisitz 5870: table.LC_calendar tr td.LC_calendar_day_current {
5871: background-color: $data_table_highlight;
1.777 tempelho 5872: }
1.795 www 5873:
1.938 bisitz 5874: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5875: background-color: $mail_new;
5876: }
1.795 www 5877:
1.938 bisitz 5878: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5879: background-color: $mail_new_hover;
5880: }
1.795 www 5881:
1.938 bisitz 5882: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5883: background-color: $mail_read;
5884: }
1.795 www 5885:
1.938 bisitz 5886: /*
5887: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5888: background-color: $mail_read_hover;
5889: }
1.938 bisitz 5890: */
1.795 www 5891:
1.938 bisitz 5892: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5893: background-color: $mail_replied;
5894: }
1.795 www 5895:
1.938 bisitz 5896: /*
5897: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5898: background-color: $mail_replied_hover;
5899: }
1.938 bisitz 5900: */
1.795 www 5901:
1.938 bisitz 5902: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5903: background-color: $mail_other;
5904: }
1.795 www 5905:
1.938 bisitz 5906: /*
5907: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5908: background-color: $mail_other_hover;
5909: }
1.938 bisitz 5910: */
1.494 raeburn 5911:
1.777 tempelho 5912: table.LC_data_table tr > td.LC_browser_file,
5913: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5914: background: #AAEE77;
1.389 albertel 5915: }
1.795 www 5916:
1.777 tempelho 5917: table.LC_data_table tr > td.LC_browser_file_locked,
5918: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5919: background: #FFAA99;
1.387 albertel 5920: }
1.795 www 5921:
1.777 tempelho 5922: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5923: background: #888888;
1.779 bisitz 5924: }
1.795 www 5925:
1.777 tempelho 5926: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5927: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5928: background: #F8F866;
1.777 tempelho 5929: }
1.795 www 5930:
1.696 bisitz 5931: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5932: background: #E0E8FF;
1.387 albertel 5933: }
1.696 bisitz 5934:
1.707 bisitz 5935: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5936: /* background: #77FF77; */
1.707 bisitz 5937: }
1.795 www 5938:
1.707 bisitz 5939: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 5940: border-right: 8px solid #FFFF77;
1.707 bisitz 5941: }
1.795 www 5942:
1.707 bisitz 5943: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 5944: border-right: 8px solid #FFAA77;
1.707 bisitz 5945: }
1.795 www 5946:
1.707 bisitz 5947: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 5948: border-right: 8px solid #FF7777;
1.707 bisitz 5949: }
1.795 www 5950:
1.707 bisitz 5951: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 5952: border-right: 8px solid #AAFF77;
1.707 bisitz 5953: }
1.795 www 5954:
1.707 bisitz 5955: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 5956: border-right: 8px solid #11CC55;
1.707 bisitz 5957: }
5958:
1.388 albertel 5959: span.LC_current_location {
1.701 harmsja 5960: font-size:larger;
1.388 albertel 5961: background: $pgbg;
5962: }
1.387 albertel 5963:
1.1029 www 5964: span.LC_current_nav_location {
5965: font-weight:bold;
5966: background: $sidebg;
5967: }
5968:
1.395 albertel 5969: span.LC_parm_menu_item {
5970: font-size: larger;
5971: }
1.795 www 5972:
1.395 albertel 5973: span.LC_parm_scope_all {
5974: color: red;
5975: }
1.795 www 5976:
1.395 albertel 5977: span.LC_parm_scope_folder {
5978: color: green;
5979: }
1.795 www 5980:
1.395 albertel 5981: span.LC_parm_scope_resource {
5982: color: orange;
5983: }
1.795 www 5984:
1.395 albertel 5985: span.LC_parm_part {
5986: color: blue;
5987: }
1.795 www 5988:
1.911 bisitz 5989: span.LC_parm_folder,
5990: span.LC_parm_symb {
1.395 albertel 5991: font-size: x-small;
5992: font-family: $mono;
5993: color: #AAAAAA;
5994: }
5995:
1.977 bisitz 5996: ul.LC_parm_parmlist li {
5997: display: inline-block;
5998: padding: 0.3em 0.8em;
5999: vertical-align: top;
6000: width: 150px;
6001: border-top:1px solid $lg_border_color;
6002: }
6003:
1.795 www 6004: td.LC_parm_overview_level_menu,
6005: td.LC_parm_overview_map_menu,
6006: td.LC_parm_overview_parm_selectors,
6007: td.LC_parm_overview_restrictions {
1.396 albertel 6008: border: 1px solid black;
6009: border-collapse: collapse;
6010: }
1.795 www 6011:
1.396 albertel 6012: table.LC_parm_overview_restrictions td {
6013: border-width: 1px 4px 1px 4px;
6014: border-style: solid;
6015: border-color: $pgbg;
6016: text-align: center;
6017: }
1.795 www 6018:
1.396 albertel 6019: table.LC_parm_overview_restrictions th {
6020: background: $tabbg;
6021: border-width: 1px 4px 1px 4px;
6022: border-style: solid;
6023: border-color: $pgbg;
6024: }
1.795 www 6025:
1.398 albertel 6026: table#LC_helpmenu {
1.803 bisitz 6027: border: none;
1.398 albertel 6028: height: 55px;
1.803 bisitz 6029: border-spacing: 0;
1.398 albertel 6030: }
6031:
6032: table#LC_helpmenu fieldset legend {
6033: font-size: larger;
6034: }
1.795 www 6035:
1.397 albertel 6036: table#LC_helpmenu_links {
6037: width: 100%;
6038: border: 1px solid black;
6039: background: $pgbg;
1.803 bisitz 6040: padding: 0;
1.397 albertel 6041: border-spacing: 1px;
6042: }
1.795 www 6043:
1.397 albertel 6044: table#LC_helpmenu_links tr td {
6045: padding: 1px;
6046: background: $tabbg;
1.399 albertel 6047: text-align: center;
6048: font-weight: bold;
1.397 albertel 6049: }
1.396 albertel 6050:
1.795 www 6051: table#LC_helpmenu_links a:link,
6052: table#LC_helpmenu_links a:visited,
1.397 albertel 6053: table#LC_helpmenu_links a:active {
6054: text-decoration: none;
6055: color: $font;
6056: }
1.795 www 6057:
1.397 albertel 6058: table#LC_helpmenu_links a:hover {
6059: text-decoration: underline;
6060: color: $vlink;
6061: }
1.396 albertel 6062:
1.417 albertel 6063: .LC_chrt_popup_exists {
6064: border: 1px solid #339933;
6065: margin: -1px;
6066: }
1.795 www 6067:
1.417 albertel 6068: .LC_chrt_popup_up {
6069: border: 1px solid yellow;
6070: margin: -1px;
6071: }
1.795 www 6072:
1.417 albertel 6073: .LC_chrt_popup {
6074: border: 1px solid #8888FF;
6075: background: #CCCCFF;
6076: }
1.795 www 6077:
1.421 albertel 6078: table.LC_pick_box {
6079: border-collapse: separate;
6080: background: white;
6081: border: 1px solid black;
6082: border-spacing: 1px;
6083: }
1.795 www 6084:
1.421 albertel 6085: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6086: background: $sidebg;
1.421 albertel 6087: font-weight: bold;
1.900 bisitz 6088: text-align: left;
1.740 bisitz 6089: vertical-align: top;
1.421 albertel 6090: width: 184px;
6091: padding: 8px;
6092: }
1.795 www 6093:
1.579 raeburn 6094: table.LC_pick_box td.LC_pick_box_value {
6095: text-align: left;
6096: padding: 8px;
6097: }
1.795 www 6098:
1.579 raeburn 6099: table.LC_pick_box td.LC_pick_box_select {
6100: text-align: left;
6101: padding: 8px;
6102: }
1.795 www 6103:
1.424 albertel 6104: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6105: padding: 0;
1.421 albertel 6106: height: 1px;
6107: background: black;
6108: }
1.795 www 6109:
1.421 albertel 6110: table.LC_pick_box td.LC_pick_box_submit {
6111: text-align: right;
6112: }
1.795 www 6113:
1.579 raeburn 6114: table.LC_pick_box td.LC_evenrow_value {
6115: text-align: left;
6116: padding: 8px;
6117: background-color: $data_table_light;
6118: }
1.795 www 6119:
1.579 raeburn 6120: table.LC_pick_box td.LC_oddrow_value {
6121: text-align: left;
6122: padding: 8px;
6123: background-color: $data_table_light;
6124: }
1.795 www 6125:
1.579 raeburn 6126: span.LC_helpform_receipt_cat {
6127: font-weight: bold;
6128: }
1.795 www 6129:
1.424 albertel 6130: table.LC_group_priv_box {
6131: background: white;
6132: border: 1px solid black;
6133: border-spacing: 1px;
6134: }
1.795 www 6135:
1.424 albertel 6136: table.LC_group_priv_box td.LC_pick_box_title {
6137: background: $tabbg;
6138: font-weight: bold;
6139: text-align: right;
6140: width: 184px;
6141: }
1.795 www 6142:
1.424 albertel 6143: table.LC_group_priv_box td.LC_groups_fixed {
6144: background: $data_table_light;
6145: text-align: center;
6146: }
1.795 www 6147:
1.424 albertel 6148: table.LC_group_priv_box td.LC_groups_optional {
6149: background: $data_table_dark;
6150: text-align: center;
6151: }
1.795 www 6152:
1.424 albertel 6153: table.LC_group_priv_box td.LC_groups_functionality {
6154: background: $data_table_darker;
6155: text-align: center;
6156: font-weight: bold;
6157: }
1.795 www 6158:
1.424 albertel 6159: table.LC_group_priv td {
6160: text-align: left;
1.803 bisitz 6161: padding: 0;
1.424 albertel 6162: }
6163:
6164: .LC_navbuttons {
6165: margin: 2ex 0ex 2ex 0ex;
6166: }
1.795 www 6167:
1.423 albertel 6168: .LC_topic_bar {
6169: font-weight: bold;
6170: background: $tabbg;
1.918 wenzelju 6171: margin: 1em 0em 1em 2em;
1.805 bisitz 6172: padding: 3px;
1.918 wenzelju 6173: font-size: 1.2em;
1.423 albertel 6174: }
1.795 www 6175:
1.423 albertel 6176: .LC_topic_bar span {
1.918 wenzelju 6177: left: 0.5em;
6178: position: absolute;
1.423 albertel 6179: vertical-align: middle;
1.918 wenzelju 6180: font-size: 1.2em;
1.423 albertel 6181: }
1.795 www 6182:
1.423 albertel 6183: table.LC_course_group_status {
6184: margin: 20px;
6185: }
1.795 www 6186:
1.423 albertel 6187: table.LC_status_selector td {
6188: vertical-align: top;
6189: text-align: center;
1.424 albertel 6190: padding: 4px;
6191: }
1.795 www 6192:
1.599 albertel 6193: div.LC_feedback_link {
1.616 albertel 6194: clear: both;
1.829 kalberla 6195: background: $sidebg;
1.779 bisitz 6196: width: 100%;
1.829 kalberla 6197: padding-bottom: 10px;
6198: border: 1px $tabbg solid;
1.833 kalberla 6199: height: 22px;
6200: line-height: 22px;
6201: padding-top: 5px;
6202: }
6203:
6204: div.LC_feedback_link img {
6205: height: 22px;
1.867 kalberla 6206: vertical-align:middle;
1.829 kalberla 6207: }
6208:
1.911 bisitz 6209: div.LC_feedback_link a {
1.829 kalberla 6210: text-decoration: none;
1.489 raeburn 6211: }
1.795 www 6212:
1.867 kalberla 6213: div.LC_comblock {
1.911 bisitz 6214: display:inline;
1.867 kalberla 6215: color:$font;
6216: font-size:90%;
6217: }
6218:
6219: div.LC_feedback_link div.LC_comblock {
6220: padding-left:5px;
6221: }
6222:
6223: div.LC_feedback_link div.LC_comblock a {
6224: color:$font;
6225: }
6226:
1.489 raeburn 6227: span.LC_feedback_link {
1.858 bisitz 6228: /* background: $feedback_link_bg; */
1.599 albertel 6229: font-size: larger;
6230: }
1.795 www 6231:
1.599 albertel 6232: span.LC_message_link {
1.858 bisitz 6233: /* background: $feedback_link_bg; */
1.599 albertel 6234: font-size: larger;
6235: position: absolute;
6236: right: 1em;
1.489 raeburn 6237: }
1.421 albertel 6238:
1.515 albertel 6239: table.LC_prior_tries {
1.524 albertel 6240: border: 1px solid #000000;
6241: border-collapse: separate;
6242: border-spacing: 1px;
1.515 albertel 6243: }
1.523 albertel 6244:
1.515 albertel 6245: table.LC_prior_tries td {
1.524 albertel 6246: padding: 2px;
1.515 albertel 6247: }
1.523 albertel 6248:
6249: .LC_answer_correct {
1.795 www 6250: background: lightgreen;
6251: color: darkgreen;
6252: padding: 6px;
1.523 albertel 6253: }
1.795 www 6254:
1.523 albertel 6255: .LC_answer_charged_try {
1.797 www 6256: background: #FFAAAA;
1.795 www 6257: color: darkred;
6258: padding: 6px;
1.523 albertel 6259: }
1.795 www 6260:
1.779 bisitz 6261: .LC_answer_not_charged_try,
1.523 albertel 6262: .LC_answer_no_grade,
6263: .LC_answer_late {
1.795 www 6264: background: lightyellow;
1.523 albertel 6265: color: black;
1.795 www 6266: padding: 6px;
1.523 albertel 6267: }
1.795 www 6268:
1.523 albertel 6269: .LC_answer_previous {
1.795 www 6270: background: lightblue;
6271: color: darkblue;
6272: padding: 6px;
1.523 albertel 6273: }
1.795 www 6274:
1.779 bisitz 6275: .LC_answer_no_message {
1.777 tempelho 6276: background: #FFFFFF;
6277: color: black;
1.795 www 6278: padding: 6px;
1.779 bisitz 6279: }
1.795 www 6280:
1.779 bisitz 6281: .LC_answer_unknown {
6282: background: orange;
6283: color: black;
1.795 www 6284: padding: 6px;
1.777 tempelho 6285: }
1.795 www 6286:
1.529 albertel 6287: span.LC_prior_numerical,
6288: span.LC_prior_string,
6289: span.LC_prior_custom,
6290: span.LC_prior_reaction,
6291: span.LC_prior_math {
1.925 bisitz 6292: font-family: $mono;
1.523 albertel 6293: white-space: pre;
6294: }
6295:
1.525 albertel 6296: span.LC_prior_string {
1.925 bisitz 6297: font-family: $mono;
1.525 albertel 6298: white-space: pre;
6299: }
6300:
1.523 albertel 6301: table.LC_prior_option {
6302: width: 100%;
6303: border-collapse: collapse;
6304: }
1.795 www 6305:
1.911 bisitz 6306: table.LC_prior_rank,
1.795 www 6307: table.LC_prior_match {
1.528 albertel 6308: border-collapse: collapse;
6309: }
1.795 www 6310:
1.528 albertel 6311: table.LC_prior_option tr td,
6312: table.LC_prior_rank tr td,
6313: table.LC_prior_match tr td {
1.524 albertel 6314: border: 1px solid #000000;
1.515 albertel 6315: }
6316:
1.855 bisitz 6317: .LC_nobreak {
1.544 albertel 6318: white-space: nowrap;
1.519 raeburn 6319: }
6320:
1.576 raeburn 6321: span.LC_cusr_emph {
6322: font-style: italic;
6323: }
6324:
1.633 raeburn 6325: span.LC_cusr_subheading {
6326: font-weight: normal;
6327: font-size: 85%;
6328: }
6329:
1.861 bisitz 6330: div.LC_docs_entry_move {
1.859 bisitz 6331: border: 1px solid #BBBBBB;
1.545 albertel 6332: background: #DDDDDD;
1.861 bisitz 6333: width: 22px;
1.859 bisitz 6334: padding: 1px;
6335: margin: 0;
1.545 albertel 6336: }
6337:
1.861 bisitz 6338: table.LC_data_table tr > td.LC_docs_entry_commands,
6339: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6340: font-size: x-small;
6341: }
1.795 www 6342:
1.861 bisitz 6343: .LC_docs_entry_parameter {
6344: white-space: nowrap;
6345: }
6346:
1.544 albertel 6347: .LC_docs_copy {
1.545 albertel 6348: color: #000099;
1.544 albertel 6349: }
1.795 www 6350:
1.544 albertel 6351: .LC_docs_cut {
1.545 albertel 6352: color: #550044;
1.544 albertel 6353: }
1.795 www 6354:
1.544 albertel 6355: .LC_docs_rename {
1.545 albertel 6356: color: #009900;
1.544 albertel 6357: }
1.795 www 6358:
1.544 albertel 6359: .LC_docs_remove {
1.545 albertel 6360: color: #990000;
6361: }
6362:
1.547 albertel 6363: .LC_docs_reinit_warn,
6364: .LC_docs_ext_edit {
6365: font-size: x-small;
6366: }
6367:
1.545 albertel 6368: table.LC_docs_adddocs td,
6369: table.LC_docs_adddocs th {
6370: border: 1px solid #BBBBBB;
6371: padding: 4px;
6372: background: #DDDDDD;
1.543 albertel 6373: }
6374:
1.584 albertel 6375: table.LC_sty_begin {
6376: background: #BBFFBB;
6377: }
1.795 www 6378:
1.584 albertel 6379: table.LC_sty_end {
6380: background: #FFBBBB;
6381: }
6382:
1.589 raeburn 6383: table.LC_double_column {
1.803 bisitz 6384: border-width: 0;
1.589 raeburn 6385: border-collapse: collapse;
6386: width: 100%;
6387: padding: 2px;
6388: }
6389:
6390: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6391: top: 2px;
1.589 raeburn 6392: left: 2px;
6393: width: 47%;
6394: vertical-align: top;
6395: }
6396:
6397: table.LC_double_column tr td.LC_right_col {
6398: top: 2px;
1.779 bisitz 6399: right: 2px;
1.589 raeburn 6400: width: 47%;
6401: vertical-align: top;
6402: }
6403:
1.591 raeburn 6404: div.LC_left_float {
6405: float: left;
6406: padding-right: 5%;
1.597 albertel 6407: padding-bottom: 4px;
1.591 raeburn 6408: }
6409:
6410: div.LC_clear_float_header {
1.597 albertel 6411: padding-bottom: 2px;
1.591 raeburn 6412: }
6413:
6414: div.LC_clear_float_footer {
1.597 albertel 6415: padding-top: 10px;
1.591 raeburn 6416: clear: both;
6417: }
6418:
1.597 albertel 6419: div.LC_grade_show_user {
1.941 bisitz 6420: /* border-left: 5px solid $sidebg; */
6421: border-top: 5px solid #000000;
6422: margin: 50px 0 0 0;
1.936 bisitz 6423: padding: 15px 0 5px 10px;
1.597 albertel 6424: }
1.795 www 6425:
1.936 bisitz 6426: div.LC_grade_show_user_odd_row {
1.941 bisitz 6427: /* border-left: 5px solid #000000; */
6428: }
6429:
6430: div.LC_grade_show_user div.LC_Box {
6431: margin-right: 50px;
1.597 albertel 6432: }
6433:
6434: div.LC_grade_submissions,
6435: div.LC_grade_message_center,
1.936 bisitz 6436: div.LC_grade_info_links {
1.597 albertel 6437: margin: 5px;
6438: width: 99%;
6439: background: #FFFFFF;
6440: }
1.795 www 6441:
1.597 albertel 6442: div.LC_grade_submissions_header,
1.936 bisitz 6443: div.LC_grade_message_center_header {
1.705 tempelho 6444: font-weight: bold;
6445: font-size: large;
1.597 albertel 6446: }
1.795 www 6447:
1.597 albertel 6448: div.LC_grade_submissions_body,
1.936 bisitz 6449: div.LC_grade_message_center_body {
1.597 albertel 6450: border: 1px solid black;
6451: width: 99%;
6452: background: #FFFFFF;
6453: }
1.795 www 6454:
1.613 albertel 6455: table.LC_scantron_action {
6456: width: 100%;
6457: }
1.795 www 6458:
1.613 albertel 6459: table.LC_scantron_action tr th {
1.698 harmsja 6460: font-weight:bold;
6461: font-style:normal;
1.613 albertel 6462: }
1.795 www 6463:
1.779 bisitz 6464: .LC_edit_problem_header,
1.614 albertel 6465: div.LC_edit_problem_footer {
1.705 tempelho 6466: font-weight: normal;
6467: font-size: medium;
1.602 albertel 6468: margin: 2px;
1.1060 bisitz 6469: background-color: $sidebg;
1.600 albertel 6470: }
1.795 www 6471:
1.600 albertel 6472: div.LC_edit_problem_header,
1.602 albertel 6473: div.LC_edit_problem_header div,
1.614 albertel 6474: div.LC_edit_problem_footer,
6475: div.LC_edit_problem_footer div,
1.602 albertel 6476: div.LC_edit_problem_editxml_header,
6477: div.LC_edit_problem_editxml_header div {
1.600 albertel 6478: margin-top: 5px;
6479: }
1.795 www 6480:
1.600 albertel 6481: div.LC_edit_problem_header_title {
1.705 tempelho 6482: font-weight: bold;
6483: font-size: larger;
1.602 albertel 6484: background: $tabbg;
6485: padding: 3px;
1.1060 bisitz 6486: margin: 0 0 5px 0;
1.602 albertel 6487: }
1.795 www 6488:
1.602 albertel 6489: table.LC_edit_problem_header_title {
6490: width: 100%;
1.600 albertel 6491: background: $tabbg;
1.602 albertel 6492: }
6493:
6494: div.LC_edit_problem_discards {
6495: float: left;
6496: padding-bottom: 5px;
6497: }
1.795 www 6498:
1.602 albertel 6499: div.LC_edit_problem_saves {
6500: float: right;
6501: padding-bottom: 5px;
1.600 albertel 6502: }
1.795 www 6503:
1.1075.2.34 raeburn 6504: .LC_edit_opt {
6505: padding-left: 1em;
6506: white-space: nowrap;
6507: }
6508:
1.1075.2.57 raeburn 6509: .LC_edit_problem_latexhelper{
6510: text-align: right;
6511: }
6512:
6513: #LC_edit_problem_colorful div{
6514: margin-left: 40px;
6515: }
6516:
1.911 bisitz 6517: img.stift {
1.803 bisitz 6518: border-width: 0;
6519: vertical-align: middle;
1.677 riegler 6520: }
1.680 riegler 6521:
1.923 bisitz 6522: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6523: vertical-align: top;
1.777 tempelho 6524: }
1.795 www 6525:
1.716 raeburn 6526: div.LC_createcourse {
1.911 bisitz 6527: margin: 10px 10px 10px 10px;
1.716 raeburn 6528: }
6529:
1.917 raeburn 6530: .LC_dccid {
1.1075.2.38 raeburn 6531: float: right;
1.917 raeburn 6532: margin: 0.2em 0 0 0;
6533: padding: 0;
6534: font-size: 90%;
6535: display:none;
6536: }
6537:
1.897 wenzelju 6538: ol.LC_primary_menu a:hover,
1.721 harmsja 6539: ol#LC_MenuBreadcrumbs a:hover,
6540: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6541: ul#LC_secondary_menu a:hover,
1.721 harmsja 6542: .LC_FormSectionClearButton input:hover
1.795 www 6543: ul.LC_TabContent li:hover a {
1.952 onken 6544: color:$button_hover;
1.911 bisitz 6545: text-decoration:none;
1.693 droeschl 6546: }
6547:
1.779 bisitz 6548: h1 {
1.911 bisitz 6549: padding: 0;
6550: line-height:130%;
1.693 droeschl 6551: }
1.698 harmsja 6552:
1.911 bisitz 6553: h2,
6554: h3,
6555: h4,
6556: h5,
6557: h6 {
6558: margin: 5px 0 5px 0;
6559: padding: 0;
6560: line-height:130%;
1.693 droeschl 6561: }
1.795 www 6562:
6563: .LC_hcell {
1.911 bisitz 6564: padding:3px 15px 3px 15px;
6565: margin: 0;
6566: background-color:$tabbg;
6567: color:$fontmenu;
6568: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6569: }
1.795 www 6570:
1.840 bisitz 6571: .LC_Box > .LC_hcell {
1.911 bisitz 6572: margin: 0 -10px 10px -10px;
1.835 bisitz 6573: }
6574:
1.721 harmsja 6575: .LC_noBorder {
1.911 bisitz 6576: border: 0;
1.698 harmsja 6577: }
1.693 droeschl 6578:
1.721 harmsja 6579: .LC_FormSectionClearButton input {
1.911 bisitz 6580: background-color:transparent;
6581: border: none;
6582: cursor:pointer;
6583: text-decoration:underline;
1.693 droeschl 6584: }
1.763 bisitz 6585:
6586: .LC_help_open_topic {
1.911 bisitz 6587: color: #FFFFFF;
6588: background-color: #EEEEFF;
6589: margin: 1px;
6590: padding: 4px;
6591: border: 1px solid #000033;
6592: white-space: nowrap;
6593: /* vertical-align: middle; */
1.759 neumanie 6594: }
1.693 droeschl 6595:
1.911 bisitz 6596: dl,
6597: ul,
6598: div,
6599: fieldset {
6600: margin: 10px 10px 10px 0;
6601: /* overflow: hidden; */
1.693 droeschl 6602: }
1.795 www 6603:
1.838 bisitz 6604: fieldset > legend {
1.911 bisitz 6605: font-weight: bold;
6606: padding: 0 5px 0 5px;
1.838 bisitz 6607: }
6608:
1.813 bisitz 6609: #LC_nav_bar {
1.911 bisitz 6610: float: left;
1.995 raeburn 6611: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6612: margin: 0 0 2px 0;
1.807 droeschl 6613: }
6614:
1.916 droeschl 6615: #LC_realm {
6616: margin: 0.2em 0 0 0;
6617: padding: 0;
6618: font-weight: bold;
6619: text-align: center;
1.995 raeburn 6620: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6621: }
6622:
1.911 bisitz 6623: #LC_nav_bar em {
6624: font-weight: bold;
6625: font-style: normal;
1.807 droeschl 6626: }
6627:
1.897 wenzelju 6628: ol.LC_primary_menu {
1.934 droeschl 6629: margin: 0;
1.1075.2.2 raeburn 6630: padding: 0;
1.995 raeburn 6631: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6632: }
6633:
1.852 droeschl 6634: ol#LC_PathBreadcrumbs {
1.911 bisitz 6635: margin: 0;
1.693 droeschl 6636: }
6637:
1.897 wenzelju 6638: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6639: color: RGB(80, 80, 80);
6640: vertical-align: middle;
6641: text-align: left;
6642: list-style: none;
6643: float: left;
6644: }
6645:
6646: ol.LC_primary_menu li a {
6647: display: block;
6648: margin: 0;
6649: padding: 0 5px 0 10px;
6650: text-decoration: none;
6651: }
6652:
6653: ol.LC_primary_menu li ul {
6654: display: none;
6655: width: 10em;
6656: background-color: $data_table_light;
6657: }
6658:
6659: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6660: display: block;
6661: position: absolute;
6662: margin: 0;
6663: padding: 0;
1.1075.2.5 raeburn 6664: z-index: 2;
1.1075.2.2 raeburn 6665: }
6666:
6667: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6668: font-size: 90%;
1.911 bisitz 6669: vertical-align: top;
1.1075.2.2 raeburn 6670: float: none;
1.1075.2.5 raeburn 6671: border-left: 1px solid black;
6672: border-right: 1px solid black;
1.1075.2.2 raeburn 6673: }
6674:
6675: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6676: background-color:$data_table_light;
1.1075.2.2 raeburn 6677: }
6678:
6679: ol.LC_primary_menu li li a:hover {
6680: color:$button_hover;
6681: background-color:$data_table_dark;
1.693 droeschl 6682: }
6683:
1.897 wenzelju 6684: ol.LC_primary_menu li img {
1.911 bisitz 6685: vertical-align: bottom;
1.934 droeschl 6686: height: 1.1em;
1.1075.2.3 raeburn 6687: margin: 0.2em 0 0 0;
1.693 droeschl 6688: }
6689:
1.897 wenzelju 6690: ol.LC_primary_menu a {
1.911 bisitz 6691: color: RGB(80, 80, 80);
6692: text-decoration: none;
1.693 droeschl 6693: }
1.795 www 6694:
1.949 droeschl 6695: ol.LC_primary_menu a.LC_new_message {
6696: font-weight:bold;
6697: color: darkred;
6698: }
6699:
1.975 raeburn 6700: ol.LC_docs_parameters {
6701: margin-left: 0;
6702: padding: 0;
6703: list-style: none;
6704: }
6705:
6706: ol.LC_docs_parameters li {
6707: margin: 0;
6708: padding-right: 20px;
6709: display: inline;
6710: }
6711:
1.976 raeburn 6712: ol.LC_docs_parameters li:before {
6713: content: "\\002022 \\0020";
6714: }
6715:
6716: li.LC_docs_parameters_title {
6717: font-weight: bold;
6718: }
6719:
6720: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6721: content: "";
6722: }
6723:
1.897 wenzelju 6724: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6725: clear: right;
1.911 bisitz 6726: color: $fontmenu;
6727: background: $tabbg;
6728: list-style: none;
6729: padding: 0;
6730: margin: 0;
6731: width: 100%;
1.995 raeburn 6732: text-align: left;
1.1075.2.4 raeburn 6733: float: left;
1.808 droeschl 6734: }
6735:
1.897 wenzelju 6736: ul#LC_secondary_menu li {
1.911 bisitz 6737: font-weight: bold;
6738: line-height: 1.8em;
6739: border-right: 1px solid black;
6740: vertical-align: middle;
1.1075.2.4 raeburn 6741: float: left;
6742: }
6743:
6744: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6745: background-color: $data_table_light;
6746: }
6747:
6748: ul#LC_secondary_menu li a {
6749: padding: 0 0.8em;
6750: }
6751:
6752: ul#LC_secondary_menu li ul {
6753: display: none;
6754: }
6755:
6756: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6757: display: block;
6758: position: absolute;
6759: margin: 0;
6760: padding: 0;
6761: list-style:none;
6762: float: none;
6763: background-color: $data_table_light;
1.1075.2.5 raeburn 6764: z-index: 2;
1.1075.2.10 raeburn 6765: margin-left: -1px;
1.1075.2.4 raeburn 6766: }
6767:
6768: ul#LC_secondary_menu li ul li {
6769: font-size: 90%;
6770: vertical-align: top;
6771: border-left: 1px solid black;
6772: border-right: 1px solid black;
1.1075.2.33 raeburn 6773: background-color: $data_table_light;
1.1075.2.4 raeburn 6774: list-style:none;
6775: float: none;
6776: }
6777:
6778: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6779: background-color: $data_table_dark;
1.807 droeschl 6780: }
6781:
1.847 tempelho 6782: ul.LC_TabContent {
1.911 bisitz 6783: display:block;
6784: background: $sidebg;
6785: border-bottom: solid 1px $lg_border_color;
6786: list-style:none;
1.1020 raeburn 6787: margin: -1px -10px 0 -10px;
1.911 bisitz 6788: padding: 0;
1.693 droeschl 6789: }
6790:
1.795 www 6791: ul.LC_TabContent li,
6792: ul.LC_TabContentBigger li {
1.911 bisitz 6793: float:left;
1.741 harmsja 6794: }
1.795 www 6795:
1.897 wenzelju 6796: ul#LC_secondary_menu li a {
1.911 bisitz 6797: color: $fontmenu;
6798: text-decoration: none;
1.693 droeschl 6799: }
1.795 www 6800:
1.721 harmsja 6801: ul.LC_TabContent {
1.952 onken 6802: min-height:20px;
1.721 harmsja 6803: }
1.795 www 6804:
6805: ul.LC_TabContent li {
1.911 bisitz 6806: vertical-align:middle;
1.959 onken 6807: padding: 0 16px 0 10px;
1.911 bisitz 6808: background-color:$tabbg;
6809: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6810: border-left: solid 1px $font;
1.721 harmsja 6811: }
1.795 www 6812:
1.847 tempelho 6813: ul.LC_TabContent .right {
1.911 bisitz 6814: float:right;
1.847 tempelho 6815: }
6816:
1.911 bisitz 6817: ul.LC_TabContent li a,
6818: ul.LC_TabContent li {
6819: color:rgb(47,47,47);
6820: text-decoration:none;
6821: font-size:95%;
6822: font-weight:bold;
1.952 onken 6823: min-height:20px;
6824: }
6825:
1.959 onken 6826: ul.LC_TabContent li a:hover,
6827: ul.LC_TabContent li a:focus {
1.952 onken 6828: color: $button_hover;
1.959 onken 6829: background:none;
6830: outline:none;
1.952 onken 6831: }
6832:
6833: ul.LC_TabContent li:hover {
6834: color: $button_hover;
6835: cursor:pointer;
1.721 harmsja 6836: }
1.795 www 6837:
1.911 bisitz 6838: ul.LC_TabContent li.active {
1.952 onken 6839: color: $font;
1.911 bisitz 6840: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6841: border-bottom:solid 1px #FFFFFF;
6842: cursor: default;
1.744 ehlerst 6843: }
1.795 www 6844:
1.959 onken 6845: ul.LC_TabContent li.active a {
6846: color:$font;
6847: background:#FFFFFF;
6848: outline: none;
6849: }
1.1047 raeburn 6850:
6851: ul.LC_TabContent li.goback {
6852: float: left;
6853: border-left: none;
6854: }
6855:
1.870 tempelho 6856: #maincoursedoc {
1.911 bisitz 6857: clear:both;
1.870 tempelho 6858: }
6859:
6860: ul.LC_TabContentBigger {
1.911 bisitz 6861: display:block;
6862: list-style:none;
6863: padding: 0;
1.870 tempelho 6864: }
6865:
1.795 www 6866: ul.LC_TabContentBigger li {
1.911 bisitz 6867: vertical-align:bottom;
6868: height: 30px;
6869: font-size:110%;
6870: font-weight:bold;
6871: color: #737373;
1.841 tempelho 6872: }
6873:
1.957 onken 6874: ul.LC_TabContentBigger li.active {
6875: position: relative;
6876: top: 1px;
6877: }
6878:
1.870 tempelho 6879: ul.LC_TabContentBigger li a {
1.911 bisitz 6880: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6881: height: 30px;
6882: line-height: 30px;
6883: text-align: center;
6884: display: block;
6885: text-decoration: none;
1.958 onken 6886: outline: none;
1.741 harmsja 6887: }
1.795 www 6888:
1.870 tempelho 6889: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6890: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6891: color:$font;
1.744 ehlerst 6892: }
1.795 www 6893:
1.870 tempelho 6894: ul.LC_TabContentBigger li b {
1.911 bisitz 6895: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6896: display: block;
6897: float: left;
6898: padding: 0 30px;
1.957 onken 6899: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6900: }
6901:
1.956 onken 6902: ul.LC_TabContentBigger li:hover b {
6903: color:$button_hover;
6904: }
6905:
1.870 tempelho 6906: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6907: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6908: color:$font;
1.957 onken 6909: border: 0;
1.741 harmsja 6910: }
1.693 droeschl 6911:
1.870 tempelho 6912:
1.862 bisitz 6913: ul.LC_CourseBreadcrumbs {
6914: background: $sidebg;
1.1020 raeburn 6915: height: 2em;
1.862 bisitz 6916: padding-left: 10px;
1.1020 raeburn 6917: margin: 0;
1.862 bisitz 6918: list-style-position: inside;
6919: }
6920:
1.911 bisitz 6921: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6922: ol#LC_PathBreadcrumbs {
1.911 bisitz 6923: padding-left: 10px;
6924: margin: 0;
1.933 droeschl 6925: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6926: }
6927:
1.911 bisitz 6928: ol#LC_MenuBreadcrumbs li,
6929: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6930: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6931: display: inline;
1.933 droeschl 6932: white-space: normal;
1.693 droeschl 6933: }
6934:
1.823 bisitz 6935: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6936: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6937: text-decoration: none;
6938: font-size:90%;
1.693 droeschl 6939: }
1.795 www 6940:
1.969 droeschl 6941: ol#LC_MenuBreadcrumbs h1 {
6942: display: inline;
6943: font-size: 90%;
6944: line-height: 2.5em;
6945: margin: 0;
6946: padding: 0;
6947: }
6948:
1.795 www 6949: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6950: text-decoration:none;
6951: font-size:100%;
6952: font-weight:bold;
1.693 droeschl 6953: }
1.795 www 6954:
1.840 bisitz 6955: .LC_Box {
1.911 bisitz 6956: border: solid 1px $lg_border_color;
6957: padding: 0 10px 10px 10px;
1.746 neumanie 6958: }
1.795 www 6959:
1.1020 raeburn 6960: .LC_DocsBox {
6961: border: solid 1px $lg_border_color;
6962: padding: 0 0 10px 10px;
6963: }
6964:
1.795 www 6965: .LC_AboutMe_Image {
1.911 bisitz 6966: float:left;
6967: margin-right:10px;
1.747 neumanie 6968: }
1.795 www 6969:
6970: .LC_Clear_AboutMe_Image {
1.911 bisitz 6971: clear:left;
1.747 neumanie 6972: }
1.795 www 6973:
1.721 harmsja 6974: dl.LC_ListStyleClean dt {
1.911 bisitz 6975: padding-right: 5px;
6976: display: table-header-group;
1.693 droeschl 6977: }
6978:
1.721 harmsja 6979: dl.LC_ListStyleClean dd {
1.911 bisitz 6980: display: table-row;
1.693 droeschl 6981: }
6982:
1.721 harmsja 6983: .LC_ListStyleClean,
6984: .LC_ListStyleSimple,
6985: .LC_ListStyleNormal,
1.795 www 6986: .LC_ListStyleSpecial {
1.911 bisitz 6987: /* display:block; */
6988: list-style-position: inside;
6989: list-style-type: none;
6990: overflow: hidden;
6991: padding: 0;
1.693 droeschl 6992: }
6993:
1.721 harmsja 6994: .LC_ListStyleSimple li,
6995: .LC_ListStyleSimple dd,
6996: .LC_ListStyleNormal li,
6997: .LC_ListStyleNormal dd,
6998: .LC_ListStyleSpecial li,
1.795 www 6999: .LC_ListStyleSpecial dd {
1.911 bisitz 7000: margin: 0;
7001: padding: 5px 5px 5px 10px;
7002: clear: both;
1.693 droeschl 7003: }
7004:
1.721 harmsja 7005: .LC_ListStyleClean li,
7006: .LC_ListStyleClean dd {
1.911 bisitz 7007: padding-top: 0;
7008: padding-bottom: 0;
1.693 droeschl 7009: }
7010:
1.721 harmsja 7011: .LC_ListStyleSimple dd,
1.795 www 7012: .LC_ListStyleSimple li {
1.911 bisitz 7013: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7014: }
7015:
1.721 harmsja 7016: .LC_ListStyleSpecial li,
7017: .LC_ListStyleSpecial dd {
1.911 bisitz 7018: list-style-type: none;
7019: background-color: RGB(220, 220, 220);
7020: margin-bottom: 4px;
1.693 droeschl 7021: }
7022:
1.721 harmsja 7023: table.LC_SimpleTable {
1.911 bisitz 7024: margin:5px;
7025: border:solid 1px $lg_border_color;
1.795 www 7026: }
1.693 droeschl 7027:
1.721 harmsja 7028: table.LC_SimpleTable tr {
1.911 bisitz 7029: padding: 0;
7030: border:solid 1px $lg_border_color;
1.693 droeschl 7031: }
1.795 www 7032:
7033: table.LC_SimpleTable thead {
1.911 bisitz 7034: background:rgb(220,220,220);
1.693 droeschl 7035: }
7036:
1.721 harmsja 7037: div.LC_columnSection {
1.911 bisitz 7038: display: block;
7039: clear: both;
7040: overflow: hidden;
7041: margin: 0;
1.693 droeschl 7042: }
7043:
1.721 harmsja 7044: div.LC_columnSection>* {
1.911 bisitz 7045: float: left;
7046: margin: 10px 20px 10px 0;
7047: overflow:hidden;
1.693 droeschl 7048: }
1.721 harmsja 7049:
1.795 www 7050: table em {
1.911 bisitz 7051: font-weight: bold;
7052: font-style: normal;
1.748 schulted 7053: }
1.795 www 7054:
1.779 bisitz 7055: table.LC_tableBrowseRes,
1.795 www 7056: table.LC_tableOfContent {
1.911 bisitz 7057: border:none;
7058: border-spacing: 1px;
7059: padding: 3px;
7060: background-color: #FFFFFF;
7061: font-size: 90%;
1.753 droeschl 7062: }
1.789 droeschl 7063:
1.911 bisitz 7064: table.LC_tableOfContent {
7065: border-collapse: collapse;
1.789 droeschl 7066: }
7067:
1.771 droeschl 7068: table.LC_tableBrowseRes a,
1.768 schulted 7069: table.LC_tableOfContent a {
1.911 bisitz 7070: background-color: transparent;
7071: text-decoration: none;
1.753 droeschl 7072: }
7073:
1.795 www 7074: table.LC_tableOfContent img {
1.911 bisitz 7075: border: none;
7076: height: 1.3em;
7077: vertical-align: text-bottom;
7078: margin-right: 0.3em;
1.753 droeschl 7079: }
1.757 schulted 7080:
1.795 www 7081: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7082: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7083: }
7084:
1.795 www 7085: a#LC_content_toolbar_everything {
1.911 bisitz 7086: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7087: }
7088:
1.795 www 7089: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7090: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7091: }
7092:
1.795 www 7093: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7094: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7095: }
7096:
1.795 www 7097: a#LC_content_toolbar_changefolder {
1.911 bisitz 7098: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7099: }
7100:
1.795 www 7101: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7102: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7103: }
7104:
1.1043 raeburn 7105: a#LC_content_toolbar_edittoplevel {
7106: background-image:url(/res/adm/pages/edittoplevel.gif);
7107: }
7108:
1.795 www 7109: ul#LC_toolbar li a:hover {
1.911 bisitz 7110: background-position: bottom center;
1.757 schulted 7111: }
7112:
1.795 www 7113: ul#LC_toolbar {
1.911 bisitz 7114: padding: 0;
7115: margin: 2px;
7116: list-style:none;
7117: position:relative;
7118: background-color:white;
1.1075.2.9 raeburn 7119: overflow: auto;
1.757 schulted 7120: }
7121:
1.795 www 7122: ul#LC_toolbar li {
1.911 bisitz 7123: border:1px solid white;
7124: padding: 0;
7125: margin: 0;
7126: float: left;
7127: display:inline;
7128: vertical-align:middle;
1.1075.2.9 raeburn 7129: white-space: nowrap;
1.911 bisitz 7130: }
1.757 schulted 7131:
1.783 amueller 7132:
1.795 www 7133: a.LC_toolbarItem {
1.911 bisitz 7134: display:block;
7135: padding: 0;
7136: margin: 0;
7137: height: 32px;
7138: width: 32px;
7139: color:white;
7140: border: none;
7141: background-repeat:no-repeat;
7142: background-color:transparent;
1.757 schulted 7143: }
7144:
1.915 droeschl 7145: ul.LC_funclist {
7146: margin: 0;
7147: padding: 0.5em 1em 0.5em 0;
7148: }
7149:
1.933 droeschl 7150: ul.LC_funclist > li:first-child {
7151: font-weight:bold;
7152: margin-left:0.8em;
7153: }
7154:
1.915 droeschl 7155: ul.LC_funclist + ul.LC_funclist {
7156: /*
7157: left border as a seperator if we have more than
7158: one list
7159: */
7160: border-left: 1px solid $sidebg;
7161: /*
7162: this hides the left border behind the border of the
7163: outer box if element is wrapped to the next 'line'
7164: */
7165: margin-left: -1px;
7166: }
7167:
1.843 bisitz 7168: ul.LC_funclist li {
1.915 droeschl 7169: display: inline;
1.782 bisitz 7170: white-space: nowrap;
1.915 droeschl 7171: margin: 0 0 0 25px;
7172: line-height: 150%;
1.782 bisitz 7173: }
7174:
1.974 wenzelju 7175: .LC_hidden {
7176: display: none;
7177: }
7178:
1.1030 www 7179: .LCmodal-overlay {
7180: position:fixed;
7181: top:0;
7182: right:0;
7183: bottom:0;
7184: left:0;
7185: height:100%;
7186: width:100%;
7187: margin:0;
7188: padding:0;
7189: background:#999;
7190: opacity:.75;
7191: filter: alpha(opacity=75);
7192: -moz-opacity: 0.75;
7193: z-index:101;
7194: }
7195:
7196: * html .LCmodal-overlay {
7197: position: absolute;
7198: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7199: }
7200:
7201: .LCmodal-window {
7202: position:fixed;
7203: top:50%;
7204: left:50%;
7205: margin:0;
7206: padding:0;
7207: z-index:102;
7208: }
7209:
7210: * html .LCmodal-window {
7211: position:absolute;
7212: }
7213:
7214: .LCclose-window {
7215: position:absolute;
7216: width:32px;
7217: height:32px;
7218: right:8px;
7219: top:8px;
7220: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7221: text-indent:-99999px;
7222: overflow:hidden;
7223: cursor:pointer;
7224: }
7225:
1.1075.2.17 raeburn 7226: /*
7227: styles used by TTH when "Default set of options to pass to tth/m
7228: when converting TeX" in course settings has been set
7229:
7230: option passed: -t
7231:
7232: */
7233:
7234: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7235: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7236: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7237: td div.norm {line-height:normal;}
7238:
7239: /*
7240: option passed -y3
7241: */
7242:
7243: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7244: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7245: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7246:
1.343 albertel 7247: END
7248: }
7249:
1.306 albertel 7250: =pod
7251:
7252: =item * &headtag()
7253:
7254: Returns a uniform footer for LON-CAPA web pages.
7255:
1.307 albertel 7256: Inputs: $title - optional title for the head
7257: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7258: $args - optional arguments
1.319 albertel 7259: force_register - if is true call registerurl so the remote is
7260: informed
1.415 albertel 7261: redirect -> array ref of
7262: 1- seconds before redirect occurs
7263: 2- url to redirect to
7264: 3- whether the side effect should occur
1.315 albertel 7265: (side effect of setting
7266: $env{'internal.head.redirect'} to the url
7267: redirected too)
1.352 albertel 7268: domain -> force to color decorate a page for a specific
7269: domain
7270: function -> force usage of a specific rolish color scheme
7271: bgcolor -> override the default page bgcolor
1.460 albertel 7272: no_auto_mt_title
7273: -> prevent &mt()ing the title arg
1.464 albertel 7274:
1.306 albertel 7275: =cut
7276:
7277: sub headtag {
1.313 albertel 7278: my ($title,$head_extra,$args) = @_;
1.306 albertel 7279:
1.363 albertel 7280: my $function = $args->{'function'} || &get_users_function();
7281: my $domain = $args->{'domain'} || &determinedomain();
7282: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7283: my $httphost = $args->{'use_absolute'};
1.418 albertel 7284: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7285: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7286: #time(),
1.418 albertel 7287: $env{'environment.color.timestamp'},
1.363 albertel 7288: $function,$domain,$bgcolor);
7289:
1.369 www 7290: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7291:
1.308 albertel 7292: my $result =
7293: '<head>'.
1.1075.2.56 raeburn 7294: &font_settings($args);
1.319 albertel 7295:
1.1064 raeburn 7296: my $inhibitprint = &print_suppression();
7297:
1.461 albertel 7298: if (!$args->{'frameset'}) {
7299: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7300: }
1.1075.2.12 raeburn 7301: if ($args->{'force_register'}) {
7302: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7303: }
1.436 albertel 7304: if (!$args->{'no_nav_bar'}
7305: && !$args->{'only_body'}
7306: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7307: $result .= &help_menu_js($httphost);
1.1032 www 7308: $result.=&modal_window();
1.1038 www 7309: $result.=&togglebox_script();
1.1034 www 7310: $result.=&wishlist_window();
1.1041 www 7311: $result.=&LCprogressbarUpdate_script();
1.1034 www 7312: } else {
7313: if ($args->{'add_modal'}) {
7314: $result.=&modal_window();
7315: }
7316: if ($args->{'add_wishlist'}) {
7317: $result.=&wishlist_window();
7318: }
1.1038 www 7319: if ($args->{'add_togglebox'}) {
7320: $result.=&togglebox_script();
7321: }
1.1041 www 7322: if ($args->{'add_progressbar'}) {
7323: $result.=&LCprogressbarUpdate_script();
7324: }
1.436 albertel 7325: }
1.314 albertel 7326: if (ref($args->{'redirect'})) {
1.414 albertel 7327: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7328: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7329: if (!$inhibit_continue) {
7330: $env{'internal.head.redirect'} = $url;
7331: }
1.313 albertel 7332: $result.=<<ADDMETA
7333: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7334: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7335: ADDMETA
7336: }
1.306 albertel 7337: if (!defined($title)) {
7338: $title = 'The LearningOnline Network with CAPA';
7339: }
1.460 albertel 7340: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7341: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 7342: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7343: if (!$args->{'frameset'}) {
7344: $result .= ' /';
7345: }
7346: $result .= '>'
1.1064 raeburn 7347: .$inhibitprint
1.414 albertel 7348: .$head_extra;
1.1075.2.42 raeburn 7349: if ($env{'browser.mobile'}) {
7350: $result .= '
7351: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7352: <meta name="apple-mobile-web-app-capable" content="yes" />';
7353: }
1.962 droeschl 7354: return $result.'</head>';
1.306 albertel 7355: }
7356:
7357: =pod
7358:
1.340 albertel 7359: =item * &font_settings()
7360:
7361: Returns neccessary <meta> to set the proper encoding
7362:
1.1075.2.56 raeburn 7363: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7364:
7365: =cut
7366:
7367: sub font_settings {
1.1075.2.56 raeburn 7368: my ($args) = @_;
1.340 albertel 7369: my $headerstring='';
1.1075.2.56 raeburn 7370: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7371: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 7372: $headerstring.=
1.1075.2.61 raeburn 7373: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7374: if (!$args->{'frameset'}) {
7375: $headerstring.= ' /';
7376: }
7377: $headerstring .= '>'."\n";
1.340 albertel 7378: }
7379: return $headerstring;
7380: }
7381:
1.341 albertel 7382: =pod
7383:
1.1064 raeburn 7384: =item * &print_suppression()
7385:
7386: In course context returns css which causes the body to be blank when media="print",
7387: if printout generation is unavailable for the current resource.
7388:
7389: This could be because:
7390:
7391: (a) printstartdate is in the future
7392:
7393: (b) printenddate is in the past
7394:
7395: (c) there is an active exam block with "printout"
7396: functionality blocked
7397:
7398: Users with pav, pfo or evb privileges are exempt.
7399:
7400: Inputs: none
7401:
7402: =cut
7403:
7404:
7405: sub print_suppression {
7406: my $noprint;
7407: if ($env{'request.course.id'}) {
7408: my $scope = $env{'request.course.id'};
7409: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7410: (&Apache::lonnet::allowed('pfo',$scope))) {
7411: return;
7412: }
7413: if ($env{'request.course.sec'} ne '') {
7414: $scope .= "/$env{'request.course.sec'}";
7415: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7416: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7417: return;
1.1064 raeburn 7418: }
7419: }
7420: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7421: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065 raeburn 7422: my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064 raeburn 7423: if ($blocked) {
7424: my $checkrole = "cm./$cdom/$cnum";
7425: if ($env{'request.course.sec'} ne '') {
7426: $checkrole .= "/$env{'request.course.sec'}";
7427: }
7428: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7429: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7430: $noprint = 1;
7431: }
7432: }
7433: unless ($noprint) {
7434: my $symb = &Apache::lonnet::symbread();
7435: if ($symb ne '') {
7436: my $navmap = Apache::lonnavmaps::navmap->new();
7437: if (ref($navmap)) {
7438: my $res = $navmap->getBySymb($symb);
7439: if (ref($res)) {
7440: if (!$res->resprintable()) {
7441: $noprint = 1;
7442: }
7443: }
7444: }
7445: }
7446: }
7447: if ($noprint) {
7448: return <<"ENDSTYLE";
7449: <style type="text/css" media="print">
7450: body { display:none }
7451: </style>
7452: ENDSTYLE
7453: }
7454: }
7455: return;
7456: }
7457:
7458: =pod
7459:
1.341 albertel 7460: =item * &xml_begin()
7461:
7462: Returns the needed doctype and <html>
7463:
7464: Inputs: none
7465:
7466: =cut
7467:
7468: sub xml_begin {
1.1075.2.61 raeburn 7469: my ($is_frameset) = @_;
1.341 albertel 7470: my $output='';
7471:
7472: if ($env{'browser.mathml'}) {
7473: $output='<?xml version="1.0"?>'
7474: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7475: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7476:
7477: # .'<!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">] >'
7478: .'<!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">'
7479: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7480: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 7481: } elsif ($is_frameset) {
7482: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7483: '<html>'."\n";
1.341 albertel 7484: } else {
1.1075.2.61 raeburn 7485: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7486: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7487: }
7488: return $output;
7489: }
1.340 albertel 7490:
7491: =pod
7492:
1.306 albertel 7493: =item * &start_page()
7494:
7495: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7496:
1.648 raeburn 7497: Inputs:
7498:
7499: =over 4
7500:
7501: $title - optional title for the page
7502:
7503: $head_extra - optional extra HTML to incude inside the <head>
7504:
7505: $args - additional optional args supported are:
7506:
7507: =over 8
7508:
7509: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7510: arg on
1.814 bisitz 7511: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7512: add_entries -> additional attributes to add to the <body>
7513: domain -> force to color decorate a page for a
1.317 albertel 7514: specific domain
1.648 raeburn 7515: function -> force usage of a specific rolish color
1.317 albertel 7516: scheme
1.648 raeburn 7517: redirect -> see &headtag()
7518: bgcolor -> override the default page bg color
7519: js_ready -> return a string ready for being used in
1.317 albertel 7520: a javascript writeln
1.648 raeburn 7521: html_encode -> return a string ready for being used in
1.320 albertel 7522: a html attribute
1.648 raeburn 7523: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7524: $forcereg arg
1.648 raeburn 7525: frameset -> if true will start with a <frameset>
1.330 albertel 7526: rather than <body>
1.648 raeburn 7527: skip_phases -> hash ref of
1.338 albertel 7528: head -> skip the <html><head> generation
7529: body -> skip all <body> generation
1.1075.2.12 raeburn 7530: no_inline_link -> if true and in remote mode, don't show the
7531: 'Switch To Inline Menu' link
1.648 raeburn 7532: no_auto_mt_title -> prevent &mt()ing the title arg
7533: inherit_jsmath -> when creating popup window in a page,
7534: should it have jsmath forced on by the
7535: current page
1.867 kalberla 7536: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7537: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7538: group -> includes the current group, if page is for a
7539: specific group
1.361 albertel 7540:
1.648 raeburn 7541: =back
1.460 albertel 7542:
1.648 raeburn 7543: =back
1.562 albertel 7544:
1.306 albertel 7545: =cut
7546:
7547: sub start_page {
1.309 albertel 7548: my ($title,$head_extra,$args) = @_;
1.318 albertel 7549: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7550:
1.315 albertel 7551: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7552: my ($result,@advtools);
1.964 droeschl 7553:
1.338 albertel 7554: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 7555: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7556: }
7557:
7558: if (! exists($args->{'skip_phases'}{'body'}) ) {
7559: if ($args->{'frameset'}) {
7560: my $attr_string = &make_attr_string($args->{'force_register'},
7561: $args->{'add_entries'});
7562: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7563: } else {
7564: $result .=
7565: &bodytag($title,
7566: $args->{'function'}, $args->{'add_entries'},
7567: $args->{'only_body'}, $args->{'domain'},
7568: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7569: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7570: $args, \@advtools);
1.831 bisitz 7571: }
1.330 albertel 7572: }
1.338 albertel 7573:
1.315 albertel 7574: if ($args->{'js_ready'}) {
1.713 kaisler 7575: $result = &js_ready($result);
1.315 albertel 7576: }
1.320 albertel 7577: if ($args->{'html_encode'}) {
1.713 kaisler 7578: $result = &html_encode($result);
7579: }
7580:
1.813 bisitz 7581: # Preparation for new and consistent functionlist at top of screen
7582: # if ($args->{'functionlist'}) {
7583: # $result .= &build_functionlist();
7584: #}
7585:
1.964 droeschl 7586: # Don't add anything more if only_body wanted or in const space
7587: return $result if $args->{'only_body'}
7588: || $env{'request.state'} eq 'construct';
1.813 bisitz 7589:
7590: #Breadcrumbs
1.758 kaisler 7591: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7592: &Apache::lonhtmlcommon::clear_breadcrumbs();
7593: #if any br links exists, add them to the breadcrumbs
7594: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7595: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7596: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7597: }
7598: }
1.1075.2.19 raeburn 7599: # if @advtools array contains items add then to the breadcrumbs
7600: if (@advtools > 0) {
7601: &Apache::lonmenu::advtools_crumbs(@advtools);
7602: }
1.758 kaisler 7603:
7604: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7605: if(exists($args->{'bread_crumbs_component'})){
7606: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7607: }else{
7608: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7609: }
1.1075.2.24 raeburn 7610: } elsif (($env{'environment.remote'} eq 'on') &&
7611: ($env{'form.inhibitmenu'} ne 'yes') &&
7612: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7613: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7614: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7615: }
1.315 albertel 7616: return $result;
1.306 albertel 7617: }
7618:
7619: sub end_page {
1.315 albertel 7620: my ($args) = @_;
7621: $env{'internal.end_page'}++;
1.330 albertel 7622: my $result;
1.335 albertel 7623: if ($args->{'discussion'}) {
7624: my ($target,$parser);
7625: if (ref($args->{'discussion'})) {
7626: ($target,$parser) =($args->{'discussion'}{'target'},
7627: $args->{'discussion'}{'parser'});
7628: }
7629: $result .= &Apache::lonxml::xmlend($target,$parser);
7630: }
1.330 albertel 7631: if ($args->{'frameset'}) {
7632: $result .= '</frameset>';
7633: } else {
1.635 raeburn 7634: $result .= &endbodytag($args);
1.330 albertel 7635: }
1.1075.2.6 raeburn 7636: unless ($args->{'notbody'}) {
7637: $result .= "\n</html>";
7638: }
1.330 albertel 7639:
1.315 albertel 7640: if ($args->{'js_ready'}) {
1.317 albertel 7641: $result = &js_ready($result);
1.315 albertel 7642: }
1.335 albertel 7643:
1.320 albertel 7644: if ($args->{'html_encode'}) {
7645: $result = &html_encode($result);
7646: }
1.335 albertel 7647:
1.315 albertel 7648: return $result;
7649: }
7650:
1.1034 www 7651: sub wishlist_window {
7652: return(<<'ENDWISHLIST');
1.1046 raeburn 7653: <script type="text/javascript">
1.1034 www 7654: // <![CDATA[
7655: // <!-- BEGIN LON-CAPA Internal
7656: function set_wishlistlink(title, path) {
7657: if (!title) {
7658: title = document.title;
7659: title = title.replace(/^LON-CAPA /,'');
7660: }
1.1075.2.65 raeburn 7661: title = encodeURIComponent(title);
1.1034 www 7662: if (!path) {
7663: path = location.pathname;
7664: }
1.1075.2.65 raeburn 7665: path = encodeURIComponent(path);
1.1034 www 7666: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7667: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7668: }
7669: // END LON-CAPA Internal -->
7670: // ]]>
7671: </script>
7672: ENDWISHLIST
7673: }
7674:
1.1030 www 7675: sub modal_window {
7676: return(<<'ENDMODAL');
1.1046 raeburn 7677: <script type="text/javascript">
1.1030 www 7678: // <![CDATA[
7679: // <!-- BEGIN LON-CAPA Internal
7680: var modalWindow = {
7681: parent:"body",
7682: windowId:null,
7683: content:null,
7684: width:null,
7685: height:null,
7686: close:function()
7687: {
7688: $(".LCmodal-window").remove();
7689: $(".LCmodal-overlay").remove();
7690: },
7691: open:function()
7692: {
7693: var modal = "";
7694: modal += "<div class=\"LCmodal-overlay\"></div>";
7695: 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;\">";
7696: modal += this.content;
7697: modal += "</div>";
7698:
7699: $(this.parent).append(modal);
7700:
7701: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7702: $(".LCclose-window").click(function(){modalWindow.close();});
7703: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7704: }
7705: };
1.1075.2.42 raeburn 7706: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7707: {
7708: modalWindow.windowId = "myModal";
7709: modalWindow.width = width;
7710: modalWindow.height = height;
1.1075.2.42 raeburn 7711: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7712: modalWindow.open();
7713: };
7714: // END LON-CAPA Internal -->
7715: // ]]>
7716: </script>
7717: ENDMODAL
7718: }
7719:
7720: sub modal_link {
1.1075.2.42 raeburn 7721: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7722: unless ($width) { $width=480; }
7723: unless ($height) { $height=400; }
1.1031 www 7724: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 7725: unless ($transparency) { $transparency='true'; }
7726:
1.1074 raeburn 7727: my $target_attr;
7728: if (defined($target)) {
7729: $target_attr = 'target="'.$target.'"';
7730: }
7731: return <<"ENDLINK";
1.1075.2.42 raeburn 7732: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7733: $linktext</a>
7734: ENDLINK
1.1030 www 7735: }
7736:
1.1032 www 7737: sub modal_adhoc_script {
7738: my ($funcname,$width,$height,$content)=@_;
7739: return (<<ENDADHOC);
1.1046 raeburn 7740: <script type="text/javascript">
1.1032 www 7741: // <![CDATA[
7742: var $funcname = function()
7743: {
7744: modalWindow.windowId = "myModal";
7745: modalWindow.width = $width;
7746: modalWindow.height = $height;
7747: modalWindow.content = '$content';
7748: modalWindow.open();
7749: };
7750: // ]]>
7751: </script>
7752: ENDADHOC
7753: }
7754:
1.1041 www 7755: sub modal_adhoc_inner {
7756: my ($funcname,$width,$height,$content)=@_;
7757: my $innerwidth=$width-20;
7758: $content=&js_ready(
1.1042 www 7759: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 7760: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7761: $content.
1.1041 www 7762: &end_scrollbox().
1.1075.2.42 raeburn 7763: &end_page()
1.1041 www 7764: );
7765: return &modal_adhoc_script($funcname,$width,$height,$content);
7766: }
7767:
7768: sub modal_adhoc_window {
7769: my ($funcname,$width,$height,$content,$linktext)=@_;
7770: return &modal_adhoc_inner($funcname,$width,$height,$content).
7771: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7772: }
7773:
7774: sub modal_adhoc_launch {
7775: my ($funcname,$width,$height,$content)=@_;
7776: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7777: <script type="text/javascript">
7778: // <![CDATA[
7779: $funcname();
7780: // ]]>
7781: </script>
7782: ENDLAUNCH
7783: }
7784:
7785: sub modal_adhoc_close {
7786: return (<<ENDCLOSE);
7787: <script type="text/javascript">
7788: // <![CDATA[
7789: modalWindow.close();
7790: // ]]>
7791: </script>
7792: ENDCLOSE
7793: }
7794:
1.1038 www 7795: sub togglebox_script {
7796: return(<<ENDTOGGLE);
7797: <script type="text/javascript">
7798: // <![CDATA[
7799: function LCtoggleDisplay(id,hidetext,showtext) {
7800: link = document.getElementById(id + "link").childNodes[0];
7801: with (document.getElementById(id).style) {
7802: if (display == "none" ) {
7803: display = "inline";
7804: link.nodeValue = hidetext;
7805: } else {
7806: display = "none";
7807: link.nodeValue = showtext;
7808: }
7809: }
7810: }
7811: // ]]>
7812: </script>
7813: ENDTOGGLE
7814: }
7815:
1.1039 www 7816: sub start_togglebox {
7817: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7818: unless ($heading) { $heading=''; } else { $heading.=' '; }
7819: unless ($showtext) { $showtext=&mt('show'); }
7820: unless ($hidetext) { $hidetext=&mt('hide'); }
7821: unless ($headerbg) { $headerbg='#FFFFFF'; }
7822: return &start_data_table().
7823: &start_data_table_header_row().
7824: '<td bgcolor="'.$headerbg.'">'.$heading.
7825: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7826: $showtext.'\')">'.$showtext.'</a>]</td>'.
7827: &end_data_table_header_row().
7828: '<tr id="'.$id.'" style="display:none""><td>';
7829: }
7830:
7831: sub end_togglebox {
7832: return '</td></tr>'.&end_data_table();
7833: }
7834:
1.1041 www 7835: sub LCprogressbar_script {
1.1045 www 7836: my ($id)=@_;
1.1041 www 7837: return(<<ENDPROGRESS);
7838: <script type="text/javascript">
7839: // <![CDATA[
1.1045 www 7840: \$('#progressbar$id').progressbar({
1.1041 www 7841: value: 0,
7842: change: function(event, ui) {
7843: var newVal = \$(this).progressbar('option', 'value');
7844: \$('.pblabel', this).text(LCprogressTxt);
7845: }
7846: });
7847: // ]]>
7848: </script>
7849: ENDPROGRESS
7850: }
7851:
7852: sub LCprogressbarUpdate_script {
7853: return(<<ENDPROGRESSUPDATE);
7854: <style type="text/css">
7855: .ui-progressbar { position:relative; }
7856: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7857: </style>
7858: <script type="text/javascript">
7859: // <![CDATA[
1.1045 www 7860: var LCprogressTxt='---';
7861:
7862: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7863: LCprogressTxt=progresstext;
1.1045 www 7864: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7865: }
7866: // ]]>
7867: </script>
7868: ENDPROGRESSUPDATE
7869: }
7870:
1.1042 www 7871: my $LClastpercent;
1.1045 www 7872: my $LCidcnt;
7873: my $LCcurrentid;
1.1042 www 7874:
1.1041 www 7875: sub LCprogressbar {
1.1042 www 7876: my ($r)=(@_);
7877: $LClastpercent=0;
1.1045 www 7878: $LCidcnt++;
7879: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7880: my $starting=&mt('Starting');
7881: my $content=(<<ENDPROGBAR);
1.1045 www 7882: <div id="progressbar$LCcurrentid">
1.1041 www 7883: <span class="pblabel">$starting</span>
7884: </div>
7885: ENDPROGBAR
1.1045 www 7886: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7887: }
7888:
7889: sub LCprogressbarUpdate {
1.1042 www 7890: my ($r,$val,$text)=@_;
7891: unless ($val) {
7892: if ($LClastpercent) {
7893: $val=$LClastpercent;
7894: } else {
7895: $val=0;
7896: }
7897: }
1.1041 www 7898: if ($val<0) { $val=0; }
7899: if ($val>100) { $val=0; }
1.1042 www 7900: $LClastpercent=$val;
1.1041 www 7901: unless ($text) { $text=$val.'%'; }
7902: $text=&js_ready($text);
1.1044 www 7903: &r_print($r,<<ENDUPDATE);
1.1041 www 7904: <script type="text/javascript">
7905: // <![CDATA[
1.1045 www 7906: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7907: // ]]>
7908: </script>
7909: ENDUPDATE
1.1035 www 7910: }
7911:
1.1042 www 7912: sub LCprogressbarClose {
7913: my ($r)=@_;
7914: $LClastpercent=0;
1.1044 www 7915: &r_print($r,<<ENDCLOSE);
1.1042 www 7916: <script type="text/javascript">
7917: // <![CDATA[
1.1045 www 7918: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7919: // ]]>
7920: </script>
7921: ENDCLOSE
1.1044 www 7922: }
7923:
7924: sub r_print {
7925: my ($r,$to_print)=@_;
7926: if ($r) {
7927: $r->print($to_print);
7928: $r->rflush();
7929: } else {
7930: print($to_print);
7931: }
1.1042 www 7932: }
7933:
1.320 albertel 7934: sub html_encode {
7935: my ($result) = @_;
7936:
1.322 albertel 7937: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7938:
7939: return $result;
7940: }
1.1044 www 7941:
1.317 albertel 7942: sub js_ready {
7943: my ($result) = @_;
7944:
1.323 albertel 7945: $result =~ s/[\n\r]/ /xmsg;
7946: $result =~ s/\\/\\\\/xmsg;
7947: $result =~ s/'/\\'/xmsg;
1.372 albertel 7948: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7949:
7950: return $result;
7951: }
7952:
1.315 albertel 7953: sub validate_page {
7954: if ( exists($env{'internal.start_page'})
1.316 albertel 7955: && $env{'internal.start_page'} > 1) {
7956: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7957: $env{'internal.start_page'}.' '.
1.316 albertel 7958: $ENV{'request.filename'});
1.315 albertel 7959: }
7960: if ( exists($env{'internal.end_page'})
1.316 albertel 7961: && $env{'internal.end_page'} > 1) {
7962: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7963: $env{'internal.end_page'}.' '.
1.316 albertel 7964: $env{'request.filename'});
1.315 albertel 7965: }
7966: if ( exists($env{'internal.start_page'})
7967: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7968: &Apache::lonnet::logthis('start_page called without end_page '.
7969: $env{'request.filename'});
1.315 albertel 7970: }
7971: if ( ! exists($env{'internal.start_page'})
7972: && exists($env{'internal.end_page'})) {
1.316 albertel 7973: &Apache::lonnet::logthis('end_page called without start_page'.
7974: $env{'request.filename'});
1.315 albertel 7975: }
1.306 albertel 7976: }
1.315 albertel 7977:
1.996 www 7978:
7979: sub start_scrollbox {
1.1075.2.56 raeburn 7980: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 7981: unless ($outerwidth) { $outerwidth='520px'; }
7982: unless ($width) { $width='500px'; }
7983: unless ($height) { $height='200px'; }
1.1075 raeburn 7984: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 7985: if ($id ne '') {
1.1075.2.42 raeburn 7986: $table_id = ' id="table_'.$id.'"';
7987: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 7988: }
1.1075 raeburn 7989: if ($bgcolor ne '') {
7990: $tdcol = "background-color: $bgcolor;";
7991: }
1.1075.2.42 raeburn 7992: my $nicescroll_js;
7993: if ($env{'browser.mobile'}) {
7994: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
7995: }
1.1075 raeburn 7996: return <<"END";
1.1075.2.42 raeburn 7997: $nicescroll_js
7998:
7999: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8000: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8001: END
1.996 www 8002: }
8003:
8004: sub end_scrollbox {
1.1036 www 8005: return '</div></td></tr></table>';
1.996 www 8006: }
8007:
1.1075.2.42 raeburn 8008: sub nicescroll_javascript {
8009: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8010: my %options;
8011: if (ref($cursor) eq 'HASH') {
8012: %options = %{$cursor};
8013: }
8014: unless ($options{'railalign'} =~ /^left|right$/) {
8015: $options{'railalign'} = 'left';
8016: }
8017: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8018: my $function = &get_users_function();
8019: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8020: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8021: $options{'cursorcolor'} = '#00F';
8022: }
8023: }
8024: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8025: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8026: $options{'cursoropacity'}='1.0';
8027: }
8028: } else {
8029: $options{'cursoropacity'}='1.0';
8030: }
8031: if ($options{'cursorfixedheight'} eq 'none') {
8032: delete($options{'cursorfixedheight'});
8033: } else {
8034: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8035: }
8036: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8037: delete($options{'railoffset'});
8038: }
8039: my @niceoptions;
8040: while (my($key,$value) = each(%options)) {
8041: if ($value =~ /^\{.+\}$/) {
8042: push(@niceoptions,$key.':'.$value);
8043: } else {
8044: push(@niceoptions,$key.':"'.$value.'"');
8045: }
8046: }
8047: my $nicescroll_js = '
8048: $(document).ready(
8049: function() {
8050: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8051: }
8052: );
8053: ';
8054: if ($framecheck) {
8055: $nicescroll_js .= '
8056: function expand_div(caller) {
8057: if (top === self) {
8058: document.getElementById("'.$id.'").style.width = "auto";
8059: document.getElementById("'.$id.'").style.height = "auto";
8060: } else {
8061: try {
8062: if (parent.frames) {
8063: if (parent.frames.length > 1) {
8064: var framesrc = parent.frames[1].location.href;
8065: var currsrc = framesrc.replace(/\#.*$/,"");
8066: if ((caller == "search") || (currsrc == "'.$location.'")) {
8067: document.getElementById("'.$id.'").style.width = "auto";
8068: document.getElementById("'.$id.'").style.height = "auto";
8069: }
8070: }
8071: }
8072: } catch (e) {
8073: return;
8074: }
8075: }
8076: return;
8077: }
8078: ';
8079: }
8080: if ($needjsready) {
8081: $nicescroll_js = '
8082: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8083: } else {
8084: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8085: }
8086: return $nicescroll_js;
8087: }
8088:
1.318 albertel 8089: sub simple_error_page {
1.1075.2.49 raeburn 8090: my ($r,$title,$msg,$args) = @_;
8091: if (ref($args) eq 'HASH') {
8092: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8093: } else {
8094: $msg = &mt($msg);
8095: }
8096:
1.318 albertel 8097: my $page =
8098: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8099: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8100: &Apache::loncommon::end_page();
8101: if (ref($r)) {
8102: $r->print($page);
1.327 albertel 8103: return;
1.318 albertel 8104: }
8105: return $page;
8106: }
1.347 albertel 8107:
8108: {
1.610 albertel 8109: my @row_count;
1.961 onken 8110:
8111: sub start_data_table_count {
8112: unshift(@row_count, 0);
8113: return;
8114: }
8115:
8116: sub end_data_table_count {
8117: shift(@row_count);
8118: return;
8119: }
8120:
1.347 albertel 8121: sub start_data_table {
1.1018 raeburn 8122: my ($add_class,$id) = @_;
1.422 albertel 8123: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8124: my $table_id;
8125: if (defined($id)) {
8126: $table_id = ' id="'.$id.'"';
8127: }
1.961 onken 8128: &start_data_table_count();
1.1018 raeburn 8129: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8130: }
8131:
8132: sub end_data_table {
1.961 onken 8133: &end_data_table_count();
1.389 albertel 8134: return '</table>'."\n";;
1.347 albertel 8135: }
8136:
8137: sub start_data_table_row {
1.974 wenzelju 8138: my ($add_class, $id) = @_;
1.610 albertel 8139: $row_count[0]++;
8140: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8141: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8142: $id = (' id="'.$id.'"') unless ($id eq '');
8143: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8144: }
1.471 banghart 8145:
8146: sub continue_data_table_row {
1.974 wenzelju 8147: my ($add_class, $id) = @_;
1.610 albertel 8148: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8149: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8150: $id = (' id="'.$id.'"') unless ($id eq '');
8151: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8152: }
1.347 albertel 8153:
8154: sub end_data_table_row {
1.389 albertel 8155: return '</tr>'."\n";;
1.347 albertel 8156: }
1.367 www 8157:
1.421 albertel 8158: sub start_data_table_empty_row {
1.707 bisitz 8159: # $row_count[0]++;
1.421 albertel 8160: return '<tr class="LC_empty_row" >'."\n";;
8161: }
8162:
8163: sub end_data_table_empty_row {
8164: return '</tr>'."\n";;
8165: }
8166:
1.367 www 8167: sub start_data_table_header_row {
1.389 albertel 8168: return '<tr class="LC_header_row">'."\n";;
1.367 www 8169: }
8170:
8171: sub end_data_table_header_row {
1.389 albertel 8172: return '</tr>'."\n";;
1.367 www 8173: }
1.890 droeschl 8174:
8175: sub data_table_caption {
8176: my $caption = shift;
8177: return "<caption class=\"LC_caption\">$caption</caption>";
8178: }
1.347 albertel 8179: }
8180:
1.548 albertel 8181: =pod
8182:
8183: =item * &inhibit_menu_check($arg)
8184:
8185: Checks for a inhibitmenu state and generates output to preserve it
8186:
8187: Inputs: $arg - can be any of
8188: - undef - in which case the return value is a string
8189: to add into arguments list of a uri
8190: - 'input' - in which case the return value is a HTML
8191: <form> <input> field of type hidden to
8192: preserve the value
8193: - a url - in which case the return value is the url with
8194: the neccesary cgi args added to preserve the
8195: inhibitmenu state
8196: - a ref to a url - no return value, but the string is
8197: updated to include the neccessary cgi
8198: args to preserve the inhibitmenu state
8199:
8200: =cut
8201:
8202: sub inhibit_menu_check {
8203: my ($arg) = @_;
8204: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8205: if ($arg eq 'input') {
8206: if ($env{'form.inhibitmenu'}) {
8207: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8208: } else {
8209: return
8210: }
8211: }
8212: if ($env{'form.inhibitmenu'}) {
8213: if (ref($arg)) {
8214: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8215: } elsif ($arg eq '') {
8216: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8217: } else {
8218: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8219: }
8220: }
8221: if (!ref($arg)) {
8222: return $arg;
8223: }
8224: }
8225:
1.251 albertel 8226: ###############################################
1.182 matthew 8227:
8228: =pod
8229:
1.549 albertel 8230: =back
8231:
8232: =head1 User Information Routines
8233:
8234: =over 4
8235:
1.405 albertel 8236: =item * &get_users_function()
1.182 matthew 8237:
8238: Used by &bodytag to determine the current users primary role.
8239: Returns either 'student','coordinator','admin', or 'author'.
8240:
8241: =cut
8242:
8243: ###############################################
8244: sub get_users_function {
1.815 tempelho 8245: my $function = 'norole';
1.818 tempelho 8246: if ($env{'request.role'}=~/^(st)/) {
8247: $function='student';
8248: }
1.907 raeburn 8249: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8250: $function='coordinator';
8251: }
1.258 albertel 8252: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8253: $function='admin';
8254: }
1.826 bisitz 8255: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8256: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8257: $function='author';
8258: }
8259: return $function;
1.54 www 8260: }
1.99 www 8261:
8262: ###############################################
8263:
1.233 raeburn 8264: =pod
8265:
1.821 raeburn 8266: =item * &show_course()
8267:
8268: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8269: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8270:
8271: Inputs:
8272: None
8273:
8274: Outputs:
8275: Scalar: 1 if 'Course' to be used, 0 otherwise.
8276:
8277: =cut
8278:
8279: ###############################################
8280: sub show_course {
8281: my $course = !$env{'user.adv'};
8282: if (!$env{'user.adv'}) {
8283: foreach my $env (keys(%env)) {
8284: next if ($env !~ m/^user\.priv\./);
8285: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8286: $course = 0;
8287: last;
8288: }
8289: }
8290: }
8291: return $course;
8292: }
8293:
8294: ###############################################
8295:
8296: =pod
8297:
1.542 raeburn 8298: =item * &check_user_status()
1.274 raeburn 8299:
8300: Determines current status of supplied role for a
8301: specific user. Roles can be active, previous or future.
8302:
8303: Inputs:
8304: user's domain, user's username, course's domain,
1.375 raeburn 8305: course's number, optional section ID.
1.274 raeburn 8306:
8307: Outputs:
8308: role status: active, previous or future.
8309:
8310: =cut
8311:
8312: sub check_user_status {
1.412 raeburn 8313: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8314: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8315: my @uroles = keys %userinfo;
8316: my $srchstr;
8317: my $active_chk = 'none';
1.412 raeburn 8318: my $now = time;
1.274 raeburn 8319: if (@uroles > 0) {
1.908 raeburn 8320: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8321: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8322: } else {
1.412 raeburn 8323: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8324: }
8325: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8326: my $role_end = 0;
8327: my $role_start = 0;
8328: $active_chk = 'active';
1.412 raeburn 8329: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8330: $role_end = $1;
8331: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8332: $role_start = $1;
1.274 raeburn 8333: }
8334: }
8335: if ($role_start > 0) {
1.412 raeburn 8336: if ($now < $role_start) {
1.274 raeburn 8337: $active_chk = 'future';
8338: }
8339: }
8340: if ($role_end > 0) {
1.412 raeburn 8341: if ($now > $role_end) {
1.274 raeburn 8342: $active_chk = 'previous';
8343: }
8344: }
8345: }
8346: }
8347: return $active_chk;
8348: }
8349:
8350: ###############################################
8351:
8352: =pod
8353:
1.405 albertel 8354: =item * &get_sections()
1.233 raeburn 8355:
8356: Determines all the sections for a course including
8357: sections with students and sections containing other roles.
1.419 raeburn 8358: Incoming parameters:
8359:
8360: 1. domain
8361: 2. course number
8362: 3. reference to array containing roles for which sections should
8363: be gathered (optional).
8364: 4. reference to array containing status types for which sections
8365: should be gathered (optional).
8366:
8367: If the third argument is undefined, sections are gathered for any role.
8368: If the fourth argument is undefined, sections are gathered for any status.
8369: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8370:
1.374 raeburn 8371: Returns section hash (keys are section IDs, values are
8372: number of users in each section), subject to the
1.419 raeburn 8373: optional roles filter, optional status filter
1.233 raeburn 8374:
8375: =cut
8376:
8377: ###############################################
8378: sub get_sections {
1.419 raeburn 8379: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8380: if (!defined($cdom) || !defined($cnum)) {
8381: my $cid = $env{'request.course.id'};
8382:
8383: return if (!defined($cid));
8384:
8385: $cdom = $env{'course.'.$cid.'.domain'};
8386: $cnum = $env{'course.'.$cid.'.num'};
8387: }
8388:
8389: my %sectioncount;
1.419 raeburn 8390: my $now = time;
1.240 albertel 8391:
1.1075.2.33 raeburn 8392: my $check_students = 1;
8393: my $only_students = 0;
8394: if (ref($possible_roles) eq 'ARRAY') {
8395: if (grep(/^st$/,@{$possible_roles})) {
8396: if (@{$possible_roles} == 1) {
8397: $only_students = 1;
8398: }
8399: } else {
8400: $check_students = 0;
8401: }
8402: }
8403:
8404: if ($check_students) {
1.276 albertel 8405: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8406: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8407: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8408: my $start_index = &Apache::loncoursedata::CL_START();
8409: my $end_index = &Apache::loncoursedata::CL_END();
8410: my $status;
1.366 albertel 8411: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8412: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8413: $data->[$status_index],
8414: $data->[$start_index],
8415: $data->[$end_index]);
8416: if ($stu_status eq 'Active') {
8417: $status = 'active';
8418: } elsif ($end < $now) {
8419: $status = 'previous';
8420: } elsif ($start > $now) {
8421: $status = 'future';
8422: }
8423: if ($section ne '-1' && $section !~ /^\s*$/) {
8424: if ((!defined($possible_status)) || (($status ne '') &&
8425: (grep/^\Q$status\E$/,@{$possible_status}))) {
8426: $sectioncount{$section}++;
8427: }
1.240 albertel 8428: }
8429: }
8430: }
1.1075.2.33 raeburn 8431: if ($only_students) {
8432: return %sectioncount;
8433: }
1.240 albertel 8434: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8435: foreach my $user (sort(keys(%courseroles))) {
8436: if ($user !~ /^(\w{2})/) { next; }
8437: my ($role) = ($user =~ /^(\w{2})/);
8438: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8439: my ($section,$status);
1.240 albertel 8440: if ($role eq 'cr' &&
8441: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8442: $section=$1;
8443: }
8444: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8445: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8446: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8447: if ($end == -1 && $start == -1) {
8448: next; #deleted role
8449: }
8450: if (!defined($possible_status)) {
8451: $sectioncount{$section}++;
8452: } else {
8453: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8454: $status = 'active';
8455: } elsif ($end < $now) {
8456: $status = 'future';
8457: } elsif ($start > $now) {
8458: $status = 'previous';
8459: }
8460: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8461: $sectioncount{$section}++;
8462: }
8463: }
1.233 raeburn 8464: }
1.366 albertel 8465: return %sectioncount;
1.233 raeburn 8466: }
8467:
1.274 raeburn 8468: ###############################################
1.294 raeburn 8469:
8470: =pod
1.405 albertel 8471:
8472: =item * &get_course_users()
8473:
1.275 raeburn 8474: Retrieves usernames:domains for users in the specified course
8475: with specific role(s), and access status.
8476:
8477: Incoming parameters:
1.277 albertel 8478: 1. course domain
8479: 2. course number
8480: 3. access status: users must have - either active,
1.275 raeburn 8481: previous, future, or all.
1.277 albertel 8482: 4. reference to array of permissible roles
1.288 raeburn 8483: 5. reference to array of section restrictions (optional)
8484: 6. reference to results object (hash of hashes).
8485: 7. reference to optional userdata hash
1.609 raeburn 8486: 8. reference to optional statushash
1.630 raeburn 8487: 9. flag if privileged users (except those set to unhide in
8488: course settings) should be excluded
1.609 raeburn 8489: Keys of top level results hash are roles.
1.275 raeburn 8490: Keys of inner hashes are username:domain, with
8491: values set to access type.
1.288 raeburn 8492: Optional userdata hash returns an array with arguments in the
8493: same order as loncoursedata::get_classlist() for student data.
8494:
1.609 raeburn 8495: Optional statushash returns
8496:
1.288 raeburn 8497: Entries for end, start, section and status are blank because
8498: of the possibility of multiple values for non-student roles.
8499:
1.275 raeburn 8500: =cut
1.405 albertel 8501:
1.275 raeburn 8502: ###############################################
1.405 albertel 8503:
1.275 raeburn 8504: sub get_course_users {
1.630 raeburn 8505: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8506: my %idx = ();
1.419 raeburn 8507: my %seclists;
1.288 raeburn 8508:
8509: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8510: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8511: $idx{end} = &Apache::loncoursedata::CL_END();
8512: $idx{start} = &Apache::loncoursedata::CL_START();
8513: $idx{id} = &Apache::loncoursedata::CL_ID();
8514: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8515: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8516: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8517:
1.290 albertel 8518: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8519: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8520: my $now = time;
1.277 albertel 8521: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8522: my $match = 0;
1.412 raeburn 8523: my $secmatch = 0;
1.419 raeburn 8524: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8525: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8526: if ($section eq '') {
8527: $section = 'none';
8528: }
1.291 albertel 8529: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8530: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8531: $secmatch = 1;
8532: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8533: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8534: $secmatch = 1;
8535: }
8536: } else {
1.419 raeburn 8537: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8538: $secmatch = 1;
8539: }
1.290 albertel 8540: }
1.412 raeburn 8541: if (!$secmatch) {
8542: next;
8543: }
1.419 raeburn 8544: }
1.275 raeburn 8545: if (defined($$types{'active'})) {
1.288 raeburn 8546: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8547: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8548: $match = 1;
1.275 raeburn 8549: }
8550: }
8551: if (defined($$types{'previous'})) {
1.609 raeburn 8552: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8553: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8554: $match = 1;
1.275 raeburn 8555: }
8556: }
8557: if (defined($$types{'future'})) {
1.609 raeburn 8558: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8559: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8560: $match = 1;
1.275 raeburn 8561: }
8562: }
1.609 raeburn 8563: if ($match) {
8564: push(@{$seclists{$student}},$section);
8565: if (ref($userdata) eq 'HASH') {
8566: $$userdata{$student} = $$classlist{$student};
8567: }
8568: if (ref($statushash) eq 'HASH') {
8569: $statushash->{$student}{'st'}{$section} = $status;
8570: }
1.288 raeburn 8571: }
1.275 raeburn 8572: }
8573: }
1.412 raeburn 8574: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8575: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8576: my $now = time;
1.609 raeburn 8577: my %displaystatus = ( previous => 'Expired',
8578: active => 'Active',
8579: future => 'Future',
8580: );
1.1075.2.36 raeburn 8581: my (%nothide,@possdoms);
1.630 raeburn 8582: if ($hidepriv) {
8583: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8584: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8585: if ($user !~ /:/) {
8586: $nothide{join(':',split(/[\@]/,$user))}=1;
8587: } else {
8588: $nothide{$user} = 1;
8589: }
8590: }
1.1075.2.36 raeburn 8591: my @possdoms = ($cdom);
8592: if ($coursehash{'checkforpriv'}) {
8593: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8594: }
1.630 raeburn 8595: }
1.439 raeburn 8596: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8597: my $match = 0;
1.412 raeburn 8598: my $secmatch = 0;
1.439 raeburn 8599: my $status;
1.412 raeburn 8600: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8601: $user =~ s/:$//;
1.439 raeburn 8602: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8603: if ($end == -1 || $start == -1) {
8604: next;
8605: }
8606: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8607: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8608: my ($uname,$udom) = split(/:/,$user);
8609: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8610: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8611: $secmatch = 1;
8612: } elsif ($usec eq '') {
1.420 albertel 8613: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8614: $secmatch = 1;
8615: }
8616: } else {
8617: if (grep(/^\Q$usec\E$/,@{$sections})) {
8618: $secmatch = 1;
8619: }
8620: }
8621: if (!$secmatch) {
8622: next;
8623: }
1.288 raeburn 8624: }
1.419 raeburn 8625: if ($usec eq '') {
8626: $usec = 'none';
8627: }
1.275 raeburn 8628: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8629: if ($hidepriv) {
1.1075.2.36 raeburn 8630: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8631: (!$nothide{$uname.':'.$udom})) {
8632: next;
8633: }
8634: }
1.503 raeburn 8635: if ($end > 0 && $end < $now) {
1.439 raeburn 8636: $status = 'previous';
8637: } elsif ($start > $now) {
8638: $status = 'future';
8639: } else {
8640: $status = 'active';
8641: }
1.277 albertel 8642: foreach my $type (keys(%{$types})) {
1.275 raeburn 8643: if ($status eq $type) {
1.420 albertel 8644: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8645: push(@{$$users{$role}{$user}},$type);
8646: }
1.288 raeburn 8647: $match = 1;
8648: }
8649: }
1.419 raeburn 8650: if (($match) && (ref($userdata) eq 'HASH')) {
8651: if (!exists($$userdata{$uname.':'.$udom})) {
8652: &get_user_info($udom,$uname,\%idx,$userdata);
8653: }
1.420 albertel 8654: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8655: push(@{$seclists{$uname.':'.$udom}},$usec);
8656: }
1.609 raeburn 8657: if (ref($statushash) eq 'HASH') {
8658: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8659: }
1.275 raeburn 8660: }
8661: }
8662: }
8663: }
1.290 albertel 8664: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8665: if ((defined($cdom)) && (defined($cnum))) {
8666: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8667: if ( defined($csettings{'internal.courseowner'}) ) {
8668: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8669: next if ($owner eq '');
8670: my ($ownername,$ownerdom);
8671: if ($owner =~ /^([^:]+):([^:]+)$/) {
8672: $ownername = $1;
8673: $ownerdom = $2;
8674: } else {
8675: $ownername = $owner;
8676: $ownerdom = $cdom;
8677: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8678: }
8679: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8680: if (defined($userdata) &&
1.609 raeburn 8681: !exists($$userdata{$owner})) {
8682: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8683: if (!grep(/^none$/,@{$seclists{$owner}})) {
8684: push(@{$seclists{$owner}},'none');
8685: }
8686: if (ref($statushash) eq 'HASH') {
8687: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8688: }
1.290 albertel 8689: }
1.279 raeburn 8690: }
8691: }
8692: }
1.419 raeburn 8693: foreach my $user (keys(%seclists)) {
8694: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8695: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8696: }
1.275 raeburn 8697: }
8698: return;
8699: }
8700:
1.288 raeburn 8701: sub get_user_info {
8702: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8703: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8704: &plainname($uname,$udom,'lastname');
1.291 albertel 8705: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8706: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8707: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8708: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8709: return;
8710: }
1.275 raeburn 8711:
1.472 raeburn 8712: ###############################################
8713:
8714: =pod
8715:
8716: =item * &get_user_quota()
8717:
1.1075.2.41 raeburn 8718: Retrieves quota assigned for storage of user files.
8719: Default is to report quota for portfolio files.
1.472 raeburn 8720:
8721: Incoming parameters:
8722: 1. user's username
8723: 2. user's domain
1.1075.2.41 raeburn 8724: 3. quota name - portfolio, author, or course
8725: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 8726: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 8727: course
1.472 raeburn 8728:
8729: Returns:
1.1075.2.58 raeburn 8730: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8731: 2. (Optional) Type of setting: custom or default
8732: (individually assigned or default for user's
8733: institutional status).
8734: 3. (Optional) - User's institutional status (e.g., faculty, staff
8735: or student - types as defined in localenroll::inst_usertypes
8736: for user's domain, which determines default quota for user.
8737: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8738:
8739: If a value has been stored in the user's environment,
1.536 raeburn 8740: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 8741: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8742:
8743: =cut
8744:
8745: ###############################################
8746:
8747:
8748: sub get_user_quota {
1.1075.2.42 raeburn 8749: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8750: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8751: if (!defined($udom)) {
8752: $udom = $env{'user.domain'};
8753: }
8754: if (!defined($uname)) {
8755: $uname = $env{'user.name'};
8756: }
8757: if (($udom eq '' || $uname eq '') ||
8758: ($udom eq 'public') && ($uname eq 'public')) {
8759: $quota = 0;
1.536 raeburn 8760: $quotatype = 'default';
8761: $defquota = 0;
1.472 raeburn 8762: } else {
1.536 raeburn 8763: my $inststatus;
1.1075.2.41 raeburn 8764: if ($quotaname eq 'course') {
8765: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8766: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8767: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8768: } else {
8769: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8770: $quota = $cenv{'internal.uploadquota'};
8771: }
1.536 raeburn 8772: } else {
1.1075.2.41 raeburn 8773: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8774: if ($quotaname eq 'author') {
8775: $quota = $env{'environment.authorquota'};
8776: } else {
8777: $quota = $env{'environment.portfolioquota'};
8778: }
8779: $inststatus = $env{'environment.inststatus'};
8780: } else {
8781: my %userenv =
8782: &Apache::lonnet::get('environment',['portfolioquota',
8783: 'authorquota','inststatus'],$udom,$uname);
8784: my ($tmp) = keys(%userenv);
8785: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8786: if ($quotaname eq 'author') {
8787: $quota = $userenv{'authorquota'};
8788: } else {
8789: $quota = $userenv{'portfolioquota'};
8790: }
8791: $inststatus = $userenv{'inststatus'};
8792: } else {
8793: undef(%userenv);
8794: }
8795: }
8796: }
8797: if ($quota eq '' || wantarray) {
8798: if ($quotaname eq 'course') {
8799: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 8800: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8801: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 8802: $defquota = $domdefs{$crstype.'quota'};
8803: }
8804: if ($defquota eq '') {
8805: $defquota = 500;
8806: }
1.1075.2.41 raeburn 8807: } else {
8808: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8809: }
8810: if ($quota eq '') {
8811: $quota = $defquota;
8812: $quotatype = 'default';
8813: } else {
8814: $quotatype = 'custom';
8815: }
1.472 raeburn 8816: }
8817: }
1.536 raeburn 8818: if (wantarray) {
8819: return ($quota,$quotatype,$settingstatus,$defquota);
8820: } else {
8821: return $quota;
8822: }
1.472 raeburn 8823: }
8824:
8825: ###############################################
8826:
8827: =pod
8828:
8829: =item * &default_quota()
8830:
1.536 raeburn 8831: Retrieves default quota assigned for storage of user portfolio files,
8832: given an (optional) user's institutional status.
1.472 raeburn 8833:
8834: Incoming parameters:
1.1075.2.42 raeburn 8835:
1.472 raeburn 8836: 1. domain
1.536 raeburn 8837: 2. (Optional) institutional status(es). This is a : separated list of
8838: status types (e.g., faculty, staff, student etc.)
8839: which apply to the user for whom the default is being retrieved.
8840: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 8841: default quota will be returned.
8842: 3. quota name - portfolio, author, or course
8843: (if no quota name provided, defaults to portfolio).
1.472 raeburn 8844:
8845: Returns:
1.1075.2.42 raeburn 8846:
1.1075.2.58 raeburn 8847: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 8848: 2. (Optional) institutional type which determined the value of the
8849: default quota.
1.472 raeburn 8850:
8851: If a value has been stored in the domain's configuration db,
8852: it will return that, otherwise it returns 20 (for backwards
8853: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 8854: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 8855:
1.536 raeburn 8856: If the user's status includes multiple types (e.g., staff and student),
8857: the largest default quota which applies to the user determines the
8858: default quota returned.
8859:
1.472 raeburn 8860: =cut
8861:
8862: ###############################################
8863:
8864:
8865: sub default_quota {
1.1075.2.41 raeburn 8866: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 8867: my ($defquota,$settingstatus);
8868: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8869: ['quotas'],$udom);
1.1075.2.41 raeburn 8870: my $key = 'defaultquota';
8871: if ($quotaname eq 'author') {
8872: $key = 'authorquota';
8873: }
1.622 raeburn 8874: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8875: if ($inststatus ne '') {
1.765 raeburn 8876: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8877: foreach my $item (@statuses) {
1.1075.2.41 raeburn 8878: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8879: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 8880: if ($defquota eq '') {
1.1075.2.41 raeburn 8881: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8882: $settingstatus = $item;
1.1075.2.41 raeburn 8883: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
8884: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8885: $settingstatus = $item;
8886: }
8887: }
1.1075.2.41 raeburn 8888: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8889: if ($quotahash{'quotas'}{$item} ne '') {
8890: if ($defquota eq '') {
8891: $defquota = $quotahash{'quotas'}{$item};
8892: $settingstatus = $item;
8893: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8894: $defquota = $quotahash{'quotas'}{$item};
8895: $settingstatus = $item;
8896: }
1.536 raeburn 8897: }
8898: }
8899: }
8900: }
8901: if ($defquota eq '') {
1.1075.2.41 raeburn 8902: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8903: $defquota = $quotahash{'quotas'}{$key}{'default'};
8904: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8905: $defquota = $quotahash{'quotas'}{'default'};
8906: }
1.536 raeburn 8907: $settingstatus = 'default';
1.1075.2.42 raeburn 8908: if ($defquota eq '') {
8909: if ($quotaname eq 'author') {
8910: $defquota = 500;
8911: }
8912: }
1.536 raeburn 8913: }
8914: } else {
8915: $settingstatus = 'default';
1.1075.2.41 raeburn 8916: if ($quotaname eq 'author') {
8917: $defquota = 500;
8918: } else {
8919: $defquota = 20;
8920: }
1.536 raeburn 8921: }
8922: if (wantarray) {
8923: return ($defquota,$settingstatus);
1.472 raeburn 8924: } else {
1.536 raeburn 8925: return $defquota;
1.472 raeburn 8926: }
8927: }
8928:
1.1075.2.41 raeburn 8929: ###############################################
8930:
8931: =pod
8932:
1.1075.2.42 raeburn 8933: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 8934:
8935: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 8936: of existing file within authoring space will cause quota for the authoring
8937: space to be exceeded.
8938:
8939: Same, if upload of a file directly to a course/community via Course Editor
8940: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 8941:
1.1075.2.61 raeburn 8942: Inputs: 7
1.1075.2.42 raeburn 8943: 1. username or coursenum
1.1075.2.41 raeburn 8944: 2. domain
1.1075.2.42 raeburn 8945: 3. context ('author' or 'course')
1.1075.2.41 raeburn 8946: 4. filename of file for which action is being requested
8947: 5. filesize (kB) of file
8948: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 8949: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 8950:
8951: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
8952: otherwise return null.
8953:
1.1075.2.42 raeburn 8954: =back
8955:
1.1075.2.41 raeburn 8956: =cut
8957:
1.1075.2.42 raeburn 8958: sub excess_filesize_warning {
1.1075.2.59 raeburn 8959: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 8960: my $current_disk_usage = 0;
1.1075.2.59 raeburn 8961: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 8962: if ($context eq 'author') {
8963: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
8964: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
8965: } else {
8966: foreach my $subdir ('docs','supplemental') {
8967: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
8968: }
8969: }
1.1075.2.41 raeburn 8970: $disk_quota = int($disk_quota * 1000);
8971: if (($current_disk_usage + $filesize) > $disk_quota) {
8972: return '<p><span class="LC_warning">'.
8973: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
8974: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
8975: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
8976: $disk_quota,$current_disk_usage).
8977: '</p>';
8978: }
8979: return;
8980: }
8981:
8982: ###############################################
8983:
8984:
1.384 raeburn 8985: sub get_secgrprole_info {
8986: my ($cdom,$cnum,$needroles,$type) = @_;
8987: my %sections_count = &get_sections($cdom,$cnum);
8988: my @sections = (sort {$a <=> $b} keys(%sections_count));
8989: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
8990: my @groups = sort(keys(%curr_groups));
8991: my $allroles = [];
8992: my $rolehash;
8993: my $accesshash = {
8994: active => 'Currently has access',
8995: future => 'Will have future access',
8996: previous => 'Previously had access',
8997: };
8998: if ($needroles) {
8999: $rolehash = {'all' => 'all'};
1.385 albertel 9000: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9001: if (&Apache::lonnet::error(%user_roles)) {
9002: undef(%user_roles);
9003: }
9004: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9005: my ($role)=split(/\:/,$item,2);
9006: if ($role eq 'cr') { next; }
9007: if ($role =~ /^cr/) {
9008: $$rolehash{$role} = (split('/',$role))[3];
9009: } else {
9010: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9011: }
9012: }
9013: foreach my $key (sort(keys(%{$rolehash}))) {
9014: push(@{$allroles},$key);
9015: }
9016: push (@{$allroles},'st');
9017: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9018: }
9019: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9020: }
9021:
1.555 raeburn 9022: sub user_picker {
1.994 raeburn 9023: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9024: my $currdom = $dom;
9025: my %curr_selected = (
9026: srchin => 'dom',
1.580 raeburn 9027: srchby => 'lastname',
1.555 raeburn 9028: );
9029: my $srchterm;
1.625 raeburn 9030: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9031: if ($srch->{'srchby'} ne '') {
9032: $curr_selected{'srchby'} = $srch->{'srchby'};
9033: }
9034: if ($srch->{'srchin'} ne '') {
9035: $curr_selected{'srchin'} = $srch->{'srchin'};
9036: }
9037: if ($srch->{'srchtype'} ne '') {
9038: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9039: }
9040: if ($srch->{'srchdomain'} ne '') {
9041: $currdom = $srch->{'srchdomain'};
9042: }
9043: $srchterm = $srch->{'srchterm'};
9044: }
9045: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9046: 'usr' => 'Search criteria',
1.563 raeburn 9047: 'doma' => 'Domain/institution to search',
1.558 albertel 9048: 'uname' => 'username',
9049: 'lastname' => 'last name',
1.555 raeburn 9050: 'lastfirst' => 'last name, first name',
1.558 albertel 9051: 'crs' => 'in this course',
1.576 raeburn 9052: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9053: 'alc' => 'all LON-CAPA',
1.573 raeburn 9054: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9055: 'exact' => 'is',
9056: 'contains' => 'contains',
1.569 raeburn 9057: 'begins' => 'begins with',
1.571 raeburn 9058: 'youm' => "You must include some text to search for.",
9059: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9060: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9061: 'yomc' => "You must choose a domain when using an institutional directory search.",
9062: 'ymcd' => "You must choose a domain when using a domain search.",
9063: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9064: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9065: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9066: );
1.563 raeburn 9067: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9068: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9069:
9070: my @srchins = ('crs','dom','alc','instd');
9071:
9072: foreach my $option (@srchins) {
9073: # FIXME 'alc' option unavailable until
9074: # loncreateuser::print_user_query_page()
9075: # has been completed.
9076: next if ($option eq 'alc');
1.880 raeburn 9077: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9078: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9079: if ($curr_selected{'srchin'} eq $option) {
9080: $srchinsel .= '
9081: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9082: } else {
9083: $srchinsel .= '
9084: <option value="'.$option.'">'.$lt{$option}.'</option>';
9085: }
1.555 raeburn 9086: }
1.563 raeburn 9087: $srchinsel .= "\n </select>\n";
1.555 raeburn 9088:
9089: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9090: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9091: if ($curr_selected{'srchby'} eq $option) {
9092: $srchbysel .= '
9093: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9094: } else {
9095: $srchbysel .= '
9096: <option value="'.$option.'">'.$lt{$option}.'</option>';
9097: }
9098: }
9099: $srchbysel .= "\n </select>\n";
9100:
9101: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9102: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9103: if ($curr_selected{'srchtype'} eq $option) {
9104: $srchtypesel .= '
9105: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9106: } else {
9107: $srchtypesel .= '
9108: <option value="'.$option.'">'.$lt{$option}.'</option>';
9109: }
9110: }
9111: $srchtypesel .= "\n </select>\n";
9112:
1.558 albertel 9113: my ($newuserscript,$new_user_create);
1.994 raeburn 9114: my $context_dom = $env{'request.role.domain'};
9115: if ($context eq 'requestcrs') {
9116: if ($env{'form.coursedom'} ne '') {
9117: $context_dom = $env{'form.coursedom'};
9118: }
9119: }
1.556 raeburn 9120: if ($forcenewuser) {
1.576 raeburn 9121: if (ref($srch) eq 'HASH') {
1.994 raeburn 9122: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9123: if ($cancreate) {
9124: $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>';
9125: } else {
1.799 bisitz 9126: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9127: my %usertypetext = (
9128: official => 'institutional',
9129: unofficial => 'non-institutional',
9130: );
1.799 bisitz 9131: $new_user_create = '<p class="LC_warning">'
9132: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9133: .' '
9134: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9135: ,'<a href="'.$helplink.'">','</a>')
9136: .'</p><br />';
1.627 raeburn 9137: }
1.576 raeburn 9138: }
9139: }
9140:
1.556 raeburn 9141: $newuserscript = <<"ENDSCRIPT";
9142:
1.570 raeburn 9143: function setSearch(createnew,callingForm) {
1.556 raeburn 9144: if (createnew == 1) {
1.570 raeburn 9145: for (var i=0; i<callingForm.srchby.length; i++) {
9146: if (callingForm.srchby.options[i].value == 'uname') {
9147: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9148: }
9149: }
1.570 raeburn 9150: for (var i=0; i<callingForm.srchin.length; i++) {
9151: if ( callingForm.srchin.options[i].value == 'dom') {
9152: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9153: }
9154: }
1.570 raeburn 9155: for (var i=0; i<callingForm.srchtype.length; i++) {
9156: if (callingForm.srchtype.options[i].value == 'exact') {
9157: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9158: }
9159: }
1.570 raeburn 9160: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9161: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9162: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9163: }
9164: }
9165: }
9166: }
9167: ENDSCRIPT
1.558 albertel 9168:
1.556 raeburn 9169: }
9170:
1.555 raeburn 9171: my $output = <<"END_BLOCK";
1.556 raeburn 9172: <script type="text/javascript">
1.824 bisitz 9173: // <![CDATA[
1.570 raeburn 9174: function validateEntry(callingForm) {
1.558 albertel 9175:
1.556 raeburn 9176: var checkok = 1;
1.558 albertel 9177: var srchin;
1.570 raeburn 9178: for (var i=0; i<callingForm.srchin.length; i++) {
9179: if ( callingForm.srchin[i].checked ) {
9180: srchin = callingForm.srchin[i].value;
1.558 albertel 9181: }
9182: }
9183:
1.570 raeburn 9184: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9185: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9186: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9187: var srchterm = callingForm.srchterm.value;
9188: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9189: var msg = "";
9190:
9191: if (srchterm == "") {
9192: checkok = 0;
1.571 raeburn 9193: msg += "$lt{'youm'}\\n";
1.556 raeburn 9194: }
9195:
1.569 raeburn 9196: if (srchtype== 'begins') {
9197: if (srchterm.length < 2) {
9198: checkok = 0;
1.571 raeburn 9199: msg += "$lt{'thte'}\\n";
1.569 raeburn 9200: }
9201: }
9202:
1.556 raeburn 9203: if (srchtype== 'contains') {
9204: if (srchterm.length < 3) {
9205: checkok = 0;
1.571 raeburn 9206: msg += "$lt{'thet'}\\n";
1.556 raeburn 9207: }
9208: }
9209: if (srchin == 'instd') {
9210: if (srchdomain == '') {
9211: checkok = 0;
1.571 raeburn 9212: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9213: }
9214: }
9215: if (srchin == 'dom') {
9216: if (srchdomain == '') {
9217: checkok = 0;
1.571 raeburn 9218: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9219: }
9220: }
9221: if (srchby == 'lastfirst') {
9222: if (srchterm.indexOf(",") == -1) {
9223: checkok = 0;
1.571 raeburn 9224: msg += "$lt{'whus'}\\n";
1.556 raeburn 9225: }
9226: if (srchterm.indexOf(",") == srchterm.length -1) {
9227: checkok = 0;
1.571 raeburn 9228: msg += "$lt{'whse'}\\n";
1.556 raeburn 9229: }
9230: }
9231: if (checkok == 0) {
1.571 raeburn 9232: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9233: return;
9234: }
9235: if (checkok == 1) {
1.570 raeburn 9236: callingForm.submit();
1.556 raeburn 9237: }
9238: }
9239:
9240: $newuserscript
9241:
1.824 bisitz 9242: // ]]>
1.556 raeburn 9243: </script>
1.558 albertel 9244:
9245: $new_user_create
9246:
1.555 raeburn 9247: END_BLOCK
1.558 albertel 9248:
1.876 raeburn 9249: $output .= &Apache::lonhtmlcommon::start_pick_box().
9250: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9251: $domform.
9252: &Apache::lonhtmlcommon::row_closure().
9253: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9254: $srchbysel.
9255: $srchtypesel.
9256: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9257: $srchinsel.
9258: &Apache::lonhtmlcommon::row_closure(1).
9259: &Apache::lonhtmlcommon::end_pick_box().
9260: '<br />';
1.555 raeburn 9261: return $output;
9262: }
9263:
1.612 raeburn 9264: sub user_rule_check {
1.615 raeburn 9265: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9266: my $response;
9267: if (ref($usershash) eq 'HASH') {
9268: foreach my $user (keys(%{$usershash})) {
9269: my ($uname,$udom) = split(/:/,$user);
9270: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9271: my ($id,$newuser);
1.612 raeburn 9272: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9273: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9274: $id = $usershash->{$user}->{'id'};
9275: }
9276: my $inst_response;
9277: if (ref($checks) eq 'HASH') {
9278: if (defined($checks->{'username'})) {
1.615 raeburn 9279: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9280: &Apache::lonnet::get_instuser($udom,$uname);
9281: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9282: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9283: &Apache::lonnet::get_instuser($udom,undef,$id);
9284: }
1.615 raeburn 9285: } else {
9286: ($inst_response,%{$inst_results->{$user}}) =
9287: &Apache::lonnet::get_instuser($udom,$uname);
9288: return;
1.612 raeburn 9289: }
1.615 raeburn 9290: if (!$got_rules->{$udom}) {
1.612 raeburn 9291: my %domconfig = &Apache::lonnet::get_dom('configuration',
9292: ['usercreation'],$udom);
9293: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9294: foreach my $item ('username','id') {
1.612 raeburn 9295: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9296: $$curr_rules{$udom}{$item} =
9297: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9298: }
9299: }
9300: }
1.615 raeburn 9301: $got_rules->{$udom} = 1;
1.585 raeburn 9302: }
1.612 raeburn 9303: foreach my $item (keys(%{$checks})) {
9304: if (ref($$curr_rules{$udom}) eq 'HASH') {
9305: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9306: if (@{$$curr_rules{$udom}{$item}} > 0) {
9307: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9308: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9309: if ($rule_check{$rule}) {
9310: $$rulematch{$user}{$item} = $rule;
9311: if ($inst_response eq 'ok') {
1.615 raeburn 9312: if (ref($inst_results) eq 'HASH') {
9313: if (ref($inst_results->{$user}) eq 'HASH') {
9314: if (keys(%{$inst_results->{$user}}) == 0) {
9315: $$alerts{$item}{$udom}{$uname} = 1;
9316: }
1.612 raeburn 9317: }
9318: }
1.615 raeburn 9319: }
9320: last;
1.585 raeburn 9321: }
9322: }
9323: }
9324: }
9325: }
9326: }
9327: }
9328: }
1.612 raeburn 9329: return;
9330: }
9331:
9332: sub user_rule_formats {
9333: my ($domain,$domdesc,$curr_rules,$check) = @_;
9334: my %text = (
9335: 'username' => 'Usernames',
9336: 'id' => 'IDs',
9337: );
9338: my $output;
9339: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9340: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9341: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9342: $output = '<br />'.
9343: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9344: '<span class="LC_cusr_emph">','</span>',$domdesc).
9345: ' <ul>';
1.612 raeburn 9346: foreach my $rule (@{$ruleorder}) {
9347: if (ref($curr_rules) eq 'ARRAY') {
9348: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9349: if (ref($rules->{$rule}) eq 'HASH') {
9350: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9351: $rules->{$rule}{'desc'}.'</li>';
9352: }
9353: }
9354: }
9355: }
9356: $output .= '</ul>';
9357: }
9358: }
9359: return $output;
9360: }
9361:
9362: sub instrule_disallow_msg {
1.615 raeburn 9363: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9364: my $response;
9365: my %text = (
9366: item => 'username',
9367: items => 'usernames',
9368: match => 'matches',
9369: do => 'does',
9370: action => 'a username',
9371: one => 'one',
9372: );
9373: if ($count > 1) {
9374: $text{'item'} = 'usernames';
9375: $text{'match'} ='match';
9376: $text{'do'} = 'do';
9377: $text{'action'} = 'usernames',
9378: $text{'one'} = 'ones';
9379: }
9380: if ($checkitem eq 'id') {
9381: $text{'items'} = 'IDs';
9382: $text{'item'} = 'ID';
9383: $text{'action'} = 'an ID';
1.615 raeburn 9384: if ($count > 1) {
9385: $text{'item'} = 'IDs';
9386: $text{'action'} = 'IDs';
9387: }
1.612 raeburn 9388: }
1.674 bisitz 9389: $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 9390: if ($mode eq 'upload') {
9391: if ($checkitem eq 'username') {
9392: $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'}.");
9393: } elsif ($checkitem eq 'id') {
1.674 bisitz 9394: $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 9395: }
1.669 raeburn 9396: } elsif ($mode eq 'selfcreate') {
9397: if ($checkitem eq 'id') {
9398: $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.");
9399: }
1.615 raeburn 9400: } else {
9401: if ($checkitem eq 'username') {
9402: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9403: } elsif ($checkitem eq 'id') {
9404: $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.");
9405: }
1.612 raeburn 9406: }
9407: return $response;
1.585 raeburn 9408: }
9409:
1.624 raeburn 9410: sub personal_data_fieldtitles {
9411: my %fieldtitles = &Apache::lonlocal::texthash (
9412: id => 'Student/Employee ID',
9413: permanentemail => 'E-mail address',
9414: lastname => 'Last Name',
9415: firstname => 'First Name',
9416: middlename => 'Middle Name',
9417: generation => 'Generation',
9418: gen => 'Generation',
1.765 raeburn 9419: inststatus => 'Affiliation',
1.624 raeburn 9420: );
9421: return %fieldtitles;
9422: }
9423:
1.642 raeburn 9424: sub sorted_inst_types {
9425: my ($dom) = @_;
9426: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9427: my $othertitle = &mt('All users');
9428: if ($env{'request.course.id'}) {
1.668 raeburn 9429: $othertitle = &mt('Any users');
1.642 raeburn 9430: }
9431: my @types;
9432: if (ref($order) eq 'ARRAY') {
9433: @types = @{$order};
9434: }
9435: if (@types == 0) {
9436: if (ref($usertypes) eq 'HASH') {
9437: @types = sort(keys(%{$usertypes}));
9438: }
9439: }
9440: if (keys(%{$usertypes}) > 0) {
9441: $othertitle = &mt('Other users');
9442: }
9443: return ($othertitle,$usertypes,\@types);
9444: }
9445:
1.645 raeburn 9446: sub get_institutional_codes {
9447: my ($settings,$allcourses,$LC_code) = @_;
9448: # Get complete list of course sections to update
9449: my @currsections = ();
9450: my @currxlists = ();
9451: my $coursecode = $$settings{'internal.coursecode'};
9452:
9453: if ($$settings{'internal.sectionnums'} ne '') {
9454: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9455: }
9456:
9457: if ($$settings{'internal.crosslistings'} ne '') {
9458: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9459: }
9460:
9461: if (@currxlists > 0) {
9462: foreach (@currxlists) {
9463: if (m/^([^:]+):(\w*)$/) {
9464: unless (grep/^$1$/,@{$allcourses}) {
9465: push @{$allcourses},$1;
9466: $$LC_code{$1} = $2;
9467: }
9468: }
9469: }
9470: }
9471:
9472: if (@currsections > 0) {
9473: foreach (@currsections) {
9474: if (m/^(\w+):(\w*)$/) {
9475: my $sec = $coursecode.$1;
9476: my $lc_sec = $2;
9477: unless (grep/^$sec$/,@{$allcourses}) {
9478: push @{$allcourses},$sec;
9479: $$LC_code{$sec} = $lc_sec;
9480: }
9481: }
9482: }
9483: }
9484: return;
9485: }
9486:
1.971 raeburn 9487: sub get_standard_codeitems {
9488: return ('Year','Semester','Department','Number','Section');
9489: }
9490:
1.112 bowersj2 9491: =pod
9492:
1.780 raeburn 9493: =head1 Slot Helpers
9494:
9495: =over 4
9496:
9497: =item * sorted_slots()
9498:
1.1040 raeburn 9499: Sorts an array of slot names in order of an optional sort key,
9500: default sort is by slot start time (earliest first).
1.780 raeburn 9501:
9502: Inputs:
9503:
9504: =over 4
9505:
9506: slotsarr - Reference to array of unsorted slot names.
9507:
9508: slots - Reference to hash of hash, where outer hash keys are slot names.
9509:
1.1040 raeburn 9510: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9511:
1.549 albertel 9512: =back
9513:
1.780 raeburn 9514: Returns:
9515:
9516: =over 4
9517:
1.1040 raeburn 9518: sorted - An array of slot names sorted by a specified sort key
9519: (default sort key is start time of the slot).
1.780 raeburn 9520:
9521: =back
9522:
9523: =cut
9524:
9525:
9526: sub sorted_slots {
1.1040 raeburn 9527: my ($slotsarr,$slots,$sortkey) = @_;
9528: if ($sortkey eq '') {
9529: $sortkey = 'starttime';
9530: }
1.780 raeburn 9531: my @sorted;
9532: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9533: @sorted =
9534: sort {
9535: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9536: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9537: }
9538: if (ref($slots->{$a})) { return -1;}
9539: if (ref($slots->{$b})) { return 1;}
9540: return 0;
9541: } @{$slotsarr};
9542: }
9543: return @sorted;
9544: }
9545:
1.1040 raeburn 9546: =pod
9547:
9548: =item * get_future_slots()
9549:
9550: Inputs:
9551:
9552: =over 4
9553:
9554: cnum - course number
9555:
9556: cdom - course domain
9557:
9558: now - current UNIX time
9559:
9560: symb - optional symb
9561:
9562: =back
9563:
9564: Returns:
9565:
9566: =over 4
9567:
9568: sorted_reservable - ref to array of student_schedulable slots currently
9569: reservable, ordered by end date of reservation period.
9570:
9571: reservable_now - ref to hash of student_schedulable slots currently
9572: reservable.
9573:
9574: Keys in inner hash are:
9575: (a) symb: either blank or symb to which slot use is restricted.
9576: (b) endreserve: end date of reservation period.
9577:
9578: sorted_future - ref to array of student_schedulable slots reservable in
9579: the future, ordered by start date of reservation period.
9580:
9581: future_reservable - ref to hash of student_schedulable slots reservable
9582: in the future.
9583:
9584: Keys in inner hash are:
9585: (a) symb: either blank or symb to which slot use is restricted.
9586: (b) startreserve: start date of reservation period.
9587:
9588: =back
9589:
9590: =cut
9591:
9592: sub get_future_slots {
9593: my ($cnum,$cdom,$now,$symb) = @_;
9594: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9595: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9596: foreach my $slot (keys(%slots)) {
9597: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9598: if ($symb) {
9599: next if (($slots{$slot}->{'symb'} ne '') &&
9600: ($slots{$slot}->{'symb'} ne $symb));
9601: }
9602: if (($slots{$slot}->{'starttime'} > $now) &&
9603: ($slots{$slot}->{'endtime'} > $now)) {
9604: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9605: my $userallowed = 0;
9606: if ($slots{$slot}->{'allowedsections'}) {
9607: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9608: if (!defined($env{'request.role.sec'})
9609: && grep(/^No section assigned$/,@allowed_sec)) {
9610: $userallowed=1;
9611: } else {
9612: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9613: $userallowed=1;
9614: }
9615: }
9616: unless ($userallowed) {
9617: if (defined($env{'request.course.groups'})) {
9618: my @groups = split(/:/,$env{'request.course.groups'});
9619: foreach my $group (@groups) {
9620: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9621: $userallowed=1;
9622: last;
9623: }
9624: }
9625: }
9626: }
9627: }
9628: if ($slots{$slot}->{'allowedusers'}) {
9629: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9630: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9631: if (grep(/^\Q$user\E$/,@allowed_users)) {
9632: $userallowed = 1;
9633: }
9634: }
9635: next unless($userallowed);
9636: }
9637: my $startreserve = $slots{$slot}->{'startreserve'};
9638: my $endreserve = $slots{$slot}->{'endreserve'};
9639: my $symb = $slots{$slot}->{'symb'};
9640: if (($startreserve < $now) &&
9641: (!$endreserve || $endreserve > $now)) {
9642: my $lastres = $endreserve;
9643: if (!$lastres) {
9644: $lastres = $slots{$slot}->{'starttime'};
9645: }
9646: $reservable_now{$slot} = {
9647: symb => $symb,
9648: endreserve => $lastres
9649: };
9650: } elsif (($startreserve > $now) &&
9651: (!$endreserve || $endreserve > $startreserve)) {
9652: $future_reservable{$slot} = {
9653: symb => $symb,
9654: startreserve => $startreserve
9655: };
9656: }
9657: }
9658: }
9659: my @unsorted_reservable = keys(%reservable_now);
9660: if (@unsorted_reservable > 0) {
9661: @sorted_reservable =
9662: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9663: }
9664: my @unsorted_future = keys(%future_reservable);
9665: if (@unsorted_future > 0) {
9666: @sorted_future =
9667: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9668: }
9669: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9670: }
1.780 raeburn 9671:
9672: =pod
9673:
1.1057 foxr 9674: =back
9675:
1.549 albertel 9676: =head1 HTTP Helpers
9677:
9678: =over 4
9679:
1.648 raeburn 9680: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9681:
1.258 albertel 9682: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9683: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9684: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9685:
9686: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9687: $possible_names is an ref to an array of form element names. As an example:
9688: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9689: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9690:
9691: =cut
1.1 albertel 9692:
1.6 albertel 9693: sub get_unprocessed_cgi {
1.25 albertel 9694: my ($query,$possible_names)= @_;
1.26 matthew 9695: # $Apache::lonxml::debug=1;
1.356 albertel 9696: foreach my $pair (split(/&/,$query)) {
9697: my ($name, $value) = split(/=/,$pair);
1.369 www 9698: $name = &unescape($name);
1.25 albertel 9699: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9700: $value =~ tr/+/ /;
9701: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9702: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9703: }
1.16 harris41 9704: }
1.6 albertel 9705: }
9706:
1.112 bowersj2 9707: =pod
9708:
1.648 raeburn 9709: =item * &cacheheader()
1.112 bowersj2 9710:
9711: returns cache-controlling header code
9712:
9713: =cut
9714:
1.7 albertel 9715: sub cacheheader {
1.258 albertel 9716: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9717: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9718: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9719: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9720: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9721: return $output;
1.7 albertel 9722: }
9723:
1.112 bowersj2 9724: =pod
9725:
1.648 raeburn 9726: =item * &no_cache($r)
1.112 bowersj2 9727:
9728: specifies header code to not have cache
9729:
9730: =cut
9731:
1.9 albertel 9732: sub no_cache {
1.216 albertel 9733: my ($r) = @_;
9734: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9735: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9736: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9737: $r->no_cache(1);
9738: $r->header_out("Expires" => $date);
9739: $r->header_out("Pragma" => "no-cache");
1.123 www 9740: }
9741:
9742: sub content_type {
1.181 albertel 9743: my ($r,$type,$charset) = @_;
1.299 foxr 9744: if ($r) {
9745: # Note that printout.pl calls this with undef for $r.
9746: &no_cache($r);
9747: }
1.258 albertel 9748: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9749: unless ($charset) {
9750: $charset=&Apache::lonlocal::current_encoding;
9751: }
9752: if ($charset) { $type.='; charset='.$charset; }
9753: if ($r) {
9754: $r->content_type($type);
9755: } else {
9756: print("Content-type: $type\n\n");
9757: }
1.9 albertel 9758: }
1.25 albertel 9759:
1.112 bowersj2 9760: =pod
9761:
1.648 raeburn 9762: =item * &add_to_env($name,$value)
1.112 bowersj2 9763:
1.258 albertel 9764: adds $name to the %env hash with value
1.112 bowersj2 9765: $value, if $name already exists, the entry is converted to an array
9766: reference and $value is added to the array.
9767:
9768: =cut
9769:
1.25 albertel 9770: sub add_to_env {
9771: my ($name,$value)=@_;
1.258 albertel 9772: if (defined($env{$name})) {
9773: if (ref($env{$name})) {
1.25 albertel 9774: #already have multiple values
1.258 albertel 9775: push(@{ $env{$name} },$value);
1.25 albertel 9776: } else {
9777: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9778: my $first=$env{$name};
9779: undef($env{$name});
9780: push(@{ $env{$name} },$first,$value);
1.25 albertel 9781: }
9782: } else {
1.258 albertel 9783: $env{$name}=$value;
1.25 albertel 9784: }
1.31 albertel 9785: }
1.149 albertel 9786:
9787: =pod
9788:
1.648 raeburn 9789: =item * &get_env_multiple($name)
1.149 albertel 9790:
1.258 albertel 9791: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9792: values may be defined and end up as an array ref.
9793:
9794: returns an array of values
9795:
9796: =cut
9797:
9798: sub get_env_multiple {
9799: my ($name) = @_;
9800: my @values;
1.258 albertel 9801: if (defined($env{$name})) {
1.149 albertel 9802: # exists is it an array
1.258 albertel 9803: if (ref($env{$name})) {
9804: @values=@{ $env{$name} };
1.149 albertel 9805: } else {
1.258 albertel 9806: $values[0]=$env{$name};
1.149 albertel 9807: }
9808: }
9809: return(@values);
9810: }
9811:
1.660 raeburn 9812: sub ask_for_embedded_content {
9813: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9814: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 9815: %currsubfile,%unused,$rem);
1.1071 raeburn 9816: my $counter = 0;
9817: my $numnew = 0;
1.987 raeburn 9818: my $numremref = 0;
9819: my $numinvalid = 0;
9820: my $numpathchg = 0;
9821: my $numexisting = 0;
1.1071 raeburn 9822: my $numunused = 0;
9823: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 9824: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9825: my $heading = &mt('Upload embedded files');
9826: my $buttontext = &mt('Upload');
9827:
1.1075.2.11 raeburn 9828: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 9829: if ($actionurl eq '/adm/dependencies') {
9830: $navmap = Apache::lonnavmaps::navmap->new();
9831: }
9832: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9833: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 9834: }
1.1075.2.35 raeburn 9835: if (($actionurl eq '/adm/portfolio') ||
9836: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 9837: my $current_path='/';
9838: if ($env{'form.currentpath'}) {
9839: $current_path = $env{'form.currentpath'};
9840: }
9841: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 9842: $udom = $cdom;
9843: $uname = $cnum;
1.984 raeburn 9844: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9845: } else {
9846: $udom = $env{'user.domain'};
9847: $uname = $env{'user.name'};
9848: $url = '/userfiles/portfolio';
9849: }
1.987 raeburn 9850: $toplevel = $url.'/';
1.984 raeburn 9851: $url .= $current_path;
9852: $getpropath = 1;
1.987 raeburn 9853: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9854: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9855: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9856: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9857: $toplevel = $url;
1.984 raeburn 9858: if ($rest ne '') {
1.987 raeburn 9859: $url .= $rest;
9860: }
9861: } elsif ($actionurl eq '/adm/coursedocs') {
9862: if (ref($args) eq 'HASH') {
1.1071 raeburn 9863: $url = $args->{'docs_url'};
9864: $toplevel = $url;
1.1075.2.11 raeburn 9865: if ($args->{'context'} eq 'paste') {
9866: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9867: ($path) =
9868: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9869: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9870: $fileloc =~ s{^/}{};
9871: }
1.1071 raeburn 9872: }
9873: } elsif ($actionurl eq '/adm/dependencies') {
9874: if ($env{'request.course.id'} ne '') {
9875: if (ref($args) eq 'HASH') {
9876: $url = $args->{'docs_url'};
9877: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 9878: $toplevel = $url;
9879: unless ($toplevel =~ m{^/}) {
9880: $toplevel = "/$url";
9881: }
1.1075.2.11 raeburn 9882: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 9883: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
9884: $path = $1;
9885: } else {
9886: ($path) =
9887: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9888: }
1.1071 raeburn 9889: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9890: $fileloc =~ s{^/}{};
9891: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9892: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9893: }
1.987 raeburn 9894: }
1.1075.2.35 raeburn 9895: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9896: $udom = $cdom;
9897: $uname = $cnum;
9898: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
9899: $toplevel = $url;
9900: $path = $url;
9901: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
9902: $fileloc =~ s{^/}{};
9903: }
9904: foreach my $file (keys(%{$allfiles})) {
9905: my $embed_file;
9906: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
9907: $embed_file = $1;
9908: } else {
9909: $embed_file = $file;
9910: }
1.1075.2.55 raeburn 9911: my ($absolutepath,$cleaned_file);
9912: if ($embed_file =~ m{^\w+://}) {
9913: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 9914: $newfiles{$cleaned_file} = 1;
9915: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 9916: } else {
1.1075.2.55 raeburn 9917: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 9918: if ($embed_file =~ m{^/}) {
9919: $absolutepath = $embed_file;
9920: }
1.1075.2.47 raeburn 9921: if ($cleaned_file =~ m{/}) {
9922: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 9923: $path = &check_for_traversal($path,$url,$toplevel);
9924: my $item = $fname;
9925: if ($path ne '') {
9926: $item = $path.'/'.$fname;
9927: $subdependencies{$path}{$fname} = 1;
9928: } else {
9929: $dependencies{$item} = 1;
9930: }
9931: if ($absolutepath) {
9932: $mapping{$item} = $absolutepath;
9933: } else {
9934: $mapping{$item} = $embed_file;
9935: }
9936: } else {
9937: $dependencies{$embed_file} = 1;
9938: if ($absolutepath) {
1.1075.2.47 raeburn 9939: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 9940: } else {
1.1075.2.47 raeburn 9941: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 9942: }
9943: }
1.984 raeburn 9944: }
9945: }
1.1071 raeburn 9946: my $dirptr = 16384;
1.984 raeburn 9947: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 9948: $currsubfile{$path} = {};
1.1075.2.35 raeburn 9949: if (($actionurl eq '/adm/portfolio') ||
9950: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9951: my ($sublistref,$listerror) =
9952: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
9953: if (ref($sublistref) eq 'ARRAY') {
9954: foreach my $line (@{$sublistref}) {
9955: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 9956: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 9957: }
1.984 raeburn 9958: }
1.987 raeburn 9959: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9960: if (opendir(my $dir,$url.'/'.$path)) {
9961: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 9962: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
9963: }
1.1075.2.11 raeburn 9964: } elsif (($actionurl eq '/adm/dependencies') ||
9965: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 9966: ($args->{'context'} eq 'paste')) ||
9967: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 9968: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 9969: my $dir;
9970: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9971: $dir = $fileloc;
9972: } else {
9973: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9974: }
1.1071 raeburn 9975: if ($dir ne '') {
9976: my ($sublistref,$listerror) =
9977: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
9978: if (ref($sublistref) eq 'ARRAY') {
9979: foreach my $line (@{$sublistref}) {
9980: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
9981: undef,$mtime)=split(/\&/,$line,12);
9982: unless (($testdir&$dirptr) ||
9983: ($file_name =~ /^\.\.?$/)) {
9984: $currsubfile{$path}{$file_name} = [$size,$mtime];
9985: }
9986: }
9987: }
9988: }
1.984 raeburn 9989: }
9990: }
9991: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 9992: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 9993: my $item = $path.'/'.$file;
9994: unless ($mapping{$item} eq $item) {
9995: $pathchanges{$item} = 1;
9996: }
9997: $existing{$item} = 1;
9998: $numexisting ++;
9999: } else {
10000: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10001: }
10002: }
1.1071 raeburn 10003: if ($actionurl eq '/adm/dependencies') {
10004: foreach my $path (keys(%currsubfile)) {
10005: if (ref($currsubfile{$path}) eq 'HASH') {
10006: foreach my $file (keys(%{$currsubfile{$path}})) {
10007: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10008: next if (($rem ne '') &&
10009: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10010: (ref($navmap) &&
10011: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10012: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10013: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10014: $unused{$path.'/'.$file} = 1;
10015: }
10016: }
10017: }
10018: }
10019: }
1.984 raeburn 10020: }
1.987 raeburn 10021: my %currfile;
1.1075.2.35 raeburn 10022: if (($actionurl eq '/adm/portfolio') ||
10023: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10024: my ($dirlistref,$listerror) =
10025: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10026: if (ref($dirlistref) eq 'ARRAY') {
10027: foreach my $line (@{$dirlistref}) {
10028: my ($file_name,$rest) = split(/\&/,$line,2);
10029: $currfile{$file_name} = 1;
10030: }
1.984 raeburn 10031: }
1.987 raeburn 10032: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10033: if (opendir(my $dir,$url)) {
1.987 raeburn 10034: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10035: map {$currfile{$_} = 1;} @dir_list;
10036: }
1.1075.2.11 raeburn 10037: } elsif (($actionurl eq '/adm/dependencies') ||
10038: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10039: ($args->{'context'} eq 'paste')) ||
10040: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10041: if ($env{'request.course.id'} ne '') {
10042: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10043: if ($dir ne '') {
10044: my ($dirlistref,$listerror) =
10045: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10046: if (ref($dirlistref) eq 'ARRAY') {
10047: foreach my $line (@{$dirlistref}) {
10048: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10049: $size,undef,$mtime)=split(/\&/,$line,12);
10050: unless (($testdir&$dirptr) ||
10051: ($file_name =~ /^\.\.?$/)) {
10052: $currfile{$file_name} = [$size,$mtime];
10053: }
10054: }
10055: }
10056: }
10057: }
1.984 raeburn 10058: }
10059: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10060: if (exists($currfile{$file})) {
1.987 raeburn 10061: unless ($mapping{$file} eq $file) {
10062: $pathchanges{$file} = 1;
10063: }
10064: $existing{$file} = 1;
10065: $numexisting ++;
10066: } else {
1.984 raeburn 10067: $newfiles{$file} = 1;
10068: }
10069: }
1.1071 raeburn 10070: foreach my $file (keys(%currfile)) {
10071: unless (($file eq $filename) ||
10072: ($file eq $filename.'.bak') ||
10073: ($dependencies{$file})) {
1.1075.2.11 raeburn 10074: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10075: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10076: next if (($rem ne '') &&
10077: (($env{"httpref.$rem".$file} ne '') ||
10078: (ref($navmap) &&
10079: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10080: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10081: ($navmap->getResourceByUrl($rem.$1)))))));
10082: }
1.1075.2.11 raeburn 10083: }
1.1071 raeburn 10084: $unused{$file} = 1;
10085: }
10086: }
1.1075.2.11 raeburn 10087: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10088: ($args->{'context'} eq 'paste')) {
10089: $counter = scalar(keys(%existing));
10090: $numpathchg = scalar(keys(%pathchanges));
10091: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10092: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10093: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10094: $counter = scalar(keys(%existing));
10095: $numpathchg = scalar(keys(%pathchanges));
10096: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10097: }
1.984 raeburn 10098: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10099: if ($actionurl eq '/adm/dependencies') {
10100: next if ($embed_file =~ m{^\w+://});
10101: }
1.660 raeburn 10102: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10103: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10104: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10105: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10106: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10107: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10108: }
1.1075.2.35 raeburn 10109: $upload_output .= '</td>';
1.1071 raeburn 10110: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10111: $upload_output.='<td align="right">'.
10112: '<span class="LC_info LC_fontsize_medium">'.
10113: &mt("URL points to web address").'</span>';
1.987 raeburn 10114: $numremref++;
1.660 raeburn 10115: } elsif ($args->{'error_on_invalid_names'}
10116: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10117: $upload_output.='<td align="right"><span class="LC_warning">'.
10118: &mt('Invalid characters').'</span>';
1.987 raeburn 10119: $numinvalid++;
1.660 raeburn 10120: } else {
1.1075.2.35 raeburn 10121: $upload_output .= '<td>'.
10122: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10123: $embed_file,\%mapping,
1.1071 raeburn 10124: $allfiles,$codebase,'upload');
10125: $counter ++;
10126: $numnew ++;
1.987 raeburn 10127: }
10128: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10129: }
10130: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10131: if ($actionurl eq '/adm/dependencies') {
10132: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10133: $modify_output .= &start_data_table_row().
10134: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10135: '<img src="'.&icon($embed_file).'" border="0" />'.
10136: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10137: '<td>'.$size.'</td>'.
10138: '<td>'.$mtime.'</td>'.
10139: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10140: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10141: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10142: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10143: &embedded_file_element('upload_embedded',$counter,
10144: $embed_file,\%mapping,
10145: $allfiles,$codebase,'modify').
10146: '</div></td>'.
10147: &end_data_table_row()."\n";
10148: $counter ++;
10149: } else {
10150: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10151: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10152: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10153: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10154: &Apache::loncommon::end_data_table_row()."\n";
10155: }
10156: }
10157: my $delidx = $counter;
10158: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10159: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10160: $delete_output .= &start_data_table_row().
10161: '<td><img src="'.&icon($oldfile).'" />'.
10162: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10163: '<td>'.$size.'</td>'.
10164: '<td>'.$mtime.'</td>'.
10165: '<td><label><input type="checkbox" name="del_upload_dep" '.
10166: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10167: &embedded_file_element('upload_embedded',$delidx,
10168: $oldfile,\%mapping,$allfiles,
10169: $codebase,'delete').'</td>'.
10170: &end_data_table_row()."\n";
10171: $numunused ++;
10172: $delidx ++;
1.987 raeburn 10173: }
10174: if ($upload_output) {
10175: $upload_output = &start_data_table().
10176: $upload_output.
10177: &end_data_table()."\n";
10178: }
1.1071 raeburn 10179: if ($modify_output) {
10180: $modify_output = &start_data_table().
10181: &start_data_table_header_row().
10182: '<th>'.&mt('File').'</th>'.
10183: '<th>'.&mt('Size (KB)').'</th>'.
10184: '<th>'.&mt('Modified').'</th>'.
10185: '<th>'.&mt('Upload replacement?').'</th>'.
10186: &end_data_table_header_row().
10187: $modify_output.
10188: &end_data_table()."\n";
10189: }
10190: if ($delete_output) {
10191: $delete_output = &start_data_table().
10192: &start_data_table_header_row().
10193: '<th>'.&mt('File').'</th>'.
10194: '<th>'.&mt('Size (KB)').'</th>'.
10195: '<th>'.&mt('Modified').'</th>'.
10196: '<th>'.&mt('Delete?').'</th>'.
10197: &end_data_table_header_row().
10198: $delete_output.
10199: &end_data_table()."\n";
10200: }
1.987 raeburn 10201: my $applies = 0;
10202: if ($numremref) {
10203: $applies ++;
10204: }
10205: if ($numinvalid) {
10206: $applies ++;
10207: }
10208: if ($numexisting) {
10209: $applies ++;
10210: }
1.1071 raeburn 10211: if ($counter || $numunused) {
1.987 raeburn 10212: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10213: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10214: $state.'<h3>'.$heading.'</h3>';
10215: if ($actionurl eq '/adm/dependencies') {
10216: if ($numnew) {
10217: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10218: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10219: $upload_output.'<br />'."\n";
10220: }
10221: if ($numexisting) {
10222: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10223: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10224: $modify_output.'<br />'."\n";
10225: $buttontext = &mt('Save changes');
10226: }
10227: if ($numunused) {
10228: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10229: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10230: $delete_output.'<br />'."\n";
10231: $buttontext = &mt('Save changes');
10232: }
10233: } else {
10234: $output .= $upload_output.'<br />'."\n";
10235: }
10236: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10237: $counter.'" />'."\n";
10238: if ($actionurl eq '/adm/dependencies') {
10239: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10240: $numnew.'" />'."\n";
10241: } elsif ($actionurl eq '') {
1.987 raeburn 10242: $output .= '<input type="hidden" name="phase" value="three" />';
10243: }
10244: } elsif ($applies) {
10245: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10246: if ($applies > 1) {
10247: $output .=
1.1075.2.35 raeburn 10248: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10249: if ($numremref) {
10250: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10251: }
10252: if ($numinvalid) {
10253: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10254: }
10255: if ($numexisting) {
10256: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10257: }
10258: $output .= '</ul><br />';
10259: } elsif ($numremref) {
10260: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10261: } elsif ($numinvalid) {
10262: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10263: } elsif ($numexisting) {
10264: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10265: }
10266: $output .= $upload_output.'<br />';
10267: }
10268: my ($pathchange_output,$chgcount);
1.1071 raeburn 10269: $chgcount = $counter;
1.987 raeburn 10270: if (keys(%pathchanges) > 0) {
10271: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10272: if ($counter) {
1.987 raeburn 10273: $output .= &embedded_file_element('pathchange',$chgcount,
10274: $embed_file,\%mapping,
1.1071 raeburn 10275: $allfiles,$codebase,'change');
1.987 raeburn 10276: } else {
10277: $pathchange_output .=
10278: &start_data_table_row().
10279: '<td><input type ="checkbox" name="namechange" value="'.
10280: $chgcount.'" checked="checked" /></td>'.
10281: '<td>'.$mapping{$embed_file}.'</td>'.
10282: '<td>'.$embed_file.
10283: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10284: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10285: '</td>'.&end_data_table_row();
1.660 raeburn 10286: }
1.987 raeburn 10287: $numpathchg ++;
10288: $chgcount ++;
1.660 raeburn 10289: }
10290: }
1.1075.2.35 raeburn 10291: if (($counter) || ($numunused)) {
1.987 raeburn 10292: if ($numpathchg) {
10293: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10294: $numpathchg.'" />'."\n";
10295: }
10296: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10297: ($actionurl eq '/adm/imsimport')) {
10298: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10299: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10300: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10301: } elsif ($actionurl eq '/adm/dependencies') {
10302: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10303: }
1.1075.2.35 raeburn 10304: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10305: } elsif ($numpathchg) {
10306: my %pathchange = ();
10307: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10308: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10309: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10310: }
1.987 raeburn 10311: }
1.1071 raeburn 10312: return ($output,$counter,$numpathchg);
1.987 raeburn 10313: }
10314:
1.1075.2.47 raeburn 10315: =pod
10316:
10317: =item * clean_path($name)
10318:
10319: Performs clean-up of directories, subdirectories and filename in an
10320: embedded object, referenced in an HTML file which is being uploaded
10321: to a course or portfolio, where
10322: "Upload embedded images/multimedia files if HTML file" checkbox was
10323: checked.
10324:
10325: Clean-up is similar to replacements in lonnet::clean_filename()
10326: except each / between sub-directory and next level is preserved.
10327:
10328: =cut
10329:
10330: sub clean_path {
10331: my ($embed_file) = @_;
10332: $embed_file =~s{^/+}{};
10333: my @contents;
10334: if ($embed_file =~ m{/}) {
10335: @contents = split(/\//,$embed_file);
10336: } else {
10337: @contents = ($embed_file);
10338: }
10339: my $lastidx = scalar(@contents)-1;
10340: for (my $i=0; $i<=$lastidx; $i++) {
10341: $contents[$i]=~s{\\}{/}g;
10342: $contents[$i]=~s/\s+/\_/g;
10343: $contents[$i]=~s{[^/\w\.\-]}{}g;
10344: if ($i == $lastidx) {
10345: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10346: }
10347: }
10348: if ($lastidx > 0) {
10349: return join('/',@contents);
10350: } else {
10351: return $contents[0];
10352: }
10353: }
10354:
1.987 raeburn 10355: sub embedded_file_element {
1.1071 raeburn 10356: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10357: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10358: (ref($codebase) eq 'HASH'));
10359: my $output;
1.1071 raeburn 10360: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10361: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10362: }
10363: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10364: &escape($embed_file).'" />';
10365: unless (($context eq 'upload_embedded') &&
10366: ($mapping->{$embed_file} eq $embed_file)) {
10367: $output .='
10368: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10369: }
10370: my $attrib;
10371: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10372: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10373: }
10374: $output .=
10375: "\n\t\t".
10376: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10377: $attrib.'" />';
10378: if (exists($codebase->{$mapping->{$embed_file}})) {
10379: $output .=
10380: "\n\t\t".
10381: '<input name="codebase_'.$num.'" type="hidden" value="'.
10382: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10383: }
1.987 raeburn 10384: return $output;
1.660 raeburn 10385: }
10386:
1.1071 raeburn 10387: sub get_dependency_details {
10388: my ($currfile,$currsubfile,$embed_file) = @_;
10389: my ($size,$mtime,$showsize,$showmtime);
10390: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10391: if ($embed_file =~ m{/}) {
10392: my ($path,$fname) = split(/\//,$embed_file);
10393: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10394: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10395: }
10396: } else {
10397: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10398: ($size,$mtime) = @{$currfile->{$embed_file}};
10399: }
10400: }
10401: $showsize = $size/1024.0;
10402: $showsize = sprintf("%.1f",$showsize);
10403: if ($mtime > 0) {
10404: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10405: }
10406: }
10407: return ($showsize,$showmtime);
10408: }
10409:
10410: sub ask_embedded_js {
10411: return <<"END";
10412: <script type="text/javascript"">
10413: // <![CDATA[
10414: function toggleBrowse(counter) {
10415: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10416: var fileid = document.getElementById('embedded_item_'+counter);
10417: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10418: if (chkboxid.checked == true) {
10419: uploaddivid.style.display='block';
10420: } else {
10421: uploaddivid.style.display='none';
10422: fileid.value = '';
10423: }
10424: }
10425: // ]]>
10426: </script>
10427:
10428: END
10429: }
10430:
1.661 raeburn 10431: sub upload_embedded {
10432: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10433: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10434: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10435: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10436: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10437: my $orig_uploaded_filename =
10438: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10439: foreach my $type ('orig','ref','attrib','codebase') {
10440: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10441: $env{'form.embedded_'.$type.'_'.$i} =
10442: &unescape($env{'form.embedded_'.$type.'_'.$i});
10443: }
10444: }
1.661 raeburn 10445: my ($path,$fname) =
10446: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10447: # no path, whole string is fname
10448: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10449: $fname = &Apache::lonnet::clean_filename($fname);
10450: # See if there is anything left
10451: next if ($fname eq '');
10452:
10453: # Check if file already exists as a file or directory.
10454: my ($state,$msg);
10455: if ($context eq 'portfolio') {
10456: my $port_path = $dirpath;
10457: if ($group ne '') {
10458: $port_path = "groups/$group/$port_path";
10459: }
1.987 raeburn 10460: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10461: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10462: $dir_root,$port_path,$disk_quota,
10463: $current_disk_usage,$uname,$udom);
10464: if ($state eq 'will_exceed_quota'
1.984 raeburn 10465: || $state eq 'file_locked') {
1.661 raeburn 10466: $output .= $msg;
10467: next;
10468: }
10469: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10470: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10471: if ($state eq 'exists') {
10472: $output .= $msg;
10473: next;
10474: }
10475: }
10476: # Check if extension is valid
10477: if (($fname =~ /\.(\w+)$/) &&
10478: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10479: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10480: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10481: next;
10482: } elsif (($fname =~ /\.(\w+)$/) &&
10483: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10484: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10485: next;
10486: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10487: $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661 raeburn 10488: next;
10489: }
10490: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10491: my $subdir = $path;
10492: $subdir =~ s{/+$}{};
1.661 raeburn 10493: if ($context eq 'portfolio') {
1.984 raeburn 10494: my $result;
10495: if ($state eq 'existingfile') {
10496: $result=
10497: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10498: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10499: } else {
1.984 raeburn 10500: $result=
10501: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10502: $dirpath.
1.1075.2.35 raeburn 10503: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10504: if ($result !~ m|^/uploaded/|) {
10505: $output .= '<span class="LC_error">'
10506: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10507: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10508: .'</span><br />';
10509: next;
10510: } else {
1.987 raeburn 10511: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10512: $path.$fname.'</span>').'<br />';
1.984 raeburn 10513: }
1.661 raeburn 10514: }
1.1075.2.35 raeburn 10515: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10516: my $extendedsubdir = $dirpath.'/'.$subdir;
10517: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10518: my $result =
1.1075.2.35 raeburn 10519: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10520: if ($result !~ m|^/uploaded/|) {
10521: $output .= '<span class="LC_error">'
10522: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10523: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10524: .'</span><br />';
10525: next;
10526: } else {
10527: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10528: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10529: if ($context eq 'syllabus') {
10530: &Apache::lonnet::make_public_indefinitely($result);
10531: }
1.987 raeburn 10532: }
1.661 raeburn 10533: } else {
10534: # Save the file
10535: my $target = $env{'form.embedded_item_'.$i};
10536: my $fullpath = $dir_root.$dirpath.'/'.$path;
10537: my $dest = $fullpath.$fname;
10538: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10539: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10540: my $count;
10541: my $filepath = $dir_root;
1.1027 raeburn 10542: foreach my $subdir (@parts) {
10543: $filepath .= "/$subdir";
10544: if (!-e $filepath) {
1.661 raeburn 10545: mkdir($filepath,0770);
10546: }
10547: }
10548: my $fh;
10549: if (!open($fh,'>'.$dest)) {
10550: &Apache::lonnet::logthis('Failed to create '.$dest);
10551: $output .= '<span class="LC_error">'.
1.1071 raeburn 10552: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10553: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10554: '</span><br />';
10555: } else {
10556: if (!print $fh $env{'form.embedded_item_'.$i}) {
10557: &Apache::lonnet::logthis('Failed to write to '.$dest);
10558: $output .= '<span class="LC_error">'.
1.1071 raeburn 10559: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10560: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10561: '</span><br />';
10562: } else {
1.987 raeburn 10563: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10564: $url.'</span>').'<br />';
10565: unless ($context eq 'testbank') {
10566: $footer .= &mt('View embedded file: [_1]',
10567: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10568: }
10569: }
10570: close($fh);
10571: }
10572: }
10573: if ($env{'form.embedded_ref_'.$i}) {
10574: $pathchange{$i} = 1;
10575: }
10576: }
10577: if ($output) {
10578: $output = '<p>'.$output.'</p>';
10579: }
10580: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10581: $returnflag = 'ok';
1.1071 raeburn 10582: my $numpathchgs = scalar(keys(%pathchange));
10583: if ($numpathchgs > 0) {
1.987 raeburn 10584: if ($context eq 'portfolio') {
10585: $output .= '<p>'.&mt('or').'</p>';
10586: } elsif ($context eq 'testbank') {
1.1071 raeburn 10587: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10588: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10589: $returnflag = 'modify_orightml';
10590: }
10591: }
1.1071 raeburn 10592: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10593: }
10594:
10595: sub modify_html_form {
10596: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10597: my $end = 0;
10598: my $modifyform;
10599: if ($context eq 'upload_embedded') {
10600: return unless (ref($pathchange) eq 'HASH');
10601: if ($env{'form.number_embedded_items'}) {
10602: $end += $env{'form.number_embedded_items'};
10603: }
10604: if ($env{'form.number_pathchange_items'}) {
10605: $end += $env{'form.number_pathchange_items'};
10606: }
10607: if ($end) {
10608: for (my $i=0; $i<$end; $i++) {
10609: if ($i < $env{'form.number_embedded_items'}) {
10610: next unless($pathchange->{$i});
10611: }
10612: $modifyform .=
10613: &start_data_table_row().
10614: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10615: 'checked="checked" /></td>'.
10616: '<td>'.$env{'form.embedded_ref_'.$i}.
10617: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10618: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10619: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10620: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10621: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10622: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10623: '<td>'.$env{'form.embedded_orig_'.$i}.
10624: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10625: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10626: &end_data_table_row();
1.1071 raeburn 10627: }
1.987 raeburn 10628: }
10629: } else {
10630: $modifyform = $pathchgtable;
10631: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10632: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10633: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10634: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10635: }
10636: }
10637: if ($modifyform) {
1.1071 raeburn 10638: if ($actionurl eq '/adm/dependencies') {
10639: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10640: }
1.987 raeburn 10641: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10642: '<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".
10643: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10644: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10645: '</ol></p>'."\n".'<p>'.
10646: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10647: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10648: &start_data_table()."\n".
10649: &start_data_table_header_row().
10650: '<th>'.&mt('Change?').'</th>'.
10651: '<th>'.&mt('Current reference').'</th>'.
10652: '<th>'.&mt('Required reference').'</th>'.
10653: &end_data_table_header_row()."\n".
10654: $modifyform.
10655: &end_data_table().'<br />'."\n".$hiddenstate.
10656: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10657: '</form>'."\n";
10658: }
10659: return;
10660: }
10661:
10662: sub modify_html_refs {
1.1075.2.35 raeburn 10663: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10664: my $container;
10665: if ($context eq 'portfolio') {
10666: $container = $env{'form.container'};
10667: } elsif ($context eq 'coursedoc') {
10668: $container = $env{'form.primaryurl'};
1.1071 raeburn 10669: } elsif ($context eq 'manage_dependencies') {
10670: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10671: $container = "/$container";
1.1075.2.35 raeburn 10672: } elsif ($context eq 'syllabus') {
10673: $container = $url;
1.987 raeburn 10674: } else {
1.1027 raeburn 10675: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10676: }
10677: my (%allfiles,%codebase,$output,$content);
10678: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10679: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10680: if (wantarray) {
10681: return ('',0,0);
10682: } else {
10683: return;
10684: }
10685: }
10686: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10687: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10688: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10689: if (wantarray) {
10690: return ('',0,0);
10691: } else {
10692: return;
10693: }
10694: }
1.987 raeburn 10695: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10696: if ($content eq '-1') {
10697: if (wantarray) {
10698: return ('',0,0);
10699: } else {
10700: return;
10701: }
10702: }
1.987 raeburn 10703: } else {
1.1071 raeburn 10704: unless ($container =~ /^\Q$dir_root\E/) {
10705: if (wantarray) {
10706: return ('',0,0);
10707: } else {
10708: return;
10709: }
10710: }
1.987 raeburn 10711: if (open(my $fh,"<$container")) {
10712: $content = join('', <$fh>);
10713: close($fh);
10714: } else {
1.1071 raeburn 10715: if (wantarray) {
10716: return ('',0,0);
10717: } else {
10718: return;
10719: }
1.987 raeburn 10720: }
10721: }
10722: my ($count,$codebasecount) = (0,0);
10723: my $mm = new File::MMagic;
10724: my $mime_type = $mm->checktype_contents($content);
10725: if ($mime_type eq 'text/html') {
10726: my $parse_result =
10727: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10728: \%codebase,\$content);
10729: if ($parse_result eq 'ok') {
10730: foreach my $i (@changes) {
10731: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10732: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10733: if ($allfiles{$ref}) {
10734: my $newname = $orig;
10735: my ($attrib_regexp,$codebase);
1.1006 raeburn 10736: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10737: if ($attrib_regexp =~ /:/) {
10738: $attrib_regexp =~ s/\:/|/g;
10739: }
10740: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10741: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10742: $count += $numchg;
1.1075.2.35 raeburn 10743: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 10744: delete($allfiles{$ref});
1.987 raeburn 10745: }
10746: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10747: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10748: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10749: $codebasecount ++;
10750: }
10751: }
10752: }
1.1075.2.35 raeburn 10753: my $skiprewrites;
1.987 raeburn 10754: if ($count || $codebasecount) {
10755: my $saveresult;
1.1071 raeburn 10756: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10757: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10758: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10759: if ($url eq $container) {
10760: my ($fname) = ($container =~ m{/([^/]+)$});
10761: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10762: $count,'<span class="LC_filename">'.
1.1071 raeburn 10763: $fname.'</span>').'</p>';
1.987 raeburn 10764: } else {
10765: $output = '<p class="LC_error">'.
10766: &mt('Error: update failed for: [_1].',
10767: '<span class="LC_filename">'.
10768: $container.'</span>').'</p>';
10769: }
1.1075.2.35 raeburn 10770: if ($context eq 'syllabus') {
10771: unless ($saveresult eq 'ok') {
10772: $skiprewrites = 1;
10773: }
10774: }
1.987 raeburn 10775: } else {
10776: if (open(my $fh,">$container")) {
10777: print $fh $content;
10778: close($fh);
10779: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10780: $count,'<span class="LC_filename">'.
10781: $container.'</span>').'</p>';
1.661 raeburn 10782: } else {
1.987 raeburn 10783: $output = '<p class="LC_error">'.
10784: &mt('Error: could not update [_1].',
10785: '<span class="LC_filename">'.
10786: $container.'</span>').'</p>';
1.661 raeburn 10787: }
10788: }
10789: }
1.1075.2.35 raeburn 10790: if (($context eq 'syllabus') && (!$skiprewrites)) {
10791: my ($actionurl,$state);
10792: $actionurl = "/public/$udom/$uname/syllabus";
10793: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10794: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10795: \%codebase,
10796: {'context' => 'rewrites',
10797: 'ignore_remote_references' => 1,});
10798: if (ref($mapping) eq 'HASH') {
10799: my $rewrites = 0;
10800: foreach my $key (keys(%{$mapping})) {
10801: next if ($key =~ m{^https?://});
10802: my $ref = $mapping->{$key};
10803: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10804: my $attrib;
10805: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10806: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10807: }
10808: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10809: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10810: $rewrites += $numchg;
10811: }
10812: }
10813: if ($rewrites) {
10814: my $saveresult;
10815: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10816: if ($url eq $container) {
10817: my ($fname) = ($container =~ m{/([^/]+)$});
10818: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10819: $count,'<span class="LC_filename">'.
10820: $fname.'</span>').'</p>';
10821: } else {
10822: $output .= '<p class="LC_error">'.
10823: &mt('Error: could not update links in [_1].',
10824: '<span class="LC_filename">'.
10825: $container.'</span>').'</p>';
10826:
10827: }
10828: }
10829: }
10830: }
1.987 raeburn 10831: } else {
10832: &logthis('Failed to parse '.$container.
10833: ' to modify references: '.$parse_result);
1.661 raeburn 10834: }
10835: }
1.1071 raeburn 10836: if (wantarray) {
10837: return ($output,$count,$codebasecount);
10838: } else {
10839: return $output;
10840: }
1.661 raeburn 10841: }
10842:
10843: sub check_for_existing {
10844: my ($path,$fname,$element) = @_;
10845: my ($state,$msg);
10846: if (-d $path.'/'.$fname) {
10847: $state = 'exists';
10848: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10849: } elsif (-e $path.'/'.$fname) {
10850: $state = 'exists';
10851: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10852: }
10853: if ($state eq 'exists') {
10854: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10855: }
10856: return ($state,$msg);
10857: }
10858:
10859: sub check_for_upload {
10860: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10861: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10862: my $filesize = length($env{'form.'.$element});
10863: if (!$filesize) {
10864: my $msg = '<span class="LC_error">'.
10865: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10866: '<span class="LC_filename">'.$fname.'</span>',
10867: $filesize).'<br />'.
1.1007 raeburn 10868: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10869: '</span>';
10870: return ('zero_bytes',$msg);
10871: }
10872: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10873: my $getpropath = 1;
1.1021 raeburn 10874: my ($dirlistref,$listerror) =
10875: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10876: my $found_file = 0;
10877: my $locked_file = 0;
1.991 raeburn 10878: my @lockers;
10879: my $navmap;
10880: if ($env{'request.course.id'}) {
10881: $navmap = Apache::lonnavmaps::navmap->new();
10882: }
1.1021 raeburn 10883: if (ref($dirlistref) eq 'ARRAY') {
10884: foreach my $line (@{$dirlistref}) {
10885: my ($file_name,$rest)=split(/\&/,$line,2);
10886: if ($file_name eq $fname){
10887: $file_name = $path.$file_name;
10888: if ($group ne '') {
10889: $file_name = $group.$file_name;
10890: }
10891: $found_file = 1;
10892: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10893: foreach my $lock (@lockers) {
10894: if (ref($lock) eq 'ARRAY') {
10895: my ($symb,$crsid) = @{$lock};
10896: if ($crsid eq $env{'request.course.id'}) {
10897: if (ref($navmap)) {
10898: my $res = $navmap->getBySymb($symb);
10899: foreach my $part (@{$res->parts()}) {
10900: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10901: unless (($slot_status == $res->RESERVED) ||
10902: ($slot_status == $res->RESERVED_LOCATION)) {
10903: $locked_file = 1;
10904: }
1.991 raeburn 10905: }
1.1021 raeburn 10906: } else {
10907: $locked_file = 1;
1.991 raeburn 10908: }
10909: } else {
10910: $locked_file = 1;
10911: }
10912: }
1.1021 raeburn 10913: }
10914: } else {
10915: my @info = split(/\&/,$rest);
10916: my $currsize = $info[6]/1000;
10917: if ($currsize < $filesize) {
10918: my $extra = $filesize - $currsize;
10919: if (($current_disk_usage + $extra) > $disk_quota) {
10920: my $msg = '<span class="LC_error">'.
10921: &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.',
10922: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
10923: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
10924: $disk_quota,$current_disk_usage);
10925: return ('will_exceed_quota',$msg);
10926: }
1.984 raeburn 10927: }
10928: }
1.661 raeburn 10929: }
10930: }
10931: }
10932: if (($current_disk_usage + $filesize) > $disk_quota){
10933: my $msg = '<span class="LC_error">'.
10934: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
10935: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
10936: return ('will_exceed_quota',$msg);
10937: } elsif ($found_file) {
10938: if ($locked_file) {
10939: my $msg = '<span class="LC_error">';
10940: $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>');
10941: $msg .= '</span><br />';
10942: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
10943: return ('file_locked',$msg);
10944: } else {
10945: my $msg = '<span class="LC_error">';
1.984 raeburn 10946: $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 10947: $msg .= '</span>';
1.984 raeburn 10948: return ('existingfile',$msg);
1.661 raeburn 10949: }
10950: }
10951: }
10952:
1.987 raeburn 10953: sub check_for_traversal {
10954: my ($path,$url,$toplevel) = @_;
10955: my @parts=split(/\//,$path);
10956: my $cleanpath;
10957: my $fullpath = $url;
10958: for (my $i=0;$i<@parts;$i++) {
10959: next if ($parts[$i] eq '.');
10960: if ($parts[$i] eq '..') {
10961: $fullpath =~ s{([^/]+/)$}{};
10962: } else {
10963: $fullpath .= $parts[$i].'/';
10964: }
10965: }
10966: if ($fullpath =~ /^\Q$url\E(.*)$/) {
10967: $cleanpath = $1;
10968: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
10969: my $curr_toprel = $1;
10970: my @parts = split(/\//,$curr_toprel);
10971: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
10972: my @urlparts = split(/\//,$url_toprel);
10973: my $doubledots;
10974: my $startdiff = -1;
10975: for (my $i=0; $i<@urlparts; $i++) {
10976: if ($startdiff == -1) {
10977: unless ($urlparts[$i] eq $parts[$i]) {
10978: $startdiff = $i;
10979: $doubledots .= '../';
10980: }
10981: } else {
10982: $doubledots .= '../';
10983: }
10984: }
10985: if ($startdiff > -1) {
10986: $cleanpath = $doubledots;
10987: for (my $i=$startdiff; $i<@parts; $i++) {
10988: $cleanpath .= $parts[$i].'/';
10989: }
10990: }
10991: }
10992: $cleanpath =~ s{(/)$}{};
10993: return $cleanpath;
10994: }
1.31 albertel 10995:
1.1053 raeburn 10996: sub is_archive_file {
10997: my ($mimetype) = @_;
10998: if (($mimetype eq 'application/octet-stream') ||
10999: ($mimetype eq 'application/x-stuffit') ||
11000: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11001: return 1;
11002: }
11003: return;
11004: }
11005:
11006: sub decompress_form {
1.1065 raeburn 11007: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11008: my %lt = &Apache::lonlocal::texthash (
11009: this => 'This file is an archive file.',
1.1067 raeburn 11010: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11011: itsc => 'Its contents are as follows:',
1.1053 raeburn 11012: youm => 'You may wish to extract its contents.',
11013: extr => 'Extract contents',
1.1067 raeburn 11014: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11015: proa => 'Process automatically?',
1.1053 raeburn 11016: yes => 'Yes',
11017: no => 'No',
1.1067 raeburn 11018: fold => 'Title for folder containing movie',
11019: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11020: );
1.1065 raeburn 11021: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11022: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11023: my $info = &list_archive_contents($fileloc,\@paths);
11024: if (@paths) {
11025: foreach my $path (@paths) {
11026: $path =~ s{^/}{};
1.1067 raeburn 11027: if ($path =~ m{^([^/]+)/$}) {
11028: $topdir = $1;
11029: }
1.1065 raeburn 11030: if ($path =~ m{^([^/]+)/}) {
11031: $toplevel{$1} = $path;
11032: } else {
11033: $toplevel{$path} = $path;
11034: }
11035: }
11036: }
1.1067 raeburn 11037: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11038: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11039: "$topdir/media/",
11040: "$topdir/media/$topdir.mp4",
11041: "$topdir/media/FirstFrame.png",
11042: "$topdir/media/player.swf",
11043: "$topdir/media/swfobject.js",
11044: "$topdir/media/expressInstall.swf");
1.1075.2.59 raeburn 11045: my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
11046: "$topdir/$topdir.mp4",
11047: "$topdir/$topdir\_config.xml",
11048: "$topdir/$topdir\_controller.swf",
11049: "$topdir/$topdir\_embed.css",
11050: "$topdir/$topdir\_First_Frame.png",
11051: "$topdir/$topdir\_player.html",
11052: "$topdir/$topdir\_Thumbnails.png",
11053: "$topdir/playerProductInstall.swf",
11054: "$topdir/scripts/",
11055: "$topdir/scripts/config_xml.js",
11056: "$topdir/scripts/handlebars.js",
11057: "$topdir/scripts/jquery-1.7.1.min.js",
11058: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11059: "$topdir/scripts/modernizr.js",
11060: "$topdir/scripts/player-min.js",
11061: "$topdir/scripts/swfobject.js",
11062: "$topdir/skins/",
11063: "$topdir/skins/configuration_express.xml",
11064: "$topdir/skins/express_show/",
11065: "$topdir/skins/express_show/player-min.css",
11066: "$topdir/skins/express_show/spritesheet.png");
11067: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11068: if (@diffs == 0) {
1.1075.2.59 raeburn 11069: $is_camtasia = 6;
11070: } else {
11071: @diffs = &compare_arrays(\@paths,\@camtasia8);
11072: if (@diffs == 0) {
11073: $is_camtasia = 8;
11074: }
1.1067 raeburn 11075: }
11076: }
11077: my $output;
11078: if ($is_camtasia) {
11079: $output = <<"ENDCAM";
11080: <script type="text/javascript" language="Javascript">
11081: // <![CDATA[
11082:
11083: function camtasiaToggle() {
11084: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11085: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11086: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11087: document.getElementById('camtasia_titles').style.display='block';
11088: } else {
11089: document.getElementById('camtasia_titles').style.display='none';
11090: }
11091: }
11092: }
11093: return;
11094: }
11095:
11096: // ]]>
11097: </script>
11098: <p>$lt{'camt'}</p>
11099: ENDCAM
1.1065 raeburn 11100: } else {
1.1067 raeburn 11101: $output = '<p>'.$lt{'this'};
11102: if ($info eq '') {
11103: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11104: } else {
11105: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11106: '<div><pre>'.$info.'</pre></div>';
11107: }
1.1065 raeburn 11108: }
1.1067 raeburn 11109: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11110: my $duplicates;
11111: my $num = 0;
11112: if (ref($dirlist) eq 'ARRAY') {
11113: foreach my $item (@{$dirlist}) {
11114: if (ref($item) eq 'ARRAY') {
11115: if (exists($toplevel{$item->[0]})) {
11116: $duplicates .=
11117: &start_data_table_row().
11118: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11119: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11120: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11121: 'value="1" />'.&mt('Yes').'</label>'.
11122: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11123: '<td>'.$item->[0].'</td>';
11124: if ($item->[2]) {
11125: $duplicates .= '<td>'.&mt('Directory').'</td>';
11126: } else {
11127: $duplicates .= '<td>'.&mt('File').'</td>';
11128: }
11129: $duplicates .= '<td>'.$item->[3].'</td>'.
11130: '<td>'.
11131: &Apache::lonlocal::locallocaltime($item->[4]).
11132: '</td>'.
11133: &end_data_table_row();
11134: $num ++;
11135: }
11136: }
11137: }
11138: }
11139: my $itemcount;
11140: if (@paths > 0) {
11141: $itemcount = scalar(@paths);
11142: } else {
11143: $itemcount = 1;
11144: }
1.1067 raeburn 11145: if ($is_camtasia) {
11146: $output .= $lt{'auto'}.'<br />'.
11147: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11148: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11149: $lt{'yes'}.'</label> <label>'.
11150: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11151: $lt{'no'}.'</label></span><br />'.
11152: '<div id="camtasia_titles" style="display:block">'.
11153: &Apache::lonhtmlcommon::start_pick_box().
11154: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11155: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11156: &Apache::lonhtmlcommon::row_closure().
11157: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11158: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11159: &Apache::lonhtmlcommon::row_closure(1).
11160: &Apache::lonhtmlcommon::end_pick_box().
11161: '</div>';
11162: }
1.1065 raeburn 11163: $output .=
11164: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11165: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11166: "\n";
1.1065 raeburn 11167: if ($duplicates ne '') {
11168: $output .= '<p><span class="LC_warning">'.
11169: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11170: &start_data_table().
11171: &start_data_table_header_row().
11172: '<th>'.&mt('Overwrite?').'</th>'.
11173: '<th>'.&mt('Name').'</th>'.
11174: '<th>'.&mt('Type').'</th>'.
11175: '<th>'.&mt('Size').'</th>'.
11176: '<th>'.&mt('Last modified').'</th>'.
11177: &end_data_table_header_row().
11178: $duplicates.
11179: &end_data_table().
11180: '</p>';
11181: }
1.1067 raeburn 11182: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11183: if (ref($hiddenelements) eq 'HASH') {
11184: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11185: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11186: }
11187: }
11188: $output .= <<"END";
1.1067 raeburn 11189: <br />
1.1053 raeburn 11190: <input type="submit" name="decompress" value="$lt{'extr'}" />
11191: </form>
11192: $noextract
11193: END
11194: return $output;
11195: }
11196:
1.1065 raeburn 11197: sub decompression_utility {
11198: my ($program) = @_;
11199: my @utilities = ('tar','gunzip','bunzip2','unzip');
11200: my $location;
11201: if (grep(/^\Q$program\E$/,@utilities)) {
11202: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11203: '/usr/sbin/') {
11204: if (-x $dir.$program) {
11205: $location = $dir.$program;
11206: last;
11207: }
11208: }
11209: }
11210: return $location;
11211: }
11212:
11213: sub list_archive_contents {
11214: my ($file,$pathsref) = @_;
11215: my (@cmd,$output);
11216: my $needsregexp;
11217: if ($file =~ /\.zip$/) {
11218: @cmd = (&decompression_utility('unzip'),"-l");
11219: $needsregexp = 1;
11220: } elsif (($file =~ m/\.tar\.gz$/) ||
11221: ($file =~ /\.tgz$/)) {
11222: @cmd = (&decompression_utility('tar'),"-ztf");
11223: } elsif ($file =~ /\.tar\.bz2$/) {
11224: @cmd = (&decompression_utility('tar'),"-jtf");
11225: } elsif ($file =~ m|\.tar$|) {
11226: @cmd = (&decompression_utility('tar'),"-tf");
11227: }
11228: if (@cmd) {
11229: undef($!);
11230: undef($@);
11231: if (open(my $fh,"-|", @cmd, $file)) {
11232: while (my $line = <$fh>) {
11233: $output .= $line;
11234: chomp($line);
11235: my $item;
11236: if ($needsregexp) {
11237: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11238: } else {
11239: $item = $line;
11240: }
11241: if ($item ne '') {
11242: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11243: push(@{$pathsref},$item);
11244: }
11245: }
11246: }
11247: close($fh);
11248: }
11249: }
11250: return $output;
11251: }
11252:
1.1053 raeburn 11253: sub decompress_uploaded_file {
11254: my ($file,$dir) = @_;
11255: &Apache::lonnet::appenv({'cgi.file' => $file});
11256: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11257: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11258: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11259: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11260: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11261: my $decompressed = $env{'cgi.decompressed'};
11262: &Apache::lonnet::delenv('cgi.file');
11263: &Apache::lonnet::delenv('cgi.dir');
11264: &Apache::lonnet::delenv('cgi.decompressed');
11265: return ($decompressed,$result);
11266: }
11267:
1.1055 raeburn 11268: sub process_decompression {
11269: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11270: my ($dir,$error,$warning,$output);
11271: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
1.1075.2.34 raeburn 11272: $error = &mt('Filename not a supported archive file type.').
11273: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11274: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11275: } else {
11276: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11277: if ($docuhome eq 'no_host') {
11278: $error = &mt('Could not determine home server for course.');
11279: } else {
11280: my @ids=&Apache::lonnet::current_machine_ids();
11281: my $currdir = "$dir_root/$destination";
11282: if (grep(/^\Q$docuhome\E$/,@ids)) {
11283: $dir = &LONCAPA::propath($docudom,$docuname).
11284: "$dir_root/$destination";
11285: } else {
11286: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11287: "$dir_root/$docudom/$docuname/$destination";
11288: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11289: $error = &mt('Archive file not found.');
11290: }
11291: }
1.1065 raeburn 11292: my (@to_overwrite,@to_skip);
11293: if ($env{'form.archive_overwrite_total'} > 0) {
11294: my $total = $env{'form.archive_overwrite_total'};
11295: for (my $i=0; $i<$total; $i++) {
11296: if ($env{'form.archive_overwrite_'.$i} == 1) {
11297: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11298: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11299: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11300: }
11301: }
11302: }
11303: my $numskip = scalar(@to_skip);
11304: if (($numskip > 0) &&
11305: ($numskip == $env{'form.archive_itemcount'})) {
11306: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11307: } elsif ($dir eq '') {
1.1055 raeburn 11308: $error = &mt('Directory containing archive file unavailable.');
11309: } elsif (!$error) {
1.1065 raeburn 11310: my ($decompressed,$display);
11311: if ($numskip > 0) {
11312: my $tempdir = time.'_'.$$.int(rand(10000));
11313: mkdir("$dir/$tempdir",0755);
11314: system("mv $dir/$file $dir/$tempdir/$file");
11315: ($decompressed,$display) =
11316: &decompress_uploaded_file($file,"$dir/$tempdir");
11317: foreach my $item (@to_skip) {
11318: if (($item ne '') && ($item !~ /\.\./)) {
11319: if (-f "$dir/$tempdir/$item") {
11320: unlink("$dir/$tempdir/$item");
11321: } elsif (-d "$dir/$tempdir/$item") {
11322: system("rm -rf $dir/$tempdir/$item");
11323: }
11324: }
11325: }
11326: system("mv $dir/$tempdir/* $dir");
11327: rmdir("$dir/$tempdir");
11328: } else {
11329: ($decompressed,$display) =
11330: &decompress_uploaded_file($file,$dir);
11331: }
1.1055 raeburn 11332: if ($decompressed eq 'ok') {
1.1065 raeburn 11333: $output = '<p class="LC_info">'.
11334: &mt('Files extracted successfully from archive.').
11335: '</p>'."\n";
1.1055 raeburn 11336: my ($warning,$result,@contents);
11337: my ($newdirlistref,$newlisterror) =
11338: &Apache::lonnet::dirlist($currdir,$docudom,
11339: $docuname,1);
11340: my (%is_dir,%changes,@newitems);
11341: my $dirptr = 16384;
1.1065 raeburn 11342: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11343: foreach my $dir_line (@{$newdirlistref}) {
11344: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11345: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11346: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11347: push(@newitems,$item);
11348: if ($dirptr&$testdir) {
11349: $is_dir{$item} = 1;
11350: }
11351: $changes{$item} = 1;
11352: }
11353: }
11354: }
11355: if (keys(%changes) > 0) {
11356: foreach my $item (sort(@newitems)) {
11357: if ($changes{$item}) {
11358: push(@contents,$item);
11359: }
11360: }
11361: }
11362: if (@contents > 0) {
1.1067 raeburn 11363: my $wantform;
11364: unless ($env{'form.autoextract_camtasia'}) {
11365: $wantform = 1;
11366: }
1.1056 raeburn 11367: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11368: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11369: $currdir,\%is_dir,
11370: \%children,\%parent,
1.1056 raeburn 11371: \@contents,\%dirorder,
11372: \%titles,$wantform);
1.1055 raeburn 11373: if ($datatable ne '') {
11374: $output .= &archive_options_form('decompressed',$datatable,
11375: $count,$hiddenelem);
1.1065 raeburn 11376: my $startcount = 6;
1.1055 raeburn 11377: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11378: \%titles,\%children);
1.1055 raeburn 11379: }
1.1067 raeburn 11380: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11381: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11382: my %displayed;
11383: my $total = 1;
11384: $env{'form.archive_directory'} = [];
11385: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11386: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11387: $path =~ s{/$}{};
11388: my $item;
11389: if ($path ne '') {
11390: $item = "$path/$titles{$i}";
11391: } else {
11392: $item = $titles{$i};
11393: }
11394: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11395: if ($item eq $contents[0]) {
11396: push(@{$env{'form.archive_directory'}},$i);
11397: $env{'form.archive_'.$i} = 'display';
11398: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11399: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11400: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11401: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11402: $env{'form.archive_'.$i} = 'display';
11403: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11404: $displayed{'web'} = $i;
11405: } else {
1.1075.2.59 raeburn 11406: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11407: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11408: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11409: push(@{$env{'form.archive_directory'}},$i);
11410: }
11411: $env{'form.archive_'.$i} = 'dependency';
11412: }
11413: $total ++;
11414: }
11415: for (my $i=1; $i<$total; $i++) {
11416: next if ($i == $displayed{'web'});
11417: next if ($i == $displayed{'folder'});
11418: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11419: }
11420: $env{'form.phase'} = 'decompress_cleanup';
11421: $env{'form.archivedelete'} = 1;
11422: $env{'form.archive_count'} = $total-1;
11423: $output .=
11424: &process_extracted_files('coursedocs',$docudom,
11425: $docuname,$destination,
11426: $dir_root,$hiddenelem);
11427: }
1.1055 raeburn 11428: } else {
11429: $warning = &mt('No new items extracted from archive file.');
11430: }
11431: } else {
11432: $output = $display;
11433: $error = &mt('An error occurred during extraction from the archive file.');
11434: }
11435: }
11436: }
11437: }
11438: if ($error) {
11439: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11440: $error.'</p>'."\n";
11441: }
11442: if ($warning) {
11443: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11444: }
11445: return $output;
11446: }
11447:
11448: sub get_extracted {
1.1056 raeburn 11449: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11450: $titles,$wantform) = @_;
1.1055 raeburn 11451: my $count = 0;
11452: my $depth = 0;
11453: my $datatable;
1.1056 raeburn 11454: my @hierarchy;
1.1055 raeburn 11455: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11456: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11457: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11458: foreach my $item (@{$contents}) {
11459: $count ++;
1.1056 raeburn 11460: @{$dirorder->{$count}} = @hierarchy;
11461: $titles->{$count} = $item;
1.1055 raeburn 11462: &archive_hierarchy($depth,$count,$parent,$children);
11463: if ($wantform) {
11464: $datatable .= &archive_row($is_dir->{$item},$item,
11465: $currdir,$depth,$count);
11466: }
11467: if ($is_dir->{$item}) {
11468: $depth ++;
1.1056 raeburn 11469: push(@hierarchy,$count);
11470: $parent->{$depth} = $count;
1.1055 raeburn 11471: $datatable .=
11472: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11473: \$depth,\$count,\@hierarchy,$dirorder,
11474: $children,$parent,$titles,$wantform);
1.1055 raeburn 11475: $depth --;
1.1056 raeburn 11476: pop(@hierarchy);
1.1055 raeburn 11477: }
11478: }
11479: return ($count,$datatable);
11480: }
11481:
11482: sub recurse_extracted_archive {
1.1056 raeburn 11483: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11484: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11485: my $result='';
1.1056 raeburn 11486: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11487: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11488: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11489: return $result;
11490: }
11491: my $dirptr = 16384;
11492: my ($newdirlistref,$newlisterror) =
11493: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11494: if (ref($newdirlistref) eq 'ARRAY') {
11495: foreach my $dir_line (@{$newdirlistref}) {
11496: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11497: unless ($item =~ /^\.+$/) {
11498: $$count ++;
1.1056 raeburn 11499: @{$dirorder->{$$count}} = @{$hierarchy};
11500: $titles->{$$count} = $item;
1.1055 raeburn 11501: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11502:
1.1055 raeburn 11503: my $is_dir;
11504: if ($dirptr&$testdir) {
11505: $is_dir = 1;
11506: }
11507: if ($wantform) {
11508: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11509: }
11510: if ($is_dir) {
11511: $$depth ++;
1.1056 raeburn 11512: push(@{$hierarchy},$$count);
11513: $parent->{$$depth} = $$count;
1.1055 raeburn 11514: $result .=
11515: &recurse_extracted_archive("$currdir/$item",$docudom,
11516: $docuname,$depth,$count,
1.1056 raeburn 11517: $hierarchy,$dirorder,$children,
11518: $parent,$titles,$wantform);
1.1055 raeburn 11519: $$depth --;
1.1056 raeburn 11520: pop(@{$hierarchy});
1.1055 raeburn 11521: }
11522: }
11523: }
11524: }
11525: return $result;
11526: }
11527:
11528: sub archive_hierarchy {
11529: my ($depth,$count,$parent,$children) =@_;
11530: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11531: if (exists($parent->{$depth})) {
11532: $children->{$parent->{$depth}} .= $count.':';
11533: }
11534: }
11535: return;
11536: }
11537:
11538: sub archive_row {
11539: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11540: my ($name) = ($item =~ m{([^/]+)$});
11541: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11542: 'display' => 'Add as file',
1.1055 raeburn 11543: 'dependency' => 'Include as dependency',
11544: 'discard' => 'Discard',
11545: );
11546: if ($is_dir) {
1.1059 raeburn 11547: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11548: }
1.1056 raeburn 11549: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11550: my $offset = 0;
1.1055 raeburn 11551: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11552: $offset ++;
1.1065 raeburn 11553: if ($action ne 'display') {
11554: $offset ++;
11555: }
1.1055 raeburn 11556: $output .= '<td><span class="LC_nobreak">'.
11557: '<label><input type="radio" name="archive_'.$count.
11558: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11559: my $text = $choices{$action};
11560: if ($is_dir) {
11561: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11562: if ($action eq 'display') {
1.1059 raeburn 11563: $text = &mt('Add as folder');
1.1055 raeburn 11564: }
1.1056 raeburn 11565: } else {
11566: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11567:
11568: }
11569: $output .= ' /> '.$choices{$action}.'</label></span>';
11570: if ($action eq 'dependency') {
11571: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11572: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11573: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11574: '<option value=""></option>'."\n".
11575: '</select>'."\n".
11576: '</div>';
1.1059 raeburn 11577: } elsif ($action eq 'display') {
11578: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11579: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11580: '</div>';
1.1055 raeburn 11581: }
1.1056 raeburn 11582: $output .= '</td>';
1.1055 raeburn 11583: }
11584: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11585: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11586: for (my $i=0; $i<$depth; $i++) {
11587: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11588: }
11589: if ($is_dir) {
11590: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11591: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11592: } else {
11593: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11594: }
11595: $output .= ' '.$name.'</td>'."\n".
11596: &end_data_table_row();
11597: return $output;
11598: }
11599:
11600: sub archive_options_form {
1.1065 raeburn 11601: my ($form,$display,$count,$hiddenelem) = @_;
11602: my %lt = &Apache::lonlocal::texthash(
11603: perm => 'Permanently remove archive file?',
11604: hows => 'How should each extracted item be incorporated in the course?',
11605: cont => 'Content actions for all',
11606: addf => 'Add as folder/file',
11607: incd => 'Include as dependency for a displayed file',
11608: disc => 'Discard',
11609: no => 'No',
11610: yes => 'Yes',
11611: save => 'Save',
11612: );
11613: my $output = <<"END";
11614: <form name="$form" method="post" action="">
11615: <p><span class="LC_nobreak">$lt{'perm'}
11616: <label>
11617: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11618: </label>
11619:
11620: <label>
11621: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11622: </span>
11623: </p>
11624: <input type="hidden" name="phase" value="decompress_cleanup" />
11625: <br />$lt{'hows'}
11626: <div class="LC_columnSection">
11627: <fieldset>
11628: <legend>$lt{'cont'}</legend>
11629: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11630: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11631: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11632: </fieldset>
11633: </div>
11634: END
11635: return $output.
1.1055 raeburn 11636: &start_data_table()."\n".
1.1065 raeburn 11637: $display."\n".
1.1055 raeburn 11638: &end_data_table()."\n".
11639: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11640: $hiddenelem.
1.1065 raeburn 11641: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11642: '</form>';
11643: }
11644:
11645: sub archive_javascript {
1.1056 raeburn 11646: my ($startcount,$numitems,$titles,$children) = @_;
11647: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11648: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11649: my $scripttag = <<START;
11650: <script type="text/javascript">
11651: // <![CDATA[
11652:
11653: function checkAll(form,prefix) {
11654: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11655: for (var i=0; i < form.elements.length; i++) {
11656: var id = form.elements[i].id;
11657: if ((id != '') && (id != undefined)) {
11658: if (idstr.test(id)) {
11659: if (form.elements[i].type == 'radio') {
11660: form.elements[i].checked = true;
1.1056 raeburn 11661: var nostart = i-$startcount;
1.1059 raeburn 11662: var offset = nostart%7;
11663: var count = (nostart-offset)/7;
1.1056 raeburn 11664: dependencyCheck(form,count,offset);
1.1055 raeburn 11665: }
11666: }
11667: }
11668: }
11669: }
11670:
11671: function propagateCheck(form,count) {
11672: if (count > 0) {
1.1059 raeburn 11673: var startelement = $startcount + ((count-1) * 7);
11674: for (var j=1; j<6; j++) {
11675: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11676: var item = startelement + j;
11677: if (form.elements[item].type == 'radio') {
11678: if (form.elements[item].checked) {
11679: containerCheck(form,count,j);
11680: break;
11681: }
1.1055 raeburn 11682: }
11683: }
11684: }
11685: }
11686: }
11687:
11688: numitems = $numitems
1.1056 raeburn 11689: var titles = new Array(numitems);
11690: var parents = new Array(numitems);
1.1055 raeburn 11691: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11692: parents[i] = new Array;
1.1055 raeburn 11693: }
1.1059 raeburn 11694: var maintitle = '$maintitle';
1.1055 raeburn 11695:
11696: START
11697:
1.1056 raeburn 11698: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11699: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11700: for (my $i=0; $i<@contents; $i ++) {
11701: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11702: }
11703: }
11704:
1.1056 raeburn 11705: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11706: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11707: }
11708:
1.1055 raeburn 11709: $scripttag .= <<END;
11710:
11711: function containerCheck(form,count,offset) {
11712: if (count > 0) {
1.1056 raeburn 11713: dependencyCheck(form,count,offset);
1.1059 raeburn 11714: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11715: form.elements[item].checked = true;
11716: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11717: if (parents[count].length > 0) {
11718: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11719: containerCheck(form,parents[count][j],offset);
11720: }
11721: }
11722: }
11723: }
11724: }
11725:
11726: function dependencyCheck(form,count,offset) {
11727: if (count > 0) {
1.1059 raeburn 11728: var chosen = (offset+$startcount)+7*(count-1);
11729: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11730: var currtype = form.elements[depitem].type;
11731: if (form.elements[chosen].value == 'dependency') {
11732: document.getElementById('arc_depon_'+count).style.display='block';
11733: form.elements[depitem].options.length = 0;
11734: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 11735: for (var i=1; i<=numitems; i++) {
11736: if (i == count) {
11737: continue;
11738: }
1.1059 raeburn 11739: var startelement = $startcount + (i-1) * 7;
11740: for (var j=1; j<6; j++) {
11741: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11742: var item = startelement + j;
11743: if (form.elements[item].type == 'radio') {
11744: if (form.elements[item].checked) {
11745: if (form.elements[item].value == 'display') {
11746: var n = form.elements[depitem].options.length;
11747: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11748: }
11749: }
11750: }
11751: }
11752: }
11753: }
11754: } else {
11755: document.getElementById('arc_depon_'+count).style.display='none';
11756: form.elements[depitem].options.length = 0;
11757: form.elements[depitem].options[0] = new Option('Select','',true,true);
11758: }
1.1059 raeburn 11759: titleCheck(form,count,offset);
1.1056 raeburn 11760: }
11761: }
11762:
11763: function propagateSelect(form,count,offset) {
11764: if (count > 0) {
1.1065 raeburn 11765: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11766: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11767: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11768: if (parents[count].length > 0) {
11769: for (var j=0; j<parents[count].length; j++) {
11770: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11771: }
11772: }
11773: }
11774: }
11775: }
1.1056 raeburn 11776:
11777: function containerSelect(form,count,offset,picked) {
11778: if (count > 0) {
1.1065 raeburn 11779: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11780: if (form.elements[item].type == 'radio') {
11781: if (form.elements[item].value == 'dependency') {
11782: if (form.elements[item+1].type == 'select-one') {
11783: for (var i=0; i<form.elements[item+1].options.length; i++) {
11784: if (form.elements[item+1].options[i].value == picked) {
11785: form.elements[item+1].selectedIndex = i;
11786: break;
11787: }
11788: }
11789: }
11790: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11791: if (parents[count].length > 0) {
11792: for (var j=0; j<parents[count].length; j++) {
11793: containerSelect(form,parents[count][j],offset,picked);
11794: }
11795: }
11796: }
11797: }
11798: }
11799: }
11800: }
11801:
1.1059 raeburn 11802: function titleCheck(form,count,offset) {
11803: if (count > 0) {
11804: var chosen = (offset+$startcount)+7*(count-1);
11805: var depitem = $startcount + ((count-1) * 7) + 2;
11806: var currtype = form.elements[depitem].type;
11807: if (form.elements[chosen].value == 'display') {
11808: document.getElementById('arc_title_'+count).style.display='block';
11809: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11810: document.getElementById('archive_title_'+count).value=maintitle;
11811: }
11812: } else {
11813: document.getElementById('arc_title_'+count).style.display='none';
11814: if (currtype == 'text') {
11815: document.getElementById('archive_title_'+count).value='';
11816: }
11817: }
11818: }
11819: return;
11820: }
11821:
1.1055 raeburn 11822: // ]]>
11823: </script>
11824: END
11825: return $scripttag;
11826: }
11827:
11828: sub process_extracted_files {
1.1067 raeburn 11829: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11830: my $numitems = $env{'form.archive_count'};
11831: return unless ($numitems);
11832: my @ids=&Apache::lonnet::current_machine_ids();
11833: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11834: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11835: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11836: if (grep(/^\Q$docuhome\E$/,@ids)) {
11837: $prefix = &LONCAPA::propath($docudom,$docuname);
11838: $pathtocheck = "$dir_root/$destination";
11839: $dir = $dir_root;
11840: $ishome = 1;
11841: } else {
11842: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11843: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11844: $dir = "$dir_root/$docudom/$docuname";
11845: }
11846: my $currdir = "$dir_root/$destination";
11847: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11848: if ($env{'form.folderpath'}) {
11849: my @items = split('&',$env{'form.folderpath'});
11850: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 11851: if ($env{'form.folderpath'} =~ /\:1$/) {
11852: $containers{'0'}='page';
11853: } else {
11854: $containers{'0'}='sequence';
11855: }
1.1055 raeburn 11856: }
11857: my @archdirs = &get_env_multiple('form.archive_directory');
11858: if ($numitems) {
11859: for (my $i=1; $i<=$numitems; $i++) {
11860: my $path = $env{'form.archive_content_'.$i};
11861: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11862: my $item = $1;
11863: $toplevelitems{$item} = $i;
11864: if (grep(/^\Q$i\E$/,@archdirs)) {
11865: $is_dir{$item} = 1;
11866: }
11867: }
11868: }
11869: }
1.1067 raeburn 11870: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11871: if (keys(%toplevelitems) > 0) {
11872: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11873: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11874: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11875: }
1.1066 raeburn 11876: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11877: if ($numitems) {
11878: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 11879: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11880: my $path = $env{'form.archive_content_'.$i};
11881: if ($path =~ /^\Q$pathtocheck\E/) {
11882: if ($env{'form.archive_'.$i} eq 'discard') {
11883: if ($prefix ne '' && $path ne '') {
11884: if (-e $prefix.$path) {
1.1066 raeburn 11885: if ((@archdirs > 0) &&
11886: (grep(/^\Q$i\E$/,@archdirs))) {
11887: $todeletedir{$prefix.$path} = 1;
11888: } else {
11889: $todelete{$prefix.$path} = 1;
11890: }
1.1055 raeburn 11891: }
11892: }
11893: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 11894: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 11895: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 11896: $docstitle = $env{'form.archive_title_'.$i};
11897: if ($docstitle eq '') {
11898: $docstitle = $title;
11899: }
1.1055 raeburn 11900: $outer = 0;
1.1056 raeburn 11901: if (ref($dirorder{$i}) eq 'ARRAY') {
11902: if (@{$dirorder{$i}} > 0) {
11903: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 11904: if ($env{'form.archive_'.$item} eq 'display') {
11905: $outer = $item;
11906: last;
11907: }
11908: }
11909: }
11910: }
11911: my ($errtext,$fatal) =
11912: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
11913: '/'.$folders{$outer}.'.'.
11914: $containers{$outer});
11915: next if ($fatal);
11916: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
11917: if ($context eq 'coursedocs') {
1.1056 raeburn 11918: $mapinner{$i} = time;
1.1055 raeburn 11919: $folders{$i} = 'default_'.$mapinner{$i};
11920: $containers{$i} = 'sequence';
11921: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11922: $folders{$i}.'.'.$containers{$i};
11923: my $newidx = &LONCAPA::map::getresidx();
11924: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11925: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11926: push(@LONCAPA::map::order,$newidx);
11927: my ($outtext,$errtext) =
11928: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11929: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 11930: '.'.$containers{$outer},1,1);
1.1056 raeburn 11931: $newseqid{$i} = $newidx;
1.1067 raeburn 11932: unless ($errtext) {
11933: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
11934: }
1.1055 raeburn 11935: }
11936: } else {
11937: if ($context eq 'coursedocs') {
11938: my $newidx=&LONCAPA::map::getresidx();
11939: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11940: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
11941: $title;
11942: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
11943: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
11944: }
11945: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11946: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
11947: }
11948: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11949: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 11950: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 11951: unless ($ishome) {
11952: my $fetch = "$newdest{$i}/$title";
11953: $fetch =~ s/^\Q$prefix$dir\E//;
11954: $prompttofetch{$fetch} = 1;
11955: }
1.1055 raeburn 11956: }
11957: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11958: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11959: push(@LONCAPA::map::order, $newidx);
11960: my ($outtext,$errtext)=
11961: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11962: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 11963: '.'.$containers{$outer},1,1);
1.1067 raeburn 11964: unless ($errtext) {
11965: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
11966: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
11967: }
11968: }
1.1055 raeburn 11969: }
11970: }
1.1075.2.11 raeburn 11971: }
11972: } else {
11973: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11974: }
11975: }
11976: for (my $i=1; $i<=$numitems; $i++) {
11977: next unless ($env{'form.archive_'.$i} eq 'dependency');
11978: my $path = $env{'form.archive_content_'.$i};
11979: if ($path =~ /^\Q$pathtocheck\E/) {
11980: my ($title) = ($path =~ m{/([^/]+)$});
11981: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
11982: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
11983: if (ref($dirorder{$i}) eq 'ARRAY') {
11984: my ($itemidx,$fullpath,$relpath);
11985: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
11986: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 11987: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 11988: if ($dirorder{$i}->[$j] eq $container) {
11989: $itemidx = $j;
1.1056 raeburn 11990: }
11991: }
1.1075.2.11 raeburn 11992: }
11993: if ($itemidx eq '') {
11994: $itemidx = 0;
11995: }
11996: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
11997: if ($mapinner{$referrer{$i}}) {
11998: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
11999: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12000: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12001: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12002: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12003: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12004: if (!-e $fullpath) {
12005: mkdir($fullpath,0755);
1.1056 raeburn 12006: }
12007: }
1.1075.2.11 raeburn 12008: } else {
12009: last;
1.1056 raeburn 12010: }
1.1075.2.11 raeburn 12011: }
12012: }
12013: } elsif ($newdest{$referrer{$i}}) {
12014: $fullpath = $newdest{$referrer{$i}};
12015: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12016: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12017: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12018: last;
12019: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12020: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12021: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12022: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12023: if (!-e $fullpath) {
12024: mkdir($fullpath,0755);
1.1056 raeburn 12025: }
12026: }
1.1075.2.11 raeburn 12027: } else {
12028: last;
1.1056 raeburn 12029: }
1.1075.2.11 raeburn 12030: }
12031: }
12032: if ($fullpath ne '') {
12033: if (-e "$prefix$path") {
12034: system("mv $prefix$path $fullpath/$title");
12035: }
12036: if (-e "$fullpath/$title") {
12037: my $showpath;
12038: if ($relpath ne '') {
12039: $showpath = "$relpath/$title";
12040: } else {
12041: $showpath = "/$title";
1.1056 raeburn 12042: }
1.1075.2.11 raeburn 12043: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12044: }
12045: unless ($ishome) {
12046: my $fetch = "$fullpath/$title";
12047: $fetch =~ s/^\Q$prefix$dir\E//;
12048: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12049: }
12050: }
12051: }
1.1075.2.11 raeburn 12052: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12053: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12054: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12055: }
12056: } else {
1.1075.2.11 raeburn 12057: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12058: }
12059: }
12060: if (keys(%todelete)) {
12061: foreach my $key (keys(%todelete)) {
12062: unlink($key);
1.1066 raeburn 12063: }
12064: }
12065: if (keys(%todeletedir)) {
12066: foreach my $key (keys(%todeletedir)) {
12067: rmdir($key);
12068: }
12069: }
12070: foreach my $dir (sort(keys(%is_dir))) {
12071: if (($pathtocheck ne '') && ($dir ne '')) {
12072: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12073: }
12074: }
1.1067 raeburn 12075: if ($result ne '') {
12076: $output .= '<ul>'."\n".
12077: $result."\n".
12078: '</ul>';
12079: }
12080: unless ($ishome) {
12081: my $replicationfail;
12082: foreach my $item (keys(%prompttofetch)) {
12083: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12084: unless ($fetchresult eq 'ok') {
12085: $replicationfail .= '<li>'.$item.'</li>'."\n";
12086: }
12087: }
12088: if ($replicationfail) {
12089: $output .= '<p class="LC_error">'.
12090: &mt('Course home server failed to retrieve:').'<ul>'.
12091: $replicationfail.
12092: '</ul></p>';
12093: }
12094: }
1.1055 raeburn 12095: } else {
12096: $warning = &mt('No items found in archive.');
12097: }
12098: if ($error) {
12099: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12100: $error.'</p>'."\n";
12101: }
12102: if ($warning) {
12103: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12104: }
12105: return $output;
12106: }
12107:
1.1066 raeburn 12108: sub cleanup_empty_dirs {
12109: my ($path) = @_;
12110: if (($path ne '') && (-d $path)) {
12111: if (opendir(my $dirh,$path)) {
12112: my @dircontents = grep(!/^\./,readdir($dirh));
12113: my $numitems = 0;
12114: foreach my $item (@dircontents) {
12115: if (-d "$path/$item") {
1.1075.2.28 raeburn 12116: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12117: if (-e "$path/$item") {
12118: $numitems ++;
12119: }
12120: } else {
12121: $numitems ++;
12122: }
12123: }
12124: if ($numitems == 0) {
12125: rmdir($path);
12126: }
12127: closedir($dirh);
12128: }
12129: }
12130: return;
12131: }
12132:
1.41 ng 12133: =pod
1.45 matthew 12134:
1.1075.2.56 raeburn 12135: =item * &get_folder_hierarchy()
1.1068 raeburn 12136:
12137: Provides hierarchy of names of folders/sub-folders containing the current
12138: item,
12139:
12140: Inputs: 3
12141: - $navmap - navmaps object
12142:
12143: - $map - url for map (either the trigger itself, or map containing
12144: the resource, which is the trigger).
12145:
12146: - $showitem - 1 => show title for map itself; 0 => do not show.
12147:
12148: Outputs: 1 @pathitems - array of folder/subfolder names.
12149:
12150: =cut
12151:
12152: sub get_folder_hierarchy {
12153: my ($navmap,$map,$showitem) = @_;
12154: my @pathitems;
12155: if (ref($navmap)) {
12156: my $mapres = $navmap->getResourceByUrl($map);
12157: if (ref($mapres)) {
12158: my $pcslist = $mapres->map_hierarchy();
12159: if ($pcslist ne '') {
12160: my @pcs = split(/,/,$pcslist);
12161: foreach my $pc (@pcs) {
12162: if ($pc == 1) {
1.1075.2.38 raeburn 12163: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12164: } else {
12165: my $res = $navmap->getByMapPc($pc);
12166: if (ref($res)) {
12167: my $title = $res->compTitle();
12168: $title =~ s/\W+/_/g;
12169: if ($title ne '') {
12170: push(@pathitems,$title);
12171: }
12172: }
12173: }
12174: }
12175: }
1.1071 raeburn 12176: if ($showitem) {
12177: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12178: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12179: } else {
12180: my $maptitle = $mapres->compTitle();
12181: $maptitle =~ s/\W+/_/g;
12182: if ($maptitle ne '') {
12183: push(@pathitems,$maptitle);
12184: }
1.1068 raeburn 12185: }
12186: }
12187: }
12188: }
12189: return @pathitems;
12190: }
12191:
12192: =pod
12193:
1.1015 raeburn 12194: =item * &get_turnedin_filepath()
12195:
12196: Determines path in a user's portfolio file for storage of files uploaded
12197: to a specific essayresponse or dropbox item.
12198:
12199: Inputs: 3 required + 1 optional.
12200: $symb is symb for resource, $uname and $udom are for current user (required).
12201: $caller is optional (can be "submission", if routine is called when storing
12202: an upoaded file when "Submit Answer" button was pressed).
12203:
12204: Returns array containing $path and $multiresp.
12205: $path is path in portfolio. $multiresp is 1 if this resource contains more
12206: than one file upload item. Callers of routine should append partid as a
12207: subdirectory to $path in cases where $multiresp is 1.
12208:
12209: Called by: homework/essayresponse.pm and homework/structuretags.pm
12210:
12211: =cut
12212:
12213: sub get_turnedin_filepath {
12214: my ($symb,$uname,$udom,$caller) = @_;
12215: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12216: my $turnindir;
12217: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12218: $turnindir = $userhash{'turnindir'};
12219: my ($path,$multiresp);
12220: if ($turnindir eq '') {
12221: if ($caller eq 'submission') {
12222: $turnindir = &mt('turned in');
12223: $turnindir =~ s/\W+/_/g;
12224: my %newhash = (
12225: 'turnindir' => $turnindir,
12226: );
12227: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12228: }
12229: }
12230: if ($turnindir ne '') {
12231: $path = '/'.$turnindir.'/';
12232: my ($multipart,$turnin,@pathitems);
12233: my $navmap = Apache::lonnavmaps::navmap->new();
12234: if (defined($navmap)) {
12235: my $mapres = $navmap->getResourceByUrl($map);
12236: if (ref($mapres)) {
12237: my $pcslist = $mapres->map_hierarchy();
12238: if ($pcslist ne '') {
12239: foreach my $pc (split(/,/,$pcslist)) {
12240: my $res = $navmap->getByMapPc($pc);
12241: if (ref($res)) {
12242: my $title = $res->compTitle();
12243: $title =~ s/\W+/_/g;
12244: if ($title ne '') {
1.1075.2.48 raeburn 12245: if (($pc > 1) && (length($title) > 12)) {
12246: $title = substr($title,0,12);
12247: }
1.1015 raeburn 12248: push(@pathitems,$title);
12249: }
12250: }
12251: }
12252: }
12253: my $maptitle = $mapres->compTitle();
12254: $maptitle =~ s/\W+/_/g;
12255: if ($maptitle ne '') {
1.1075.2.48 raeburn 12256: if (length($maptitle) > 12) {
12257: $maptitle = substr($maptitle,0,12);
12258: }
1.1015 raeburn 12259: push(@pathitems,$maptitle);
12260: }
12261: unless ($env{'request.state'} eq 'construct') {
12262: my $res = $navmap->getBySymb($symb);
12263: if (ref($res)) {
12264: my $partlist = $res->parts();
12265: my $totaluploads = 0;
12266: if (ref($partlist) eq 'ARRAY') {
12267: foreach my $part (@{$partlist}) {
12268: my @types = $res->responseType($part);
12269: my @ids = $res->responseIds($part);
12270: for (my $i=0; $i < scalar(@ids); $i++) {
12271: if ($types[$i] eq 'essay') {
12272: my $partid = $part.'_'.$ids[$i];
12273: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12274: $totaluploads ++;
12275: }
12276: }
12277: }
12278: }
12279: if ($totaluploads > 1) {
12280: $multiresp = 1;
12281: }
12282: }
12283: }
12284: }
12285: } else {
12286: return;
12287: }
12288: } else {
12289: return;
12290: }
12291: my $restitle=&Apache::lonnet::gettitle($symb);
12292: $restitle =~ s/\W+/_/g;
12293: if ($restitle eq '') {
12294: $restitle = ($resurl =~ m{/[^/]+$});
12295: if ($restitle eq '') {
12296: $restitle = time;
12297: }
12298: }
1.1075.2.48 raeburn 12299: if (length($restitle) > 12) {
12300: $restitle = substr($restitle,0,12);
12301: }
1.1015 raeburn 12302: push(@pathitems,$restitle);
12303: $path .= join('/',@pathitems);
12304: }
12305: return ($path,$multiresp);
12306: }
12307:
12308: =pod
12309:
1.464 albertel 12310: =back
1.41 ng 12311:
1.112 bowersj2 12312: =head1 CSV Upload/Handling functions
1.38 albertel 12313:
1.41 ng 12314: =over 4
12315:
1.648 raeburn 12316: =item * &upfile_store($r)
1.41 ng 12317:
12318: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12319: needs $env{'form.upfile'}
1.41 ng 12320: returns $datatoken to be put into hidden field
12321:
12322: =cut
1.31 albertel 12323:
12324: sub upfile_store {
12325: my $r=shift;
1.258 albertel 12326: $env{'form.upfile'}=~s/\r/\n/gs;
12327: $env{'form.upfile'}=~s/\f/\n/gs;
12328: $env{'form.upfile'}=~s/\n+/\n/gs;
12329: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12330:
1.258 albertel 12331: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12332: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12333: {
1.158 raeburn 12334: my $datafile = $r->dir_config('lonDaemons').
12335: '/tmp/'.$datatoken.'.tmp';
12336: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12337: print $fh $env{'form.upfile'};
1.158 raeburn 12338: close($fh);
12339: }
1.31 albertel 12340: }
12341: return $datatoken;
12342: }
12343:
1.56 matthew 12344: =pod
12345:
1.648 raeburn 12346: =item * &load_tmp_file($r)
1.41 ng 12347:
12348: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12349: needs $env{'form.datatoken'},
12350: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12351:
12352: =cut
1.31 albertel 12353:
12354: sub load_tmp_file {
12355: my $r=shift;
12356: my @studentdata=();
12357: {
1.158 raeburn 12358: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12359: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12360: if ( open(my $fh,"<$studentfile") ) {
12361: @studentdata=<$fh>;
12362: close($fh);
12363: }
1.31 albertel 12364: }
1.258 albertel 12365: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12366: }
12367:
1.56 matthew 12368: =pod
12369:
1.648 raeburn 12370: =item * &upfile_record_sep()
1.41 ng 12371:
12372: Separate uploaded file into records
12373: returns array of records,
1.258 albertel 12374: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12375:
12376: =cut
1.31 albertel 12377:
12378: sub upfile_record_sep {
1.258 albertel 12379: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12380: } else {
1.248 albertel 12381: my @records;
1.258 albertel 12382: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12383: if ($line=~/^\s*$/) { next; }
12384: push(@records,$line);
12385: }
12386: return @records;
1.31 albertel 12387: }
12388: }
12389:
1.56 matthew 12390: =pod
12391:
1.648 raeburn 12392: =item * &record_sep($record)
1.41 ng 12393:
1.258 albertel 12394: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12395:
12396: =cut
12397:
1.263 www 12398: sub takeleft {
12399: my $index=shift;
12400: return substr('0000'.$index,-4,4);
12401: }
12402:
1.31 albertel 12403: sub record_sep {
12404: my $record=shift;
12405: my %components=();
1.258 albertel 12406: if ($env{'form.upfiletype'} eq 'xml') {
12407: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12408: my $i=0;
1.356 albertel 12409: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12410: $field=~s/^(\"|\')//;
12411: $field=~s/(\"|\')$//;
1.263 www 12412: $components{&takeleft($i)}=$field;
1.31 albertel 12413: $i++;
12414: }
1.258 albertel 12415: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12416: my $i=0;
1.356 albertel 12417: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12418: $field=~s/^(\"|\')//;
12419: $field=~s/(\"|\')$//;
1.263 www 12420: $components{&takeleft($i)}=$field;
1.31 albertel 12421: $i++;
12422: }
12423: } else {
1.561 www 12424: my $separator=',';
1.480 banghart 12425: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12426: $separator=';';
1.480 banghart 12427: }
1.31 albertel 12428: my $i=0;
1.561 www 12429: # the character we are looking for to indicate the end of a quote or a record
12430: my $looking_for=$separator;
12431: # do not add the characters to the fields
12432: my $ignore=0;
12433: # we just encountered a separator (or the beginning of the record)
12434: my $just_found_separator=1;
12435: # store the field we are working on here
12436: my $field='';
12437: # work our way through all characters in record
12438: foreach my $character ($record=~/(.)/g) {
12439: if ($character eq $looking_for) {
12440: if ($character ne $separator) {
12441: # Found the end of a quote, again looking for separator
12442: $looking_for=$separator;
12443: $ignore=1;
12444: } else {
12445: # Found a separator, store away what we got
12446: $components{&takeleft($i)}=$field;
12447: $i++;
12448: $just_found_separator=1;
12449: $ignore=0;
12450: $field='';
12451: }
12452: next;
12453: }
12454: # single or double quotation marks after a separator indicate beginning of a quote
12455: # we are now looking for the end of the quote and need to ignore separators
12456: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12457: $looking_for=$character;
12458: next;
12459: }
12460: # ignore would be true after we reached the end of a quote
12461: if ($ignore) { next; }
12462: if (($just_found_separator) && ($character=~/\s/)) { next; }
12463: $field.=$character;
12464: $just_found_separator=0;
1.31 albertel 12465: }
1.561 www 12466: # catch the very last entry, since we never encountered the separator
12467: $components{&takeleft($i)}=$field;
1.31 albertel 12468: }
12469: return %components;
12470: }
12471:
1.144 matthew 12472: ######################################################
12473: ######################################################
12474:
1.56 matthew 12475: =pod
12476:
1.648 raeburn 12477: =item * &upfile_select_html()
1.41 ng 12478:
1.144 matthew 12479: Return HTML code to select a file from the users machine and specify
12480: the file type.
1.41 ng 12481:
12482: =cut
12483:
1.144 matthew 12484: ######################################################
12485: ######################################################
1.31 albertel 12486: sub upfile_select_html {
1.144 matthew 12487: my %Types = (
12488: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12489: semisv => &mt('Semicolon separated values'),
1.144 matthew 12490: space => &mt('Space separated'),
12491: tab => &mt('Tabulator separated'),
12492: # xml => &mt('HTML/XML'),
12493: );
12494: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12495: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12496: foreach my $type (sort(keys(%Types))) {
12497: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12498: }
12499: $Str .= "</select>\n";
12500: return $Str;
1.31 albertel 12501: }
12502:
1.301 albertel 12503: sub get_samples {
12504: my ($records,$toget) = @_;
12505: my @samples=({});
12506: my $got=0;
12507: foreach my $rec (@$records) {
12508: my %temp = &record_sep($rec);
12509: if (! grep(/\S/, values(%temp))) { next; }
12510: if (%temp) {
12511: $samples[$got]=\%temp;
12512: $got++;
12513: if ($got == $toget) { last; }
12514: }
12515: }
12516: return \@samples;
12517: }
12518:
1.144 matthew 12519: ######################################################
12520: ######################################################
12521:
1.56 matthew 12522: =pod
12523:
1.648 raeburn 12524: =item * &csv_print_samples($r,$records)
1.41 ng 12525:
12526: Prints a table of sample values from each column uploaded $r is an
12527: Apache Request ref, $records is an arrayref from
12528: &Apache::loncommon::upfile_record_sep
12529:
12530: =cut
12531:
1.144 matthew 12532: ######################################################
12533: ######################################################
1.31 albertel 12534: sub csv_print_samples {
12535: my ($r,$records) = @_;
1.662 bisitz 12536: my $samples = &get_samples($records,5);
1.301 albertel 12537:
1.594 raeburn 12538: $r->print(&mt('Samples').'<br />'.&start_data_table().
12539: &start_data_table_header_row());
1.356 albertel 12540: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12541: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12542: $r->print(&end_data_table_header_row());
1.301 albertel 12543: foreach my $hash (@$samples) {
1.594 raeburn 12544: $r->print(&start_data_table_row());
1.356 albertel 12545: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12546: $r->print('<td>');
1.356 albertel 12547: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12548: $r->print('</td>');
12549: }
1.594 raeburn 12550: $r->print(&end_data_table_row());
1.31 albertel 12551: }
1.594 raeburn 12552: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12553: }
12554:
1.144 matthew 12555: ######################################################
12556: ######################################################
12557:
1.56 matthew 12558: =pod
12559:
1.648 raeburn 12560: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12561:
12562: Prints a table to create associations between values and table columns.
1.144 matthew 12563:
1.41 ng 12564: $r is an Apache Request ref,
12565: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12566: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12567:
12568: =cut
12569:
1.144 matthew 12570: ######################################################
12571: ######################################################
1.31 albertel 12572: sub csv_print_select_table {
12573: my ($r,$records,$d) = @_;
1.301 albertel 12574: my $i=0;
12575: my $samples = &get_samples($records,1);
1.144 matthew 12576: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12577: &start_data_table().&start_data_table_header_row().
1.144 matthew 12578: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12579: '<th>'.&mt('Column').'</th>'.
12580: &end_data_table_header_row()."\n");
1.356 albertel 12581: foreach my $array_ref (@$d) {
12582: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12583: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12584:
1.875 bisitz 12585: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12586: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12587: $r->print('<option value="none"></option>');
1.356 albertel 12588: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12589: $r->print('<option value="'.$sample.'"'.
12590: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12591: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12592: }
1.594 raeburn 12593: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12594: $i++;
12595: }
1.594 raeburn 12596: $r->print(&end_data_table());
1.31 albertel 12597: $i--;
12598: return $i;
12599: }
1.56 matthew 12600:
1.144 matthew 12601: ######################################################
12602: ######################################################
12603:
1.56 matthew 12604: =pod
1.31 albertel 12605:
1.648 raeburn 12606: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12607:
12608: Prints a table of sample values from the upload and can make associate samples to internal names.
12609:
12610: $r is an Apache Request ref,
12611: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12612: $d is an array of 2 element arrays (internal name, displayed name)
12613:
12614: =cut
12615:
1.144 matthew 12616: ######################################################
12617: ######################################################
1.31 albertel 12618: sub csv_samples_select_table {
12619: my ($r,$records,$d) = @_;
12620: my $i=0;
1.144 matthew 12621: #
1.662 bisitz 12622: my $max_samples = 5;
12623: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12624: $r->print(&start_data_table().
12625: &start_data_table_header_row().'<th>'.
12626: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12627: &end_data_table_header_row());
1.301 albertel 12628:
12629: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12630: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12631: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12632: foreach my $option (@$d) {
12633: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12634: $r->print('<option value="'.$value.'"'.
1.253 albertel 12635: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12636: $display.'</option>');
1.31 albertel 12637: }
12638: $r->print('</select></td><td>');
1.662 bisitz 12639: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12640: if (defined($samples->[$line]{$key})) {
12641: $r->print($samples->[$line]{$key}."<br />\n");
12642: }
12643: }
1.594 raeburn 12644: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12645: $i++;
12646: }
1.594 raeburn 12647: $r->print(&end_data_table());
1.31 albertel 12648: $i--;
12649: return($i);
1.115 matthew 12650: }
12651:
1.144 matthew 12652: ######################################################
12653: ######################################################
12654:
1.115 matthew 12655: =pod
12656:
1.648 raeburn 12657: =item * &clean_excel_name($name)
1.115 matthew 12658:
12659: Returns a replacement for $name which does not contain any illegal characters.
12660:
12661: =cut
12662:
1.144 matthew 12663: ######################################################
12664: ######################################################
1.115 matthew 12665: sub clean_excel_name {
12666: my ($name) = @_;
12667: $name =~ s/[:\*\?\/\\]//g;
12668: if (length($name) > 31) {
12669: $name = substr($name,0,31);
12670: }
12671: return $name;
1.25 albertel 12672: }
1.84 albertel 12673:
1.85 albertel 12674: =pod
12675:
1.648 raeburn 12676: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12677:
12678: Returns either 1 or undef
12679:
12680: 1 if the part is to be hidden, undef if it is to be shown
12681:
12682: Arguments are:
12683:
12684: $id the id of the part to be checked
12685: $symb, optional the symb of the resource to check
12686: $udom, optional the domain of the user to check for
12687: $uname, optional the username of the user to check for
12688:
12689: =cut
1.84 albertel 12690:
12691: sub check_if_partid_hidden {
12692: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12693: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12694: $symb,$udom,$uname);
1.141 albertel 12695: my $truth=1;
12696: #if the string starts with !, then the list is the list to show not hide
12697: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12698: my @hiddenlist=split(/,/,$hiddenparts);
12699: foreach my $checkid (@hiddenlist) {
1.141 albertel 12700: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12701: }
1.141 albertel 12702: return !$truth;
1.84 albertel 12703: }
1.127 matthew 12704:
1.138 matthew 12705:
12706: ############################################################
12707: ############################################################
12708:
12709: =pod
12710:
1.157 matthew 12711: =back
12712:
1.138 matthew 12713: =head1 cgi-bin script and graphing routines
12714:
1.157 matthew 12715: =over 4
12716:
1.648 raeburn 12717: =item * &get_cgi_id()
1.138 matthew 12718:
12719: Inputs: none
12720:
12721: Returns an id which can be used to pass environment variables
12722: to various cgi-bin scripts. These environment variables will
12723: be removed from the users environment after a given time by
12724: the routine &Apache::lonnet::transfer_profile_to_env.
12725:
12726: =cut
12727:
12728: ############################################################
12729: ############################################################
1.152 albertel 12730: my $uniq=0;
1.136 matthew 12731: sub get_cgi_id {
1.154 albertel 12732: $uniq=($uniq+1)%100000;
1.280 albertel 12733: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12734: }
12735:
1.127 matthew 12736: ############################################################
12737: ############################################################
12738:
12739: =pod
12740:
1.648 raeburn 12741: =item * &DrawBarGraph()
1.127 matthew 12742:
1.138 matthew 12743: Facilitates the plotting of data in a (stacked) bar graph.
12744: Puts plot definition data into the users environment in order for
12745: graph.png to plot it. Returns an <img> tag for the plot.
12746: The bars on the plot are labeled '1','2',...,'n'.
12747:
12748: Inputs:
12749:
12750: =over 4
12751:
12752: =item $Title: string, the title of the plot
12753:
12754: =item $xlabel: string, text describing the X-axis of the plot
12755:
12756: =item $ylabel: string, text describing the Y-axis of the plot
12757:
12758: =item $Max: scalar, the maximum Y value to use in the plot
12759: If $Max is < any data point, the graph will not be rendered.
12760:
1.140 matthew 12761: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12762: they are plotted. If undefined, default values will be used.
12763:
1.178 matthew 12764: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12765:
1.138 matthew 12766: =item @Values: An array of array references. Each array reference holds data
12767: to be plotted in a stacked bar chart.
12768:
1.239 matthew 12769: =item If the final element of @Values is a hash reference the key/value
12770: pairs will be added to the graph definition.
12771:
1.138 matthew 12772: =back
12773:
12774: Returns:
12775:
12776: An <img> tag which references graph.png and the appropriate identifying
12777: information for the plot.
12778:
1.127 matthew 12779: =cut
12780:
12781: ############################################################
12782: ############################################################
1.134 matthew 12783: sub DrawBarGraph {
1.178 matthew 12784: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12785: #
12786: if (! defined($colors)) {
12787: $colors = ['#33ff00',
12788: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12789: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12790: ];
12791: }
1.228 matthew 12792: my $extra_settings = {};
12793: if (ref($Values[-1]) eq 'HASH') {
12794: $extra_settings = pop(@Values);
12795: }
1.127 matthew 12796: #
1.136 matthew 12797: my $identifier = &get_cgi_id();
12798: my $id = 'cgi.'.$identifier;
1.129 matthew 12799: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12800: return '';
12801: }
1.225 matthew 12802: #
12803: my @Labels;
12804: if (defined($labels)) {
12805: @Labels = @$labels;
12806: } else {
12807: for (my $i=0;$i<@{$Values[0]};$i++) {
12808: push (@Labels,$i+1);
12809: }
12810: }
12811: #
1.129 matthew 12812: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12813: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12814: my %ValuesHash;
12815: my $NumSets=1;
12816: foreach my $array (@Values) {
12817: next if (! ref($array));
1.136 matthew 12818: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12819: join(',',@$array);
1.129 matthew 12820: }
1.127 matthew 12821: #
1.136 matthew 12822: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12823: if ($NumBars < 3) {
12824: $width = 120+$NumBars*32;
1.220 matthew 12825: $xskip = 1;
1.225 matthew 12826: $bar_width = 30;
12827: } elsif ($NumBars < 5) {
12828: $width = 120+$NumBars*20;
12829: $xskip = 1;
12830: $bar_width = 20;
1.220 matthew 12831: } elsif ($NumBars < 10) {
1.136 matthew 12832: $width = 120+$NumBars*15;
12833: $xskip = 1;
12834: $bar_width = 15;
12835: } elsif ($NumBars <= 25) {
12836: $width = 120+$NumBars*11;
12837: $xskip = 5;
12838: $bar_width = 8;
12839: } elsif ($NumBars <= 50) {
12840: $width = 120+$NumBars*8;
12841: $xskip = 5;
12842: $bar_width = 4;
12843: } else {
12844: $width = 120+$NumBars*8;
12845: $xskip = 5;
12846: $bar_width = 4;
12847: }
12848: #
1.137 matthew 12849: $Max = 1 if ($Max < 1);
12850: if ( int($Max) < $Max ) {
12851: $Max++;
12852: $Max = int($Max);
12853: }
1.127 matthew 12854: $Title = '' if (! defined($Title));
12855: $xlabel = '' if (! defined($xlabel));
12856: $ylabel = '' if (! defined($ylabel));
1.369 www 12857: $ValuesHash{$id.'.title'} = &escape($Title);
12858: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12859: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12860: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12861: $ValuesHash{$id.'.NumBars'} = $NumBars;
12862: $ValuesHash{$id.'.NumSets'} = $NumSets;
12863: $ValuesHash{$id.'.PlotType'} = 'bar';
12864: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12865: $ValuesHash{$id.'.height'} = $height;
12866: $ValuesHash{$id.'.width'} = $width;
12867: $ValuesHash{$id.'.xskip'} = $xskip;
12868: $ValuesHash{$id.'.bar_width'} = $bar_width;
12869: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12870: #
1.228 matthew 12871: # Deal with other parameters
12872: while (my ($key,$value) = each(%$extra_settings)) {
12873: $ValuesHash{$id.'.'.$key} = $value;
12874: }
12875: #
1.646 raeburn 12876: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12877: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12878: }
12879:
12880: ############################################################
12881: ############################################################
12882:
12883: =pod
12884:
1.648 raeburn 12885: =item * &DrawXYGraph()
1.137 matthew 12886:
1.138 matthew 12887: Facilitates the plotting of data in an XY graph.
12888: Puts plot definition data into the users environment in order for
12889: graph.png to plot it. Returns an <img> tag for the plot.
12890:
12891: Inputs:
12892:
12893: =over 4
12894:
12895: =item $Title: string, the title of the plot
12896:
12897: =item $xlabel: string, text describing the X-axis of the plot
12898:
12899: =item $ylabel: string, text describing the Y-axis of the plot
12900:
12901: =item $Max: scalar, the maximum Y value to use in the plot
12902: If $Max is < any data point, the graph will not be rendered.
12903:
12904: =item $colors: Array ref containing the hex color codes for the data to be
12905: plotted in. If undefined, default values will be used.
12906:
12907: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12908:
12909: =item $Ydata: Array ref containing Array refs.
1.185 www 12910: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 12911:
12912: =item %Values: hash indicating or overriding any default values which are
12913: passed to graph.png.
12914: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12915:
12916: =back
12917:
12918: Returns:
12919:
12920: An <img> tag which references graph.png and the appropriate identifying
12921: information for the plot.
12922:
1.137 matthew 12923: =cut
12924:
12925: ############################################################
12926: ############################################################
12927: sub DrawXYGraph {
12928: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
12929: #
12930: # Create the identifier for the graph
12931: my $identifier = &get_cgi_id();
12932: my $id = 'cgi.'.$identifier;
12933: #
12934: $Title = '' if (! defined($Title));
12935: $xlabel = '' if (! defined($xlabel));
12936: $ylabel = '' if (! defined($ylabel));
12937: my %ValuesHash =
12938: (
1.369 www 12939: $id.'.title' => &escape($Title),
12940: $id.'.xlabel' => &escape($xlabel),
12941: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 12942: $id.'.y_max_value'=> $Max,
12943: $id.'.labels' => join(',',@$Xlabels),
12944: $id.'.PlotType' => 'XY',
12945: );
12946: #
12947: if (defined($colors) && ref($colors) eq 'ARRAY') {
12948: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12949: }
12950: #
12951: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
12952: return '';
12953: }
12954: my $NumSets=1;
1.138 matthew 12955: foreach my $array (@{$Ydata}){
1.137 matthew 12956: next if (! ref($array));
12957: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
12958: }
1.138 matthew 12959: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 12960: #
12961: # Deal with other parameters
12962: while (my ($key,$value) = each(%Values)) {
12963: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 12964: }
12965: #
1.646 raeburn 12966: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 12967: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12968: }
12969:
12970: ############################################################
12971: ############################################################
12972:
12973: =pod
12974:
1.648 raeburn 12975: =item * &DrawXYYGraph()
1.138 matthew 12976:
12977: Facilitates the plotting of data in an XY graph with two Y axes.
12978: Puts plot definition data into the users environment in order for
12979: graph.png to plot it. Returns an <img> tag for the plot.
12980:
12981: Inputs:
12982:
12983: =over 4
12984:
12985: =item $Title: string, the title of the plot
12986:
12987: =item $xlabel: string, text describing the X-axis of the plot
12988:
12989: =item $ylabel: string, text describing the Y-axis of the plot
12990:
12991: =item $colors: Array ref containing the hex color codes for the data to be
12992: plotted in. If undefined, default values will be used.
12993:
12994: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12995:
12996: =item $Ydata1: The first data set
12997:
12998: =item $Min1: The minimum value of the left Y-axis
12999:
13000: =item $Max1: The maximum value of the left Y-axis
13001:
13002: =item $Ydata2: The second data set
13003:
13004: =item $Min2: The minimum value of the right Y-axis
13005:
13006: =item $Max2: The maximum value of the left Y-axis
13007:
13008: =item %Values: hash indicating or overriding any default values which are
13009: passed to graph.png.
13010: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13011:
13012: =back
13013:
13014: Returns:
13015:
13016: An <img> tag which references graph.png and the appropriate identifying
13017: information for the plot.
1.136 matthew 13018:
13019: =cut
13020:
13021: ############################################################
13022: ############################################################
1.137 matthew 13023: sub DrawXYYGraph {
13024: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13025: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13026: #
13027: # Create the identifier for the graph
13028: my $identifier = &get_cgi_id();
13029: my $id = 'cgi.'.$identifier;
13030: #
13031: $Title = '' if (! defined($Title));
13032: $xlabel = '' if (! defined($xlabel));
13033: $ylabel = '' if (! defined($ylabel));
13034: my %ValuesHash =
13035: (
1.369 www 13036: $id.'.title' => &escape($Title),
13037: $id.'.xlabel' => &escape($xlabel),
13038: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13039: $id.'.labels' => join(',',@$Xlabels),
13040: $id.'.PlotType' => 'XY',
13041: $id.'.NumSets' => 2,
1.137 matthew 13042: $id.'.two_axes' => 1,
13043: $id.'.y1_max_value' => $Max1,
13044: $id.'.y1_min_value' => $Min1,
13045: $id.'.y2_max_value' => $Max2,
13046: $id.'.y2_min_value' => $Min2,
1.136 matthew 13047: );
13048: #
1.137 matthew 13049: if (defined($colors) && ref($colors) eq 'ARRAY') {
13050: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13051: }
13052: #
13053: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13054: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13055: return '';
13056: }
13057: my $NumSets=1;
1.137 matthew 13058: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13059: next if (! ref($array));
13060: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13061: }
13062: #
13063: # Deal with other parameters
13064: while (my ($key,$value) = each(%Values)) {
13065: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13066: }
13067: #
1.646 raeburn 13068: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13069: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13070: }
13071:
13072: ############################################################
13073: ############################################################
13074:
13075: =pod
13076:
1.157 matthew 13077: =back
13078:
1.139 matthew 13079: =head1 Statistics helper routines?
13080:
13081: Bad place for them but what the hell.
13082:
1.157 matthew 13083: =over 4
13084:
1.648 raeburn 13085: =item * &chartlink()
1.139 matthew 13086:
13087: Returns a link to the chart for a specific student.
13088:
13089: Inputs:
13090:
13091: =over 4
13092:
13093: =item $linktext: The text of the link
13094:
13095: =item $sname: The students username
13096:
13097: =item $sdomain: The students domain
13098:
13099: =back
13100:
1.157 matthew 13101: =back
13102:
1.139 matthew 13103: =cut
13104:
13105: ############################################################
13106: ############################################################
13107: sub chartlink {
13108: my ($linktext, $sname, $sdomain) = @_;
13109: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13110: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13111: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13112: '">'.$linktext.'</a>';
1.153 matthew 13113: }
13114:
13115: #######################################################
13116: #######################################################
13117:
13118: =pod
13119:
13120: =head1 Course Environment Routines
1.157 matthew 13121:
13122: =over 4
1.153 matthew 13123:
1.648 raeburn 13124: =item * &restore_course_settings()
1.153 matthew 13125:
1.648 raeburn 13126: =item * &store_course_settings()
1.153 matthew 13127:
13128: Restores/Store indicated form parameters from the course environment.
13129: Will not overwrite existing values of the form parameters.
13130:
13131: Inputs:
13132: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13133:
13134: a hash ref describing the data to be stored. For example:
13135:
13136: %Save_Parameters = ('Status' => 'scalar',
13137: 'chartoutputmode' => 'scalar',
13138: 'chartoutputdata' => 'scalar',
13139: 'Section' => 'array',
1.373 raeburn 13140: 'Group' => 'array',
1.153 matthew 13141: 'StudentData' => 'array',
13142: 'Maps' => 'array');
13143:
13144: Returns: both routines return nothing
13145:
1.631 raeburn 13146: =back
13147:
1.153 matthew 13148: =cut
13149:
13150: #######################################################
13151: #######################################################
13152: sub store_course_settings {
1.496 albertel 13153: return &store_settings($env{'request.course.id'},@_);
13154: }
13155:
13156: sub store_settings {
1.153 matthew 13157: # save to the environment
13158: # appenv the same items, just to be safe
1.300 albertel 13159: my $udom = $env{'user.domain'};
13160: my $uname = $env{'user.name'};
1.496 albertel 13161: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13162: my %SaveHash;
13163: my %AppHash;
13164: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13165: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13166: my $envname = 'environment.'.$basename;
1.258 albertel 13167: if (exists($env{'form.'.$setting})) {
1.153 matthew 13168: # Save this value away
13169: if ($type eq 'scalar' &&
1.258 albertel 13170: (! exists($env{$envname}) ||
13171: $env{$envname} ne $env{'form.'.$setting})) {
13172: $SaveHash{$basename} = $env{'form.'.$setting};
13173: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13174: } elsif ($type eq 'array') {
13175: my $stored_form;
1.258 albertel 13176: if (ref($env{'form.'.$setting})) {
1.153 matthew 13177: $stored_form = join(',',
13178: map {
1.369 www 13179: &escape($_);
1.258 albertel 13180: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13181: } else {
13182: $stored_form =
1.369 www 13183: &escape($env{'form.'.$setting});
1.153 matthew 13184: }
13185: # Determine if the array contents are the same.
1.258 albertel 13186: if ($stored_form ne $env{$envname}) {
1.153 matthew 13187: $SaveHash{$basename} = $stored_form;
13188: $AppHash{$envname} = $stored_form;
13189: }
13190: }
13191: }
13192: }
13193: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13194: $udom,$uname);
1.153 matthew 13195: if ($put_result !~ /^(ok|delayed)/) {
13196: &Apache::lonnet::logthis('unable to save form parameters, '.
13197: 'got error:'.$put_result);
13198: }
13199: # Make sure these settings stick around in this session, too
1.646 raeburn 13200: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13201: return;
13202: }
13203:
13204: sub restore_course_settings {
1.499 albertel 13205: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13206: }
13207:
13208: sub restore_settings {
13209: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13210: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13211: next if (exists($env{'form.'.$setting}));
1.496 albertel 13212: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13213: '.'.$setting;
1.258 albertel 13214: if (exists($env{$envname})) {
1.153 matthew 13215: if ($type eq 'scalar') {
1.258 albertel 13216: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13217: } elsif ($type eq 'array') {
1.258 albertel 13218: $env{'form.'.$setting} = [
1.153 matthew 13219: map {
1.369 www 13220: &unescape($_);
1.258 albertel 13221: } split(',',$env{$envname})
1.153 matthew 13222: ];
13223: }
13224: }
13225: }
1.127 matthew 13226: }
13227:
1.618 raeburn 13228: #######################################################
13229: #######################################################
13230:
13231: =pod
13232:
13233: =head1 Domain E-mail Routines
13234:
13235: =over 4
13236:
1.648 raeburn 13237: =item * &build_recipient_list()
1.618 raeburn 13238:
1.1075.2.44 raeburn 13239: Build recipient lists for following types of e-mail:
1.766 raeburn 13240: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13241: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13242: module change checking, student/employee ID conflict checks, as
13243: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13244: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13245:
13246: Inputs:
1.1075.2.44 raeburn 13247: defmail (scalar - email address of default recipient),
13248: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13249: requestsmail, updatesmail, or idconflictsmail).
13250:
1.619 raeburn 13251: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13252:
13253: origmail (scalar - email address of recipient from loncapa.conf,
13254: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13255:
1.655 raeburn 13256: Returns: comma separated list of addresses to which to send e-mail.
13257:
13258: =back
1.618 raeburn 13259:
13260: =cut
13261:
13262: ############################################################
13263: ############################################################
13264: sub build_recipient_list {
1.619 raeburn 13265: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13266: my @recipients;
13267: my $otheremails;
13268: my %domconfig =
13269: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13270: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13271: if (exists($domconfig{'contacts'}{$mailing})) {
13272: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13273: my @contacts = ('adminemail','supportemail');
13274: foreach my $item (@contacts) {
13275: if ($domconfig{'contacts'}{$mailing}{$item}) {
13276: my $addr = $domconfig{'contacts'}{$item};
13277: if (!grep(/^\Q$addr\E$/,@recipients)) {
13278: push(@recipients,$addr);
13279: }
1.619 raeburn 13280: }
1.766 raeburn 13281: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13282: }
13283: }
1.766 raeburn 13284: } elsif ($origmail ne '') {
13285: push(@recipients,$origmail);
1.618 raeburn 13286: }
1.619 raeburn 13287: } elsif ($origmail ne '') {
13288: push(@recipients,$origmail);
1.618 raeburn 13289: }
1.688 raeburn 13290: if (defined($defmail)) {
13291: if ($defmail ne '') {
13292: push(@recipients,$defmail);
13293: }
1.618 raeburn 13294: }
13295: if ($otheremails) {
1.619 raeburn 13296: my @others;
13297: if ($otheremails =~ /,/) {
13298: @others = split(/,/,$otheremails);
1.618 raeburn 13299: } else {
1.619 raeburn 13300: push(@others,$otheremails);
13301: }
13302: foreach my $addr (@others) {
13303: if (!grep(/^\Q$addr\E$/,@recipients)) {
13304: push(@recipients,$addr);
13305: }
1.618 raeburn 13306: }
13307: }
1.619 raeburn 13308: my $recipientlist = join(',',@recipients);
1.618 raeburn 13309: return $recipientlist;
13310: }
13311:
1.127 matthew 13312: ############################################################
13313: ############################################################
1.154 albertel 13314:
1.655 raeburn 13315: =pod
13316:
13317: =head1 Course Catalog Routines
13318:
13319: =over 4
13320:
13321: =item * &gather_categories()
13322:
13323: Converts category definitions - keys of categories hash stored in
13324: coursecategories in configuration.db on the primary library server in a
13325: domain - to an array. Also generates javascript and idx hash used to
13326: generate Domain Coordinator interface for editing Course Categories.
13327:
13328: Inputs:
1.663 raeburn 13329:
1.655 raeburn 13330: categories (reference to hash of category definitions).
1.663 raeburn 13331:
1.655 raeburn 13332: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13333: categories and subcategories).
1.663 raeburn 13334:
1.655 raeburn 13335: idx (reference to hash of counters used in Domain Coordinator interface for
13336: editing Course Categories).
1.663 raeburn 13337:
1.655 raeburn 13338: jsarray (reference to array of categories used to create Javascript arrays for
13339: Domain Coordinator interface for editing Course Categories).
13340:
13341: Returns: nothing
13342:
13343: Side effects: populates cats, idx and jsarray.
13344:
13345: =cut
13346:
13347: sub gather_categories {
13348: my ($categories,$cats,$idx,$jsarray) = @_;
13349: my %counters;
13350: my $num = 0;
13351: foreach my $item (keys(%{$categories})) {
13352: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13353: if ($container eq '' && $depth == 0) {
13354: $cats->[$depth][$categories->{$item}] = $cat;
13355: } else {
13356: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13357: }
13358: my ($escitem,$tail) = split(/:/,$item,2);
13359: if ($counters{$tail} eq '') {
13360: $counters{$tail} = $num;
13361: $num ++;
13362: }
13363: if (ref($idx) eq 'HASH') {
13364: $idx->{$item} = $counters{$tail};
13365: }
13366: if (ref($jsarray) eq 'ARRAY') {
13367: push(@{$jsarray->[$counters{$tail}]},$item);
13368: }
13369: }
13370: return;
13371: }
13372:
13373: =pod
13374:
13375: =item * &extract_categories()
13376:
13377: Used to generate breadcrumb trails for course categories.
13378:
13379: Inputs:
1.663 raeburn 13380:
1.655 raeburn 13381: categories (reference to hash of category definitions).
1.663 raeburn 13382:
1.655 raeburn 13383: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13384: categories and subcategories).
1.663 raeburn 13385:
1.655 raeburn 13386: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13387:
1.655 raeburn 13388: allitems (reference to hash - key is category key
13389: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13390:
1.655 raeburn 13391: idx (reference to hash of counters used in Domain Coordinator interface for
13392: editing Course Categories).
1.663 raeburn 13393:
1.655 raeburn 13394: jsarray (reference to array of categories used to create Javascript arrays for
13395: Domain Coordinator interface for editing Course Categories).
13396:
1.665 raeburn 13397: subcats (reference to hash of arrays containing all subcategories within each
13398: category, -recursive)
13399:
1.655 raeburn 13400: Returns: nothing
13401:
13402: Side effects: populates trails and allitems hash references.
13403:
13404: =cut
13405:
13406: sub extract_categories {
1.665 raeburn 13407: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13408: if (ref($categories) eq 'HASH') {
13409: &gather_categories($categories,$cats,$idx,$jsarray);
13410: if (ref($cats->[0]) eq 'ARRAY') {
13411: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13412: my $name = $cats->[0][$i];
13413: my $item = &escape($name).'::0';
13414: my $trailstr;
13415: if ($name eq 'instcode') {
13416: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13417: } elsif ($name eq 'communities') {
13418: $trailstr = &mt('Communities');
1.655 raeburn 13419: } else {
13420: $trailstr = $name;
13421: }
13422: if ($allitems->{$item} eq '') {
13423: push(@{$trails},$trailstr);
13424: $allitems->{$item} = scalar(@{$trails})-1;
13425: }
13426: my @parents = ($name);
13427: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13428: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13429: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13430: if (ref($subcats) eq 'HASH') {
13431: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13432: }
13433: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13434: }
13435: } else {
13436: if (ref($subcats) eq 'HASH') {
13437: $subcats->{$item} = [];
1.655 raeburn 13438: }
13439: }
13440: }
13441: }
13442: }
13443: return;
13444: }
13445:
13446: =pod
13447:
1.1075.2.56 raeburn 13448: =item * &recurse_categories()
1.655 raeburn 13449:
13450: Recursively used to generate breadcrumb trails for course categories.
13451:
13452: Inputs:
1.663 raeburn 13453:
1.655 raeburn 13454: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13455: categories and subcategories).
1.663 raeburn 13456:
1.655 raeburn 13457: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13458:
13459: category (current course category, for which breadcrumb trail is being generated).
13460:
13461: trails (reference to array of breadcrumb trails for each category).
13462:
1.655 raeburn 13463: allitems (reference to hash - key is category key
13464: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13465:
1.655 raeburn 13466: parents (array containing containers directories for current category,
13467: back to top level).
13468:
13469: Returns: nothing
13470:
13471: Side effects: populates trails and allitems hash references
13472:
13473: =cut
13474:
13475: sub recurse_categories {
1.665 raeburn 13476: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13477: my $shallower = $depth - 1;
13478: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13479: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13480: my $name = $cats->[$depth]{$category}[$k];
13481: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13482: my $trailstr = join(' -> ',(@{$parents},$category));
13483: if ($allitems->{$item} eq '') {
13484: push(@{$trails},$trailstr);
13485: $allitems->{$item} = scalar(@{$trails})-1;
13486: }
13487: my $deeper = $depth+1;
13488: push(@{$parents},$category);
1.665 raeburn 13489: if (ref($subcats) eq 'HASH') {
13490: my $subcat = &escape($name).':'.$category.':'.$depth;
13491: for (my $j=@{$parents}; $j>=0; $j--) {
13492: my $higher;
13493: if ($j > 0) {
13494: $higher = &escape($parents->[$j]).':'.
13495: &escape($parents->[$j-1]).':'.$j;
13496: } else {
13497: $higher = &escape($parents->[$j]).'::'.$j;
13498: }
13499: push(@{$subcats->{$higher}},$subcat);
13500: }
13501: }
13502: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13503: $subcats);
1.655 raeburn 13504: pop(@{$parents});
13505: }
13506: } else {
13507: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13508: my $trailstr = join(' -> ',(@{$parents},$category));
13509: if ($allitems->{$item} eq '') {
13510: push(@{$trails},$trailstr);
13511: $allitems->{$item} = scalar(@{$trails})-1;
13512: }
13513: }
13514: return;
13515: }
13516:
1.663 raeburn 13517: =pod
13518:
1.1075.2.56 raeburn 13519: =item * &assign_categories_table()
1.663 raeburn 13520:
13521: Create a datatable for display of hierarchical categories in a domain,
13522: with checkboxes to allow a course to be categorized.
13523:
13524: Inputs:
13525:
13526: cathash - reference to hash of categories defined for the domain (from
13527: configuration.db)
13528:
13529: currcat - scalar with an & separated list of categories assigned to a course.
13530:
1.919 raeburn 13531: type - scalar contains course type (Course or Community).
13532:
1.663 raeburn 13533: Returns: $output (markup to be displayed)
13534:
13535: =cut
13536:
13537: sub assign_categories_table {
1.919 raeburn 13538: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13539: my $output;
13540: if (ref($cathash) eq 'HASH') {
13541: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13542: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13543: $maxdepth = scalar(@cats);
13544: if (@cats > 0) {
13545: my $itemcount = 0;
13546: if (ref($cats[0]) eq 'ARRAY') {
13547: my @currcategories;
13548: if ($currcat ne '') {
13549: @currcategories = split('&',$currcat);
13550: }
1.919 raeburn 13551: my $table;
1.663 raeburn 13552: for (my $i=0; $i<@{$cats[0]}; $i++) {
13553: my $parent = $cats[0][$i];
1.919 raeburn 13554: next if ($parent eq 'instcode');
13555: if ($type eq 'Community') {
13556: next unless ($parent eq 'communities');
13557: } else {
13558: next if ($parent eq 'communities');
13559: }
1.663 raeburn 13560: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13561: my $item = &escape($parent).'::0';
13562: my $checked = '';
13563: if (@currcategories > 0) {
13564: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13565: $checked = ' checked="checked"';
1.663 raeburn 13566: }
13567: }
1.919 raeburn 13568: my $parent_title = $parent;
13569: if ($parent eq 'communities') {
13570: $parent_title = &mt('Communities');
13571: }
13572: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13573: '<input type="checkbox" name="usecategory" value="'.
13574: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13575: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13576: my $depth = 1;
13577: push(@path,$parent);
1.919 raeburn 13578: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13579: pop(@path);
1.919 raeburn 13580: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13581: $itemcount ++;
13582: }
1.919 raeburn 13583: if ($itemcount) {
13584: $output = &Apache::loncommon::start_data_table().
13585: $table.
13586: &Apache::loncommon::end_data_table();
13587: }
1.663 raeburn 13588: }
13589: }
13590: }
13591: return $output;
13592: }
13593:
13594: =pod
13595:
1.1075.2.56 raeburn 13596: =item * &assign_category_rows()
1.663 raeburn 13597:
13598: Create a datatable row for display of nested categories in a domain,
13599: with checkboxes to allow a course to be categorized,called recursively.
13600:
13601: Inputs:
13602:
13603: itemcount - track row number for alternating colors
13604:
13605: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13606: categories and subcategories.
13607:
13608: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13609:
13610: parent - parent of current category item
13611:
13612: path - Array containing all categories back up through the hierarchy from the
13613: current category to the top level.
13614:
13615: currcategories - reference to array of current categories assigned to the course
13616:
13617: Returns: $output (markup to be displayed).
13618:
13619: =cut
13620:
13621: sub assign_category_rows {
13622: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13623: my ($text,$name,$item,$chgstr);
13624: if (ref($cats) eq 'ARRAY') {
13625: my $maxdepth = scalar(@{$cats});
13626: if (ref($cats->[$depth]) eq 'HASH') {
13627: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13628: my $numchildren = @{$cats->[$depth]{$parent}};
13629: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13630: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13631: for (my $j=0; $j<$numchildren; $j++) {
13632: $name = $cats->[$depth]{$parent}[$j];
13633: $item = &escape($name).':'.&escape($parent).':'.$depth;
13634: my $deeper = $depth+1;
13635: my $checked = '';
13636: if (ref($currcategories) eq 'ARRAY') {
13637: if (@{$currcategories} > 0) {
13638: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13639: $checked = ' checked="checked"';
1.663 raeburn 13640: }
13641: }
13642: }
1.664 raeburn 13643: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13644: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13645: $item.'"'.$checked.' />'.$name.'</label></span>'.
13646: '<input type="hidden" name="catname" value="'.$name.'" />'.
13647: '</td><td>';
1.663 raeburn 13648: if (ref($path) eq 'ARRAY') {
13649: push(@{$path},$name);
13650: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13651: pop(@{$path});
13652: }
13653: $text .= '</td></tr>';
13654: }
13655: $text .= '</table></td>';
13656: }
13657: }
13658: }
13659: return $text;
13660: }
13661:
1.655 raeburn 13662: ############################################################
13663: ############################################################
13664:
13665:
1.443 albertel 13666: sub commit_customrole {
1.664 raeburn 13667: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13668: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13669: ($start?', '.&mt('starting').' '.localtime($start):'').
13670: ($end?', ending '.localtime($end):'').': <b>'.
13671: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13672: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13673: '</b><br />';
13674: return $output;
13675: }
13676:
13677: sub commit_standardrole {
1.1075.2.31 raeburn 13678: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13679: my ($output,$logmsg,$linefeed);
13680: if ($context eq 'auto') {
13681: $linefeed = "\n";
13682: } else {
13683: $linefeed = "<br />\n";
13684: }
1.443 albertel 13685: if ($three eq 'st') {
1.541 raeburn 13686: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 13687: $one,$two,$sec,$context,$credits);
1.541 raeburn 13688: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13689: ($result eq 'unknown_course') || ($result eq 'refused')) {
13690: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13691: } else {
1.541 raeburn 13692: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13693: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13694: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13695: if ($context eq 'auto') {
13696: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13697: } else {
13698: $output .= '<b>'.$result.'</b>'.$linefeed.
13699: &mt('Add to classlist').': <b>ok</b>';
13700: }
13701: $output .= $linefeed;
1.443 albertel 13702: }
13703: } else {
13704: $output = &mt('Assigning').' '.$three.' in '.$url.
13705: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13706: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13707: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13708: if ($context eq 'auto') {
13709: $output .= $result.$linefeed;
13710: } else {
13711: $output .= '<b>'.$result.'</b>'.$linefeed;
13712: }
1.443 albertel 13713: }
13714: return $output;
13715: }
13716:
13717: sub commit_studentrole {
1.1075.2.31 raeburn 13718: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13719: $credits) = @_;
1.626 raeburn 13720: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13721: if ($context eq 'auto') {
13722: $linefeed = "\n";
13723: } else {
13724: $linefeed = '<br />'."\n";
13725: }
1.443 albertel 13726: if (defined($one) && defined($two)) {
13727: my $cid=$one.'_'.$two;
13728: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13729: my $secchange = 0;
13730: my $expire_role_result;
13731: my $modify_section_result;
1.628 raeburn 13732: if ($oldsec ne '-1') {
13733: if ($oldsec ne $sec) {
1.443 albertel 13734: $secchange = 1;
1.628 raeburn 13735: my $now = time;
1.443 albertel 13736: my $uurl='/'.$cid;
13737: $uurl=~s/\_/\//g;
13738: if ($oldsec) {
13739: $uurl.='/'.$oldsec;
13740: }
1.626 raeburn 13741: $oldsecurl = $uurl;
1.628 raeburn 13742: $expire_role_result =
1.652 raeburn 13743: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13744: if ($env{'request.course.sec'} ne '') {
13745: if ($expire_role_result eq 'refused') {
13746: my @roles = ('st');
13747: my @statuses = ('previous');
13748: my @roledoms = ($one);
13749: my $withsec = 1;
13750: my %roleshash =
13751: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13752: \@statuses,\@roles,\@roledoms,$withsec);
13753: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13754: my ($oldstart,$oldend) =
13755: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13756: if ($oldend > 0 && $oldend <= $now) {
13757: $expire_role_result = 'ok';
13758: }
13759: }
13760: }
13761: }
1.443 albertel 13762: $result = $expire_role_result;
13763: }
13764: }
13765: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 13766: $modify_section_result =
13767: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13768: undef,undef,undef,$sec,
13769: $end,$start,'','',$cid,
13770: '',$context,$credits);
1.443 albertel 13771: if ($modify_section_result =~ /^ok/) {
13772: if ($secchange == 1) {
1.628 raeburn 13773: if ($sec eq '') {
13774: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13775: } else {
13776: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13777: }
1.443 albertel 13778: } elsif ($oldsec eq '-1') {
1.628 raeburn 13779: if ($sec eq '') {
13780: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13781: } else {
13782: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13783: }
1.443 albertel 13784: } else {
1.628 raeburn 13785: if ($sec eq '') {
13786: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13787: } else {
13788: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13789: }
1.443 albertel 13790: }
13791: } else {
1.628 raeburn 13792: if ($secchange) {
13793: $$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;
13794: } else {
13795: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13796: }
1.443 albertel 13797: }
13798: $result = $modify_section_result;
13799: } elsif ($secchange == 1) {
1.628 raeburn 13800: if ($oldsec eq '') {
1.1075.2.20 raeburn 13801: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
1.628 raeburn 13802: } else {
13803: $$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;
13804: }
1.626 raeburn 13805: if ($expire_role_result eq 'refused') {
13806: my $newsecurl = '/'.$cid;
13807: $newsecurl =~ s/\_/\//g;
13808: if ($sec ne '') {
13809: $newsecurl.='/'.$sec;
13810: }
13811: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13812: if ($sec eq '') {
13813: $$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;
13814: } else {
13815: $$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;
13816: }
13817: }
13818: }
1.443 albertel 13819: }
13820: } else {
1.626 raeburn 13821: $$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 13822: $result = "error: incomplete course id\n";
13823: }
13824: return $result;
13825: }
13826:
1.1075.2.25 raeburn 13827: sub show_role_extent {
13828: my ($scope,$context,$role) = @_;
13829: $scope =~ s{^/}{};
13830: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13831: push(@courseroles,'co');
13832: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13833: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13834: $scope =~ s{/}{_};
13835: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13836: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13837: my ($audom,$auname) = split(/\//,$scope);
13838: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13839: &Apache::loncommon::plainname($auname,$audom).'</span>');
13840: } else {
13841: $scope =~ s{/$}{};
13842: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13843: &Apache::lonnet::domain($scope,'description').'</span>');
13844: }
13845: }
13846:
1.443 albertel 13847: ############################################################
13848: ############################################################
13849:
1.566 albertel 13850: sub check_clone {
1.578 raeburn 13851: my ($args,$linefeed) = @_;
1.566 albertel 13852: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13853: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13854: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13855: my $clonemsg;
13856: my $can_clone = 0;
1.944 raeburn 13857: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13858: if ($lctype ne 'community') {
13859: $lctype = 'course';
13860: }
1.566 albertel 13861: if ($clonehome eq 'no_host') {
1.944 raeburn 13862: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13863: $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'});
13864: } else {
13865: $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'});
13866: }
1.566 albertel 13867: } else {
13868: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13869: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13870: if ($clonedesc{'type'} ne 'Community') {
13871: $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'});
13872: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13873: }
13874: }
1.882 raeburn 13875: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13876: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13877: $can_clone = 1;
13878: } else {
13879: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13880: $args->{'clonedomain'},$args->{'clonecourse'});
13881: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 13882: if (grep(/^\*$/,@cloners)) {
13883: $can_clone = 1;
13884: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
13885: $can_clone = 1;
13886: } else {
1.908 raeburn 13887: my $ccrole = 'cc';
1.944 raeburn 13888: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13889: $ccrole = 'co';
13890: }
1.578 raeburn 13891: my %roleshash =
13892: &Apache::lonnet::get_my_roles($args->{'ccuname'},
13893: $args->{'ccdomain'},
1.908 raeburn 13894: 'userroles',['active'],[$ccrole],
1.578 raeburn 13895: [$args->{'clonedomain'}]);
1.908 raeburn 13896: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 13897: $can_clone = 1;
13898: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
13899: $can_clone = 1;
13900: } else {
1.944 raeburn 13901: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13902: $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'});
13903: } else {
13904: $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'});
13905: }
1.578 raeburn 13906: }
1.566 albertel 13907: }
1.578 raeburn 13908: }
1.566 albertel 13909: }
13910: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13911: }
13912:
1.444 albertel 13913: sub construct_course {
1.1075.2.59 raeburn 13914: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 13915: my $outcome;
1.541 raeburn 13916: my $linefeed = '<br />'."\n";
13917: if ($context eq 'auto') {
13918: $linefeed = "\n";
13919: }
1.566 albertel 13920:
13921: #
13922: # Are we cloning?
13923: #
13924: my ($can_clone, $clonemsg, $cloneid, $clonehome);
13925: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 13926: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 13927: if ($context ne 'auto') {
1.578 raeburn 13928: if ($clonemsg ne '') {
13929: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
13930: }
1.566 albertel 13931: }
13932: $outcome .= $clonemsg.$linefeed;
13933:
13934: if (!$can_clone) {
13935: return (0,$outcome);
13936: }
13937: }
13938:
1.444 albertel 13939: #
13940: # Open course
13941: #
13942: my $crstype = lc($args->{'crstype'});
13943: my %cenv=();
13944: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
13945: $args->{'cdescr'},
13946: $args->{'curl'},
13947: $args->{'course_home'},
13948: $args->{'nonstandard'},
13949: $args->{'crscode'},
13950: $args->{'ccuname'}.':'.
13951: $args->{'ccdomain'},
1.882 raeburn 13952: $args->{'crstype'},
1.885 raeburn 13953: $cnum,$context,$category);
1.444 albertel 13954:
13955: # Note: The testing routines depend on this being output; see
13956: # Utils::Course. This needs to at least be output as a comment
13957: # if anyone ever decides to not show this, and Utils::Course::new
13958: # will need to be suitably modified.
1.541 raeburn 13959: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 13960: if ($$courseid =~ /^error:/) {
13961: return (0,$outcome);
13962: }
13963:
1.444 albertel 13964: #
13965: # Check if created correctly
13966: #
1.479 albertel 13967: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 13968: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 13969: if ($crsuhome eq 'no_host') {
13970: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
13971: return (0,$outcome);
13972: }
1.541 raeburn 13973: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 13974:
1.444 albertel 13975: #
1.566 albertel 13976: # Do the cloning
13977: #
13978: if ($can_clone && $cloneid) {
13979: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
13980: if ($context ne 'auto') {
13981: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
13982: }
13983: $outcome .= $clonemsg.$linefeed;
13984: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 13985: # Copy all files
1.637 www 13986: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 13987: # Restore URL
1.566 albertel 13988: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 13989: # Restore title
1.566 albertel 13990: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 13991: # Restore creation date, creator and creation context.
13992: $cenv{'internal.created'}=$oldcenv{'internal.created'};
13993: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
13994: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 13995: # Mark as cloned
1.566 albertel 13996: $cenv{'clonedfrom'}=$cloneid;
1.638 www 13997: # Need to clone grading mode
13998: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
13999: $cenv{'grading'}=$newenv{'grading'};
14000: # Do not clone these environment entries
14001: &Apache::lonnet::del('environment',
14002: ['default_enrollment_start_date',
14003: 'default_enrollment_end_date',
14004: 'question.email',
14005: 'policy.email',
14006: 'comment.email',
14007: 'pch.users.denied',
1.725 raeburn 14008: 'plc.users.denied',
14009: 'hidefromcat',
1.1075.2.36 raeburn 14010: 'checkforpriv',
1.1075.2.59 raeburn 14011: 'categories',
14012: 'internal.uniquecode'],
1.638 www 14013: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14014: if ($args->{'textbook'}) {
14015: $cenv{'internal.textbook'} = $args->{'textbook'};
14016: }
1.444 albertel 14017: }
1.566 albertel 14018:
1.444 albertel 14019: #
14020: # Set environment (will override cloned, if existing)
14021: #
14022: my @sections = ();
14023: my @xlists = ();
14024: if ($args->{'crstype'}) {
14025: $cenv{'type'}=$args->{'crstype'};
14026: }
14027: if ($args->{'crsid'}) {
14028: $cenv{'courseid'}=$args->{'crsid'};
14029: }
14030: if ($args->{'crscode'}) {
14031: $cenv{'internal.coursecode'}=$args->{'crscode'};
14032: }
14033: if ($args->{'crsquota'} ne '') {
14034: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14035: } else {
14036: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14037: }
14038: if ($args->{'ccuname'}) {
14039: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14040: ':'.$args->{'ccdomain'};
14041: } else {
14042: $cenv{'internal.courseowner'} = $args->{'curruser'};
14043: }
1.1075.2.31 raeburn 14044: if ($args->{'defaultcredits'}) {
14045: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14046: }
1.444 albertel 14047: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14048: if ($args->{'crssections'}) {
14049: $cenv{'internal.sectionnums'} = '';
14050: if ($args->{'crssections'} =~ m/,/) {
14051: @sections = split/,/,$args->{'crssections'};
14052: } else {
14053: $sections[0] = $args->{'crssections'};
14054: }
14055: if (@sections > 0) {
14056: foreach my $item (@sections) {
14057: my ($sec,$gp) = split/:/,$item;
14058: my $class = $args->{'crscode'}.$sec;
14059: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14060: $cenv{'internal.sectionnums'} .= $item.',';
14061: unless ($addcheck eq 'ok') {
14062: push @badclasses, $class;
14063: }
14064: }
14065: $cenv{'internal.sectionnums'} =~ s/,$//;
14066: }
14067: }
14068: # do not hide course coordinator from staff listing,
14069: # even if privileged
14070: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14071: # add course coordinator's domain to domains to check for privileged users
14072: # if different to course domain
14073: if ($$crsudom ne $args->{'ccdomain'}) {
14074: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14075: }
1.444 albertel 14076: # add crosslistings
14077: if ($args->{'crsxlist'}) {
14078: $cenv{'internal.crosslistings'}='';
14079: if ($args->{'crsxlist'} =~ m/,/) {
14080: @xlists = split/,/,$args->{'crsxlist'};
14081: } else {
14082: $xlists[0] = $args->{'crsxlist'};
14083: }
14084: if (@xlists > 0) {
14085: foreach my $item (@xlists) {
14086: my ($xl,$gp) = split/:/,$item;
14087: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14088: $cenv{'internal.crosslistings'} .= $item.',';
14089: unless ($addcheck eq 'ok') {
14090: push @badclasses, $xl;
14091: }
14092: }
14093: $cenv{'internal.crosslistings'} =~ s/,$//;
14094: }
14095: }
14096: if ($args->{'autoadds'}) {
14097: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14098: }
14099: if ($args->{'autodrops'}) {
14100: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14101: }
14102: # check for notification of enrollment changes
14103: my @notified = ();
14104: if ($args->{'notify_owner'}) {
14105: if ($args->{'ccuname'} ne '') {
14106: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14107: }
14108: }
14109: if ($args->{'notify_dc'}) {
14110: if ($uname ne '') {
1.630 raeburn 14111: push(@notified,$uname.':'.$udom);
1.444 albertel 14112: }
14113: }
14114: if (@notified > 0) {
14115: my $notifylist;
14116: if (@notified > 1) {
14117: $notifylist = join(',',@notified);
14118: } else {
14119: $notifylist = $notified[0];
14120: }
14121: $cenv{'internal.notifylist'} = $notifylist;
14122: }
14123: if (@badclasses > 0) {
14124: my %lt=&Apache::lonlocal::texthash(
14125: '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',
14126: 'dnhr' => 'does not have rights to access enrollment in these classes',
14127: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14128: );
1.541 raeburn 14129: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14130: ' ('.$lt{'adby'}.')';
14131: if ($context eq 'auto') {
14132: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14133: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14134: foreach my $item (@badclasses) {
14135: if ($context eq 'auto') {
14136: $outcome .= " - $item\n";
14137: } else {
14138: $outcome .= "<li>$item</li>\n";
14139: }
14140: }
14141: if ($context eq 'auto') {
14142: $outcome .= $linefeed;
14143: } else {
1.566 albertel 14144: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14145: }
14146: }
1.444 albertel 14147: }
14148: if ($args->{'no_end_date'}) {
14149: $args->{'endaccess'} = 0;
14150: }
14151: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14152: $cenv{'internal.autoend'}=$args->{'enrollend'};
14153: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14154: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14155: if ($args->{'showphotos'}) {
14156: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14157: }
14158: $cenv{'internal.authtype'} = $args->{'authtype'};
14159: $cenv{'internal.autharg'} = $args->{'autharg'};
14160: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14161: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14162: 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');
14163: if ($context eq 'auto') {
14164: $outcome .= $krb_msg;
14165: } else {
1.566 albertel 14166: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14167: }
14168: $outcome .= $linefeed;
1.444 albertel 14169: }
14170: }
14171: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14172: if ($args->{'setpolicy'}) {
14173: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14174: }
14175: if ($args->{'setcontent'}) {
14176: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14177: }
14178: }
14179: if ($args->{'reshome'}) {
14180: $cenv{'reshome'}=$args->{'reshome'}.'/';
14181: $cenv{'reshome'}=~s/\/+$/\//;
14182: }
14183: #
14184: # course has keyed access
14185: #
14186: if ($args->{'setkeys'}) {
14187: $cenv{'keyaccess'}='yes';
14188: }
14189: # if specified, key authority is not course, but user
14190: # only active if keyaccess is yes
14191: if ($args->{'keyauth'}) {
1.487 albertel 14192: my ($user,$domain) = split(':',$args->{'keyauth'});
14193: $user = &LONCAPA::clean_username($user);
14194: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14195: if ($user ne '' && $domain ne '') {
1.487 albertel 14196: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14197: }
14198: }
14199:
1.1075.2.59 raeburn 14200: #
14201: # generate and store uniquecode (available to course requester), if course should have one.
14202: #
14203: if ($args->{'uniquecode'}) {
14204: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14205: if ($code) {
14206: $cenv{'internal.uniquecode'} = $code;
14207: my %crsinfo =
14208: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14209: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14210: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14211: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14212: }
14213: if (ref($coderef)) {
14214: $$coderef = $code;
14215: }
14216: }
14217: }
14218:
1.444 albertel 14219: if ($args->{'disresdis'}) {
14220: $cenv{'pch.roles.denied'}='st';
14221: }
14222: if ($args->{'disablechat'}) {
14223: $cenv{'plc.roles.denied'}='st';
14224: }
14225:
14226: # Record we've not yet viewed the Course Initialization Helper for this
14227: # course
14228: $cenv{'course.helper.not.run'} = 1;
14229: #
14230: # Use new Randomseed
14231: #
14232: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14233: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14234: #
14235: # The encryption code and receipt prefix for this course
14236: #
14237: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14238: $cenv{'internal.encpref'}=100+int(9*rand(99));
14239: #
14240: # By default, use standard grading
14241: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14242:
1.541 raeburn 14243: $outcome .= $linefeed.&mt('Setting environment').': '.
14244: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14245: #
14246: # Open all assignments
14247: #
14248: if ($args->{'openall'}) {
14249: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14250: my %storecontent = ($storeunder => time,
14251: $storeunder.'.type' => 'date_start');
14252:
14253: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14254: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14255: }
14256: #
14257: # Set first page
14258: #
14259: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14260: || ($cloneid)) {
1.445 albertel 14261: use LONCAPA::map;
1.444 albertel 14262: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14263:
14264: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14265: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14266:
1.444 albertel 14267: $outcome .= ($fatal?$errtext:'read ok').' - ';
14268: my $title; my $url;
14269: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14270: $title=&mt('Syllabus');
1.444 albertel 14271: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14272: } else {
1.963 raeburn 14273: $title=&mt('Table of Contents');
1.444 albertel 14274: $url='/adm/navmaps';
14275: }
1.445 albertel 14276:
14277: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14278: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14279:
14280: if ($errtext) { $fatal=2; }
1.541 raeburn 14281: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14282: }
1.566 albertel 14283:
14284: return (1,$outcome);
1.444 albertel 14285: }
14286:
1.1075.2.59 raeburn 14287: sub make_unique_code {
14288: my ($cdom,$cnum) = @_;
14289: # get lock on uniquecodes db
14290: my $lockhash = {
14291: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14292: ':'.$env{'user.domain'},
14293: };
14294: my $tries = 0;
14295: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14296: my ($code,$error);
14297:
14298: while (($gotlock ne 'ok') && ($tries<3)) {
14299: $tries ++;
14300: sleep 1;
14301: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14302: }
14303: if ($gotlock eq 'ok') {
14304: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14305: my $gotcode;
14306: my $attempts = 0;
14307: while ((!$gotcode) && ($attempts < 100)) {
14308: $code = &generate_code();
14309: if (!exists($currcodes{$code})) {
14310: $gotcode = 1;
14311: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14312: $error = 'nostore';
14313: }
14314: }
14315: $attempts ++;
14316: }
14317: my @del_lock = ($cnum."\0".'uniquecodes');
14318: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14319: } else {
14320: $error = 'nolock';
14321: }
14322: return ($code,$error);
14323: }
14324:
14325: sub generate_code {
14326: my $code;
14327: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14328: for (my $i=0; $i<6; $i++) {
14329: my $lettnum = int (rand 2);
14330: my $item = '';
14331: if ($lettnum) {
14332: $item = $letts[int( rand(18) )];
14333: } else {
14334: $item = 1+int( rand(8) );
14335: }
14336: $code .= $item;
14337: }
14338: return $code;
14339: }
14340:
1.444 albertel 14341: ############################################################
14342: ############################################################
14343:
1.953 droeschl 14344: #SD
14345: # only Community and Course, or anything else?
1.378 raeburn 14346: sub course_type {
14347: my ($cid) = @_;
14348: if (!defined($cid)) {
14349: $cid = $env{'request.course.id'};
14350: }
1.404 albertel 14351: if (defined($env{'course.'.$cid.'.type'})) {
14352: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14353: } else {
14354: return 'Course';
1.377 raeburn 14355: }
14356: }
1.156 albertel 14357:
1.406 raeburn 14358: sub group_term {
14359: my $crstype = &course_type();
14360: my %names = (
14361: 'Course' => 'group',
1.865 raeburn 14362: 'Community' => 'group',
1.406 raeburn 14363: );
14364: return $names{$crstype};
14365: }
14366:
1.902 raeburn 14367: sub course_types {
1.1075.2.59 raeburn 14368: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14369: my %typename = (
14370: official => 'Official course',
14371: unofficial => 'Unofficial course',
14372: community => 'Community',
1.1075.2.59 raeburn 14373: textbook => 'Textbook course',
1.902 raeburn 14374: );
14375: return (\@types,\%typename);
14376: }
14377:
1.156 albertel 14378: sub icon {
14379: my ($file)=@_;
1.505 albertel 14380: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14381: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14382: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14383: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14384: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14385: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14386: $curfext.".gif") {
14387: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14388: $curfext.".gif";
14389: }
14390: }
1.249 albertel 14391: return &lonhttpdurl($iconname);
1.154 albertel 14392: }
1.84 albertel 14393:
1.575 albertel 14394: sub lonhttpdurl {
1.692 www 14395: #
14396: # Had been used for "small fry" static images on separate port 8080.
14397: # Modify here if lightweight http functionality desired again.
14398: # Currently eliminated due to increasing firewall issues.
14399: #
1.575 albertel 14400: my ($url)=@_;
1.692 www 14401: return $url;
1.215 albertel 14402: }
14403:
1.213 albertel 14404: sub connection_aborted {
14405: my ($r)=@_;
14406: $r->print(" ");$r->rflush();
14407: my $c = $r->connection;
14408: return $c->aborted();
14409: }
14410:
1.221 foxr 14411: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14412: # strings as 'strings'.
14413: sub escape_single {
1.221 foxr 14414: my ($input) = @_;
1.223 albertel 14415: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14416: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14417: return $input;
14418: }
1.223 albertel 14419:
1.222 foxr 14420: # Same as escape_single, but escape's "'s This
14421: # can be used for "strings"
14422: sub escape_double {
14423: my ($input) = @_;
14424: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14425: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14426: return $input;
14427: }
1.223 albertel 14428:
1.222 foxr 14429: # Escapes the last element of a full URL.
14430: sub escape_url {
14431: my ($url) = @_;
1.238 raeburn 14432: my @urlslices = split(/\//, $url,-1);
1.369 www 14433: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 14434: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 14435: }
1.462 albertel 14436:
1.820 raeburn 14437: sub compare_arrays {
14438: my ($arrayref1,$arrayref2) = @_;
14439: my (@difference,%count);
14440: @difference = ();
14441: %count = ();
14442: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14443: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14444: foreach my $element (keys(%count)) {
14445: if ($count{$element} == 1) {
14446: push(@difference,$element);
14447: }
14448: }
14449: }
14450: return @difference;
14451: }
14452:
1.817 bisitz 14453: # -------------------------------------------------------- Initialize user login
1.462 albertel 14454: sub init_user_environment {
1.463 albertel 14455: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14456: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14457:
14458: my $public=($username eq 'public' && $domain eq 'public');
14459:
14460: # See if old ID present, if so, remove
14461:
1.1062 raeburn 14462: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14463: my $now=time;
14464:
14465: if ($public) {
14466: my $max_public=100;
14467: my $oldest;
14468: my $oldest_time=0;
14469: for(my $next=1;$next<=$max_public;$next++) {
14470: if (-e $lonids."/publicuser_$next.id") {
14471: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14472: if ($mtime<$oldest_time || !$oldest_time) {
14473: $oldest_time=$mtime;
14474: $oldest=$next;
14475: }
14476: } else {
14477: $cookie="publicuser_$next";
14478: last;
14479: }
14480: }
14481: if (!$cookie) { $cookie="publicuser_$oldest"; }
14482: } else {
1.463 albertel 14483: # if this isn't a robot, kill any existing non-robot sessions
14484: if (!$args->{'robot'}) {
14485: opendir(DIR,$lonids);
14486: while ($filename=readdir(DIR)) {
14487: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14488: unlink($lonids.'/'.$filename);
14489: }
1.462 albertel 14490: }
1.463 albertel 14491: closedir(DIR);
1.462 albertel 14492: }
14493: # Give them a new cookie
1.463 albertel 14494: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14495: : $now.$$.int(rand(10000)));
1.463 albertel 14496: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14497:
14498: # Initialize roles
14499:
1.1062 raeburn 14500: ($userroles,$firstaccenv,$timerintenv) =
14501: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14502: }
14503: # ------------------------------------ Check browser type and MathML capability
14504:
14505: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42 raeburn 14506: $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462 albertel 14507:
14508: # ------------------------------------------------------------- Get environment
14509:
14510: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14511: my ($tmp) = keys(%userenv);
14512: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14513: } else {
14514: undef(%userenv);
14515: }
14516: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14517: $form->{'interface'}=$userenv{'interface'};
14518: }
14519: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14520:
14521: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14522: foreach my $option ('interface','localpath','localres') {
14523: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14524: }
14525: # --------------------------------------------------------- Write first profile
14526:
14527: {
14528: my %initial_env =
14529: ("user.name" => $username,
14530: "user.domain" => $domain,
14531: "user.home" => $authhost,
14532: "browser.type" => $clientbrowser,
14533: "browser.version" => $clientversion,
14534: "browser.mathml" => $clientmathml,
14535: "browser.unicode" => $clientunicode,
14536: "browser.os" => $clientos,
1.1075.2.42 raeburn 14537: "browser.mobile" => $clientmobile,
14538: "browser.info" => $clientinfo,
1.462 albertel 14539: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14540: "request.course.fn" => '',
14541: "request.course.uri" => '',
14542: "request.course.sec" => '',
14543: "request.role" => 'cm',
14544: "request.role.adv" => $env{'user.adv'},
14545: "request.host" => $ENV{'REMOTE_ADDR'},);
14546:
14547: if ($form->{'localpath'}) {
14548: $initial_env{"browser.localpath"} = $form->{'localpath'};
14549: $initial_env{"browser.localres"} = $form->{'localres'};
14550: }
14551:
14552: if ($form->{'interface'}) {
14553: $form->{'interface'}=~s/\W//gs;
14554: $initial_env{"browser.interface"} = $form->{'interface'};
14555: $env{'browser.interface'}=$form->{'interface'};
14556: }
14557:
1.1075.2.54 raeburn 14558: if ($form->{'iptoken'}) {
14559: my $lonhost = $r->dir_config('lonHostID');
14560: $initial_env{"user.noloadbalance"} = $lonhost;
14561: $env{'user.noloadbalance'} = $lonhost;
14562: }
14563:
1.981 raeburn 14564: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14565: my %domdef;
14566: unless ($domain eq 'public') {
14567: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14568: }
1.980 raeburn 14569:
1.1075.2.7 raeburn 14570: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14571: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14572: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14573: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14574: }
14575:
1.1075.2.59 raeburn 14576: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14577: $userenv{'canrequest.'.$crstype} =
14578: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14579: 'reload','requestcourses',
14580: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14581: }
14582:
1.1075.2.14 raeburn 14583: $userenv{'canrequest.author'} =
14584: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14585: 'reload','requestauthor',
14586: \%userenv,\%domdef,\%is_adv);
14587: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14588: $domain,$username);
14589: my $reqstatus = $reqauthor{'author_status'};
14590: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14591: if (ref($reqauthor{'author'}) eq 'HASH') {
14592: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14593: $reqauthor{'author'}{'timestamp'};
14594: }
14595: }
14596:
1.462 albertel 14597: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14598:
1.462 albertel 14599: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14600: &GDBM_WRCREAT(),0640)) {
14601: &_add_to_env(\%disk_env,\%initial_env);
14602: &_add_to_env(\%disk_env,\%userenv,'environment.');
14603: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14604: if (ref($firstaccenv) eq 'HASH') {
14605: &_add_to_env(\%disk_env,$firstaccenv);
14606: }
14607: if (ref($timerintenv) eq 'HASH') {
14608: &_add_to_env(\%disk_env,$timerintenv);
14609: }
1.463 albertel 14610: if (ref($args->{'extra_env'})) {
14611: &_add_to_env(\%disk_env,$args->{'extra_env'});
14612: }
1.462 albertel 14613: untie(%disk_env);
14614: } else {
1.705 tempelho 14615: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14616: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14617: return 'error: '.$!;
14618: }
14619: }
14620: $env{'request.role'}='cm';
14621: $env{'request.role.adv'}=$env{'user.adv'};
14622: $env{'browser.type'}=$clientbrowser;
14623:
14624: return $cookie;
14625:
14626: }
14627:
14628: sub _add_to_env {
14629: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14630: if (ref($env_data) eq 'HASH') {
14631: while (my ($key,$value) = each(%$env_data)) {
14632: $idf->{$prefix.$key} = $value;
14633: $env{$prefix.$key} = $value;
14634: }
1.462 albertel 14635: }
14636: }
14637:
1.685 tempelho 14638: # --- Get the symbolic name of a problem and the url
14639: sub get_symb {
14640: my ($request,$silent) = @_;
1.726 raeburn 14641: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14642: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14643: if ($symb eq '') {
14644: if (!$silent) {
1.1071 raeburn 14645: if (ref($request)) {
14646: $request->print("Unable to handle ambiguous references:$url:.");
14647: }
1.685 tempelho 14648: return ();
14649: }
14650: }
14651: &Apache::lonenc::check_decrypt(\$symb);
14652: return ($symb);
14653: }
14654:
14655: # --------------------------------------------------------------Get annotation
14656:
14657: sub get_annotation {
14658: my ($symb,$enc) = @_;
14659:
14660: my $key = $symb;
14661: if (!$enc) {
14662: $key =
14663: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14664: }
14665: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14666: return $annotation{$key};
14667: }
14668:
14669: sub clean_symb {
1.731 raeburn 14670: my ($symb,$delete_enc) = @_;
1.685 tempelho 14671:
14672: &Apache::lonenc::check_decrypt(\$symb);
14673: my $enc = $env{'request.enc'};
1.731 raeburn 14674: if ($delete_enc) {
1.730 raeburn 14675: delete($env{'request.enc'});
14676: }
1.685 tempelho 14677:
14678: return ($symb,$enc);
14679: }
1.462 albertel 14680:
1.990 raeburn 14681: sub build_release_hashes {
14682: my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
14683: return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
14684: (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
14685: (ref($randomizetry) eq 'HASH'));
14686: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14687: my ($item,$name,$value) = split(/:/,$key);
14688: if ($item eq 'parameter') {
14689: if (ref($checkparms->{$name}) eq 'ARRAY') {
14690: unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
14691: push(@{$checkparms->{$name}},$value);
14692: }
14693: } else {
14694: push(@{$checkparms->{$name}},$value);
14695: }
14696: } elsif ($item eq 'resourcetag') {
14697: if ($name eq 'responsetype') {
14698: $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
14699: }
14700: } elsif ($item eq 'course') {
14701: if ($name eq 'crstype') {
14702: $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
14703: }
14704: }
14705: }
14706: ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
14707: ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
14708: return;
14709: }
14710:
1.1075.2.11 raeburn 14711: sub update_content_constraints {
14712: my ($cdom,$cnum,$chome,$cid) = @_;
14713: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
14714: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
14715: my %checkresponsetypes;
14716: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14717: my ($item,$name,$value) = split(/:/,$key);
14718: if ($item eq 'resourcetag') {
14719: if ($name eq 'responsetype') {
14720: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
14721: }
14722: }
14723: }
14724: my $navmap = Apache::lonnavmaps::navmap->new();
14725: if (defined($navmap)) {
14726: my %allresponses;
14727: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
14728: my %responses = $res->responseTypes();
14729: foreach my $key (keys(%responses)) {
14730: next unless(exists($checkresponsetypes{$key}));
14731: $allresponses{$key} += $responses{$key};
14732: }
14733: }
14734: foreach my $key (keys(%allresponses)) {
14735: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
14736: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
14737: ($reqdmajor,$reqdminor) = ($major,$minor);
14738: }
14739: }
14740: undef($navmap);
14741: }
14742: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
14743: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
14744: }
14745: return;
14746: }
14747:
1.1075.2.27 raeburn 14748: sub allmaps_incourse {
14749: my ($cdom,$cnum,$chome,$cid) = @_;
14750: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
14751: $cid = $env{'request.course.id'};
14752: $cdom = $env{'course.'.$cid.'.domain'};
14753: $cnum = $env{'course.'.$cid.'.num'};
14754: $chome = $env{'course.'.$cid.'.home'};
14755: }
14756: my %allmaps = ();
14757: my $lastchange =
14758: &Apache::lonnet::get_coursechange($cdom,$cnum);
14759: if ($lastchange > $env{'request.course.tied'}) {
14760: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
14761: unless ($ferr) {
14762: &update_content_constraints($cdom,$cnum,$chome,$cid);
14763: }
14764: }
14765: my $navmap = Apache::lonnavmaps::navmap->new();
14766: if (defined($navmap)) {
14767: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
14768: $allmaps{$res->src()} = 1;
14769: }
14770: }
14771: return \%allmaps;
14772: }
14773:
1.1075.2.11 raeburn 14774: sub parse_supplemental_title {
14775: my ($title) = @_;
14776:
14777: my ($foldertitle,$renametitle);
14778: if ($title =~ /&&&/) {
14779: $title = &HTML::Entites::decode($title);
14780: }
14781: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
14782: $renametitle=$4;
14783: my ($time,$uname,$udom) = ($1,$2,$3);
14784: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
14785: my $name = &plainname($uname,$udom);
14786: $name = &HTML::Entities::encode($name,'"<>&\'');
14787: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
14788: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
14789: $name.': <br />'.$foldertitle;
14790: }
14791: if (wantarray) {
14792: return ($title,$foldertitle,$renametitle);
14793: }
14794: return $title;
14795: }
14796:
1.1075.2.43 raeburn 14797: sub recurse_supplemental {
14798: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
14799: if ($suppmap) {
14800: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
14801: if ($fatal) {
14802: $errors ++;
14803: } else {
14804: if ($#LONCAPA::map::resources > 0) {
14805: foreach my $res (@LONCAPA::map::resources) {
14806: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
14807: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 14808: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
14809: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 14810: } else {
14811: $numfiles ++;
14812: }
14813: }
14814: }
14815: }
14816: }
14817: }
14818: return ($numfiles,$errors);
14819: }
14820:
1.1075.2.18 raeburn 14821: sub symb_to_docspath {
14822: my ($symb) = @_;
14823: return unless ($symb);
14824: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
14825: if ($resurl=~/\.(sequence|page)$/) {
14826: $mapurl=$resurl;
14827: } elsif ($resurl eq 'adm/navmaps') {
14828: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
14829: }
14830: my $mapresobj;
14831: my $navmap = Apache::lonnavmaps::navmap->new();
14832: if (ref($navmap)) {
14833: $mapresobj = $navmap->getResourceByUrl($mapurl);
14834: }
14835: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
14836: my $type=$2;
14837: my $path;
14838: if (ref($mapresobj)) {
14839: my $pcslist = $mapresobj->map_hierarchy();
14840: if ($pcslist ne '') {
14841: foreach my $pc (split(/,/,$pcslist)) {
14842: next if ($pc <= 1);
14843: my $res = $navmap->getByMapPc($pc);
14844: if (ref($res)) {
14845: my $thisurl = $res->src();
14846: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
14847: my $thistitle = $res->title();
14848: $path .= '&'.
14849: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 14850: &escape($thistitle).
1.1075.2.18 raeburn 14851: ':'.$res->randompick().
14852: ':'.$res->randomout().
14853: ':'.$res->encrypted().
14854: ':'.$res->randomorder().
14855: ':'.$res->is_page();
14856: }
14857: }
14858: }
14859: $path =~ s/^\&//;
14860: my $maptitle = $mapresobj->title();
14861: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 14862: $maptitle = 'Main Content';
1.1075.2.18 raeburn 14863: }
14864: $path .= (($path ne '')? '&' : '').
14865: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 14866: &escape($maptitle).
1.1075.2.18 raeburn 14867: ':'.$mapresobj->randompick().
14868: ':'.$mapresobj->randomout().
14869: ':'.$mapresobj->encrypted().
14870: ':'.$mapresobj->randomorder().
14871: ':'.$mapresobj->is_page();
14872: } else {
14873: my $maptitle = &Apache::lonnet::gettitle($mapurl);
14874: my $ispage = (($type eq 'page')? 1 : '');
14875: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 14876: $maptitle = 'Main Content';
1.1075.2.18 raeburn 14877: }
14878: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 14879: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 14880: }
14881: unless ($mapurl eq 'default') {
14882: $path = 'default&'.
1.1075.2.46 raeburn 14883: &escape('Main Content').
1.1075.2.18 raeburn 14884: ':::::&'.$path;
14885: }
14886: return $path;
14887: }
14888:
1.1075.2.14 raeburn 14889: sub captcha_display {
14890: my ($context,$lonhost) = @_;
14891: my ($output,$error);
14892: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
14893: if ($captcha eq 'original') {
14894: $output = &create_captcha();
14895: unless ($output) {
14896: $error = 'captcha';
14897: }
14898: } elsif ($captcha eq 'recaptcha') {
14899: $output = &create_recaptcha($pubkey);
14900: unless ($output) {
14901: $error = 'recaptcha';
14902: }
14903: }
1.1075.2.66 raeburn 14904: return ($output,$error,$captcha);
1.1075.2.14 raeburn 14905: }
14906:
14907: sub captcha_response {
14908: my ($context,$lonhost) = @_;
14909: my ($captcha_chk,$captcha_error);
14910: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
14911: if ($captcha eq 'original') {
14912: ($captcha_chk,$captcha_error) = &check_captcha();
14913: } elsif ($captcha eq 'recaptcha') {
14914: $captcha_chk = &check_recaptcha($privkey);
14915: } else {
14916: $captcha_chk = 1;
14917: }
14918: return ($captcha_chk,$captcha_error);
14919: }
14920:
14921: sub get_captcha_config {
14922: my ($context,$lonhost) = @_;
14923: my ($captcha,$pubkey,$privkey,$hashtocheck);
14924: my $hostname = &Apache::lonnet::hostname($lonhost);
14925: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
14926: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
14927: if ($context eq 'usercreation') {
14928: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
14929: if (ref($domconfig{$context}) eq 'HASH') {
14930: $hashtocheck = $domconfig{$context}{'cancreate'};
14931: if (ref($hashtocheck) eq 'HASH') {
14932: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
14933: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
14934: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
14935: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
14936: }
14937: if ($privkey && $pubkey) {
14938: $captcha = 'recaptcha';
14939: } else {
14940: $captcha = 'original';
14941: }
14942: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
14943: $captcha = 'original';
14944: }
14945: }
14946: } else {
14947: $captcha = 'captcha';
14948: }
14949: } elsif ($context eq 'login') {
14950: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
14951: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
14952: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
14953: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
14954: if ($privkey && $pubkey) {
14955: $captcha = 'recaptcha';
14956: } else {
14957: $captcha = 'original';
14958: }
14959: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
14960: $captcha = 'original';
14961: }
14962: }
14963: return ($captcha,$pubkey,$privkey);
14964: }
14965:
14966: sub create_captcha {
14967: my %captcha_params = &captcha_settings();
14968: my ($output,$maxtries,$tries) = ('',10,0);
14969: while ($tries < $maxtries) {
14970: $tries ++;
14971: my $captcha = Authen::Captcha->new (
14972: output_folder => $captcha_params{'output_dir'},
14973: data_folder => $captcha_params{'db_dir'},
14974: );
14975: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
14976:
14977: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
14978: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
14979: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 14980: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
14981: '<br />'.
14982: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 14983: last;
14984: }
14985: }
14986: return $output;
14987: }
14988:
14989: sub captcha_settings {
14990: my %captcha_params = (
14991: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
14992: www_output_dir => "/captchaspool",
14993: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
14994: numchars => '5',
14995: );
14996: return %captcha_params;
14997: }
14998:
14999: sub check_captcha {
15000: my ($captcha_chk,$captcha_error);
15001: my $code = $env{'form.code'};
15002: my $md5sum = $env{'form.crypt'};
15003: my %captcha_params = &captcha_settings();
15004: my $captcha = Authen::Captcha->new(
15005: output_folder => $captcha_params{'output_dir'},
15006: data_folder => $captcha_params{'db_dir'},
15007: );
1.1075.2.26 raeburn 15008: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 15009: my %captcha_hash = (
15010: 0 => 'Code not checked (file error)',
15011: -1 => 'Failed: code expired',
15012: -2 => 'Failed: invalid code (not in database)',
15013: -3 => 'Failed: invalid code (code does not match crypt)',
15014: );
15015: if ($captcha_chk != 1) {
15016: $captcha_error = $captcha_hash{$captcha_chk}
15017: }
15018: return ($captcha_chk,$captcha_error);
15019: }
15020:
15021: sub create_recaptcha {
15022: my ($pubkey) = @_;
1.1075.2.51 raeburn 15023: my $use_ssl;
15024: if ($ENV{'SERVER_PORT'} == 443) {
15025: $use_ssl = 1;
15026: }
1.1075.2.14 raeburn 15027: my $captcha = Captcha::reCAPTCHA->new;
15028: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 15029: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14 raeburn 15030: &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 15031: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 15032: '<br /><br />';
15033: }
15034:
15035: sub check_recaptcha {
15036: my ($privkey) = @_;
15037: my $captcha_chk;
15038: my $captcha = Captcha::reCAPTCHA->new;
15039: my $captcha_result =
15040: $captcha->check_answer(
15041: $privkey,
15042: $ENV{'REMOTE_ADDR'},
15043: $env{'form.recaptcha_challenge_field'},
15044: $env{'form.recaptcha_response_field'},
15045: );
15046: if ($captcha_result->{is_valid}) {
15047: $captcha_chk = 1;
15048: }
15049: return $captcha_chk;
15050: }
15051:
1.1075.2.64 raeburn 15052: sub emailusername_info {
1.1075.2.67 raeburn 15053: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64 raeburn 15054: my %titles = &Apache::lonlocal::texthash (
15055: lastname => 'Last Name',
15056: firstname => 'First Name',
15057: institution => 'School/college/university',
15058: location => "School's city, state/province, country",
15059: web => "School's web address",
15060: officialemail => 'E-mail address at institution (if different)',
15061: );
15062: return (\@fields,\%titles);
15063: }
15064:
1.1075.2.56 raeburn 15065: sub cleanup_html {
15066: my ($incoming) = @_;
15067: my $outgoing;
15068: if ($incoming ne '') {
15069: $outgoing = $incoming;
15070: $outgoing =~ s/;/;/g;
15071: $outgoing =~ s/\#/#/g;
15072: $outgoing =~ s/\&/&/g;
15073: $outgoing =~ s/</</g;
15074: $outgoing =~ s/>/>/g;
15075: $outgoing =~ s/\(/(/g;
15076: $outgoing =~ s/\)/)/g;
15077: $outgoing =~ s/"/"/g;
15078: $outgoing =~ s/'/'/g;
15079: $outgoing =~ s/\$/$/g;
15080: $outgoing =~ s{/}{/}g;
15081: $outgoing =~ s/=/=/g;
15082: $outgoing =~ s/\\/\/g
15083: }
15084: return $outgoing;
15085: }
15086:
1.1075.2.64 raeburn 15087: # Use:
15088: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
15089: #
15090: ##################################################
15091: # password associated functions #
15092: ##################################################
15093: sub des_keys {
15094: # Make a new key for DES encryption.
15095: # Each key has two parts which are returned separately.
15096: # Please note: Each key must be passed through the &hex function
15097: # before it is output to the web browser. The hex versions cannot
15098: # be used to decrypt.
15099: my @hexstr=('0','1','2','3','4','5','6','7',
15100: '8','9','a','b','c','d','e','f');
15101: my $lkey='';
15102: for (0..7) {
15103: $lkey.=$hexstr[rand(15)];
15104: }
15105: my $ukey='';
15106: for (0..7) {
15107: $ukey.=$hexstr[rand(15)];
15108: }
15109: return ($lkey,$ukey);
15110: }
15111:
15112: sub des_decrypt {
15113: my ($key,$cyphertext) = @_;
15114: my $keybin=pack("H16",$key);
15115: my $cypher;
15116: if ($Crypt::DES::VERSION>=2.03) {
15117: $cypher=new Crypt::DES $keybin;
15118: } else {
15119: $cypher=new DES $keybin;
15120: }
15121: my $plaintext=
15122: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
15123: $plaintext.=
15124: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
15125: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
15126: return $plaintext;
15127: }
15128:
1.41 ng 15129: =pod
15130:
15131: =back
15132:
1.112 bowersj2 15133: =cut
1.41 ng 15134:
1.112 bowersj2 15135: 1;
15136: __END__;
1.41 ng 15137:
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