Annotation of loncom/interface/loncommon.pm, revision 1.1239
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1239 ! raeburn 4: # $Id: loncommon.pm,v 1.1238 2016/04/04 00:56:04 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.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1220 raeburn 76: use Encode();
1.1091 foxr 77: use Text::Aspell;
1.1094 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.1234 raeburn 80: use JSON::DWIW;
81: use LWP::UserAgent;
1.1174 raeburn 82: use Crypt::DES;
83: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 84: use MIME::Lite;
85: use MIME::Types;
1.117 www 86:
1.517 raeburn 87: # ---------------------------------------------- Designs
88: use vars qw(%defaultdesign);
89:
1.22 www 90: my $readit;
91:
1.517 raeburn 92:
1.157 matthew 93: ##
94: ## Global Variables
95: ##
1.46 matthew 96:
1.643 foxr 97:
98: # ----------------------------------------------- SSI with retries:
99: #
100:
101: =pod
102:
1.648 raeburn 103: =head1 Server Side include with retries:
1.643 foxr 104:
105: =over 4
106:
1.648 raeburn 107: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 108:
109: Performs an ssi with some number of retries. Retries continue either
110: until the result is ok or until the retry count supplied by the
111: caller is exhausted.
112:
113: Inputs:
1.648 raeburn 114:
115: =over 4
116:
1.643 foxr 117: resource - Identifies the resource to insert.
1.648 raeburn 118:
1.643 foxr 119: retries - Count of the number of retries allowed.
1.648 raeburn 120:
1.643 foxr 121: form - Hash that identifies the rendering options.
122:
1.648 raeburn 123: =back
124:
125: Returns:
126:
127: =over 4
128:
1.643 foxr 129: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 130:
1.643 foxr 131: response - The response from the last attempt (which may or may not have been successful.
132:
1.648 raeburn 133: =back
134:
135: =back
136:
1.643 foxr 137: =cut
138:
139: sub ssi_with_retries {
140: my ($resource, $retries, %form) = @_;
141:
142:
143: my $ok = 0; # True if we got a good response.
144: my $content;
145: my $response;
146:
147: # Try to get the ssi done. within the retries count:
148:
149: do {
150: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
151: $ok = $response->is_success;
1.650 www 152: if (!$ok) {
153: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
154: }
1.643 foxr 155: $retries--;
156: } while (!$ok && ($retries > 0));
157:
158: if (!$ok) {
159: $content = ''; # On error return an empty content.
160: }
161: return ($content, $response);
162:
163: }
164:
165:
166:
1.20 www 167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 168: my %language;
1.124 www 169: my %supported_language;
1.1088 foxr 170: my %supported_codes;
1.1048 foxr 171: my %latex_language; # For choosing hyphenation in <transl..>
172: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 173: my %cprtag;
1.192 taceyjo1 174: my %scprtag;
1.351 www 175: my %fe; my %fd; my %fm;
1.41 ng 176: my %category_extensions;
1.12 harris41 177:
1.46 matthew 178: # ---------------------------------------------- Thesaurus variables
1.144 matthew 179: #
180: # %Keywords:
181: # A hash used by &keyword to determine if a word is considered a keyword.
182: # $thesaurus_db_file
183: # Scalar containing the full path to the thesaurus database.
1.46 matthew 184:
185: my %Keywords;
186: my $thesaurus_db_file;
187:
1.144 matthew 188: #
189: # Initialize values from language.tab, copyright.tab, filetypes.tab,
190: # thesaurus.tab, and filecategories.tab.
191: #
1.18 www 192: BEGIN {
1.46 matthew 193: # Variable initialization
194: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
195: #
1.22 www 196: unless ($readit) {
1.12 harris41 197: # ------------------------------------------------------------------- languages
198: {
1.158 raeburn 199: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
200: '/language.tab';
201: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 202: while (my $line = <$fh>) {
203: next if ($line=~/^\#/);
204: chomp($line);
1.1088 foxr 205: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 206: $language{$key}=$val.' - '.$enc;
207: if ($sup) {
208: $supported_language{$key}=$sup;
1.1088 foxr 209: $supported_codes{$key} = $code;
1.158 raeburn 210: }
1.1048 foxr 211: if ($latex) {
212: $latex_language_bykey{$key} = $latex;
1.1088 foxr 213: $latex_language{$code} = $latex;
1.1048 foxr 214: }
1.158 raeburn 215: }
216: close($fh);
217: }
1.12 harris41 218: }
219: # ------------------------------------------------------------------ copyrights
220: {
1.158 raeburn 221: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
222: '/copyright.tab';
223: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line=~/^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 228: $cprtag{$key}=$val;
229: }
230: close($fh);
231: }
1.12 harris41 232: }
1.351 www 233: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 234: {
235: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
236: '/source_copyright.tab';
237: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 242: $scprtag{$key}=$val;
243: }
244: close($fh);
245: }
246: }
1.63 www 247:
1.517 raeburn 248: # -------------------------------------------------------------- default domain designs
1.63 www 249: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 250: my $designfile = $designdir.'/default.tab';
251: if ( open (my $fh,"<$designfile") ) {
252: while (my $line = <$fh>) {
253: next if ($line =~ /^\#/);
254: chomp($line);
255: my ($key,$val)=(split(/\=/,$line));
256: if ($val) { $defaultdesign{$key}=$val; }
257: }
258: close($fh);
1.63 www 259: }
260:
1.15 harris41 261: # ------------------------------------------------------------- file categories
262: {
1.158 raeburn 263: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
264: '/filecategories.tab';
265: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 266: while (my $line = <$fh>) {
267: next if ($line =~ /^\#/);
268: chomp($line);
269: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 270: push @{$category_extensions{lc($category)}},$extension;
271: }
272: close($fh);
273: }
274:
1.15 harris41 275: }
1.12 harris41 276: # ------------------------------------------------------------------ file types
277: {
1.158 raeburn 278: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
279: '/filetypes.tab';
280: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 281: while (my $line = <$fh>) {
282: next if ($line =~ /^\#/);
283: chomp($line);
284: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 285: if ($descr ne '') {
286: $fe{$ending}=lc($emb);
287: $fd{$ending}=$descr;
1.351 www 288: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 289: }
290: }
291: close($fh);
292: }
1.12 harris41 293: }
1.22 www 294: &Apache::lonnet::logthis(
1.705 tempelho 295: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 296: $readit=1;
1.46 matthew 297: } # end of unless($readit)
1.32 matthew 298:
299: }
1.112 bowersj2 300:
1.42 matthew 301: ###############################################################
302: ## HTML and Javascript Helper Functions ##
303: ###############################################################
304:
305: =pod
306:
1.112 bowersj2 307: =head1 HTML and Javascript Functions
1.42 matthew 308:
1.112 bowersj2 309: =over 4
310:
1.648 raeburn 311: =item * &browser_and_searcher_javascript()
1.112 bowersj2 312:
313: X<browsing, javascript>X<searching, javascript>Returns a string
314: containing javascript with two functions, C<openbrowser> and
315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
316: tags.
1.42 matthew 317:
1.648 raeburn 318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 319:
320: inputs: formname, elementname, only, omit
321:
322: formname and elementname indicate the name of the html form and name of
323: the element that the results of the browsing selection are to be placed in.
324:
325: Specifying 'only' will restrict the browser to displaying only files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 329: with the given extension. Can be a comma separated list.
1.42 matthew 330:
1.648 raeburn 331: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 332:
333: Inputs: formname, elementname
334:
335: formname and elementname specify the name of the html form and the name
336: of the element the selection from the search results will be placed in.
1.542 raeburn 337:
1.42 matthew 338: =cut
339:
340: sub browser_and_searcher_javascript {
1.199 albertel 341: my ($mode)=@_;
342: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 343: my $resurl=&escape_single(&lastresurl());
1.42 matthew 344: return <<END;
1.219 albertel 345: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 346: var editbrowser = null;
1.135 albertel 347: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 348: var url = '$resurl/?';
1.42 matthew 349: if (editbrowser == null) {
350: url += 'launch=1&';
351: }
352: url += 'catalogmode=interactive&';
1.199 albertel 353: url += 'mode=$mode&';
1.611 albertel 354: url += 'inhibitmenu=yes&';
1.42 matthew 355: url += 'form=' + formname + '&';
356: if (only != null) {
357: url += 'only=' + only + '&';
1.217 albertel 358: } else {
359: url += 'only=&';
360: }
1.42 matthew 361: if (omit != null) {
362: url += 'omit=' + omit + '&';
1.217 albertel 363: } else {
364: url += 'omit=&';
365: }
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Browser';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editbrowser = open(url,title,options,'1');
376: editbrowser.focus();
377: }
378: var editsearcher;
1.135 albertel 379: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 380: var url = '/adm/searchcat?';
381: if (editsearcher == null) {
382: url += 'launch=1&';
383: }
384: url += 'catalogmode=interactive&';
1.199 albertel 385: url += 'mode=$mode&';
1.42 matthew 386: url += 'form=' + formname + '&';
1.135 albertel 387: if (titleelement != null) {
388: url += 'titleelement=' + titleelement + '&';
1.217 albertel 389: } else {
390: url += 'titleelement=&';
391: }
1.42 matthew 392: url += 'element=' + elementname + '';
393: var title = 'Search';
1.435 albertel 394: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 395: options += ',width=700,height=600';
396: editsearcher = open(url,title,options,'1');
397: editsearcher.focus();
398: }
1.219 albertel 399: // END LON-CAPA Internal -->
1.42 matthew 400: END
1.170 www 401: }
402:
403: sub lastresurl {
1.258 albertel 404: if ($env{'environment.lastresurl'}) {
405: return $env{'environment.lastresurl'}
1.170 www 406: } else {
407: return '/res';
408: }
409: }
410:
411: sub storeresurl {
412: my $resurl=&Apache::lonnet::clutter(shift);
413: unless ($resurl=~/^\/res/) { return 0; }
414: $resurl=~s/\/$//;
415: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 416: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 417: return 1;
1.42 matthew 418: }
419:
1.74 www 420: sub studentbrowser_javascript {
1.111 www 421: unless (
1.258 albertel 422: (($env{'request.course.id'}) &&
1.302 albertel 423: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
424: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
425: '/'.$env{'request.course.sec'})
426: ))
1.258 albertel 427: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 428: ) { return ''; }
1.74 www 429: return (<<'ENDSTDBRW');
1.776 bisitz 430: <script type="text/javascript" language="Javascript">
1.824 bisitz 431: // <![CDATA[
1.74 www 432: var stdeditbrowser;
1.999 www 433: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 434: var url = '/adm/pickstudent?';
435: var filter;
1.558 albertel 436: if (!ignorefilter) {
437: eval('filter=document.'+formname+'.'+uname+'.value;');
438: }
1.74 www 439: if (filter != null) {
440: if (filter != '') {
441: url += 'filter='+filter+'&';
442: }
443: }
444: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 445: '&udomelement='+udom+
446: '&clicker='+clicker;
1.111 www 447: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 448: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 449: var title = 'Student_Browser';
1.74 www 450: var options = 'scrollbars=1,resizable=1,menubar=0';
451: options += ',width=700,height=600';
452: stdeditbrowser = open(url,title,options,'1');
453: stdeditbrowser.focus();
454: }
1.824 bisitz 455: // ]]>
1.74 www 456: </script>
457: ENDSTDBRW
458: }
1.42 matthew 459:
1.1003 www 460: sub resourcebrowser_javascript {
461: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 462: return (<<'ENDRESBRW');
1.1003 www 463: <script type="text/javascript" language="Javascript">
464: // <![CDATA[
465: var reseditbrowser;
1.1004 www 466: function openresbrowser(formname,reslink) {
1.1005 www 467: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 468: var title = 'Resource_Browser';
469: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 470: options += ',width=700,height=500';
1.1004 www 471: reseditbrowser = open(url,title,options,'1');
472: reseditbrowser.focus();
1.1003 www 473: }
474: // ]]>
475: </script>
1.1004 www 476: ENDRESBRW
1.1003 www 477: }
478:
1.74 www 479: sub selectstudent_link {
1.999 www 480: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
481: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
482: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
483: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 484: if ($env{'request.course.id'}) {
1.302 albertel 485: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
486: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
487: '/'.$env{'request.course.sec'})) {
1.111 www 488: return '';
489: }
1.999 www 490: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 491: if ($courseadvonly) {
492: $callargs .= ",'',1,1";
493: }
494: return '<span class="LC_nobreak">'.
495: '<a href="javascript:openstdbrowser('.$callargs.');">'.
496: &mt('Select User').'</a></span>';
1.74 www 497: }
1.258 albertel 498: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 499: $callargs .= ",'',1";
1.793 raeburn 500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openstdbrowser('.$callargs.');">'.
502: &mt('Select User').'</a></span>';
1.111 www 503: }
504: return '';
1.91 www 505: }
506:
1.1004 www 507: sub selectresource_link {
508: my ($form,$reslink,$arg)=@_;
509:
510: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
511: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
512: unless ($env{'request.course.id'}) { return $arg; }
513: return '<span class="LC_nobreak">'.
514: '<a href="javascript:openresbrowser('.$callargs.');">'.
515: $arg.'</a></span>';
516: }
517:
518:
519:
1.653 raeburn 520: sub authorbrowser_javascript {
521: return <<"ENDAUTHORBRW";
1.776 bisitz 522: <script type="text/javascript" language="JavaScript">
1.824 bisitz 523: // <![CDATA[
1.653 raeburn 524: var stdeditbrowser;
525:
526: function openauthorbrowser(formname,udom) {
527: var url = '/adm/pickauthor?';
528: url += 'form='+formname+'&roledom='+udom;
529: var title = 'Author_Browser';
530: var options = 'scrollbars=1,resizable=1,menubar=0';
531: options += ',width=700,height=600';
532: stdeditbrowser = open(url,title,options,'1');
533: stdeditbrowser.focus();
534: }
535:
1.824 bisitz 536: // ]]>
1.653 raeburn 537: </script>
538: ENDAUTHORBRW
539: }
540:
1.91 www 541: sub coursebrowser_javascript {
1.1116 raeburn 542: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 543: $credits_element,$instcode) = @_;
1.932 raeburn 544: my $wintitle = 'Course_Browser';
1.931 raeburn 545: if ($crstype eq 'Community') {
1.932 raeburn 546: $wintitle = 'Community_Browser';
1.909 raeburn 547: }
1.876 raeburn 548: my $id_functions = &javascript_index_functions();
549: my $output = '
1.776 bisitz 550: <script type="text/javascript" language="JavaScript">
1.824 bisitz 551: // <![CDATA[
1.468 raeburn 552: var stdeditbrowser;'."\n";
1.876 raeburn 553:
554: $output .= <<"ENDSTDBRW";
1.909 raeburn 555: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 556: var url = '/adm/pickcourse?';
1.895 raeburn 557: var formid = getFormIdByName(formname);
1.876 raeburn 558: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 559: if (domainfilter != null) {
560: if (domainfilter != '') {
561: url += 'domainfilter='+domainfilter+'&';
562: }
563: }
1.91 www 564: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 565: '&cdomelement='+udom+
566: '&cnameelement='+desc;
1.468 raeburn 567: if (extra_element !=null && extra_element != '') {
1.594 raeburn 568: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 569: url += '&roleelement='+extra_element;
570: if (domainfilter == null || domainfilter == '') {
571: url += '&domainfilter='+extra_element;
572: }
1.234 raeburn 573: }
1.468 raeburn 574: else {
575: if (formname == 'portform') {
576: url += '&setroles='+extra_element;
1.800 raeburn 577: } else {
578: if (formname == 'rules') {
579: url += '&fixeddom='+extra_element;
580: }
1.468 raeburn 581: }
582: }
1.230 raeburn 583: }
1.909 raeburn 584: if (type != null && type != '') {
585: url += '&type='+type;
586: }
587: if (type_elem != null && type_elem != '') {
588: url += '&typeelement='+type_elem;
589: }
1.872 raeburn 590: if (formname == 'ccrs') {
591: var ownername = document.forms[formid].ccuname.value;
592: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 593: url += '&cloner='+ownername+':'+ownerdom;
594: if (type == 'Course') {
595: url += '&crscode='+document.forms[formid].crscode.value;
596: }
1.1221 raeburn 597: }
598: if (formname == 'requestcrs') {
599: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 600: }
1.293 raeburn 601: if (multflag !=null && multflag != '') {
602: url += '&multiple='+multflag;
603: }
1.909 raeburn 604: var title = '$wintitle';
1.91 www 605: var options = 'scrollbars=1,resizable=1,menubar=0';
606: options += ',width=700,height=600';
607: stdeditbrowser = open(url,title,options,'1');
608: stdeditbrowser.focus();
609: }
1.876 raeburn 610: $id_functions
611: ENDSTDBRW
1.1116 raeburn 612: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
613: $output .= &setsec_javascript($sec_element,$formname,$role_element,
614: $credits_element);
1.876 raeburn 615: }
616: $output .= '
617: // ]]>
618: </script>';
619: return $output;
620: }
621:
622: sub javascript_index_functions {
623: return <<"ENDJS";
624:
625: function getFormIdByName(formname) {
626: for (var i=0;i<document.forms.length;i++) {
627: if (document.forms[i].name == formname) {
628: return i;
629: }
630: }
631: return -1;
632: }
633:
634: function getIndexByName(formid,item) {
635: for (var i=0;i<document.forms[formid].elements.length;i++) {
636: if (document.forms[formid].elements[i].name == item) {
637: return i;
638: }
639: }
640: return -1;
641: }
1.468 raeburn 642:
1.876 raeburn 643: function getDomainFromSelectbox(formname,udom) {
644: var userdom;
645: var formid = getFormIdByName(formname);
646: if (formid > -1) {
647: var domid = getIndexByName(formid,udom);
648: if (domid > -1) {
649: if (document.forms[formid].elements[domid].type == 'select-one') {
650: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
651: }
652: if (document.forms[formid].elements[domid].type == 'hidden') {
653: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 654: }
655: }
656: }
1.876 raeburn 657: return userdom;
658: }
659:
660: ENDJS
1.468 raeburn 661:
1.876 raeburn 662: }
663:
1.1017 raeburn 664: sub javascript_array_indexof {
1.1018 raeburn 665: return <<ENDJS;
1.1017 raeburn 666: <script type="text/javascript" language="JavaScript">
667: // <![CDATA[
668:
669: if (!Array.prototype.indexOf) {
670: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
671: "use strict";
672: if (this === void 0 || this === null) {
673: throw new TypeError();
674: }
675: var t = Object(this);
676: var len = t.length >>> 0;
677: if (len === 0) {
678: return -1;
679: }
680: var n = 0;
681: if (arguments.length > 0) {
682: n = Number(arguments[1]);
1.1088 foxr 683: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 684: n = 0;
685: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
686: n = (n > 0 || -1) * Math.floor(Math.abs(n));
687: }
688: }
689: if (n >= len) {
690: return -1;
691: }
692: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
693: for (; k < len; k++) {
694: if (k in t && t[k] === searchElement) {
695: return k;
696: }
697: }
698: return -1;
699: }
700: }
701:
702: // ]]>
703: </script>
704:
705: ENDJS
706:
707: }
708:
1.876 raeburn 709: sub userbrowser_javascript {
710: my $id_functions = &javascript_index_functions();
711: return <<"ENDUSERBRW";
712:
1.888 raeburn 713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 714: var url = '/adm/pickuser?';
715: var userdom = getDomainFromSelectbox(formname,udom);
716: if (userdom != null) {
717: if (userdom != '') {
718: url += 'srchdom='+userdom+'&';
719: }
720: }
721: url += 'form=' + formname + '&unameelement='+uname+
722: '&udomelement='+udom+
723: '&ulastelement='+ulast+
724: '&ufirstelement='+ufirst+
725: '&uemailelement='+uemail+
1.881 raeburn 726: '&hideudomelement='+hideudom+
727: '&coursedom='+crsdom;
1.888 raeburn 728: if ((caller != null) && (caller != undefined)) {
729: url += '&caller='+caller;
730: }
1.876 raeburn 731: var title = 'User_Browser';
732: var options = 'scrollbars=1,resizable=1,menubar=0';
733: options += ',width=700,height=600';
734: var stdeditbrowser = open(url,title,options,'1');
735: stdeditbrowser.focus();
736: }
737:
1.888 raeburn 738: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 739: var formid = getFormIdByName(formname);
740: if (formid > -1) {
1.888 raeburn 741: var unameid = getIndexByName(formid,uname);
1.876 raeburn 742: var domid = getIndexByName(formid,udom);
743: var hidedomid = getIndexByName(formid,origdom);
744: if (hidedomid > -1) {
745: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 746: var unameval = document.forms[formid].elements[unameid].value;
747: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
748: if (domid > -1) {
749: var slct = document.forms[formid].elements[domid];
750: if (slct.type == 'select-one') {
751: var i;
752: for (i=0;i<slct.length;i++) {
753: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
754: }
755: }
756: if (slct.type == 'hidden') {
757: slct.value = fixeddom;
1.876 raeburn 758: }
759: }
1.468 raeburn 760: }
761: }
762: }
1.876 raeburn 763: return;
764: }
765:
766: $id_functions
767: ENDUSERBRW
1.468 raeburn 768: }
769:
770: sub setsec_javascript {
1.1116 raeburn 771: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 772: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
773: $communityrolestr);
774: if ($role_element ne '') {
775: my @allroles = ('st','ta','ep','in','ad');
776: foreach my $crstype ('Course','Community') {
777: if ($crstype eq 'Community') {
778: foreach my $role (@allroles) {
779: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
780: }
781: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
782: } else {
783: foreach my $role (@allroles) {
784: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
785: }
786: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
787: }
788: }
789: $rolestr = '"'.join('","',@allroles).'"';
790: $courserolestr = '"'.join('","',@courserolenames).'"';
791: $communityrolestr = '"'.join('","',@communityrolenames).'"';
792: }
1.468 raeburn 793: my $setsections = qq|
794: function setSect(sectionlist) {
1.629 raeburn 795: var sectionsArray = new Array();
796: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
797: sectionsArray = sectionlist.split(",");
798: }
1.468 raeburn 799: var numSections = sectionsArray.length;
800: document.$formname.$sec_element.length = 0;
801: if (numSections == 0) {
802: document.$formname.$sec_element.multiple=false;
803: document.$formname.$sec_element.size=1;
804: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
805: } else {
806: if (numSections == 1) {
807: document.$formname.$sec_element.multiple=false;
808: document.$formname.$sec_element.size=1;
809: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
810: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
811: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
812: } else {
813: for (var i=0; i<numSections; i++) {
814: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
815: }
816: document.$formname.$sec_element.multiple=true
817: if (numSections < 3) {
818: document.$formname.$sec_element.size=numSections;
819: } else {
820: document.$formname.$sec_element.size=3;
821: }
822: document.$formname.$sec_element.options[0].selected = false
823: }
824: }
1.91 www 825: }
1.905 raeburn 826:
827: function setRole(crstype) {
1.468 raeburn 828: |;
1.905 raeburn 829: if ($role_element eq '') {
830: $setsections .= ' return;
831: }
832: ';
833: } else {
834: $setsections .= qq|
835: var elementLength = document.$formname.$role_element.length;
836: var allroles = Array($rolestr);
837: var courserolenames = Array($courserolestr);
838: var communityrolenames = Array($communityrolestr);
839: if (elementLength != undefined) {
840: if (document.$formname.$role_element.options[5].value == 'cc') {
841: if (crstype == 'Course') {
842: return;
843: } else {
844: allroles[5] = 'co';
845: for (var i=0; i<6; i++) {
846: document.$formname.$role_element.options[i].value = allroles[i];
847: document.$formname.$role_element.options[i].text = communityrolenames[i];
848: }
849: }
850: } else {
851: if (crstype == 'Community') {
852: return;
853: } else {
854: allroles[5] = 'cc';
855: for (var i=0; i<6; i++) {
856: document.$formname.$role_element.options[i].value = allroles[i];
857: document.$formname.$role_element.options[i].text = courserolenames[i];
858: }
859: }
860: }
861: }
862: return;
863: }
864: |;
865: }
1.1116 raeburn 866: if ($credits_element) {
867: $setsections .= qq|
868: function setCredits(defaultcredits) {
869: document.$formname.$credits_element.value = defaultcredits;
870: return;
871: }
872: |;
873: }
1.468 raeburn 874: return $setsections;
875: }
876:
1.91 www 877: sub selectcourse_link {
1.909 raeburn 878: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
879: $typeelement) = @_;
880: my $type = $selecttype;
1.871 raeburn 881: my $linktext = &mt('Select Course');
882: if ($selecttype eq 'Community') {
1.909 raeburn 883: $linktext = &mt('Select Community');
1.1239 ! raeburn 884: } elsif ($selecttype eq 'Placement') {
! 885: $linktext = &mt('Select Placement Test');
1.906 raeburn 886: } elsif ($selecttype eq 'Course/Community') {
887: $linktext = &mt('Select Course/Community');
1.909 raeburn 888: $type = '';
1.1019 raeburn 889: } elsif ($selecttype eq 'Select') {
890: $linktext = &mt('Select');
891: $type = '';
1.871 raeburn 892: }
1.787 bisitz 893: return '<span class="LC_nobreak">'
894: ."<a href='"
895: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
896: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 897: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 898: ."'>".$linktext.'</a>'
1.787 bisitz 899: .'</span>';
1.74 www 900: }
1.42 matthew 901:
1.653 raeburn 902: sub selectauthor_link {
903: my ($form,$udom)=@_;
904: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
905: &mt('Select Author').'</a>';
906: }
907:
1.876 raeburn 908: sub selectuser_link {
1.881 raeburn 909: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 910: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 911: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 912: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 913: ');">'.$linktext.'</a>';
1.876 raeburn 914: }
915:
1.273 raeburn 916: sub check_uncheck_jscript {
917: my $jscript = <<"ENDSCRT";
918: function checkAll(field) {
919: if (field.length > 0) {
920: for (i = 0; i < field.length; i++) {
1.1093 raeburn 921: if (!field[i].disabled) {
922: field[i].checked = true;
923: }
1.273 raeburn 924: }
925: } else {
1.1093 raeburn 926: if (!field.disabled) {
927: field.checked = true;
928: }
1.273 raeburn 929: }
930: }
931:
932: function uncheckAll(field) {
933: if (field.length > 0) {
934: for (i = 0; i < field.length; i++) {
935: field[i].checked = false ;
1.543 albertel 936: }
937: } else {
1.273 raeburn 938: field.checked = false ;
939: }
940: }
941: ENDSCRT
942: return $jscript;
943: }
944:
1.656 www 945: sub select_timezone {
1.659 raeburn 946: my ($name,$selected,$onchange,$includeempty)=@_;
947: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
948: if ($includeempty) {
949: $output .= '<option value=""';
950: if (($selected eq '') || ($selected eq 'local')) {
951: $output .= ' selected="selected" ';
952: }
953: $output .= '> </option>';
954: }
1.657 raeburn 955: my @timezones = DateTime::TimeZone->all_names;
956: foreach my $tzone (@timezones) {
957: $output.= '<option value="'.$tzone.'"';
958: if ($tzone eq $selected) {
959: $output.=' selected="selected"';
960: }
961: $output.=">$tzone</option>\n";
1.656 www 962: }
963: $output.="</select>";
964: return $output;
965: }
1.273 raeburn 966:
1.687 raeburn 967: sub select_datelocale {
968: my ($name,$selected,$onchange,$includeempty)=@_;
969: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
970: if ($includeempty) {
971: $output .= '<option value=""';
972: if ($selected eq '') {
973: $output .= ' selected="selected" ';
974: }
975: $output .= '> </option>';
976: }
977: my (@possibles,%locale_names);
978: my @locales = DateTime::Locale::Catalog::Locales;
979: foreach my $locale (@locales) {
980: if (ref($locale) eq 'HASH') {
981: my $id = $locale->{'id'};
982: if ($id ne '') {
983: my $en_terr = $locale->{'en_territory'};
984: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 985: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 986: if (grep(/^en$/,@languages) || !@languages) {
987: if ($en_terr ne '') {
988: $locale_names{$id} = '('.$en_terr.')';
989: } elsif ($native_terr ne '') {
990: $locale_names{$id} = $native_terr;
991: }
992: } else {
993: if ($native_terr ne '') {
994: $locale_names{$id} = $native_terr.' ';
995: } elsif ($en_terr ne '') {
996: $locale_names{$id} = '('.$en_terr.')';
997: }
998: }
1.1220 raeburn 999: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687 raeburn 1000: push (@possibles,$id);
1001: }
1002: }
1003: }
1004: foreach my $item (sort(@possibles)) {
1005: $output.= '<option value="'.$item.'"';
1006: if ($item eq $selected) {
1007: $output.=' selected="selected"';
1008: }
1009: $output.=">$item";
1010: if ($locale_names{$item} ne '') {
1.1220 raeburn 1011: $output.=' '.$locale_names{$item};
1.687 raeburn 1012: }
1013: $output.="</option>\n";
1014: }
1015: $output.="</select>";
1016: return $output;
1017: }
1018:
1.792 raeburn 1019: sub select_language {
1020: my ($name,$selected,$includeempty) = @_;
1021: my %langchoices;
1022: if ($includeempty) {
1.1117 raeburn 1023: %langchoices = ('' => 'No language preference');
1.792 raeburn 1024: }
1025: foreach my $id (&languageids()) {
1026: my $code = &supportedlanguagecode($id);
1027: if ($code) {
1028: $langchoices{$code} = &plainlanguagedescription($id);
1029: }
1030: }
1.1117 raeburn 1031: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1032: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1033: }
1034:
1.42 matthew 1035: =pod
1.36 matthew 1036:
1.1088 foxr 1037:
1038: =item * &list_languages()
1039:
1040: Returns an array reference that is suitable for use in language prompters.
1041: Each array element is itself a two element array. The first element
1042: is the language code. The second element a descsriptiuon of the
1043: language itself. This is suitable for use in e.g.
1044: &Apache::edit::select_arg (once dereferenced that is).
1045:
1046: =cut
1047:
1048: sub list_languages {
1049: my @lang_choices;
1050:
1051: foreach my $id (&languageids()) {
1052: my $code = &supportedlanguagecode($id);
1053: if ($code) {
1054: my $selector = $supported_codes{$id};
1055: my $description = &plainlanguagedescription($id);
1056: push (@lang_choices, [$selector, $description]);
1057: }
1058: }
1059: return \@lang_choices;
1060: }
1061:
1062: =pod
1063:
1.648 raeburn 1064: =item * &linked_select_forms(...)
1.36 matthew 1065:
1066: linked_select_forms returns a string containing a <script></script> block
1067: and html for two <select> menus. The select menus will be linked in that
1068: changing the value of the first menu will result in new values being placed
1069: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1070: order unless a defined order is provided.
1.36 matthew 1071:
1072: linked_select_forms takes the following ordered inputs:
1073:
1074: =over 4
1075:
1.112 bowersj2 1076: =item * $formname, the name of the <form> tag
1.36 matthew 1077:
1.112 bowersj2 1078: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1079:
1.112 bowersj2 1080: =item * $firstdefault, the default value for the first menu
1.36 matthew 1081:
1.112 bowersj2 1082: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1083:
1.112 bowersj2 1084: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1085:
1.112 bowersj2 1086: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1087:
1.609 raeburn 1088: =item * $menuorder, the order of values in the first menu
1089:
1.1115 raeburn 1090: =item * $onchangefirst, additional javascript call to execute for an onchange
1091: event for the first <select> tag
1092:
1093: =item * $onchangesecond, additional javascript call to execute for an onchange
1094: event for the second <select> tag
1095:
1.41 ng 1096: =back
1097:
1.36 matthew 1098: Below is an example of such a hash. Only the 'text', 'default', and
1099: 'select2' keys must appear as stated. keys(%menu) are the possible
1100: values for the first select menu. The text that coincides with the
1.41 ng 1101: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1102: and text for the second menu are given in the hash pointed to by
1103: $menu{$choice1}->{'select2'}.
1104:
1.112 bowersj2 1105: my %menu = ( A1 => { text =>"Choice A1" ,
1106: default => "B3",
1107: select2 => {
1108: B1 => "Choice B1",
1109: B2 => "Choice B2",
1110: B3 => "Choice B3",
1111: B4 => "Choice B4"
1.609 raeburn 1112: },
1113: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1114: },
1115: A2 => { text =>"Choice A2" ,
1116: default => "C2",
1117: select2 => {
1118: C1 => "Choice C1",
1119: C2 => "Choice C2",
1120: C3 => "Choice C3"
1.609 raeburn 1121: },
1122: order => ['C2','C1','C3'],
1.112 bowersj2 1123: },
1124: A3 => { text =>"Choice A3" ,
1125: default => "D6",
1126: select2 => {
1127: D1 => "Choice D1",
1128: D2 => "Choice D2",
1129: D3 => "Choice D3",
1130: D4 => "Choice D4",
1131: D5 => "Choice D5",
1132: D6 => "Choice D6",
1133: D7 => "Choice D7"
1.609 raeburn 1134: },
1135: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1136: }
1137: );
1.36 matthew 1138:
1139: =cut
1140:
1141: sub linked_select_forms {
1142: my ($formname,
1143: $middletext,
1144: $firstdefault,
1145: $firstselectname,
1146: $secondselectname,
1.609 raeburn 1147: $hashref,
1148: $menuorder,
1.1115 raeburn 1149: $onchangefirst,
1150: $onchangesecond
1.36 matthew 1151: ) = @_;
1152: my $second = "document.$formname.$secondselectname";
1153: my $first = "document.$formname.$firstselectname";
1154: # output the javascript to do the changing
1155: my $result = '';
1.776 bisitz 1156: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1157: $result.="// <![CDATA[\n";
1.36 matthew 1158: $result.="var select2data = new Object();\n";
1159: $" = '","';
1160: my $debug = '';
1161: foreach my $s1 (sort(keys(%$hashref))) {
1162: $result.="select2data.d_$s1 = new Object();\n";
1163: $result.="select2data.d_$s1.def = new String('".
1164: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1165: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1166: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1167: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1168: @s2values = @{$hashref->{$s1}->{'order'}};
1169: }
1.36 matthew 1170: $result.="\"@s2values\");\n";
1171: $result.="select2data.d_$s1.texts = new Array(";
1172: my @s2texts;
1173: foreach my $value (@s2values) {
1174: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1175: }
1176: $result.="\"@s2texts\");\n";
1177: }
1178: $"=' ';
1179: $result.= <<"END";
1180:
1181: function select1_changed() {
1182: // Determine new choice
1183: var newvalue = "d_" + $first.value;
1184: // update select2
1185: var values = select2data[newvalue].values;
1186: var texts = select2data[newvalue].texts;
1187: var select2def = select2data[newvalue].def;
1188: var i;
1189: // out with the old
1190: for (i = 0; i < $second.options.length; i++) {
1191: $second.options[i] = null;
1192: }
1193: // in with the nuclear
1194: for (i=0;i<values.length; i++) {
1195: $second.options[i] = new Option(values[i]);
1.143 matthew 1196: $second.options[i].value = values[i];
1.36 matthew 1197: $second.options[i].text = texts[i];
1198: if (values[i] == select2def) {
1199: $second.options[i].selected = true;
1200: }
1201: }
1202: }
1.824 bisitz 1203: // ]]>
1.36 matthew 1204: </script>
1205: END
1206: # output the initial values for the selection lists
1.1115 raeburn 1207: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1208: my @order = sort(keys(%{$hashref}));
1209: if (ref($menuorder) eq 'ARRAY') {
1210: @order = @{$menuorder};
1211: }
1212: foreach my $value (@order) {
1.36 matthew 1213: $result.=" <option value=\"$value\" ";
1.253 albertel 1214: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1215: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1216: }
1217: $result .= "</select>\n";
1218: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1219: $result .= $middletext;
1.1115 raeburn 1220: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1221: if ($onchangesecond) {
1222: $result .= ' onchange="'.$onchangesecond.'"';
1223: }
1224: $result .= ">\n";
1.36 matthew 1225: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1226:
1227: my @secondorder = sort(keys(%select2));
1228: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1229: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1230: }
1231: foreach my $value (@secondorder) {
1.36 matthew 1232: $result.=" <option value=\"$value\" ";
1.253 albertel 1233: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1234: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1235: }
1236: $result .= "</select>\n";
1237: # return $debug;
1238: return $result;
1239: } # end of sub linked_select_forms {
1240:
1.45 matthew 1241: =pod
1.44 bowersj2 1242:
1.973 raeburn 1243: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1244:
1.112 bowersj2 1245: Returns a string corresponding to an HTML link to the given help
1246: $topic, where $topic corresponds to the name of a .tex file in
1247: /home/httpd/html/adm/help/tex, with underscores replaced by
1248: spaces.
1249:
1250: $text will optionally be linked to the same topic, allowing you to
1251: link text in addition to the graphic. If you do not want to link
1252: text, but wish to specify one of the later parameters, pass an
1253: empty string.
1254:
1255: $stayOnPage is a value that will be interpreted as a boolean. If true,
1256: the link will not open a new window. If false, the link will open
1257: a new window using Javascript. (Default is false.)
1258:
1259: $width and $height are optional numerical parameters that will
1260: override the width and height of the popped up window, which may
1.973 raeburn 1261: be useful for certain help topics with big pictures included.
1262:
1263: $imgid is the id of the img tag used for the help icon. This may be
1264: used in a javascript call to switch the image src. See
1265: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1266:
1267: =cut
1268:
1269: sub help_open_topic {
1.973 raeburn 1270: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1271: $text = "" if (not defined $text);
1.44 bowersj2 1272: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1273: $width = 500 if (not defined $width);
1.44 bowersj2 1274: $height = 400 if (not defined $height);
1275: my $filename = $topic;
1276: $filename =~ s/ /_/g;
1277:
1.48 bowersj2 1278: my $template = "";
1279: my $link;
1.572 banghart 1280:
1.159 www 1281: $topic=~s/\W/\_/g;
1.44 bowersj2 1282:
1.572 banghart 1283: if (!$stayOnPage) {
1.1033 www 1284: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1285: } elsif ($stayOnPage eq 'popup') {
1286: $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 1287: } else {
1.48 bowersj2 1288: $link = "/adm/help/${filename}.hlp";
1289: }
1290:
1291: # Add the text
1.755 neumanie 1292: if ($text ne "") {
1.763 bisitz 1293: $template.='<span class="LC_help_open_topic">'
1294: .'<a target="_top" href="'.$link.'">'
1295: .$text.'</a>';
1.48 bowersj2 1296: }
1297:
1.763 bisitz 1298: # (Always) Add the graphic
1.179 matthew 1299: my $title = &mt('Online Help');
1.667 raeburn 1300: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1301: if ($imgid ne '') {
1302: $imgid = ' id="'.$imgid.'"';
1303: }
1.763 bisitz 1304: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1305: .'<img src="'.$helpicon.'" border="0"'
1306: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1307: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1308: .' /></a>';
1309: if ($text ne "") {
1310: $template.='</span>';
1311: }
1.44 bowersj2 1312: return $template;
1313:
1.106 bowersj2 1314: }
1315:
1316: # This is a quicky function for Latex cheatsheet editing, since it
1317: # appears in at least four places
1318: sub helpLatexCheatsheet {
1.1037 www 1319: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1320: my $out;
1.106 bowersj2 1321: my $addOther = '';
1.732 raeburn 1322: if ($topic) {
1.1037 www 1323: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1324: }
1325: $out = '<span>' # Start cheatsheet
1326: .$addOther
1327: .'<span>'
1.1037 www 1328: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1329: .'</span> <span>'
1.1037 www 1330: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1331: .'</span>';
1.732 raeburn 1332: unless ($not_author) {
1.1186 kruse 1333: $out .= '<span>'
1334: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1335: .'</span> <span>'
1336: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1337: .'</span>';
1.732 raeburn 1338: }
1.763 bisitz 1339: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1340: return $out;
1.172 www 1341: }
1342:
1.430 albertel 1343: sub general_help {
1344: my $helptopic='Student_Intro';
1345: if ($env{'request.role'}=~/^(ca|au)/) {
1346: $helptopic='Authoring_Intro';
1.907 raeburn 1347: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1348: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1349: } elsif ($env{'request.role'}=~/^dc/) {
1350: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1351: }
1352: return $helptopic;
1353: }
1354:
1355: sub update_help_link {
1356: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1357: my $origurl = $ENV{'REQUEST_URI'};
1358: $origurl=~s|^/~|/priv/|;
1359: my $timestamp = time;
1360: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1361: $$datum = &escape($$datum);
1362: }
1363:
1364: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1365: my $output .= <<"ENDOUTPUT";
1366: <script type="text/javascript">
1.824 bisitz 1367: // <![CDATA[
1.430 albertel 1368: banner_link = '$banner_link';
1.824 bisitz 1369: // ]]>
1.430 albertel 1370: </script>
1371: ENDOUTPUT
1372: return $output;
1373: }
1374:
1375: # now just updates the help link and generates a blue icon
1.193 raeburn 1376: sub help_open_menu {
1.430 albertel 1377: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1378: = @_;
1.949 droeschl 1379: $stayOnPage = 1;
1.430 albertel 1380: my $output;
1381: if ($component_help) {
1382: if (!$text) {
1383: $output=&help_open_topic($component_help,undef,$stayOnPage,
1384: $width,$height);
1385: } else {
1386: my $help_text;
1387: $help_text=&unescape($topic);
1388: $output='<table><tr><td>'.
1389: &help_open_topic($component_help,$help_text,$stayOnPage,
1390: $width,$height).'</td></tr></table>';
1391: }
1392: }
1393: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1394: return $output.$banner_link;
1395: }
1396:
1397: sub top_nav_help {
1398: my ($text) = @_;
1.436 albertel 1399: $text = &mt($text);
1.949 droeschl 1400: my $stay_on_page = 1;
1401:
1.1168 raeburn 1402: my ($link,$banner_link);
1403: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1404: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1405: : "javascript:helpMenu('open')";
1406: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1407: }
1.201 raeburn 1408: my $title = &mt('Get help');
1.1168 raeburn 1409: if ($link) {
1410: return <<"END";
1.436 albertel 1411: $banner_link
1.1159 raeburn 1412: <a href="$link" title="$title">$text</a>
1.436 albertel 1413: END
1.1168 raeburn 1414: } else {
1415: return ' '.$text.' ';
1416: }
1.436 albertel 1417: }
1418:
1419: sub help_menu_js {
1.1154 raeburn 1420: my ($httphost) = @_;
1.949 droeschl 1421: my $stayOnPage = 1;
1.436 albertel 1422: my $width = 620;
1423: my $height = 600;
1.430 albertel 1424: my $helptopic=&general_help();
1.1154 raeburn 1425: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1426: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1427: my $start_page =
1428: &Apache::loncommon::start_page('Help Menu', undef,
1429: {'frameset' => 1,
1430: 'js_ready' => 1,
1.1154 raeburn 1431: 'use_absolute' => $httphost,
1.331 albertel 1432: 'add_entries' => {
1.1168 raeburn 1433: 'border' => '0',
1.579 raeburn 1434: 'rows' => "110,*",},});
1.331 albertel 1435: my $end_page =
1436: &Apache::loncommon::end_page({'frameset' => 1,
1437: 'js_ready' => 1,});
1438:
1.436 albertel 1439: my $template .= <<"ENDTEMPLATE";
1440: <script type="text/javascript">
1.877 bisitz 1441: // <![CDATA[
1.253 albertel 1442: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1443: var banner_link = '';
1.243 raeburn 1444: function helpMenu(target) {
1445: var caller = this;
1446: if (target == 'open') {
1447: var newWindow = null;
1448: try {
1.262 albertel 1449: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1450: }
1451: catch(error) {
1452: writeHelp(caller);
1453: return;
1454: }
1455: if (newWindow) {
1456: caller = newWindow;
1457: }
1.193 raeburn 1458: }
1.243 raeburn 1459: writeHelp(caller);
1460: return;
1461: }
1462: function writeHelp(caller) {
1.1168 raeburn 1463: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1464: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1465: caller.document.close();
1466: caller.focus();
1.193 raeburn 1467: }
1.877 bisitz 1468: // END LON-CAPA Internal -->
1.253 albertel 1469: // ]]>
1.436 albertel 1470: </script>
1.193 raeburn 1471: ENDTEMPLATE
1472: return $template;
1473: }
1474:
1.172 www 1475: sub help_open_bug {
1476: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1477: unless ($env{'user.adv'}) { return ''; }
1.172 www 1478: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1479: $text = "" if (not defined $text);
1480: $stayOnPage=1;
1.184 albertel 1481: $width = 600 if (not defined $width);
1482: $height = 600 if (not defined $height);
1.172 www 1483:
1484: $topic=~s/\W+/\+/g;
1485: my $link='';
1486: my $template='';
1.379 albertel 1487: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1488: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1489: if (!$stayOnPage)
1490: {
1491: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1492: }
1493: else
1494: {
1495: $link = $url;
1496: }
1497: # Add the text
1498: if ($text ne "")
1499: {
1500: $template .=
1501: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1502: "<td bgcolor='#FF5555'><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('Report a Bug');
1.215 albertel 1507: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1508: $template .= <<"ENDTEMPLATE";
1.436 albertel 1509: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1510: ENDTEMPLATE
1511: if ($text ne '') { $template.='</td></tr></table>' };
1512: return $template;
1513:
1514: }
1515:
1516: sub help_open_faq {
1517: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1518: unless ($env{'user.adv'}) { return ''; }
1.172 www 1519: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1520: $text = "" if (not defined $text);
1521: $stayOnPage=1;
1522: $width = 350 if (not defined $width);
1523: $height = 400 if (not defined $height);
1524:
1525: $topic=~s/\W+/\+/g;
1526: my $link='';
1527: my $template='';
1528: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1529: if (!$stayOnPage)
1530: {
1531: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1532: }
1533: else
1534: {
1535: $link = $url;
1536: }
1537:
1538: # Add the text
1539: if ($text ne "")
1540: {
1541: $template .=
1.173 www 1542: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1543: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1544: }
1545:
1546: # Add the graphic
1.179 matthew 1547: my $title = &mt('View the FAQ');
1.215 albertel 1548: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1549: $template .= <<"ENDTEMPLATE";
1.436 albertel 1550: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1551: ENDTEMPLATE
1552: if ($text ne '') { $template.='</td></tr></table>' };
1553: return $template;
1554:
1.44 bowersj2 1555: }
1.37 matthew 1556:
1.180 matthew 1557: ###############################################################
1558: ###############################################################
1559:
1.45 matthew 1560: =pod
1561:
1.648 raeburn 1562: =item * &change_content_javascript():
1.256 matthew 1563:
1564: This and the next function allow you to create small sections of an
1565: otherwise static HTML page that you can update on the fly with
1566: Javascript, even in Netscape 4.
1567:
1568: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1569: must be written to the HTML page once. It will prove the Javascript
1570: function "change(name, content)". Calling the change function with the
1571: name of the section
1572: you want to update, matching the name passed to C<changable_area>, and
1573: the new content you want to put in there, will put the content into
1574: that area.
1575:
1576: B<Note>: Netscape 4 only reserves enough space for the changable area
1577: to contain room for the original contents. You need to "make space"
1578: for whatever changes you wish to make, and be B<sure> to check your
1579: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1580: it's adequate for updating a one-line status display, but little more.
1581: This script will set the space to 100% width, so you only need to
1582: worry about height in Netscape 4.
1583:
1584: Modern browsers are much less limiting, and if you can commit to the
1585: user not using Netscape 4, this feature may be used freely with
1586: pretty much any HTML.
1587:
1588: =cut
1589:
1590: sub change_content_javascript {
1591: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1592: if ($env{'browser.type'} eq 'netscape' &&
1593: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1594: return (<<NETSCAPE4);
1595: function change(name, content) {
1596: doc = document.layers[name+"___escape"].layers[0].document;
1597: doc.open();
1598: doc.write(content);
1599: doc.close();
1600: }
1601: NETSCAPE4
1602: } else {
1603: # Otherwise, we need to use semi-standards-compliant code
1604: # (technically, "innerHTML" isn't standard but the equivalent
1605: # is really scary, and every useful browser supports it
1606: return (<<DOMBASED);
1607: function change(name, content) {
1608: element = document.getElementById(name);
1609: element.innerHTML = content;
1610: }
1611: DOMBASED
1612: }
1613: }
1614:
1615: =pod
1616:
1.648 raeburn 1617: =item * &changable_area($name,$origContent):
1.256 matthew 1618:
1619: This provides a "changable area" that can be modified on the fly via
1620: the Javascript code provided in C<change_content_javascript>. $name is
1621: the name you will use to reference the area later; do not repeat the
1622: same name on a given HTML page more then once. $origContent is what
1623: the area will originally contain, which can be left blank.
1624:
1625: =cut
1626:
1627: sub changable_area {
1628: my ($name, $origContent) = @_;
1629:
1.258 albertel 1630: if ($env{'browser.type'} eq 'netscape' &&
1631: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1632: # If this is netscape 4, we need to use the Layer tag
1633: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1634: } else {
1635: return "<span id='$name'>$origContent</span>";
1636: }
1637: }
1638:
1639: =pod
1640:
1.648 raeburn 1641: =item * &viewport_geometry_js
1.590 raeburn 1642:
1643: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1644:
1645: =cut
1646:
1647:
1648: sub viewport_geometry_js {
1649: return <<"GEOMETRY";
1650: var Geometry = {};
1651: function init_geometry() {
1652: if (Geometry.init) { return };
1653: Geometry.init=1;
1654: if (window.innerHeight) {
1655: Geometry.getViewportHeight = function() { return window.innerHeight; };
1656: Geometry.getViewportWidth = function() { return window.innerWidth; };
1657: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1658: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1659: }
1660: else if (document.documentElement && document.documentElement.clientHeight) {
1661: Geometry.getViewportHeight =
1662: function() { return document.documentElement.clientHeight; };
1663: Geometry.getViewportWidth =
1664: function() { return document.documentElement.clientWidth; };
1665:
1666: Geometry.getHorizontalScroll =
1667: function() { return document.documentElement.scrollLeft; };
1668: Geometry.getVerticalScroll =
1669: function() { return document.documentElement.scrollTop; };
1670: }
1671: else if (document.body.clientHeight) {
1672: Geometry.getViewportHeight =
1673: function() { return document.body.clientHeight; };
1674: Geometry.getViewportWidth =
1675: function() { return document.body.clientWidth; };
1676: Geometry.getHorizontalScroll =
1677: function() { return document.body.scrollLeft; };
1678: Geometry.getVerticalScroll =
1679: function() { return document.body.scrollTop; };
1680: }
1681: }
1682:
1683: GEOMETRY
1684: }
1685:
1686: =pod
1687:
1.648 raeburn 1688: =item * &viewport_size_js()
1.590 raeburn 1689:
1690: 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.
1691:
1692: =cut
1693:
1694: sub viewport_size_js {
1695: my $geometry = &viewport_geometry_js();
1696: return <<"DIMS";
1697:
1698: $geometry
1699:
1700: function getViewportDims(width,height) {
1701: init_geometry();
1702: width.value = Geometry.getViewportWidth();
1703: height.value = Geometry.getViewportHeight();
1704: return;
1705: }
1706:
1707: DIMS
1708: }
1709:
1710: =pod
1711:
1.648 raeburn 1712: =item * &resize_textarea_js()
1.565 albertel 1713:
1714: emits the needed javascript to resize a textarea to be as big as possible
1715:
1716: creates a function resize_textrea that takes two IDs first should be
1717: the id of the element to resize, second should be the id of a div that
1718: surrounds everything that comes after the textarea, this routine needs
1719: to be attached to the <body> for the onload and onresize events.
1720:
1.648 raeburn 1721: =back
1.565 albertel 1722:
1723: =cut
1724:
1725: sub resize_textarea_js {
1.590 raeburn 1726: my $geometry = &viewport_geometry_js();
1.565 albertel 1727: return <<"RESIZE";
1728: <script type="text/javascript">
1.824 bisitz 1729: // <![CDATA[
1.590 raeburn 1730: $geometry
1.565 albertel 1731:
1.588 albertel 1732: function getX(element) {
1733: var x = 0;
1734: while (element) {
1735: x += element.offsetLeft;
1736: element = element.offsetParent;
1737: }
1738: return x;
1739: }
1740: function getY(element) {
1741: var y = 0;
1742: while (element) {
1743: y += element.offsetTop;
1744: element = element.offsetParent;
1745: }
1746: return y;
1747: }
1748:
1749:
1.565 albertel 1750: function resize_textarea(textarea_id,bottom_id) {
1751: init_geometry();
1752: var textarea = document.getElementById(textarea_id);
1753: //alert(textarea);
1754:
1.588 albertel 1755: var textarea_top = getY(textarea);
1.565 albertel 1756: var textarea_height = textarea.offsetHeight;
1757: var bottom = document.getElementById(bottom_id);
1.588 albertel 1758: var bottom_top = getY(bottom);
1.565 albertel 1759: var bottom_height = bottom.offsetHeight;
1760: var window_height = Geometry.getViewportHeight();
1.588 albertel 1761: var fudge = 23;
1.565 albertel 1762: var new_height = window_height-fudge-textarea_top-bottom_height;
1763: if (new_height < 300) {
1764: new_height = 300;
1765: }
1766: textarea.style.height=new_height+'px';
1767: }
1.824 bisitz 1768: // ]]>
1.565 albertel 1769: </script>
1770: RESIZE
1771:
1772: }
1773:
1.1205 golterma 1774: sub colorfuleditor_js {
1775: return <<"COLORFULEDIT"
1776: <script type="text/javascript">
1777: // <![CDATA[>
1778: function fold_box(curDepth, lastresource){
1779:
1780: // we need a list because there can be several blocks you need to fold in one tag
1781: var block = document.getElementsByName('foldblock_'+curDepth);
1782: // but there is only one folding button per tag
1783: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1784:
1785: if(block.item(0).style.display == 'none'){
1786:
1787: foldbutton.value = '@{[&mt("Hide")]}';
1788: for (i = 0; i < block.length; i++){
1789: block.item(i).style.display = '';
1790: }
1791: }else{
1792:
1793: foldbutton.value = '@{[&mt("Show")]}';
1794: for (i = 0; i < block.length; i++){
1795: // block.item(i).style.visibility = 'collapse';
1796: block.item(i).style.display = 'none';
1797: }
1798: };
1799: saveState(lastresource);
1800: }
1801:
1802: function saveState (lastresource) {
1803:
1804: var tag_list = getTagList();
1805: if(tag_list != null){
1806: var timestamp = new Date().getTime();
1807: var key = lastresource;
1808:
1809: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1810: // starting with timestamp
1811: var value = timestamp+';';
1812:
1813: // building the list of key-value pairs
1814: for(var i = 0; i < tag_list.length; i++){
1815: value += tag_list[i]+',';
1816: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1817: }
1818:
1819: // only iterate whole storage if nothing to override
1820: if(localStorage.getItem(key) == null){
1821:
1822: // prevent storage from growing large
1823: if(localStorage.length > 50){
1824: var regex_getTimestamp = /^(?:\d)+;/;
1825: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1826: var oldest_key;
1827:
1828: for(var i = 1; i < localStorage.length; i++){
1829: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1830: oldest_key = localStorage.key(i);
1831: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1832: }
1833: }
1834: localStorage.removeItem(oldest_key);
1835: }
1836: }
1837: localStorage.setItem(key,value);
1838: }
1839: }
1840:
1841: // restore folding status of blocks (on page load)
1842: function restoreState (lastresource) {
1843: if(localStorage.getItem(lastresource) != null){
1844: var key = lastresource;
1845: var value = localStorage.getItem(key);
1846: var regex_delTimestamp = /^\d+;/;
1847:
1848: value.replace(regex_delTimestamp, '');
1849:
1850: var valueArr = value.split(';');
1851: var pairs;
1852: var elements;
1853: for (var i = 0; i < valueArr.length; i++){
1854: pairs = valueArr[i].split(',');
1855: elements = document.getElementsByName(pairs[0]);
1856:
1857: for (var j = 0; j < elements.length; j++){
1858: elements[j].style.display = pairs[1];
1859: if (pairs[1] == "none"){
1860: var regex_id = /([_\\d]+)\$/;
1861: regex_id.exec(pairs[0]);
1862: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1863: }
1864: }
1865: }
1866: }
1867: }
1868:
1869: function getTagList () {
1870:
1871: var stringToSearch = document.lonhomework.innerHTML;
1872:
1873: var ret = new Array();
1874: var regex_findBlock = /(foldblock_.*?)"/g;
1875: var tag_list = stringToSearch.match(regex_findBlock);
1876:
1877: if(tag_list != null){
1878: for(var i = 0; i < tag_list.length; i++){
1879: ret.push(tag_list[i].replace(/"/, ''));
1880: }
1881: }
1882: return ret;
1883: }
1884:
1885: function saveScrollPosition (resource) {
1886: var tag_list = getTagList();
1887:
1888: // we dont always want to jump to the first block
1889: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1890: if(\$(window).scrollTop() > 170){
1891: if(tag_list != null){
1892: var result;
1893: for(var i = 0; i < tag_list.length; i++){
1894: if(isElementInViewport(tag_list[i])){
1895: result += tag_list[i]+';';
1896: }
1897: }
1898: sessionStorage.setItem('anchor_'+resource, result);
1899: }
1900: } else {
1901: // we dont need to save zero, just delete the item to leave everything tidy
1902: sessionStorage.removeItem('anchor_'+resource);
1903: }
1904: }
1905:
1906: function restoreScrollPosition(resource){
1907:
1908: var elem = sessionStorage.getItem('anchor_'+resource);
1909: if(elem != null){
1910: var tag_list = elem.split(';');
1911: var elem_list;
1912:
1913: for(var i = 0; i < tag_list.length; i++){
1914: elem_list = document.getElementsByName(tag_list[i]);
1915:
1916: if(elem_list.length > 0){
1917: elem = elem_list[0];
1918: break;
1919: }
1920: }
1921: elem.scrollIntoView();
1922: }
1923: }
1924:
1925: function isElementInViewport(el) {
1926:
1927: // change to last element instead of first
1928: var elem = document.getElementsByName(el);
1929: var rect = elem[0].getBoundingClientRect();
1930:
1931: return (
1932: rect.top >= 0 &&
1933: rect.left >= 0 &&
1934: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1935: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1936: );
1937: }
1938:
1939: function autosize(depth){
1940: var cmInst = window['cm'+depth];
1941: var fitsizeButton = document.getElementById('fitsize'+depth);
1942:
1943: // is fixed size, switching to dynamic
1944: if (sessionStorage.getItem("autosized_"+depth) == null) {
1945: cmInst.setSize("","auto");
1946: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1947: sessionStorage.setItem("autosized_"+depth, "yes");
1948:
1949: // is dynamic size, switching to fixed
1950: } else {
1951: cmInst.setSize("","300px");
1952: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1953: sessionStorage.removeItem("autosized_"+depth);
1954: }
1955: }
1956:
1957:
1958:
1959: // ]]>
1960: </script>
1961: COLORFULEDIT
1962: }
1963:
1964: sub xmleditor_js {
1965: return <<XMLEDIT
1966: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1967: <script type="text/javascript">
1968: // <![CDATA[>
1969:
1970: function saveScrollPosition (resource) {
1971:
1972: var scrollPos = \$(window).scrollTop();
1973: sessionStorage.setItem(resource,scrollPos);
1974: }
1975:
1976: function restoreScrollPosition(resource){
1977:
1978: var scrollPos = sessionStorage.getItem(resource);
1979: \$(window).scrollTop(scrollPos);
1980: }
1981:
1982: // unless internet explorer
1983: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1984:
1985: \$(document).ready(function() {
1986: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1987: });
1988: }
1989:
1990: // inserts text at cursor position into codemirror (xml editor only)
1991: function insertText(text){
1992: cm.focus();
1993: var curPos = cm.getCursor();
1994: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1995: }
1996: // ]]>
1997: </script>
1998: XMLEDIT
1999: }
2000:
2001: sub insert_folding_button {
2002: my $curDepth = $Apache::lonxml::curdepth;
2003: my $lastresource = $env{'request.ambiguous'};
2004:
2005: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2006: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2007: }
2008:
1.565 albertel 2009: =pod
2010:
1.256 matthew 2011: =head1 Excel and CSV file utility routines
2012:
2013: =cut
2014:
2015: ###############################################################
2016: ###############################################################
2017:
2018: =pod
2019:
1.1162 raeburn 2020: =over 4
2021:
1.648 raeburn 2022: =item * &csv_translate($text)
1.37 matthew 2023:
1.185 www 2024: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2025: format.
2026:
2027: =cut
2028:
1.180 matthew 2029: ###############################################################
2030: ###############################################################
1.37 matthew 2031: sub csv_translate {
2032: my $text = shift;
2033: $text =~ s/\"/\"\"/g;
1.209 albertel 2034: $text =~ s/\n/ /g;
1.37 matthew 2035: return $text;
2036: }
1.180 matthew 2037:
2038: ###############################################################
2039: ###############################################################
2040:
2041: =pod
2042:
1.648 raeburn 2043: =item * &define_excel_formats()
1.180 matthew 2044:
2045: Define some commonly used Excel cell formats.
2046:
2047: Currently supported formats:
2048:
2049: =over 4
2050:
2051: =item header
2052:
2053: =item bold
2054:
2055: =item h1
2056:
2057: =item h2
2058:
2059: =item h3
2060:
1.256 matthew 2061: =item h4
2062:
2063: =item i
2064:
1.180 matthew 2065: =item date
2066:
2067: =back
2068:
2069: Inputs: $workbook
2070:
2071: Returns: $format, a hash reference.
2072:
1.1057 foxr 2073:
1.180 matthew 2074: =cut
2075:
2076: ###############################################################
2077: ###############################################################
2078: sub define_excel_formats {
2079: my ($workbook) = @_;
2080: my $format;
2081: $format->{'header'} = $workbook->add_format(bold => 1,
2082: bottom => 1,
2083: align => 'center');
2084: $format->{'bold'} = $workbook->add_format(bold=>1);
2085: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2086: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2087: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2088: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2089: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2090: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2091: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2092: return $format;
2093: }
2094:
2095: ###############################################################
2096: ###############################################################
1.113 bowersj2 2097:
2098: =pod
2099:
1.648 raeburn 2100: =item * &create_workbook()
1.255 matthew 2101:
2102: Create an Excel worksheet. If it fails, output message on the
2103: request object and return undefs.
2104:
2105: Inputs: Apache request object
2106:
2107: Returns (undef) on failure,
2108: Excel worksheet object, scalar with filename, and formats
2109: from &Apache::loncommon::define_excel_formats on success
2110:
2111: =cut
2112:
2113: ###############################################################
2114: ###############################################################
2115: sub create_workbook {
2116: my ($r) = @_;
2117: #
2118: # Create the excel spreadsheet
2119: my $filename = '/prtspool/'.
1.258 albertel 2120: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2121: time.'_'.rand(1000000000).'.xls';
2122: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2123: if (! defined($workbook)) {
2124: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2125: $r->print(
2126: '<p class="LC_error">'
2127: .&mt('Problems occurred in creating the new Excel file.')
2128: .' '.&mt('This error has been logged.')
2129: .' '.&mt('Please alert your LON-CAPA administrator.')
2130: .'</p>'
2131: );
1.255 matthew 2132: return (undef);
2133: }
2134: #
1.1014 foxr 2135: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2136: #
2137: my $format = &Apache::loncommon::define_excel_formats($workbook);
2138: return ($workbook,$filename,$format);
2139: }
2140:
2141: ###############################################################
2142: ###############################################################
2143:
2144: =pod
2145:
1.648 raeburn 2146: =item * &create_text_file()
1.113 bowersj2 2147:
1.542 raeburn 2148: Create a file to write to and eventually make available to the user.
1.256 matthew 2149: If file creation fails, outputs an error message on the request object and
2150: return undefs.
1.113 bowersj2 2151:
1.256 matthew 2152: Inputs: Apache request object, and file suffix
1.113 bowersj2 2153:
1.256 matthew 2154: Returns (undef) on failure,
2155: Filehandle and filename on success.
1.113 bowersj2 2156:
2157: =cut
2158:
1.256 matthew 2159: ###############################################################
2160: ###############################################################
2161: sub create_text_file {
2162: my ($r,$suffix) = @_;
2163: if (! defined($suffix)) { $suffix = 'txt'; };
2164: my $fh;
2165: my $filename = '/prtspool/'.
1.258 albertel 2166: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2167: time.'_'.rand(1000000000).'.'.$suffix;
2168: $fh = Apache::File->new('>/home/httpd'.$filename);
2169: if (! defined($fh)) {
2170: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2171: $r->print(
2172: '<p class="LC_error">'
2173: .&mt('Problems occurred in creating the output file.')
2174: .' '.&mt('This error has been logged.')
2175: .' '.&mt('Please alert your LON-CAPA administrator.')
2176: .'</p>'
2177: );
1.113 bowersj2 2178: }
1.256 matthew 2179: return ($fh,$filename)
1.113 bowersj2 2180: }
2181:
2182:
1.256 matthew 2183: =pod
1.113 bowersj2 2184:
2185: =back
2186:
2187: =cut
1.37 matthew 2188:
2189: ###############################################################
1.33 matthew 2190: ## Home server <option> list generating code ##
2191: ###############################################################
1.35 matthew 2192:
1.169 www 2193: # ------------------------------------------
2194:
2195: sub domain_select {
2196: my ($name,$value,$multiple)=@_;
2197: my %domains=map {
1.514 albertel 2198: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2199: } &Apache::lonnet::all_domains();
1.169 www 2200: if ($multiple) {
2201: $domains{''}=&mt('Any domain');
1.550 albertel 2202: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2203: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2204: } else {
1.550 albertel 2205: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2206: return &select_form($name,$value,\%domains);
1.169 www 2207: }
2208: }
2209:
1.282 albertel 2210: #-------------------------------------------
2211:
2212: =pod
2213:
1.519 raeburn 2214: =head1 Routines for form select boxes
2215:
2216: =over 4
2217:
1.648 raeburn 2218: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2219:
2220: Returns a string containing a <select> element int multiple mode
2221:
2222:
2223: Args:
2224: $name - name of the <select> element
1.506 raeburn 2225: $value - scalar or array ref of values that should already be selected
1.282 albertel 2226: $size - number of rows long the select element is
1.283 albertel 2227: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2228: (shown text should already have been &mt())
1.506 raeburn 2229: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2230:
1.282 albertel 2231: =cut
2232:
2233: #-------------------------------------------
1.169 www 2234: sub multiple_select_form {
1.284 albertel 2235: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2236: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2237: my $output='';
1.191 matthew 2238: if (! defined($size)) {
2239: $size = 4;
1.283 albertel 2240: if (scalar(keys(%$hash))<4) {
2241: $size = scalar(keys(%$hash));
1.191 matthew 2242: }
2243: }
1.734 bisitz 2244: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2245: my @order;
1.506 raeburn 2246: if (ref($order) eq 'ARRAY') {
2247: @order = @{$order};
2248: } else {
2249: @order = sort(keys(%$hash));
1.501 banghart 2250: }
2251: if (exists($$hash{'select_form_order'})) {
2252: @order = @{$$hash{'select_form_order'}};
2253: }
2254:
1.284 albertel 2255: foreach my $key (@order) {
1.356 albertel 2256: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2257: $output.='selected="selected" ' if ($selected{$key});
2258: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2259: }
2260: $output.="</select>\n";
2261: return $output;
2262: }
2263:
1.88 www 2264: #-------------------------------------------
2265:
2266: =pod
2267:
1.970 raeburn 2268: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2269:
2270: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2271: allow a user to select options from a ref to a hash containing:
2272: option_name => displayed text. An optional $onchange can include
2273: a javascript onchange item, e.g., onchange="this.form.submit();"
2274:
1.88 www 2275: See lonrights.pm for an example invocation and use.
2276:
2277: =cut
2278:
2279: #-------------------------------------------
2280: sub select_form {
1.1228 raeburn 2281: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2282: return unless (ref($hashref) eq 'HASH');
2283: if ($onchange) {
2284: $onchange = ' onchange="'.$onchange.'"';
2285: }
1.1228 raeburn 2286: my $disabled;
2287: if ($readonly) {
2288: $disabled = ' disabled="disabled"';
2289: }
2290: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2291: my @keys;
1.970 raeburn 2292: if (exists($hashref->{'select_form_order'})) {
2293: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2294: } else {
1.970 raeburn 2295: @keys=sort(keys(%{$hashref}));
1.128 albertel 2296: }
1.356 albertel 2297: foreach my $key (@keys) {
2298: $selectform.=
2299: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2300: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2301: ">".$hashref->{$key}."</option>\n";
1.88 www 2302: }
2303: $selectform.="</select>";
2304: return $selectform;
2305: }
2306:
1.475 www 2307: # For display filters
2308:
2309: sub display_filter {
1.1074 raeburn 2310: my ($context) = @_;
1.475 www 2311: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2312: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2313: my $phraseinput = 'hidden';
2314: my $includeinput = 'hidden';
2315: my ($checked,$includetypestext);
2316: if ($env{'form.displayfilter'} eq 'containing') {
2317: $phraseinput = 'text';
2318: if ($context eq 'parmslog') {
2319: $includeinput = 'checkbox';
2320: if ($env{'form.includetypes'}) {
2321: $checked = ' checked="checked"';
2322: }
2323: $includetypestext = &mt('Include parameter types');
2324: }
2325: } else {
2326: $includetypestext = ' ';
2327: }
2328: my ($additional,$secondid,$thirdid);
2329: if ($context eq 'parmslog') {
2330: $additional =
2331: '<label><input type="'.$includeinput.'" name="includetypes"'.
2332: $checked.' name="includetypes" value="1" id="includetypes" />'.
2333: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2334: '</label>';
2335: $secondid = 'includetypes';
2336: $thirdid = 'includetypestext';
2337: }
2338: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2339: '$secondid','$thirdid')";
2340: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2341: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2342: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2343: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2344: &mt('Filter: [_1]',
1.477 www 2345: &select_form($env{'form.displayfilter'},
2346: 'displayfilter',
1.970 raeburn 2347: {'currentfolder' => 'Current folder/page',
1.477 www 2348: 'containing' => 'Containing phrase',
1.1074 raeburn 2349: 'none' => 'None'},$onchange)).' '.
2350: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2351: &HTML::Entities::encode($env{'form.containingphrase'}).
2352: '" />'.$additional;
2353: }
2354:
2355: sub display_filter_js {
2356: my $includetext = &mt('Include parameter types');
2357: return <<"ENDJS";
2358:
2359: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2360: var firstType = 'hidden';
2361: if (setter.options[setter.selectedIndex].value == 'containing') {
2362: firstType = 'text';
2363: }
2364: firstObject = document.getElementById(firstid);
2365: if (typeof(firstObject) == 'object') {
2366: if (firstObject.type != firstType) {
2367: changeInputType(firstObject,firstType);
2368: }
2369: }
2370: if (context == 'parmslog') {
2371: var secondType = 'hidden';
2372: if (firstType == 'text') {
2373: secondType = 'checkbox';
2374: }
2375: secondObject = document.getElementById(secondid);
2376: if (typeof(secondObject) == 'object') {
2377: if (secondObject.type != secondType) {
2378: changeInputType(secondObject,secondType);
2379: }
2380: }
2381: var textItem = document.getElementById(thirdid);
2382: var currtext = textItem.innerHTML;
2383: var newtext;
2384: if (firstType == 'text') {
2385: newtext = '$includetext';
2386: } else {
2387: newtext = ' ';
2388: }
2389: if (currtext != newtext) {
2390: textItem.innerHTML = newtext;
2391: }
2392: }
2393: return;
2394: }
2395:
2396: function changeInputType(oldObject,newType) {
2397: var newObject = document.createElement('input');
2398: newObject.type = newType;
2399: if (oldObject.size) {
2400: newObject.size = oldObject.size;
2401: }
2402: if (oldObject.value) {
2403: newObject.value = oldObject.value;
2404: }
2405: if (oldObject.name) {
2406: newObject.name = oldObject.name;
2407: }
2408: if (oldObject.id) {
2409: newObject.id = oldObject.id;
2410: }
2411: oldObject.parentNode.replaceChild(newObject,oldObject);
2412: return;
2413: }
2414:
2415: ENDJS
1.475 www 2416: }
2417:
1.167 www 2418: sub gradeleveldescription {
2419: my $gradelevel=shift;
2420: my %gradelevels=(0 => 'Not specified',
2421: 1 => 'Grade 1',
2422: 2 => 'Grade 2',
2423: 3 => 'Grade 3',
2424: 4 => 'Grade 4',
2425: 5 => 'Grade 5',
2426: 6 => 'Grade 6',
2427: 7 => 'Grade 7',
2428: 8 => 'Grade 8',
2429: 9 => 'Grade 9',
2430: 10 => 'Grade 10',
2431: 11 => 'Grade 11',
2432: 12 => 'Grade 12',
2433: 13 => 'Grade 13',
2434: 14 => '100 Level',
2435: 15 => '200 Level',
2436: 16 => '300 Level',
2437: 17 => '400 Level',
2438: 18 => 'Graduate Level');
2439: return &mt($gradelevels{$gradelevel});
2440: }
2441:
1.163 www 2442: sub select_level_form {
2443: my ($deflevel,$name)=@_;
2444: unless ($deflevel) { $deflevel=0; }
1.167 www 2445: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2446: for (my $i=0; $i<=18; $i++) {
2447: $selectform.="<option value=\"$i\" ".
1.253 albertel 2448: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2449: ">".&gradeleveldescription($i)."</option>\n";
2450: }
2451: $selectform.="</select>";
2452: return $selectform;
1.163 www 2453: }
1.167 www 2454:
1.35 matthew 2455: #-------------------------------------------
2456:
1.45 matthew 2457: =pod
2458:
1.1121 raeburn 2459: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2460:
2461: Returns a string containing a <select name='$name' size='1'> form to
2462: allow a user to select the domain to preform an operation in.
2463: See loncreateuser.pm for an example invocation and use.
2464:
1.90 www 2465: If the $includeempty flag is set, it also includes an empty choice ("no domain
2466: selected");
2467:
1.743 raeburn 2468: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2469:
1.910 raeburn 2470: 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.
2471:
1.1121 raeburn 2472: The optional $incdoms is a reference to an array of domains which will be the only available options.
2473:
2474: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2475:
1.35 matthew 2476: =cut
2477:
2478: #-------------------------------------------
1.34 matthew 2479: sub select_dom_form {
1.1121 raeburn 2480: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2481: if ($onchange) {
1.874 raeburn 2482: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2483: }
1.1121 raeburn 2484: my (@domains,%exclude);
1.910 raeburn 2485: if (ref($incdoms) eq 'ARRAY') {
2486: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2487: } else {
2488: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2489: }
1.90 www 2490: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2491: if (ref($excdoms) eq 'ARRAY') {
2492: map { $exclude{$_} = 1; } @{$excdoms};
2493: }
1.743 raeburn 2494: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2495: foreach my $dom (@domains) {
1.1121 raeburn 2496: next if ($exclude{$dom});
1.356 albertel 2497: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2498: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2499: if ($showdomdesc) {
2500: if ($dom ne '') {
2501: my $domdesc = &Apache::lonnet::domain($dom,'description');
2502: if ($domdesc ne '') {
2503: $selectdomain .= ' ('.$domdesc.')';
2504: }
2505: }
2506: }
2507: $selectdomain .= "</option>\n";
1.34 matthew 2508: }
2509: $selectdomain.="</select>";
2510: return $selectdomain;
2511: }
2512:
1.35 matthew 2513: #-------------------------------------------
2514:
1.45 matthew 2515: =pod
2516:
1.648 raeburn 2517: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2518:
1.586 raeburn 2519: input: 4 arguments (two required, two optional) -
2520: $domain - domain of new user
2521: $name - name of form element
2522: $default - Value of 'default' causes a default item to be first
2523: option, and selected by default.
2524: $hide - Value of 'hide' causes hiding of the name of the server,
2525: if 1 server found, or default, if 0 found.
1.594 raeburn 2526: output: returns 2 items:
1.586 raeburn 2527: (a) form element which contains either:
2528: (i) <select name="$name">
2529: <option value="$hostid1">$hostid $servers{$hostid}</option>
2530: <option value="$hostid2">$hostid $servers{$hostid}</option>
2531: </select>
2532: form item if there are multiple library servers in $domain, or
2533: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2534: if there is only one library server in $domain.
2535:
2536: (b) number of library servers found.
2537:
2538: See loncreateuser.pm for example of use.
1.35 matthew 2539:
2540: =cut
2541:
2542: #-------------------------------------------
1.586 raeburn 2543: sub home_server_form_item {
2544: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2545: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2546: my $result;
2547: my $numlib = keys(%servers);
2548: if ($numlib > 1) {
2549: $result .= '<select name="'.$name.'" />'."\n";
2550: if ($default) {
1.804 bisitz 2551: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2552: '</option>'."\n";
2553: }
2554: foreach my $hostid (sort(keys(%servers))) {
2555: $result.= '<option value="'.$hostid.'">'.
2556: $hostid.' '.$servers{$hostid}."</option>\n";
2557: }
2558: $result .= '</select>'."\n";
2559: } elsif ($numlib == 1) {
2560: my $hostid;
2561: foreach my $item (keys(%servers)) {
2562: $hostid = $item;
2563: }
2564: $result .= '<input type="hidden" name="'.$name.'" value="'.
2565: $hostid.'" />';
2566: if (!$hide) {
2567: $result .= $hostid.' '.$servers{$hostid};
2568: }
2569: $result .= "\n";
2570: } elsif ($default) {
2571: $result .= '<input type="hidden" name="'.$name.
2572: '" value="default" />';
2573: if (!$hide) {
2574: $result .= &mt('default');
2575: }
2576: $result .= "\n";
1.33 matthew 2577: }
1.586 raeburn 2578: return ($result,$numlib);
1.33 matthew 2579: }
1.112 bowersj2 2580:
2581: =pod
2582:
1.534 albertel 2583: =back
2584:
1.112 bowersj2 2585: =cut
1.87 matthew 2586:
2587: ###############################################################
1.112 bowersj2 2588: ## Decoding User Agent ##
1.87 matthew 2589: ###############################################################
2590:
2591: =pod
2592:
1.112 bowersj2 2593: =head1 Decoding the User Agent
2594:
2595: =over 4
2596:
2597: =item * &decode_user_agent()
1.87 matthew 2598:
2599: Inputs: $r
2600:
2601: Outputs:
2602:
2603: =over 4
2604:
1.112 bowersj2 2605: =item * $httpbrowser
1.87 matthew 2606:
1.112 bowersj2 2607: =item * $clientbrowser
1.87 matthew 2608:
1.112 bowersj2 2609: =item * $clientversion
1.87 matthew 2610:
1.112 bowersj2 2611: =item * $clientmathml
1.87 matthew 2612:
1.112 bowersj2 2613: =item * $clientunicode
1.87 matthew 2614:
1.112 bowersj2 2615: =item * $clientos
1.87 matthew 2616:
1.1137 raeburn 2617: =item * $clientmobile
2618:
1.1141 raeburn 2619: =item * $clientinfo
2620:
1.1194 raeburn 2621: =item * $clientosversion
2622:
1.87 matthew 2623: =back
2624:
1.157 matthew 2625: =back
2626:
1.87 matthew 2627: =cut
2628:
2629: ###############################################################
2630: ###############################################################
2631: sub decode_user_agent {
1.247 albertel 2632: my ($r)=@_;
1.87 matthew 2633: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2634: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2635: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2636: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2637: my $clientbrowser='unknown';
2638: my $clientversion='0';
2639: my $clientmathml='';
2640: my $clientunicode='0';
1.1137 raeburn 2641: my $clientmobile=0;
1.1194 raeburn 2642: my $clientosversion='';
1.87 matthew 2643: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2644: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2645: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2646: $clientbrowser=$bname;
2647: $httpbrowser=~/$vreg/i;
2648: $clientversion=$1;
2649: $clientmathml=($clientversion>=$minv);
2650: $clientunicode=($clientversion>=$univ);
2651: }
2652: }
2653: my $clientos='unknown';
1.1141 raeburn 2654: my $clientinfo;
1.87 matthew 2655: if (($httpbrowser=~/linux/i) ||
2656: ($httpbrowser=~/unix/i) ||
2657: ($httpbrowser=~/ux/i) ||
2658: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2659: if (($httpbrowser=~/vax/i) ||
2660: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2661: if ($httpbrowser=~/next/i) { $clientos='next'; }
2662: if (($httpbrowser=~/mac/i) ||
2663: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2664: if ($httpbrowser=~/win/i) {
2665: $clientos='win';
2666: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2667: $clientosversion = $1;
2668: }
2669: }
1.87 matthew 2670: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2671: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2672: $clientmobile=lc($1);
2673: }
1.1141 raeburn 2674: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2675: $clientinfo = 'firefox-'.$1;
2676: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2677: $clientinfo = 'chromeframe-'.$1;
2678: }
1.87 matthew 2679: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2680: $clientunicode,$clientos,$clientmobile,$clientinfo,
2681: $clientosversion);
1.87 matthew 2682: }
2683:
1.32 matthew 2684: ###############################################################
2685: ## Authentication changing form generation subroutines ##
2686: ###############################################################
2687: ##
2688: ## All of the authform_xxxxxxx subroutines take their inputs in a
2689: ## hash, and have reasonable default values.
2690: ##
2691: ## formname = the name given in the <form> tag.
1.35 matthew 2692: #-------------------------------------------
2693:
1.45 matthew 2694: =pod
2695:
1.112 bowersj2 2696: =head1 Authentication Routines
2697:
2698: =over 4
2699:
1.648 raeburn 2700: =item * &authform_xxxxxx()
1.35 matthew 2701:
2702: The authform_xxxxxx subroutines provide javascript and html forms which
2703: handle some of the conveniences required for authentication forms.
2704: This is not an optimal method, but it works.
2705:
2706: =over 4
2707:
1.112 bowersj2 2708: =item * authform_header
1.35 matthew 2709:
1.112 bowersj2 2710: =item * authform_authorwarning
1.35 matthew 2711:
1.112 bowersj2 2712: =item * authform_nochange
1.35 matthew 2713:
1.112 bowersj2 2714: =item * authform_kerberos
1.35 matthew 2715:
1.112 bowersj2 2716: =item * authform_internal
1.35 matthew 2717:
1.112 bowersj2 2718: =item * authform_filesystem
1.35 matthew 2719:
2720: =back
2721:
1.648 raeburn 2722: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2723:
1.35 matthew 2724: =cut
2725:
2726: #-------------------------------------------
1.32 matthew 2727: sub authform_header{
2728: my %in = (
2729: formname => 'cu',
1.80 albertel 2730: kerb_def_dom => '',
1.32 matthew 2731: @_,
2732: );
2733: $in{'formname'} = 'document.' . $in{'formname'};
2734: my $result='';
1.80 albertel 2735:
2736: #---------------------------------------------- Code for upper case translation
2737: my $Javascript_toUpperCase;
2738: unless ($in{kerb_def_dom}) {
2739: $Javascript_toUpperCase =<<"END";
2740: switch (choice) {
2741: case 'krb': currentform.elements[choicearg].value =
2742: currentform.elements[choicearg].value.toUpperCase();
2743: break;
2744: default:
2745: }
2746: END
2747: } else {
2748: $Javascript_toUpperCase = "";
2749: }
2750:
1.165 raeburn 2751: my $radioval = "'nochange'";
1.591 raeburn 2752: if (defined($in{'curr_authtype'})) {
2753: if ($in{'curr_authtype'} ne '') {
2754: $radioval = "'".$in{'curr_authtype'}."arg'";
2755: }
1.174 matthew 2756: }
1.165 raeburn 2757: my $argfield = 'null';
1.591 raeburn 2758: if (defined($in{'mode'})) {
1.165 raeburn 2759: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2760: if (defined($in{'curr_autharg'})) {
2761: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2762: $argfield = "'$in{'curr_autharg'}'";
2763: }
2764: }
2765: }
2766: }
2767:
1.32 matthew 2768: $result.=<<"END";
2769: var current = new Object();
1.165 raeburn 2770: current.radiovalue = $radioval;
2771: current.argfield = $argfield;
1.32 matthew 2772:
2773: function changed_radio(choice,currentform) {
2774: var choicearg = choice + 'arg';
2775: // If a radio button in changed, we need to change the argfield
2776: if (current.radiovalue != choice) {
2777: current.radiovalue = choice;
2778: if (current.argfield != null) {
2779: currentform.elements[current.argfield].value = '';
2780: }
2781: if (choice == 'nochange') {
2782: current.argfield = null;
2783: } else {
2784: current.argfield = choicearg;
2785: switch(choice) {
2786: case 'krb':
2787: currentform.elements[current.argfield].value =
2788: "$in{'kerb_def_dom'}";
2789: break;
2790: default:
2791: break;
2792: }
2793: }
2794: }
2795: return;
2796: }
1.22 www 2797:
1.32 matthew 2798: function changed_text(choice,currentform) {
2799: var choicearg = choice + 'arg';
2800: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2801: $Javascript_toUpperCase
1.32 matthew 2802: // clear old field
2803: if ((current.argfield != choicearg) && (current.argfield != null)) {
2804: currentform.elements[current.argfield].value = '';
2805: }
2806: current.argfield = choicearg;
2807: }
2808: set_auth_radio_buttons(choice,currentform);
2809: return;
1.20 www 2810: }
1.32 matthew 2811:
2812: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2813: var numauthchoices = currentform.login.length;
2814: if (typeof numauthchoices == "undefined") {
2815: return;
2816: }
1.32 matthew 2817: var i=0;
1.986 raeburn 2818: while (i < numauthchoices) {
1.32 matthew 2819: if (currentform.login[i].value == newvalue) { break; }
2820: i++;
2821: }
1.986 raeburn 2822: if (i == numauthchoices) {
1.32 matthew 2823: return;
2824: }
2825: current.radiovalue = newvalue;
2826: currentform.login[i].checked = true;
2827: return;
2828: }
2829: END
2830: return $result;
2831: }
2832:
1.1106 raeburn 2833: sub authform_authorwarning {
1.32 matthew 2834: my $result='';
1.144 matthew 2835: $result='<i>'.
2836: &mt('As a general rule, only authors or co-authors should be '.
2837: 'filesystem authenticated '.
2838: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2839: return $result;
2840: }
2841:
1.1106 raeburn 2842: sub authform_nochange {
1.32 matthew 2843: my %in = (
2844: formname => 'document.cu',
2845: kerb_def_dom => 'MSU.EDU',
2846: @_,
2847: );
1.1106 raeburn 2848: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2849: my $result;
1.1104 raeburn 2850: if (!$authnum) {
1.1105 raeburn 2851: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2852: } else {
2853: $result = '<label>'.&mt('[_1] Do not change login data',
2854: '<input type="radio" name="login" value="nochange" '.
2855: 'checked="checked" onclick="'.
1.281 albertel 2856: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2857: '</label>';
1.586 raeburn 2858: }
1.32 matthew 2859: return $result;
2860: }
2861:
1.591 raeburn 2862: sub authform_kerberos {
1.32 matthew 2863: my %in = (
2864: formname => 'document.cu',
2865: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2866: kerb_def_auth => 'krb4',
1.32 matthew 2867: @_,
2868: );
1.586 raeburn 2869: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2870: $autharg,$jscall);
1.1106 raeburn 2871: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2872: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2873: $check5 = ' checked="checked"';
1.80 albertel 2874: } else {
1.772 bisitz 2875: $check4 = ' checked="checked"';
1.80 albertel 2876: }
1.165 raeburn 2877: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2878: if (defined($in{'curr_authtype'})) {
2879: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2880: $krbcheck = ' checked="checked"';
1.623 raeburn 2881: if (defined($in{'mode'})) {
2882: if ($in{'mode'} eq 'modifyuser') {
2883: $krbcheck = '';
2884: }
2885: }
1.591 raeburn 2886: if (defined($in{'curr_kerb_ver'})) {
2887: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2888: $check5 = ' checked="checked"';
1.591 raeburn 2889: $check4 = '';
2890: } else {
1.772 bisitz 2891: $check4 = ' checked="checked"';
1.591 raeburn 2892: $check5 = '';
2893: }
1.586 raeburn 2894: }
1.591 raeburn 2895: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2896: $krbarg = $in{'curr_autharg'};
2897: }
1.586 raeburn 2898: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2899: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2900: $result =
2901: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2902: $in{'curr_autharg'},$krbver);
2903: } else {
2904: $result =
2905: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2906: }
2907: return $result;
2908: }
2909: }
2910: } else {
2911: if ($authnum == 1) {
1.784 bisitz 2912: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2913: }
2914: }
1.586 raeburn 2915: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2916: return;
1.587 raeburn 2917: } elsif ($authtype eq '') {
1.591 raeburn 2918: if (defined($in{'mode'})) {
1.587 raeburn 2919: if ($in{'mode'} eq 'modifycourse') {
2920: if ($authnum == 1) {
1.1104 raeburn 2921: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2922: }
2923: }
2924: }
1.586 raeburn 2925: }
2926: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2927: if ($authtype eq '') {
2928: $authtype = '<input type="radio" name="login" value="krb" '.
2929: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2930: $krbcheck.' />';
2931: }
2932: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2933: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2934: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2935: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2936: $in{'curr_authtype'} eq 'krb4')) {
2937: $result .= &mt
1.144 matthew 2938: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2939: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2940: '<label>'.$authtype,
1.281 albertel 2941: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2942: 'value="'.$krbarg.'" '.
1.144 matthew 2943: 'onchange="'.$jscall.'" />',
1.281 albertel 2944: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2945: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2946: '</label>');
1.586 raeburn 2947: } elsif ($can_assign{'krb4'}) {
2948: $result .= &mt
2949: ('[_1] Kerberos authenticated with domain [_2] '.
2950: '[_3] Version 4 [_4]',
2951: '<label>'.$authtype,
2952: '</label><input type="text" size="10" name="krbarg" '.
2953: 'value="'.$krbarg.'" '.
2954: 'onchange="'.$jscall.'" />',
2955: '<label><input type="hidden" name="krbver" value="4" />',
2956: '</label>');
2957: } elsif ($can_assign{'krb5'}) {
2958: $result .= &mt
2959: ('[_1] Kerberos authenticated with domain [_2] '.
2960: '[_3] Version 5 [_4]',
2961: '<label>'.$authtype,
2962: '</label><input type="text" size="10" name="krbarg" '.
2963: 'value="'.$krbarg.'" '.
2964: 'onchange="'.$jscall.'" />',
2965: '<label><input type="hidden" name="krbver" value="5" />',
2966: '</label>');
2967: }
1.32 matthew 2968: return $result;
2969: }
2970:
1.1106 raeburn 2971: sub authform_internal {
1.586 raeburn 2972: my %in = (
1.32 matthew 2973: formname => 'document.cu',
2974: kerb_def_dom => 'MSU.EDU',
2975: @_,
2976: );
1.586 raeburn 2977: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2978: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2979: if (defined($in{'curr_authtype'})) {
2980: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2981: if ($can_assign{'int'}) {
1.772 bisitz 2982: $intcheck = 'checked="checked" ';
1.623 raeburn 2983: if (defined($in{'mode'})) {
2984: if ($in{'mode'} eq 'modifyuser') {
2985: $intcheck = '';
2986: }
2987: }
1.591 raeburn 2988: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2989: $intarg = $in{'curr_autharg'};
2990: }
2991: } else {
2992: $result = &mt('Currently internally authenticated.');
2993: return $result;
1.165 raeburn 2994: }
2995: }
1.586 raeburn 2996: } else {
2997: if ($authnum == 1) {
1.784 bisitz 2998: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2999: }
3000: }
3001: if (!$can_assign{'int'}) {
3002: return;
1.587 raeburn 3003: } elsif ($authtype eq '') {
1.591 raeburn 3004: if (defined($in{'mode'})) {
1.587 raeburn 3005: if ($in{'mode'} eq 'modifycourse') {
3006: if ($authnum == 1) {
1.1104 raeburn 3007: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 3008: }
3009: }
3010: }
1.165 raeburn 3011: }
1.586 raeburn 3012: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3013: if ($authtype eq '') {
3014: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
3015: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
3016: }
1.605 bisitz 3017: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3018: $intarg.'" onchange="'.$jscall.'" />';
3019: $result = &mt
1.144 matthew 3020: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3021: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3022: $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 3023: return $result;
3024: }
3025:
1.1104 raeburn 3026: sub authform_local {
1.32 matthew 3027: my %in = (
3028: formname => 'document.cu',
3029: kerb_def_dom => 'MSU.EDU',
3030: @_,
3031: );
1.586 raeburn 3032: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3033: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3034: if (defined($in{'curr_authtype'})) {
3035: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3036: if ($can_assign{'loc'}) {
1.772 bisitz 3037: $loccheck = 'checked="checked" ';
1.623 raeburn 3038: if (defined($in{'mode'})) {
3039: if ($in{'mode'} eq 'modifyuser') {
3040: $loccheck = '';
3041: }
3042: }
1.591 raeburn 3043: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3044: $locarg = $in{'curr_autharg'};
3045: }
3046: } else {
3047: $result = &mt('Currently using local (institutional) authentication.');
3048: return $result;
1.165 raeburn 3049: }
3050: }
1.586 raeburn 3051: } else {
3052: if ($authnum == 1) {
1.784 bisitz 3053: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3054: }
3055: }
3056: if (!$can_assign{'loc'}) {
3057: return;
1.587 raeburn 3058: } elsif ($authtype eq '') {
1.591 raeburn 3059: if (defined($in{'mode'})) {
1.587 raeburn 3060: if ($in{'mode'} eq 'modifycourse') {
3061: if ($authnum == 1) {
1.1104 raeburn 3062: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3063: }
3064: }
3065: }
1.165 raeburn 3066: }
1.586 raeburn 3067: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3068: if ($authtype eq '') {
3069: $authtype = '<input type="radio" name="login" value="loc" '.
3070: $loccheck.' onchange="'.$jscall.'" onclick="'.
3071: $jscall.'" />';
3072: }
3073: $autharg = '<input type="text" size="10" name="locarg" value="'.
3074: $locarg.'" onchange="'.$jscall.'" />';
3075: $result = &mt('[_1] Local Authentication with argument [_2]',
3076: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3077: return $result;
3078: }
3079:
1.1106 raeburn 3080: sub authform_filesystem {
1.32 matthew 3081: my %in = (
3082: formname => 'document.cu',
3083: kerb_def_dom => 'MSU.EDU',
3084: @_,
3085: );
1.586 raeburn 3086: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3087: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3088: if (defined($in{'curr_authtype'})) {
3089: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3090: if ($can_assign{'fsys'}) {
1.772 bisitz 3091: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3092: if (defined($in{'mode'})) {
3093: if ($in{'mode'} eq 'modifyuser') {
3094: $fsyscheck = '';
3095: }
3096: }
1.586 raeburn 3097: } else {
3098: $result = &mt('Currently Filesystem Authenticated.');
3099: return $result;
3100: }
3101: }
3102: } else {
3103: if ($authnum == 1) {
1.784 bisitz 3104: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3105: }
3106: }
3107: if (!$can_assign{'fsys'}) {
3108: return;
1.587 raeburn 3109: } elsif ($authtype eq '') {
1.591 raeburn 3110: if (defined($in{'mode'})) {
1.587 raeburn 3111: if ($in{'mode'} eq 'modifycourse') {
3112: if ($authnum == 1) {
1.1104 raeburn 3113: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3114: }
3115: }
3116: }
1.586 raeburn 3117: }
3118: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3119: if ($authtype eq '') {
3120: $authtype = '<input type="radio" name="login" value="fsys" '.
3121: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3122: $jscall.'" />';
3123: }
3124: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3125: ' onchange="'.$jscall.'" />';
3126: $result = &mt
1.144 matthew 3127: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3128: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3129: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3130: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3131: 'onchange="'.$jscall.'" />');
1.32 matthew 3132: return $result;
3133: }
3134:
1.586 raeburn 3135: sub get_assignable_auth {
3136: my ($dom) = @_;
3137: if ($dom eq '') {
3138: $dom = $env{'request.role.domain'};
3139: }
3140: my %can_assign = (
3141: krb4 => 1,
3142: krb5 => 1,
3143: int => 1,
3144: loc => 1,
3145: );
3146: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3147: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3148: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3149: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3150: my $context;
3151: if ($env{'request.role'} =~ /^au/) {
3152: $context = 'author';
3153: } elsif ($env{'request.role'} =~ /^dc/) {
3154: $context = 'domain';
3155: } elsif ($env{'request.course.id'}) {
3156: $context = 'course';
3157: }
3158: if ($context) {
3159: if (ref($authhash->{$context}) eq 'HASH') {
3160: %can_assign = %{$authhash->{$context}};
3161: }
3162: }
3163: }
3164: }
3165: my $authnum = 0;
3166: foreach my $key (keys(%can_assign)) {
3167: if ($can_assign{$key}) {
3168: $authnum ++;
3169: }
3170: }
3171: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3172: $authnum --;
3173: }
3174: return ($authnum,%can_assign);
3175: }
3176:
1.80 albertel 3177: ###############################################################
3178: ## Get Kerberos Defaults for Domain ##
3179: ###############################################################
3180: ##
3181: ## Returns default kerberos version and an associated argument
3182: ## as listed in file domain.tab. If not listed, provides
3183: ## appropriate default domain and kerberos version.
3184: ##
3185: #-------------------------------------------
3186:
3187: =pod
3188:
1.648 raeburn 3189: =item * &get_kerberos_defaults()
1.80 albertel 3190:
3191: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3192: version and domain. If not found, it defaults to version 4 and the
3193: domain of the server.
1.80 albertel 3194:
1.648 raeburn 3195: =over 4
3196:
1.80 albertel 3197: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3198:
1.648 raeburn 3199: =back
3200:
3201: =back
3202:
1.80 albertel 3203: =cut
3204:
3205: #-------------------------------------------
3206: sub get_kerberos_defaults {
3207: my $domain=shift;
1.641 raeburn 3208: my ($krbdef,$krbdefdom);
3209: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3210: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3211: $krbdef = $domdefaults{'auth_def'};
3212: $krbdefdom = $domdefaults{'auth_arg_def'};
3213: } else {
1.80 albertel 3214: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3215: my $krbdefdom=$1;
3216: $krbdefdom=~tr/a-z/A-Z/;
3217: $krbdef = "krb4";
3218: }
3219: return ($krbdef,$krbdefdom);
3220: }
1.112 bowersj2 3221:
1.32 matthew 3222:
1.46 matthew 3223: ###############################################################
3224: ## Thesaurus Functions ##
3225: ###############################################################
1.20 www 3226:
1.46 matthew 3227: =pod
1.20 www 3228:
1.112 bowersj2 3229: =head1 Thesaurus Functions
3230:
3231: =over 4
3232:
1.648 raeburn 3233: =item * &initialize_keywords()
1.46 matthew 3234:
3235: Initializes the package variable %Keywords if it is empty. Uses the
3236: package variable $thesaurus_db_file.
3237:
3238: =cut
3239:
3240: ###################################################
3241:
3242: sub initialize_keywords {
3243: return 1 if (scalar keys(%Keywords));
3244: # If we are here, %Keywords is empty, so fill it up
3245: # Make sure the file we need exists...
3246: if (! -e $thesaurus_db_file) {
3247: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3248: " failed because it does not exist");
3249: return 0;
3250: }
3251: # Set up the hash as a database
3252: my %thesaurus_db;
3253: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3254: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3255: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3256: $thesaurus_db_file);
3257: return 0;
3258: }
3259: # Get the average number of appearances of a word.
3260: my $avecount = $thesaurus_db{'average.count'};
3261: # Put keywords (those that appear > average) into %Keywords
3262: while (my ($word,$data)=each (%thesaurus_db)) {
3263: my ($count,undef) = split /:/,$data;
3264: $Keywords{$word}++ if ($count > $avecount);
3265: }
3266: untie %thesaurus_db;
3267: # Remove special values from %Keywords.
1.356 albertel 3268: foreach my $value ('total.count','average.count') {
3269: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3270: }
1.46 matthew 3271: return 1;
3272: }
3273:
3274: ###################################################
3275:
3276: =pod
3277:
1.648 raeburn 3278: =item * &keyword($word)
1.46 matthew 3279:
3280: Returns true if $word is a keyword. A keyword is a word that appears more
3281: than the average number of times in the thesaurus database. Calls
3282: &initialize_keywords
3283:
3284: =cut
3285:
3286: ###################################################
1.20 www 3287:
3288: sub keyword {
1.46 matthew 3289: return if (!&initialize_keywords());
3290: my $word=lc(shift());
3291: $word=~s/\W//g;
3292: return exists($Keywords{$word});
1.20 www 3293: }
1.46 matthew 3294:
3295: ###############################################################
3296:
3297: =pod
1.20 www 3298:
1.648 raeburn 3299: =item * &get_related_words()
1.46 matthew 3300:
1.160 matthew 3301: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3302: an array of words. If the keyword is not in the thesaurus, an empty array
3303: will be returned. The order of the words returned is determined by the
3304: database which holds them.
3305:
3306: Uses global $thesaurus_db_file.
3307:
1.1057 foxr 3308:
1.46 matthew 3309: =cut
3310:
3311: ###############################################################
3312: sub get_related_words {
3313: my $keyword = shift;
3314: my %thesaurus_db;
3315: if (! -e $thesaurus_db_file) {
3316: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3317: "failed because the file does not exist");
3318: return ();
3319: }
3320: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3321: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3322: return ();
3323: }
3324: my @Words=();
1.429 www 3325: my $count=0;
1.46 matthew 3326: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3327: # The first element is the number of times
3328: # the word appears. We do not need it now.
1.429 www 3329: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3330: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3331: my $threshold=$mostfrequentcount/10;
3332: foreach my $possibleword (@RelatedWords) {
3333: my ($word,$wordcount)=split(/\,/,$possibleword);
3334: if ($wordcount>$threshold) {
3335: push(@Words,$word);
3336: $count++;
3337: if ($count>10) { last; }
3338: }
1.20 www 3339: }
3340: }
1.46 matthew 3341: untie %thesaurus_db;
3342: return @Words;
1.14 harris41 3343: }
1.1090 foxr 3344: ###############################################################
3345: #
3346: # Spell checking
3347: #
3348:
3349: =pod
3350:
1.1142 raeburn 3351: =back
3352:
1.1090 foxr 3353: =head1 Spell checking
3354:
3355: =over 4
3356:
3357: =item * &check_spelling($wordlist $language)
3358:
3359: Takes a string containing words and feeds it to an external
3360: spellcheck program via a pipeline. Returns a string containing
3361: them mis-spelled words.
3362:
3363: Parameters:
3364:
3365: =over 4
3366:
3367: =item - $wordlist
3368:
3369: String that will be fed into the spellcheck program.
3370:
3371: =item - $language
3372:
3373: Language string that specifies the language for which the spell
3374: check will be performed.
3375:
3376: =back
3377:
3378: =back
3379:
3380: Note: This sub assumes that aspell is installed.
3381:
3382:
3383: =cut
3384:
1.46 matthew 3385:
1.1090 foxr 3386: sub check_spelling {
3387: my ($wordlist, $language) = @_;
1.1091 foxr 3388: my @misspellings;
3389:
3390: # Generate the speller and set the langauge.
3391: # if explicitly selected:
1.1090 foxr 3392:
1.1091 foxr 3393: my $speller = Text::Aspell->new;
1.1090 foxr 3394: if ($language) {
1.1091 foxr 3395: $speller->set_option('lang', $language);
1.1090 foxr 3396: }
3397:
1.1091 foxr 3398: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3399:
1.1091 foxr 3400: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3401:
1.1091 foxr 3402: foreach my $word (@words) {
3403: if(! $speller->check($word)) {
3404: push(@misspellings, $word);
1.1090 foxr 3405: }
3406: }
1.1091 foxr 3407: return join(' ', @misspellings);
3408:
1.1090 foxr 3409: }
3410:
1.61 www 3411: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3412: =pod
3413:
1.112 bowersj2 3414: =head1 User Name Functions
3415:
3416: =over 4
3417:
1.648 raeburn 3418: =item * &plainname($uname,$udom,$first)
1.81 albertel 3419:
1.112 bowersj2 3420: Takes a users logon name and returns it as a string in
1.226 albertel 3421: "first middle last generation" form
3422: if $first is set to 'lastname' then it returns it as
3423: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3424:
3425: =cut
1.61 www 3426:
1.295 www 3427:
1.81 albertel 3428: ###############################################################
1.61 www 3429: sub plainname {
1.226 albertel 3430: my ($uname,$udom,$first)=@_;
1.537 albertel 3431: return if (!defined($uname) || !defined($udom));
1.295 www 3432: my %names=&getnames($uname,$udom);
1.226 albertel 3433: my $name=&Apache::lonnet::format_name($names{'firstname'},
3434: $names{'middlename'},
3435: $names{'lastname'},
3436: $names{'generation'},$first);
3437: $name=~s/^\s+//;
1.62 www 3438: $name=~s/\s+$//;
3439: $name=~s/\s+/ /g;
1.353 albertel 3440: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3441: return $name;
1.61 www 3442: }
1.66 www 3443:
3444: # -------------------------------------------------------------------- Nickname
1.81 albertel 3445: =pod
3446:
1.648 raeburn 3447: =item * &nickname($uname,$udom)
1.81 albertel 3448:
3449: Gets a users name and returns it as a string as
3450:
3451: ""nickname""
1.66 www 3452:
1.81 albertel 3453: if the user has a nickname or
3454:
3455: "first middle last generation"
3456:
3457: if the user does not
3458:
3459: =cut
1.66 www 3460:
3461: sub nickname {
3462: my ($uname,$udom)=@_;
1.537 albertel 3463: return if (!defined($uname) || !defined($udom));
1.295 www 3464: my %names=&getnames($uname,$udom);
1.68 albertel 3465: my $name=$names{'nickname'};
1.66 www 3466: if ($name) {
3467: $name='"'.$name.'"';
3468: } else {
3469: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3470: $names{'lastname'}.' '.$names{'generation'};
3471: $name=~s/\s+$//;
3472: $name=~s/\s+/ /g;
3473: }
3474: return $name;
3475: }
3476:
1.295 www 3477: sub getnames {
3478: my ($uname,$udom)=@_;
1.537 albertel 3479: return if (!defined($uname) || !defined($udom));
1.433 albertel 3480: if ($udom eq 'public' && $uname eq 'public') {
3481: return ('lastname' => &mt('Public'));
3482: }
1.295 www 3483: my $id=$uname.':'.$udom;
3484: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3485: if ($cached) {
3486: return %{$names};
3487: } else {
3488: my %loadnames=&Apache::lonnet::get('environment',
3489: ['firstname','middlename','lastname','generation','nickname'],
3490: $udom,$uname);
3491: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3492: return %loadnames;
3493: }
3494: }
1.61 www 3495:
1.542 raeburn 3496: # -------------------------------------------------------------------- getemails
1.648 raeburn 3497:
1.542 raeburn 3498: =pod
3499:
1.648 raeburn 3500: =item * &getemails($uname,$udom)
1.542 raeburn 3501:
3502: Gets a user's email information and returns it as a hash with keys:
3503: notification, critnotification, permanentemail
3504:
3505: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3506: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3507:
1.648 raeburn 3508:
1.542 raeburn 3509: =cut
3510:
1.648 raeburn 3511:
1.466 albertel 3512: sub getemails {
3513: my ($uname,$udom)=@_;
3514: if ($udom eq 'public' && $uname eq 'public') {
3515: return;
3516: }
1.467 www 3517: if (!$udom) { $udom=$env{'user.domain'}; }
3518: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3519: my $id=$uname.':'.$udom;
3520: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3521: if ($cached) {
3522: return %{$names};
3523: } else {
3524: my %loadnames=&Apache::lonnet::get('environment',
3525: ['notification','critnotification',
3526: 'permanentemail'],
3527: $udom,$uname);
3528: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3529: return %loadnames;
3530: }
3531: }
3532:
1.551 albertel 3533: sub flush_email_cache {
3534: my ($uname,$udom)=@_;
3535: if (!$udom) { $udom =$env{'user.domain'}; }
3536: if (!$uname) { $uname=$env{'user.name'}; }
3537: return if ($udom eq 'public' && $uname eq 'public');
3538: my $id=$uname.':'.$udom;
3539: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3540: }
3541:
1.728 raeburn 3542: # -------------------------------------------------------------------- getlangs
3543:
3544: =pod
3545:
3546: =item * &getlangs($uname,$udom)
3547:
3548: Gets a user's language preference and returns it as a hash with key:
3549: language.
3550:
3551: =cut
3552:
3553:
3554: sub getlangs {
3555: my ($uname,$udom) = @_;
3556: if (!$udom) { $udom =$env{'user.domain'}; }
3557: if (!$uname) { $uname=$env{'user.name'}; }
3558: my $id=$uname.':'.$udom;
3559: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3560: if ($cached) {
3561: return %{$langs};
3562: } else {
3563: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3564: $udom,$uname);
3565: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3566: return %loadlangs;
3567: }
3568: }
3569:
3570: sub flush_langs_cache {
3571: my ($uname,$udom)=@_;
3572: if (!$udom) { $udom =$env{'user.domain'}; }
3573: if (!$uname) { $uname=$env{'user.name'}; }
3574: return if ($udom eq 'public' && $uname eq 'public');
3575: my $id=$uname.':'.$udom;
3576: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3577: }
3578:
1.61 www 3579: # ------------------------------------------------------------------ Screenname
1.81 albertel 3580:
3581: =pod
3582:
1.648 raeburn 3583: =item * &screenname($uname,$udom)
1.81 albertel 3584:
3585: Gets a users screenname and returns it as a string
3586:
3587: =cut
1.61 www 3588:
3589: sub screenname {
3590: my ($uname,$udom)=@_;
1.258 albertel 3591: if ($uname eq $env{'user.name'} &&
3592: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3593: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3594: return $names{'screenname'};
1.62 www 3595: }
3596:
1.212 albertel 3597:
1.802 bisitz 3598: # ------------------------------------------------------------- Confirm Wrapper
3599: =pod
3600:
1.1142 raeburn 3601: =item * &confirmwrapper($message)
1.802 bisitz 3602:
3603: Wrap messages about completion of operation in box
3604:
3605: =cut
3606:
3607: sub confirmwrapper {
3608: my ($message)=@_;
3609: if ($message) {
3610: return "\n".'<div class="LC_confirm_box">'."\n"
3611: .$message."\n"
3612: .'</div>'."\n";
3613: } else {
3614: return $message;
3615: }
3616: }
3617:
1.62 www 3618: # ------------------------------------------------------------- Message Wrapper
3619:
3620: sub messagewrapper {
1.369 www 3621: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3622: return
1.441 albertel 3623: '<a href="/adm/email?compose=individual&'.
3624: 'recname='.$username.'&recdom='.$domain.
3625: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3626: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3627: }
1.802 bisitz 3628:
1.74 www 3629: # --------------------------------------------------------------- Notes Wrapper
3630:
3631: sub noteswrapper {
3632: my ($link,$un,$do)=@_;
3633: return
1.896 amueller 3634: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3635: }
1.802 bisitz 3636:
1.62 www 3637: # ------------------------------------------------------------- Aboutme Wrapper
3638:
3639: sub aboutmewrapper {
1.1070 raeburn 3640: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3641: if (!defined($username) && !defined($domain)) {
3642: return;
3643: }
1.1096 raeburn 3644: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3645: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3646: }
3647:
3648: # ------------------------------------------------------------ Syllabus Wrapper
3649:
3650: sub syllabuswrapper {
1.707 bisitz 3651: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3652: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3653: }
1.14 harris41 3654:
1.802 bisitz 3655: # -----------------------------------------------------------------------------
3656:
1.208 matthew 3657: sub track_student_link {
1.887 raeburn 3658: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3659: my $link ="/adm/trackstudent?";
1.208 matthew 3660: my $title = 'View recent activity';
3661: if (defined($sname) && $sname !~ /^\s*$/ &&
3662: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3663: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3664: $title .= ' of this student';
1.268 albertel 3665: }
1.208 matthew 3666: if (defined($target) && $target !~ /^\s*$/) {
3667: $target = qq{target="$target"};
3668: } else {
3669: $target = '';
3670: }
1.268 albertel 3671: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3672: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3673: $title = &mt($title);
3674: $linktext = &mt($linktext);
1.448 albertel 3675: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3676: &help_open_topic('View_recent_activity');
1.208 matthew 3677: }
3678:
1.781 raeburn 3679: sub slot_reservations_link {
3680: my ($linktext,$sname,$sdom,$target) = @_;
3681: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3682: my $title = 'View slot reservation history';
3683: if (defined($sname) && $sname !~ /^\s*$/ &&
3684: defined($sdom) && $sdom !~ /^\s*$/) {
3685: $link .= "&uname=$sname&udom=$sdom";
3686: $title .= ' of this student';
3687: }
3688: if (defined($target) && $target !~ /^\s*$/) {
3689: $target = qq{target="$target"};
3690: } else {
3691: $target = '';
3692: }
3693: $title = &mt($title);
3694: $linktext = &mt($linktext);
3695: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3696: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3697:
3698: }
3699:
1.508 www 3700: # ===================================================== Display a student photo
3701:
3702:
1.509 albertel 3703: sub student_image_tag {
1.508 www 3704: my ($domain,$user)=@_;
3705: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3706: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3707: return '<img src="'.$imgsrc.'" align="right" />';
3708: } else {
3709: return '';
3710: }
3711: }
3712:
1.112 bowersj2 3713: =pod
3714:
3715: =back
3716:
3717: =head1 Access .tab File Data
3718:
3719: =over 4
3720:
1.648 raeburn 3721: =item * &languageids()
1.112 bowersj2 3722:
3723: returns list of all language ids
3724:
3725: =cut
3726:
1.14 harris41 3727: sub languageids {
1.16 harris41 3728: return sort(keys(%language));
1.14 harris41 3729: }
3730:
1.112 bowersj2 3731: =pod
3732:
1.648 raeburn 3733: =item * &languagedescription()
1.112 bowersj2 3734:
3735: returns description of a specified language id
3736:
3737: =cut
3738:
1.14 harris41 3739: sub languagedescription {
1.125 www 3740: my $code=shift;
3741: return ($supported_language{$code}?'* ':'').
3742: $language{$code}.
1.126 www 3743: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3744: }
3745:
1.1048 foxr 3746: =pod
3747:
3748: =item * &plainlanguagedescription
3749:
3750: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3751: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3752:
3753: =cut
3754:
1.145 www 3755: sub plainlanguagedescription {
3756: my $code=shift;
3757: return $language{$code};
3758: }
3759:
1.1048 foxr 3760: =pod
3761:
3762: =item * &supportedlanguagecode
3763:
3764: Returns the supported language code (e.g. sptutf maps to pt) given a language
3765: code.
3766:
3767: =cut
3768:
1.145 www 3769: sub supportedlanguagecode {
3770: my $code=shift;
3771: return $supported_language{$code};
1.97 www 3772: }
3773:
1.112 bowersj2 3774: =pod
3775:
1.1048 foxr 3776: =item * &latexlanguage()
3777:
3778: Given a language key code returns the correspondnig language to use
3779: to select the correct hyphenation on LaTeX printouts. This is undef if there
3780: is no supported hyphenation for the language code.
3781:
3782: =cut
3783:
3784: sub latexlanguage {
3785: my $code = shift;
3786: return $latex_language{$code};
3787: }
3788:
3789: =pod
3790:
3791: =item * &latexhyphenation()
3792:
3793: Same as above but what's supplied is the language as it might be stored
3794: in the metadata.
3795:
3796: =cut
3797:
3798: sub latexhyphenation {
3799: my $key = shift;
3800: return $latex_language_bykey{$key};
3801: }
3802:
3803: =pod
3804:
1.648 raeburn 3805: =item * ©rightids()
1.112 bowersj2 3806:
3807: returns list of all copyrights
3808:
3809: =cut
3810:
3811: sub copyrightids {
3812: return sort(keys(%cprtag));
3813: }
3814:
3815: =pod
3816:
1.648 raeburn 3817: =item * ©rightdescription()
1.112 bowersj2 3818:
3819: returns description of a specified copyright id
3820:
3821: =cut
3822:
3823: sub copyrightdescription {
1.166 www 3824: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3825: }
1.197 matthew 3826:
3827: =pod
3828:
1.648 raeburn 3829: =item * &source_copyrightids()
1.192 taceyjo1 3830:
3831: returns list of all source copyrights
3832:
3833: =cut
3834:
3835: sub source_copyrightids {
3836: return sort(keys(%scprtag));
3837: }
3838:
3839: =pod
3840:
1.648 raeburn 3841: =item * &source_copyrightdescription()
1.192 taceyjo1 3842:
3843: returns description of a specified source copyright id
3844:
3845: =cut
3846:
3847: sub source_copyrightdescription {
3848: return &mt($scprtag{shift(@_)});
3849: }
1.112 bowersj2 3850:
3851: =pod
3852:
1.648 raeburn 3853: =item * &filecategories()
1.112 bowersj2 3854:
3855: returns list of all file categories
3856:
3857: =cut
3858:
3859: sub filecategories {
3860: return sort(keys(%category_extensions));
3861: }
3862:
3863: =pod
3864:
1.648 raeburn 3865: =item * &filecategorytypes()
1.112 bowersj2 3866:
3867: returns list of file types belonging to a given file
3868: category
3869:
3870: =cut
3871:
3872: sub filecategorytypes {
1.356 albertel 3873: my ($cat) = @_;
3874: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3875: }
3876:
3877: =pod
3878:
1.648 raeburn 3879: =item * &fileembstyle()
1.112 bowersj2 3880:
3881: returns embedding style for a specified file type
3882:
3883: =cut
3884:
3885: sub fileembstyle {
3886: return $fe{lc(shift(@_))};
1.169 www 3887: }
3888:
1.351 www 3889: sub filemimetype {
3890: return $fm{lc(shift(@_))};
3891: }
3892:
1.169 www 3893:
3894: sub filecategoryselect {
3895: my ($name,$value)=@_;
1.189 matthew 3896: return &select_form($value,$name,
1.970 raeburn 3897: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3898: }
3899:
3900: =pod
3901:
1.648 raeburn 3902: =item * &filedescription()
1.112 bowersj2 3903:
3904: returns description for a specified file type
3905:
3906: =cut
3907:
3908: sub filedescription {
1.188 matthew 3909: my $file_description = $fd{lc(shift())};
3910: $file_description =~ s:([\[\]]):~$1:g;
3911: return &mt($file_description);
1.112 bowersj2 3912: }
3913:
3914: =pod
3915:
1.648 raeburn 3916: =item * &filedescriptionex()
1.112 bowersj2 3917:
3918: returns description for a specified file type with
3919: extra formatting
3920:
3921: =cut
3922:
3923: sub filedescriptionex {
3924: my $ex=shift;
1.188 matthew 3925: my $file_description = $fd{lc($ex)};
3926: $file_description =~ s:([\[\]]):~$1:g;
3927: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3928: }
3929:
3930: # End of .tab access
3931: =pod
3932:
3933: =back
3934:
3935: =cut
3936:
3937: # ------------------------------------------------------------------ File Types
3938: sub fileextensions {
3939: return sort(keys(%fe));
3940: }
3941:
1.97 www 3942: # ----------------------------------------------------------- Display Languages
3943: # returns a hash with all desired display languages
3944: #
3945:
3946: sub display_languages {
3947: my %languages=();
1.695 raeburn 3948: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3949: $languages{$lang}=1;
1.97 www 3950: }
3951: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3952: if ($env{'form.displaylanguage'}) {
1.356 albertel 3953: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3954: $languages{$lang}=1;
1.97 www 3955: }
3956: }
3957: return %languages;
1.14 harris41 3958: }
3959:
1.582 albertel 3960: sub languages {
3961: my ($possible_langs) = @_;
1.695 raeburn 3962: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3963: if (!ref($possible_langs)) {
3964: if( wantarray ) {
3965: return @preferred_langs;
3966: } else {
3967: return $preferred_langs[0];
3968: }
3969: }
3970: my %possibilities = map { $_ => 1 } (@$possible_langs);
3971: my @preferred_possibilities;
3972: foreach my $preferred_lang (@preferred_langs) {
3973: if (exists($possibilities{$preferred_lang})) {
3974: push(@preferred_possibilities, $preferred_lang);
3975: }
3976: }
3977: if( wantarray ) {
3978: return @preferred_possibilities;
3979: }
3980: return $preferred_possibilities[0];
3981: }
3982:
1.742 raeburn 3983: sub user_lang {
3984: my ($touname,$toudom,$fromcid) = @_;
3985: my @userlangs;
3986: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3987: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3988: $env{'course.'.$fromcid.'.languages'}));
3989: } else {
3990: my %langhash = &getlangs($touname,$toudom);
3991: if ($langhash{'languages'} ne '') {
3992: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3993: } else {
3994: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3995: if ($domdefs{'lang_def'} ne '') {
3996: @userlangs = ($domdefs{'lang_def'});
3997: }
3998: }
3999: }
4000: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4001: my $user_lh = Apache::localize->get_handle(@languages);
4002: return $user_lh;
4003: }
4004:
4005:
1.112 bowersj2 4006: ###############################################################
4007: ## Student Answer Attempts ##
4008: ###############################################################
4009:
4010: =pod
4011:
4012: =head1 Alternate Problem Views
4013:
4014: =over 4
4015:
1.648 raeburn 4016: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4017: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4018:
4019: Return string with previous attempt on problem. Arguments:
4020:
4021: =over 4
4022:
4023: =item * $symb: Problem, including path
4024:
4025: =item * $username: username of the desired student
4026:
4027: =item * $domain: domain of the desired student
1.14 harris41 4028:
1.112 bowersj2 4029: =item * $course: Course ID
1.14 harris41 4030:
1.112 bowersj2 4031: =item * $getattempt: Leave blank for all attempts, otherwise put
4032: something
1.14 harris41 4033:
1.112 bowersj2 4034: =item * $regexp: if string matches this regexp, the string will be
4035: sent to $gradesub
1.14 harris41 4036:
1.112 bowersj2 4037: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4038:
1.1199 raeburn 4039: =item * $usec: section of the desired student
4040:
4041: =item * $identifier: counter for student (multiple students one problem) or
4042: problem (one student; whole sequence).
4043:
1.112 bowersj2 4044: =back
1.14 harris41 4045:
1.112 bowersj2 4046: The output string is a table containing all desired attempts, if any.
1.16 harris41 4047:
1.112 bowersj2 4048: =cut
1.1 albertel 4049:
4050: sub get_previous_attempt {
1.1199 raeburn 4051: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4052: my $prevattempts='';
1.43 ng 4053: no strict 'refs';
1.1 albertel 4054: if ($symb) {
1.3 albertel 4055: my (%returnhash)=
4056: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4057: if ($returnhash{'version'}) {
4058: my %lasthash=();
4059: my $version;
4060: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4061: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4062: if ($key =~ /\.rawrndseed$/) {
4063: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4064: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4065: } else {
4066: $lasthash{$key}=$returnhash{$version.':'.$key};
4067: }
1.19 harris41 4068: }
1.1 albertel 4069: }
1.596 albertel 4070: $prevattempts=&start_data_table().&start_data_table_header_row();
4071: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4072: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4073: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4074: foreach my $key (sort(keys(%lasthash))) {
4075: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4076: if ($#parts > 0) {
1.31 albertel 4077: my $data=$parts[-1];
1.989 raeburn 4078: next if ($data eq 'foilorder');
1.31 albertel 4079: pop(@parts);
1.1010 www 4080: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4081: if ($data eq 'type') {
4082: unless ($showsurv) {
4083: my $id = join(',',@parts);
4084: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4085: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4086: $lasthidden{$ign.'.'.$id} = 1;
4087: }
1.945 raeburn 4088: }
1.1199 raeburn 4089: if ($identifier ne '') {
4090: my $id = join(',',@parts);
4091: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4092: $domain,$username,$usec,undef,$course) =~ /^no/) {
4093: $hidestatus{$ign.'.'.$id} = 1;
4094: }
4095: }
4096: } elsif ($data eq 'regrader') {
4097: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4098: my $id = join(',',@parts);
4099: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4100: }
1.1010 www 4101: }
1.31 albertel 4102: } else {
1.41 ng 4103: if ($#parts == 0) {
4104: $prevattempts.='<th>'.$parts[0].'</th>';
4105: } else {
4106: $prevattempts.='<th>'.$ign.'</th>';
4107: }
1.31 albertel 4108: }
1.16 harris41 4109: }
1.596 albertel 4110: $prevattempts.=&end_data_table_header_row();
1.40 ng 4111: if ($getattempt eq '') {
1.1199 raeburn 4112: my (%solved,%resets,%probstatus);
1.1200 raeburn 4113: if (($identifier ne '') && (keys(%regraded) > 0)) {
4114: for ($version=1;$version<=$returnhash{'version'};$version++) {
4115: foreach my $id (keys(%regraded)) {
4116: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4117: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4118: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4119: push(@{$resets{$id}},$version);
1.1199 raeburn 4120: }
4121: }
4122: }
1.1200 raeburn 4123: }
4124: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4125: my (@hidden,@unsolved);
1.945 raeburn 4126: if (%typeparts) {
4127: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4128: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4129: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4130: push(@hidden,$id);
1.1199 raeburn 4131: } elsif ($identifier ne '') {
4132: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4133: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4134: ($hidestatus{$id})) {
1.1200 raeburn 4135: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4136: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4137: push(@{$solved{$id}},$version);
4138: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4139: (ref($solved{$id}) eq 'ARRAY')) {
4140: my $skip;
4141: if (ref($resets{$id}) eq 'ARRAY') {
4142: foreach my $reset (@{$resets{$id}}) {
4143: if ($reset > $solved{$id}[-1]) {
4144: $skip=1;
4145: last;
4146: }
4147: }
4148: }
4149: unless ($skip) {
4150: my ($ign,$partslist) = split(/\./,$id,2);
4151: push(@unsolved,$partslist);
4152: }
4153: }
4154: }
1.945 raeburn 4155: }
4156: }
4157: }
4158: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4159: '<td>'.&mt('Transaction [_1]',$version);
4160: if (@unsolved) {
4161: $prevattempts .= '<span class="LC_nobreak"><label>'.
4162: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4163: &mt('Hide').'</label></span>';
4164: }
4165: $prevattempts .= '</td>';
1.945 raeburn 4166: if (@hidden) {
4167: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4168: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4169: my $hide;
4170: foreach my $id (@hidden) {
4171: if ($key =~ /^\Q$id\E/) {
4172: $hide = 1;
4173: last;
4174: }
4175: }
4176: if ($hide) {
4177: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4178: if (($data eq 'award') || ($data eq 'awarddetail')) {
4179: my $value = &format_previous_attempt_value($key,
4180: $returnhash{$version.':'.$key});
1.1173 kruse 4181: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4182: } else {
4183: $prevattempts.='<td> </td>';
4184: }
4185: } else {
4186: if ($key =~ /\./) {
1.1212 raeburn 4187: my $value = $returnhash{$version.':'.$key};
4188: if ($key =~ /\.rndseed$/) {
4189: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4190: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4191: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4192: }
4193: }
4194: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4195: ' </td>';
1.945 raeburn 4196: } else {
4197: $prevattempts.='<td> </td>';
4198: }
4199: }
4200: }
4201: } else {
4202: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4203: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4204: my $value = $returnhash{$version.':'.$key};
4205: if ($key =~ /\.rndseed$/) {
4206: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4207: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4208: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4209: }
4210: }
4211: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4212: ' </td>';
1.945 raeburn 4213: }
4214: }
4215: $prevattempts.=&end_data_table_row();
1.40 ng 4216: }
1.1 albertel 4217: }
1.945 raeburn 4218: my @currhidden = keys(%lasthidden);
1.596 albertel 4219: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4220: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4221: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4222: if (%typeparts) {
4223: my $hidden;
4224: foreach my $id (@currhidden) {
4225: if ($key =~ /^\Q$id\E/) {
4226: $hidden = 1;
4227: last;
4228: }
4229: }
4230: if ($hidden) {
4231: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4232: if (($data eq 'award') || ($data eq 'awarddetail')) {
4233: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4234: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4235: $value = &$gradesub($value);
4236: }
1.1173 kruse 4237: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4238: } else {
4239: $prevattempts.='<td> </td>';
4240: }
4241: } else {
4242: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4243: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4244: $value = &$gradesub($value);
4245: }
1.1173 kruse 4246: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4247: }
4248: } else {
4249: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4250: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4251: $value = &$gradesub($value);
4252: }
1.1173 kruse 4253: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4254: }
1.16 harris41 4255: }
1.596 albertel 4256: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4257: } else {
1.596 albertel 4258: $prevattempts=
4259: &start_data_table().&start_data_table_row().
4260: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4261: &end_data_table_row().&end_data_table();
1.1 albertel 4262: }
4263: } else {
1.596 albertel 4264: $prevattempts=
4265: &start_data_table().&start_data_table_row().
4266: '<td>'.&mt('No data.').'</td>'.
4267: &end_data_table_row().&end_data_table();
1.1 albertel 4268: }
1.10 albertel 4269: }
4270:
1.581 albertel 4271: sub format_previous_attempt_value {
4272: my ($key,$value) = @_;
1.1011 www 4273: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4274: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4275: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4276: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4277: } elsif ($key =~ /answerstring$/) {
4278: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4279: my @answer = %answers;
4280: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4281: my @anskeys = sort(keys(%answers));
4282: if (@anskeys == 1) {
4283: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4284: if ($answer =~ m{\0}) {
4285: $answer =~ s{\0}{,}g;
1.988 raeburn 4286: }
4287: my $tag_internal_answer_name = 'INTERNAL';
4288: if ($anskeys[0] eq $tag_internal_answer_name) {
4289: $value = $answer;
4290: } else {
4291: $value = $anskeys[0].'='.$answer;
4292: }
4293: } else {
4294: foreach my $ans (@anskeys) {
4295: my $answer = $answers{$ans};
1.1001 raeburn 4296: if ($answer =~ m{\0}) {
4297: $answer =~ s{\0}{,}g;
1.988 raeburn 4298: }
4299: $value .= $ans.'='.$answer.'<br />';;
4300: }
4301: }
1.581 albertel 4302: } else {
1.1173 kruse 4303: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4304: }
4305: return $value;
4306: }
4307:
4308:
1.107 albertel 4309: sub relative_to_absolute {
4310: my ($url,$output)=@_;
4311: my $parser=HTML::TokeParser->new(\$output);
4312: my $token;
4313: my $thisdir=$url;
4314: my @rlinks=();
4315: while ($token=$parser->get_token) {
4316: if ($token->[0] eq 'S') {
4317: if ($token->[1] eq 'a') {
4318: if ($token->[2]->{'href'}) {
4319: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4320: }
4321: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4322: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4323: } elsif ($token->[1] eq 'base') {
4324: $thisdir=$token->[2]->{'href'};
4325: }
4326: }
4327: }
4328: $thisdir=~s-/[^/]*$--;
1.356 albertel 4329: foreach my $link (@rlinks) {
1.726 raeburn 4330: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4331: ($link=~/^\//) ||
4332: ($link=~/^javascript:/i) ||
4333: ($link=~/^mailto:/i) ||
4334: ($link=~/^\#/)) {
4335: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4336: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4337: }
4338: }
4339: # -------------------------------------------------- Deal with Applet codebases
4340: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4341: return $output;
4342: }
4343:
1.112 bowersj2 4344: =pod
4345:
1.648 raeburn 4346: =item * &get_student_view()
1.112 bowersj2 4347:
4348: show a snapshot of what student was looking at
4349:
4350: =cut
4351:
1.10 albertel 4352: sub get_student_view {
1.186 albertel 4353: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4354: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4355: my (%form);
1.10 albertel 4356: my @elements=('symb','courseid','domain','username');
4357: foreach my $element (@elements) {
1.186 albertel 4358: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4359: }
1.186 albertel 4360: if (defined($moreenv)) {
4361: %form=(%form,%{$moreenv});
4362: }
1.236 albertel 4363: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4364: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4365: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4366: $userview=~s/\<body[^\>]*\>//gi;
4367: $userview=~s/\<\/body\>//gi;
4368: $userview=~s/\<html\>//gi;
4369: $userview=~s/\<\/html\>//gi;
4370: $userview=~s/\<head\>//gi;
4371: $userview=~s/\<\/head\>//gi;
4372: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4373: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4374: if (wantarray) {
4375: return ($userview,$response);
4376: } else {
4377: return $userview;
4378: }
4379: }
4380:
4381: sub get_student_view_with_retries {
4382: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4383:
4384: my $ok = 0; # True if we got a good response.
4385: my $content;
4386: my $response;
4387:
4388: # Try to get the student_view done. within the retries count:
4389:
4390: do {
4391: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4392: $ok = $response->is_success;
4393: if (!$ok) {
4394: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4395: }
4396: $retries--;
4397: } while (!$ok && ($retries > 0));
4398:
4399: if (!$ok) {
4400: $content = ''; # On error return an empty content.
4401: }
1.651 www 4402: if (wantarray) {
4403: return ($content, $response);
4404: } else {
4405: return $content;
4406: }
1.11 albertel 4407: }
4408:
1.112 bowersj2 4409: =pod
4410:
1.648 raeburn 4411: =item * &get_student_answers()
1.112 bowersj2 4412:
4413: show a snapshot of how student was answering problem
4414:
4415: =cut
4416:
1.11 albertel 4417: sub get_student_answers {
1.100 sakharuk 4418: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4419: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4420: my (%moreenv);
1.11 albertel 4421: my @elements=('symb','courseid','domain','username');
4422: foreach my $element (@elements) {
1.186 albertel 4423: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4424: }
1.186 albertel 4425: $moreenv{'grade_target'}='answer';
4426: %moreenv=(%form,%moreenv);
1.497 raeburn 4427: $feedurl = &Apache::lonnet::clutter($feedurl);
4428: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4429: return $userview;
1.1 albertel 4430: }
1.116 albertel 4431:
4432: =pod
4433:
4434: =item * &submlink()
4435:
1.242 albertel 4436: Inputs: $text $uname $udom $symb $target
1.116 albertel 4437:
4438: Returns: A link to grades.pm such as to see the SUBM view of a student
4439:
4440: =cut
4441:
4442: ###############################################
4443: sub submlink {
1.242 albertel 4444: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4445: if (!($uname && $udom)) {
4446: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4447: &Apache::lonnet::whichuser($symb);
1.116 albertel 4448: if (!$symb) { $symb=$cursymb; }
4449: }
1.254 matthew 4450: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4451: $symb=&escape($symb);
1.960 bisitz 4452: if ($target) { $target=" target=\"$target\""; }
4453: return
4454: '<a href="/adm/grades?command=submission'.
4455: '&symb='.$symb.
4456: '&student='.$uname.
4457: '&userdom='.$udom.'"'.
4458: $target.'>'.$text.'</a>';
1.242 albertel 4459: }
4460: ##############################################
4461:
4462: =pod
4463:
4464: =item * &pgrdlink()
4465:
4466: Inputs: $text $uname $udom $symb $target
4467:
4468: Returns: A link to grades.pm such as to see the PGRD view of a student
4469:
4470: =cut
4471:
4472: ###############################################
4473: sub pgrdlink {
4474: my $link=&submlink(@_);
4475: $link=~s/(&command=submission)/$1&showgrading=yes/;
4476: return $link;
4477: }
4478: ##############################################
4479:
4480: =pod
4481:
4482: =item * &pprmlink()
4483:
4484: Inputs: $text $uname $udom $symb $target
4485:
4486: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4487: student and a specific resource
1.242 albertel 4488:
4489: =cut
4490:
4491: ###############################################
4492: sub pprmlink {
4493: my ($text,$uname,$udom,$symb,$target)=@_;
4494: if (!($uname && $udom)) {
4495: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4496: &Apache::lonnet::whichuser($symb);
1.242 albertel 4497: if (!$symb) { $symb=$cursymb; }
4498: }
1.254 matthew 4499: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4500: $symb=&escape($symb);
1.242 albertel 4501: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4502: return '<a href="/adm/parmset?command=set&'.
4503: 'symb='.$symb.'&uname='.$uname.
4504: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4505: }
4506: ##############################################
1.37 matthew 4507:
1.112 bowersj2 4508: =pod
4509:
4510: =back
4511:
4512: =cut
4513:
1.37 matthew 4514: ###############################################
1.51 www 4515:
4516:
4517: sub timehash {
1.687 raeburn 4518: my ($thistime) = @_;
4519: my $timezone = &Apache::lonlocal::gettimezone();
4520: my $dt = DateTime->from_epoch(epoch => $thistime)
4521: ->set_time_zone($timezone);
4522: my $wday = $dt->day_of_week();
4523: if ($wday == 7) { $wday = 0; }
4524: return ( 'second' => $dt->second(),
4525: 'minute' => $dt->minute(),
4526: 'hour' => $dt->hour(),
4527: 'day' => $dt->day_of_month(),
4528: 'month' => $dt->month(),
4529: 'year' => $dt->year(),
4530: 'weekday' => $wday,
4531: 'dayyear' => $dt->day_of_year(),
4532: 'dlsav' => $dt->is_dst() );
1.51 www 4533: }
4534:
1.370 www 4535: sub utc_string {
4536: my ($date)=@_;
1.371 www 4537: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4538: }
4539:
1.51 www 4540: sub maketime {
4541: my %th=@_;
1.687 raeburn 4542: my ($epoch_time,$timezone,$dt);
4543: $timezone = &Apache::lonlocal::gettimezone();
4544: eval {
4545: $dt = DateTime->new( year => $th{'year'},
4546: month => $th{'month'},
4547: day => $th{'day'},
4548: hour => $th{'hour'},
4549: minute => $th{'minute'},
4550: second => $th{'second'},
4551: time_zone => $timezone,
4552: );
4553: };
4554: if (!$@) {
4555: $epoch_time = $dt->epoch;
4556: if ($epoch_time) {
4557: return $epoch_time;
4558: }
4559: }
1.51 www 4560: return POSIX::mktime(
4561: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4562: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4563: }
4564:
4565: #########################################
1.51 www 4566:
4567: sub findallcourses {
1.482 raeburn 4568: my ($roles,$uname,$udom) = @_;
1.355 albertel 4569: my %roles;
4570: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4571: my %courses;
1.51 www 4572: my $now=time;
1.482 raeburn 4573: if (!defined($uname)) {
4574: $uname = $env{'user.name'};
4575: }
4576: if (!defined($udom)) {
4577: $udom = $env{'user.domain'};
4578: }
4579: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4580: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4581: if (!%roles) {
4582: %roles = (
4583: cc => 1,
1.907 raeburn 4584: co => 1,
1.482 raeburn 4585: in => 1,
4586: ep => 1,
4587: ta => 1,
4588: cr => 1,
4589: st => 1,
4590: );
4591: }
4592: foreach my $entry (keys(%roleshash)) {
4593: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4594: if ($trole =~ /^cr/) {
4595: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4596: } else {
4597: next if (!exists($roles{$trole}));
4598: }
4599: if ($tend) {
4600: next if ($tend < $now);
4601: }
4602: if ($tstart) {
4603: next if ($tstart > $now);
4604: }
1.1058 raeburn 4605: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4606: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4607: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4608: if ($secpart eq '') {
4609: ($cnum,$role) = split(/_/,$cnumpart);
4610: $sec = 'none';
1.1058 raeburn 4611: $value .= $cnum.'/';
1.482 raeburn 4612: } else {
4613: $cnum = $cnumpart;
4614: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4615: $value .= $cnum.'/'.$sec;
4616: }
4617: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4618: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4619: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4620: }
4621: } else {
4622: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4623: }
1.482 raeburn 4624: }
4625: } else {
4626: foreach my $key (keys(%env)) {
1.483 albertel 4627: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4628: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4629: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4630: next if ($role eq 'ca' || $role eq 'aa');
4631: next if (%roles && !exists($roles{$role}));
4632: my ($starttime,$endtime)=split(/\./,$env{$key});
4633: my $active=1;
4634: if ($starttime) {
4635: if ($now<$starttime) { $active=0; }
4636: }
4637: if ($endtime) {
4638: if ($now>$endtime) { $active=0; }
4639: }
4640: if ($active) {
1.1058 raeburn 4641: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4642: if ($sec eq '') {
4643: $sec = 'none';
1.1058 raeburn 4644: } else {
4645: $value .= $sec;
4646: }
4647: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4648: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4649: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4650: }
4651: } else {
4652: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4653: }
1.474 raeburn 4654: }
4655: }
1.51 www 4656: }
4657: }
1.474 raeburn 4658: return %courses;
1.51 www 4659: }
1.37 matthew 4660:
1.54 www 4661: ###############################################
1.474 raeburn 4662:
4663: sub blockcheck {
1.1189 raeburn 4664: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4665:
1.1189 raeburn 4666: if (defined($udom) && defined($uname)) {
4667: # If uname and udom are for a course, check for blocks in the course.
4668: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4669: my ($startblock,$endblock,$triggerblock) =
4670: &get_blocks($setters,$activity,$udom,$uname,$url);
4671: return ($startblock,$endblock,$triggerblock);
4672: }
4673: } else {
1.490 raeburn 4674: $udom = $env{'user.domain'};
4675: $uname = $env{'user.name'};
4676: }
4677:
1.502 raeburn 4678: my $startblock = 0;
4679: my $endblock = 0;
1.1062 raeburn 4680: my $triggerblock = '';
1.482 raeburn 4681: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4682:
1.490 raeburn 4683: # If uname is for a user, and activity is course-specific, i.e.,
4684: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4685:
1.490 raeburn 4686: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4687: $activity eq 'groups' || $activity eq 'printout') &&
4688: ($env{'request.course.id'})) {
1.490 raeburn 4689: foreach my $key (keys(%live_courses)) {
4690: if ($key ne $env{'request.course.id'}) {
4691: delete($live_courses{$key});
4692: }
4693: }
4694: }
4695:
4696: my $otheruser = 0;
4697: my %own_courses;
4698: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4699: # Resource belongs to user other than current user.
4700: $otheruser = 1;
4701: # Gather courses for current user
4702: %own_courses =
4703: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4704: }
4705:
4706: # Gather active course roles - course coordinator, instructor,
4707: # exam proctor, ta, student, or custom role.
1.474 raeburn 4708:
4709: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4710: my ($cdom,$cnum);
4711: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4712: $cdom = $env{'course.'.$course.'.domain'};
4713: $cnum = $env{'course.'.$course.'.num'};
4714: } else {
1.490 raeburn 4715: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4716: }
4717: my $no_ownblock = 0;
4718: my $no_userblock = 0;
1.533 raeburn 4719: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4720: # Check if current user has 'evb' priv for this
4721: if (defined($own_courses{$course})) {
4722: foreach my $sec (keys(%{$own_courses{$course}})) {
4723: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4724: if ($sec ne 'none') {
4725: $checkrole .= '/'.$sec;
4726: }
4727: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4728: $no_ownblock = 1;
4729: last;
4730: }
4731: }
4732: }
4733: # if they have 'evb' priv and are currently not playing student
4734: next if (($no_ownblock) &&
4735: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4736: }
1.474 raeburn 4737: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4738: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4739: if ($sec ne 'none') {
1.482 raeburn 4740: $checkrole .= '/'.$sec;
1.474 raeburn 4741: }
1.490 raeburn 4742: if ($otheruser) {
4743: # Resource belongs to user other than current user.
4744: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4745: my (%allroles,%userroles);
4746: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4747: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4748: my ($trole,$tdom,$tnum,$tsec);
4749: if ($entry =~ /^cr/) {
4750: ($trole,$tdom,$tnum,$tsec) =
4751: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4752: } else {
4753: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4754: }
4755: my ($spec,$area,$trest);
4756: $area = '/'.$tdom.'/'.$tnum;
4757: $trest = $tnum;
4758: if ($tsec ne '') {
4759: $area .= '/'.$tsec;
4760: $trest .= '/'.$tsec;
4761: }
4762: $spec = $trole.'.'.$area;
4763: if ($trole =~ /^cr/) {
4764: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4765: $tdom,$spec,$trest,$area);
4766: } else {
4767: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4768: $tdom,$spec,$trest,$area);
4769: }
4770: }
4771: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4772: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4773: if ($1) {
4774: $no_userblock = 1;
4775: last;
4776: }
1.486 raeburn 4777: }
4778: }
1.490 raeburn 4779: } else {
4780: # Resource belongs to current user
4781: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4782: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4783: $no_ownblock = 1;
4784: last;
4785: }
1.474 raeburn 4786: }
4787: }
4788: # if they have the evb priv and are currently not playing student
1.482 raeburn 4789: next if (($no_ownblock) &&
1.491 albertel 4790: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4791: next if ($no_userblock);
1.474 raeburn 4792:
1.866 kalberla 4793: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4794: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4795:
1.1062 raeburn 4796: my ($start,$end,$trigger) =
4797: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4798: if (($start != 0) &&
4799: (($startblock == 0) || ($startblock > $start))) {
4800: $startblock = $start;
1.1062 raeburn 4801: if ($trigger ne '') {
4802: $triggerblock = $trigger;
4803: }
1.502 raeburn 4804: }
4805: if (($end != 0) &&
4806: (($endblock == 0) || ($endblock < $end))) {
4807: $endblock = $end;
1.1062 raeburn 4808: if ($trigger ne '') {
4809: $triggerblock = $trigger;
4810: }
1.502 raeburn 4811: }
1.490 raeburn 4812: }
1.1062 raeburn 4813: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4814: }
4815:
4816: sub get_blocks {
1.1062 raeburn 4817: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4818: my $startblock = 0;
4819: my $endblock = 0;
1.1062 raeburn 4820: my $triggerblock = '';
1.490 raeburn 4821: my $course = $cdom.'_'.$cnum;
4822: $setters->{$course} = {};
4823: $setters->{$course}{'staff'} = [];
4824: $setters->{$course}{'times'} = [];
1.1062 raeburn 4825: $setters->{$course}{'triggers'} = [];
4826: my (@blockers,%triggered);
4827: my $now = time;
4828: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4829: if ($activity eq 'docs') {
4830: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4831: foreach my $block (@blockers) {
4832: if ($block =~ /^firstaccess____(.+)$/) {
4833: my $item = $1;
4834: my $type = 'map';
4835: my $timersymb = $item;
4836: if ($item eq 'course') {
4837: $type = 'course';
4838: } elsif ($item =~ /___\d+___/) {
4839: $type = 'resource';
4840: } else {
4841: $timersymb = &Apache::lonnet::symbread($item);
4842: }
4843: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4844: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4845: $triggered{$block} = {
4846: start => $start,
4847: end => $end,
4848: type => $type,
4849: };
4850: }
4851: }
4852: } else {
4853: foreach my $block (keys(%commblocks)) {
4854: if ($block =~ m/^(\d+)____(\d+)$/) {
4855: my ($start,$end) = ($1,$2);
4856: if ($start <= time && $end >= time) {
4857: if (ref($commblocks{$block}) eq 'HASH') {
4858: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4859: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4860: unless(grep(/^\Q$block\E$/,@blockers)) {
4861: push(@blockers,$block);
4862: }
4863: }
4864: }
4865: }
4866: }
4867: } elsif ($block =~ /^firstaccess____(.+)$/) {
4868: my $item = $1;
4869: my $timersymb = $item;
4870: my $type = 'map';
4871: if ($item eq 'course') {
4872: $type = 'course';
4873: } elsif ($item =~ /___\d+___/) {
4874: $type = 'resource';
4875: } else {
4876: $timersymb = &Apache::lonnet::symbread($item);
4877: }
4878: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4879: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4880: if ($start && $end) {
4881: if (($start <= time) && ($end >= time)) {
4882: unless (grep(/^\Q$block\E$/,@blockers)) {
4883: push(@blockers,$block);
4884: $triggered{$block} = {
4885: start => $start,
4886: end => $end,
4887: type => $type,
4888: };
4889: }
4890: }
1.490 raeburn 4891: }
1.1062 raeburn 4892: }
4893: }
4894: }
4895: foreach my $blocker (@blockers) {
4896: my ($staff_name,$staff_dom,$title,$blocks) =
4897: &parse_block_record($commblocks{$blocker});
4898: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4899: my ($start,$end,$triggertype);
4900: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4901: ($start,$end) = ($1,$2);
4902: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4903: $start = $triggered{$blocker}{'start'};
4904: $end = $triggered{$blocker}{'end'};
4905: $triggertype = $triggered{$blocker}{'type'};
4906: }
4907: if ($start) {
4908: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4909: if ($triggertype) {
4910: push(@{$$setters{$course}{'triggers'}},$triggertype);
4911: } else {
4912: push(@{$$setters{$course}{'triggers'}},0);
4913: }
4914: if ( ($startblock == 0) || ($startblock > $start) ) {
4915: $startblock = $start;
4916: if ($triggertype) {
4917: $triggerblock = $blocker;
1.474 raeburn 4918: }
4919: }
1.1062 raeburn 4920: if ( ($endblock == 0) || ($endblock < $end) ) {
4921: $endblock = $end;
4922: if ($triggertype) {
4923: $triggerblock = $blocker;
4924: }
4925: }
1.474 raeburn 4926: }
4927: }
1.1062 raeburn 4928: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4929: }
4930:
4931: sub parse_block_record {
4932: my ($record) = @_;
4933: my ($setuname,$setudom,$title,$blocks);
4934: if (ref($record) eq 'HASH') {
4935: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4936: $title = &unescape($record->{'event'});
4937: $blocks = $record->{'blocks'};
4938: } else {
4939: my @data = split(/:/,$record,3);
4940: if (scalar(@data) eq 2) {
4941: $title = $data[1];
4942: ($setuname,$setudom) = split(/@/,$data[0]);
4943: } else {
4944: ($setuname,$setudom,$title) = @data;
4945: }
4946: $blocks = { 'com' => 'on' };
4947: }
4948: return ($setuname,$setudom,$title,$blocks);
4949: }
4950:
1.854 kalberla 4951: sub blocking_status {
1.1189 raeburn 4952: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4953: my %setters;
1.890 droeschl 4954:
1.1061 raeburn 4955: # check for active blocking
1.1062 raeburn 4956: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4957: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4958: my $blocked = 0;
4959: if ($startblock && $endblock) {
4960: $blocked = 1;
4961: }
1.890 droeschl 4962:
1.1061 raeburn 4963: # caller just wants to know whether a block is active
4964: if (!wantarray) { return $blocked; }
4965:
4966: # build a link to a popup window containing the details
4967: my $querystring = "?activity=$activity";
4968: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 4969: if (($activity eq 'port') || ($activity eq 'passwd')) {
4970: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
4971: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 4972: } elsif ($activity eq 'docs') {
4973: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4974: }
1.1061 raeburn 4975:
4976: my $output .= <<'END_MYBLOCK';
4977: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4978: var options = "width=" + w + ",height=" + h + ",";
4979: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4980: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4981: var newWin = window.open(url, wdwName, options);
4982: newWin.focus();
4983: }
1.890 droeschl 4984: END_MYBLOCK
1.854 kalberla 4985:
1.1061 raeburn 4986: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4987:
1.1061 raeburn 4988: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4989: my $text = &mt('Communication Blocked');
1.1217 raeburn 4990: my $class = 'LC_comblock';
1.1062 raeburn 4991: if ($activity eq 'docs') {
4992: $text = &mt('Content Access Blocked');
1.1217 raeburn 4993: $class = '';
1.1063 raeburn 4994: } elsif ($activity eq 'printout') {
4995: $text = &mt('Printing Blocked');
1.1232 raeburn 4996: } elsif ($activity eq 'passwd') {
4997: $text = &mt('Password Changing Blocked');
1.1062 raeburn 4998: }
1.1061 raeburn 4999: $output .= <<"END_BLOCK";
1.1217 raeburn 5000: <div class='$class'>
1.869 kalberla 5001: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5002: title='$text'>
5003: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5004: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5005: title='$text'>$text</a>
1.867 kalberla 5006: </div>
5007:
5008: END_BLOCK
1.474 raeburn 5009:
1.1061 raeburn 5010: return ($blocked, $output);
1.854 kalberla 5011: }
1.490 raeburn 5012:
1.60 matthew 5013: ###############################################
5014:
1.682 raeburn 5015: sub check_ip_acc {
1.1201 raeburn 5016: my ($acc,$clientip)=@_;
1.682 raeburn 5017: &Apache::lonxml::debug("acc is $acc");
5018: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5019: return 1;
5020: }
1.1219 raeburn 5021: my $allowed;
1.1201 raeburn 5022: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682 raeburn 5023:
5024: my $name;
1.1219 raeburn 5025: my %access = (
5026: allowfrom => 1,
5027: denyfrom => 0,
5028: );
5029: my @allows;
5030: my @denies;
5031: foreach my $item (split(',',$acc)) {
5032: $item =~ s/^\s*//;
5033: $item =~ s/\s*$//;
5034: my $pattern;
5035: if ($item =~ /^\!(.+)$/) {
5036: push(@denies,$1);
5037: } else {
5038: push(@allows,$item);
5039: }
5040: }
5041: my $numdenies = scalar(@denies);
5042: my $numallows = scalar(@allows);
5043: my $count = 0;
5044: foreach my $pattern (@denies,@allows) {
5045: $count ++;
5046: my $acctype = 'allowfrom';
5047: if ($count <= $numdenies) {
5048: $acctype = 'denyfrom';
5049: }
1.682 raeburn 5050: if ($pattern =~ /\*$/) {
5051: #35.8.*
5052: $pattern=~s/\*//;
1.1219 raeburn 5053: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5054: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5055: #35.8.3.[34-56]
5056: my $low=$2;
5057: my $high=$3;
5058: $pattern=$1;
5059: if ($ip =~ /^\Q$pattern\E/) {
5060: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5061: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5062: }
5063: } elsif ($pattern =~ /^\*/) {
5064: #*.msu.edu
5065: $pattern=~s/\*//;
5066: if (!defined($name)) {
5067: use Socket;
5068: my $netaddr=inet_aton($ip);
5069: ($name)=gethostbyaddr($netaddr,AF_INET);
5070: }
1.1219 raeburn 5071: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5072: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5073: #127.0.0.1
1.1219 raeburn 5074: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5075: } else {
5076: #some.name.com
5077: if (!defined($name)) {
5078: use Socket;
5079: my $netaddr=inet_aton($ip);
5080: ($name)=gethostbyaddr($netaddr,AF_INET);
5081: }
1.1219 raeburn 5082: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5083: }
5084: if ($allowed =~ /^(0|1)$/) { last; }
5085: }
5086: if ($allowed eq '') {
5087: if ($numdenies && !$numallows) {
5088: $allowed = 1;
5089: } else {
5090: $allowed = 0;
1.682 raeburn 5091: }
5092: }
5093: return $allowed;
5094: }
5095:
5096: ###############################################
5097:
1.60 matthew 5098: =pod
5099:
1.112 bowersj2 5100: =head1 Domain Template Functions
5101:
5102: =over 4
5103:
5104: =item * &determinedomain()
1.60 matthew 5105:
5106: Inputs: $domain (usually will be undef)
5107:
1.63 www 5108: Returns: Determines which domain should be used for designs
1.60 matthew 5109:
5110: =cut
1.54 www 5111:
1.60 matthew 5112: ###############################################
1.63 www 5113: sub determinedomain {
5114: my $domain=shift;
1.531 albertel 5115: if (! $domain) {
1.60 matthew 5116: # Determine domain if we have not been given one
1.893 raeburn 5117: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5118: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5119: if ($env{'request.role.domain'}) {
5120: $domain=$env{'request.role.domain'};
1.60 matthew 5121: }
5122: }
1.63 www 5123: return $domain;
5124: }
5125: ###############################################
1.517 raeburn 5126:
1.518 albertel 5127: sub devalidate_domconfig_cache {
5128: my ($udom)=@_;
5129: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5130: }
5131:
5132: # ---------------------- Get domain configuration for a domain
5133: sub get_domainconf {
5134: my ($udom) = @_;
5135: my $cachetime=1800;
5136: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5137: if (defined($cached)) { return %{$result}; }
5138:
5139: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5140: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5141: my (%designhash,%legacy);
1.518 albertel 5142: if (keys(%domconfig) > 0) {
5143: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5144: if (keys(%{$domconfig{'login'}})) {
5145: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5146: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5147: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5148: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5149: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5150: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5151: if ($key eq 'loginvia') {
5152: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5153: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5154: $designhash{$udom.'.login.loginvia'} = $server;
5155: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5156:
5157: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5158: } else {
5159: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5160: }
1.948 raeburn 5161: }
1.1208 raeburn 5162: } elsif ($key eq 'headtag') {
5163: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5164: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5165: }
1.946 raeburn 5166: }
1.1208 raeburn 5167: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5168: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5169: }
1.946 raeburn 5170: }
5171: }
5172: }
5173: } else {
5174: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5175: $designhash{$udom.'.login.'.$key.'_'.$img} =
5176: $domconfig{'login'}{$key}{$img};
5177: }
1.699 raeburn 5178: }
5179: } else {
5180: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5181: }
1.632 raeburn 5182: }
5183: } else {
5184: $legacy{'login'} = 1;
1.518 albertel 5185: }
1.632 raeburn 5186: } else {
5187: $legacy{'login'} = 1;
1.518 albertel 5188: }
5189: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5190: if (keys(%{$domconfig{'rolecolors'}})) {
5191: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5192: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5193: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5194: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5195: }
1.518 albertel 5196: }
5197: }
1.632 raeburn 5198: } else {
5199: $legacy{'rolecolors'} = 1;
1.518 albertel 5200: }
1.632 raeburn 5201: } else {
5202: $legacy{'rolecolors'} = 1;
1.518 albertel 5203: }
1.948 raeburn 5204: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5205: if ($domconfig{'autoenroll'}{'co-owners'}) {
5206: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5207: }
5208: }
1.632 raeburn 5209: if (keys(%legacy) > 0) {
5210: my %legacyhash = &get_legacy_domconf($udom);
5211: foreach my $item (keys(%legacyhash)) {
5212: if ($item =~ /^\Q$udom\E\.login/) {
5213: if ($legacy{'login'}) {
5214: $designhash{$item} = $legacyhash{$item};
5215: }
5216: } else {
5217: if ($legacy{'rolecolors'}) {
5218: $designhash{$item} = $legacyhash{$item};
5219: }
1.518 albertel 5220: }
5221: }
5222: }
1.632 raeburn 5223: } else {
5224: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5225: }
5226: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5227: $cachetime);
5228: return %designhash;
5229: }
5230:
1.632 raeburn 5231: sub get_legacy_domconf {
5232: my ($udom) = @_;
5233: my %legacyhash;
5234: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5235: my $designfile = $designdir.'/'.$udom.'.tab';
5236: if (-e $designfile) {
5237: if ( open (my $fh,"<$designfile") ) {
5238: while (my $line = <$fh>) {
5239: next if ($line =~ /^\#/);
5240: chomp($line);
5241: my ($key,$val)=(split(/\=/,$line));
5242: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5243: }
5244: close($fh);
5245: }
5246: }
1.1026 raeburn 5247: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5248: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5249: }
5250: return %legacyhash;
5251: }
5252:
1.63 www 5253: =pod
5254:
1.112 bowersj2 5255: =item * &domainlogo()
1.63 www 5256:
5257: Inputs: $domain (usually will be undef)
5258:
5259: Returns: A link to a domain logo, if the domain logo exists.
5260: If the domain logo does not exist, a description of the domain.
5261:
5262: =cut
1.112 bowersj2 5263:
1.63 www 5264: ###############################################
5265: sub domainlogo {
1.517 raeburn 5266: my $domain = &determinedomain(shift);
1.518 albertel 5267: my %designhash = &get_domainconf($domain);
1.517 raeburn 5268: # See if there is a logo
5269: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5270: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5271: if ($imgsrc =~ m{^/(adm|res)/}) {
5272: if ($imgsrc =~ m{^/res/}) {
5273: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5274: &Apache::lonnet::repcopy($local_name);
5275: }
5276: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5277: }
5278: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5279: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5280: return &Apache::lonnet::domain($domain,'description');
1.59 www 5281: } else {
1.60 matthew 5282: return '';
1.59 www 5283: }
5284: }
1.63 www 5285: ##############################################
5286:
5287: =pod
5288:
1.112 bowersj2 5289: =item * &designparm()
1.63 www 5290:
5291: Inputs: $which parameter; $domain (usually will be undef)
5292:
5293: Returns: value of designparamter $which
5294:
5295: =cut
1.112 bowersj2 5296:
1.397 albertel 5297:
1.400 albertel 5298: ##############################################
1.397 albertel 5299: sub designparm {
5300: my ($which,$domain)=@_;
5301: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5302: return $env{'environment.color.'.$which};
1.96 www 5303: }
1.63 www 5304: $domain=&determinedomain($domain);
1.1016 raeburn 5305: my %domdesign;
5306: unless ($domain eq 'public') {
5307: %domdesign = &get_domainconf($domain);
5308: }
1.520 raeburn 5309: my $output;
1.517 raeburn 5310: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5311: $output = $domdesign{$domain.'.'.$which};
1.63 www 5312: } else {
1.520 raeburn 5313: $output = $defaultdesign{$which};
5314: }
5315: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5316: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5317: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5318: if ($output =~ m{^/res/}) {
5319: my $local_name = &Apache::lonnet::filelocation('',$output);
5320: &Apache::lonnet::repcopy($local_name);
5321: }
1.520 raeburn 5322: $output = &lonhttpdurl($output);
5323: }
1.63 www 5324: }
1.520 raeburn 5325: return $output;
1.63 www 5326: }
1.59 www 5327:
1.822 bisitz 5328: ##############################################
5329: =pod
5330:
1.832 bisitz 5331: =item * &authorspace()
5332:
1.1028 raeburn 5333: Inputs: $url (usually will be undef).
1.832 bisitz 5334:
1.1132 raeburn 5335: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5336: directory being viewed (or for which action is being taken).
5337: If $url is provided, and begins /priv/<domain>/<uname>
5338: the path will be that portion of the $context argument.
5339: Otherwise the path will be for the author space of the current
5340: user when the current role is author, or for that of the
5341: co-author/assistant co-author space when the current role
5342: is co-author or assistant co-author.
1.832 bisitz 5343:
5344: =cut
5345:
5346: sub authorspace {
1.1028 raeburn 5347: my ($url) = @_;
5348: if ($url ne '') {
5349: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5350: return $1;
5351: }
5352: }
1.832 bisitz 5353: my $caname = '';
1.1024 www 5354: my $cadom = '';
1.1028 raeburn 5355: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5356: ($cadom,$caname) =
1.832 bisitz 5357: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5358: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5359: $caname = $env{'user.name'};
1.1024 www 5360: $cadom = $env{'user.domain'};
1.832 bisitz 5361: }
1.1028 raeburn 5362: if (($caname ne '') && ($cadom ne '')) {
5363: return "/priv/$cadom/$caname/";
5364: }
5365: return;
1.832 bisitz 5366: }
5367:
5368: ##############################################
5369: =pod
5370:
1.822 bisitz 5371: =item * &head_subbox()
5372:
5373: Inputs: $content (contains HTML code with page functions, etc.)
5374:
5375: Returns: HTML div with $content
5376: To be included in page header
5377:
5378: =cut
5379:
5380: sub head_subbox {
5381: my ($content)=@_;
5382: my $output =
1.993 raeburn 5383: '<div class="LC_head_subbox">'
1.822 bisitz 5384: .$content
5385: .'</div>'
5386: }
5387:
5388: ##############################################
5389: =pod
5390:
5391: =item * &CSTR_pageheader()
5392:
1.1026 raeburn 5393: Input: (optional) filename from which breadcrumb trail is built.
5394: In most cases no input as needed, as $env{'request.filename'}
5395: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5396:
5397: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5398: To be included on Authoring Space pages
1.822 bisitz 5399:
5400: =cut
5401:
5402: sub CSTR_pageheader {
1.1026 raeburn 5403: my ($trailfile) = @_;
5404: if ($trailfile eq '') {
5405: $trailfile = $env{'request.filename'};
5406: }
5407:
5408: # this is for resources; directories have customtitle, and crumbs
5409: # and select recent are created in lonpubdir.pm
5410:
5411: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5412: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5413: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5414: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5415: $formaction =~ s{/+}{/}g;
1.822 bisitz 5416:
5417: my $parentpath = '';
5418: my $lastitem = '';
5419: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5420: $parentpath = $1;
5421: $lastitem = $2;
5422: } else {
5423: $lastitem = $thisdisfn;
5424: }
1.921 bisitz 5425:
5426: my $output =
1.822 bisitz 5427: '<div>'
5428: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5429: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5430: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5431: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5432: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5433:
5434: if ($lastitem) {
5435: $output .=
5436: '<span class="LC_filename">'
5437: .$lastitem
5438: .'</span>';
5439: }
5440: $output .=
5441: '<br />'
1.822 bisitz 5442: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5443: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5444: .'</form>'
5445: .&Apache::lonmenu::constspaceform()
5446: .'</div>';
1.921 bisitz 5447:
5448: return $output;
1.822 bisitz 5449: }
5450:
1.60 matthew 5451: ###############################################
5452: ###############################################
5453:
5454: =pod
5455:
1.112 bowersj2 5456: =back
5457:
1.549 albertel 5458: =head1 HTML Helpers
1.112 bowersj2 5459:
5460: =over 4
5461:
5462: =item * &bodytag()
1.60 matthew 5463:
5464: Returns a uniform header for LON-CAPA web pages.
5465:
5466: Inputs:
5467:
1.112 bowersj2 5468: =over 4
5469:
5470: =item * $title, A title to be displayed on the page.
5471:
5472: =item * $function, the current role (can be undef).
5473:
5474: =item * $addentries, extra parameters for the <body> tag.
5475:
5476: =item * $bodyonly, if defined, only return the <body> tag.
5477:
5478: =item * $domain, if defined, force a given domain.
5479:
5480: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5481: text interface only)
1.60 matthew 5482:
1.814 bisitz 5483: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5484: navigational links
1.317 albertel 5485:
1.338 albertel 5486: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5487:
1.460 albertel 5488: =item * $args, optional argument valid values are
5489: no_auto_mt_title -> prevents &mt()ing the title arg
5490:
1.1096 raeburn 5491: =item * $advtoolsref, optional argument, ref to an array containing
5492: inlineremote items to be added in "Functions" menu below
5493: breadcrumbs.
5494:
1.112 bowersj2 5495: =back
5496:
1.60 matthew 5497: Returns: A uniform header for LON-CAPA web pages.
5498: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5499: If $bodyonly is undef or zero, an html string containing a <body> tag and
5500: other decorations will be returned.
5501:
5502: =cut
5503:
1.54 www 5504: sub bodytag {
1.831 bisitz 5505: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5506: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5507:
1.954 raeburn 5508: my $public;
5509: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5510: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5511: $public = 1;
5512: }
1.460 albertel 5513: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5514: my $httphost = $args->{'use_absolute'};
1.339 albertel 5515:
1.183 matthew 5516: $function = &get_users_function() if (!$function);
1.339 albertel 5517: my $img = &designparm($function.'.img',$domain);
5518: my $font = &designparm($function.'.font',$domain);
5519: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5520:
1.803 bisitz 5521: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5522: 'bgcolor' => $pgbg,
1.339 albertel 5523: 'text' => $font,
5524: 'alink' => &designparm($function.'.alink',$domain),
5525: 'vlink' => &designparm($function.'.vlink',$domain),
5526: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5527: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5528:
1.63 www 5529: # role and realm
1.1178 raeburn 5530: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5531: if ($realm) {
5532: $realm = '/'.$realm;
5533: }
1.378 raeburn 5534: if ($role eq 'ca') {
1.479 albertel 5535: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5536: $realm = &plainname($rname,$rdom);
1.378 raeburn 5537: }
1.55 www 5538: # realm
1.258 albertel 5539: if ($env{'request.course.id'}) {
1.378 raeburn 5540: if ($env{'request.role'} !~ /^cr/) {
5541: $role = &Apache::lonnet::plaintext($role,&course_type());
5542: }
1.898 raeburn 5543: if ($env{'request.course.sec'}) {
5544: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5545: }
1.359 albertel 5546: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5547: } else {
5548: $role = &Apache::lonnet::plaintext($role);
1.54 www 5549: }
1.433 albertel 5550:
1.359 albertel 5551: if (!$realm) { $realm=' '; }
1.330 albertel 5552:
1.438 albertel 5553: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5554:
1.101 www 5555: # construct main body tag
1.359 albertel 5556: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5557: &Apache::lontexconvert::init_math_support();
1.252 albertel 5558:
1.1131 raeburn 5559: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5560:
1.1130 raeburn 5561: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5562: return $bodytag;
1.1130 raeburn 5563: }
1.359 albertel 5564:
1.954 raeburn 5565: if ($public) {
1.433 albertel 5566: undef($role);
5567: }
1.359 albertel 5568:
1.762 bisitz 5569: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5570: #
5571: # Extra info if you are the DC
5572: my $dc_info = '';
5573: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5574: $env{'course.'.$env{'request.course.id'}.
5575: '.domain'}.'/'})) {
5576: my $cid = $env{'request.course.id'};
1.917 raeburn 5577: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5578: $dc_info =~ s/\s+$//;
1.359 albertel 5579: }
5580:
1.1237 raeburn 5581: my $crstype;
5582: if ($env{'request.course.id'}) {
5583: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5584: } elsif ($args->{'crstype'}) {
5585: $crstype = $args->{'crstype'};
5586: }
5587: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5588: undef($role);
5589: } else {
5590: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
5591: }
1.853 droeschl 5592:
1.903 droeschl 5593: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5594:
5595: # if ($env{'request.state'} eq 'construct') {
5596: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5597: # }
5598:
1.1130 raeburn 5599: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5600: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5601:
1.1237 raeburn 5602: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5603:
1.916 droeschl 5604: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5605: if ($dc_info) {
5606: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5607: }
1.1130 raeburn 5608: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5609: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5610: return $bodytag;
5611: }
1.894 droeschl 5612:
1.927 raeburn 5613: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5614: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5615: }
1.916 droeschl 5616:
1.1130 raeburn 5617: $bodytag .= $right;
1.852 droeschl 5618:
1.917 raeburn 5619: if ($dc_info) {
5620: $dc_info = &dc_courseid_toggle($dc_info);
5621: }
5622: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5623:
1.1169 raeburn 5624: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5625: if ($args->{'no_secondary_menu'}) {
5626: return $bodytag;
5627: }
1.1169 raeburn 5628: #don't show menus for public users
1.954 raeburn 5629: if (!$public){
1.1154 raeburn 5630: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5631: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5632: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5633: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5634: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5635: $args->{'bread_crumbs'});
1.1096 raeburn 5636: } elsif ($forcereg) {
5637: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5638: $args->{'group'});
5639: } else {
5640: $bodytag .=
5641: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5642: $forcereg,$args->{'group'},
5643: $args->{'bread_crumbs'},
5644: $advtoolsref);
1.920 raeburn 5645: }
1.903 droeschl 5646: }else{
5647: # this is to seperate menu from content when there's no secondary
5648: # menu. Especially needed for public accessible ressources.
5649: $bodytag .= '<hr style="clear:both" />';
5650: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5651: }
1.903 droeschl 5652:
1.235 raeburn 5653: return $bodytag;
1.182 matthew 5654: }
5655:
1.917 raeburn 5656: sub dc_courseid_toggle {
5657: my ($dc_info) = @_;
1.980 raeburn 5658: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5659: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5660: &mt('(More ...)').'</a></span>'.
5661: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5662: }
5663:
1.330 albertel 5664: sub make_attr_string {
5665: my ($register,$attr_ref) = @_;
5666:
5667: if ($attr_ref && !ref($attr_ref)) {
5668: die("addentries Must be a hash ref ".
5669: join(':',caller(1))." ".
5670: join(':',caller(0))." ");
5671: }
5672:
5673: if ($register) {
1.339 albertel 5674: my ($on_load,$on_unload);
5675: foreach my $key (keys(%{$attr_ref})) {
5676: if (lc($key) eq 'onload') {
5677: $on_load.=$attr_ref->{$key}.';';
5678: delete($attr_ref->{$key});
5679:
5680: } elsif (lc($key) eq 'onunload') {
5681: $on_unload.=$attr_ref->{$key}.';';
5682: delete($attr_ref->{$key});
5683: }
5684: }
1.953 droeschl 5685: $attr_ref->{'onload'} = $on_load;
5686: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5687: }
1.339 albertel 5688:
1.330 albertel 5689: my $attr_string;
1.1159 raeburn 5690: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5691: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5692: }
5693: return $attr_string;
5694: }
5695:
5696:
1.182 matthew 5697: ###############################################
1.251 albertel 5698: ###############################################
5699:
5700: =pod
5701:
5702: =item * &endbodytag()
5703:
5704: Returns a uniform footer for LON-CAPA web pages.
5705:
1.635 raeburn 5706: Inputs: 1 - optional reference to an args hash
5707: If in the hash, key for noredirectlink has a value which evaluates to true,
5708: a 'Continue' link is not displayed if the page contains an
5709: internal redirect in the <head></head> section,
5710: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5711:
5712: =cut
5713:
5714: sub endbodytag {
1.635 raeburn 5715: my ($args) = @_;
1.1080 raeburn 5716: my $endbodytag;
5717: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5718: $endbodytag='</body>';
5719: }
1.315 albertel 5720: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5721: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5722: $endbodytag=
5723: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5724: &mt('Continue').'</a>'.
5725: $endbodytag;
5726: }
1.315 albertel 5727: }
1.251 albertel 5728: return $endbodytag;
5729: }
5730:
1.352 albertel 5731: =pod
5732:
5733: =item * &standard_css()
5734:
5735: Returns a style sheet
5736:
5737: Inputs: (all optional)
5738: domain -> force to color decorate a page for a specific
5739: domain
5740: function -> force usage of a specific rolish color scheme
5741: bgcolor -> override the default page bgcolor
5742:
5743: =cut
5744:
1.343 albertel 5745: sub standard_css {
1.345 albertel 5746: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5747: $function = &get_users_function() if (!$function);
5748: my $img = &designparm($function.'.img', $domain);
5749: my $tabbg = &designparm($function.'.tabbg', $domain);
5750: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5751: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5752: #second colour for later usage
1.345 albertel 5753: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5754: my $pgbg_or_bgcolor =
5755: $bgcolor ||
1.352 albertel 5756: &designparm($function.'.pgbg', $domain);
1.382 albertel 5757: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5758: my $alink = &designparm($function.'.alink', $domain);
5759: my $vlink = &designparm($function.'.vlink', $domain);
5760: my $link = &designparm($function.'.link', $domain);
5761:
1.602 albertel 5762: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5763: my $mono = 'monospace';
1.850 bisitz 5764: my $data_table_head = $sidebg;
5765: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5766: my $data_table_dark = '#E0E0E0';
1.470 banghart 5767: my $data_table_darker = '#CCCCCC';
1.349 albertel 5768: my $data_table_highlight = '#FFFF00';
1.352 albertel 5769: my $mail_new = '#FFBB77';
5770: my $mail_new_hover = '#DD9955';
5771: my $mail_read = '#BBBB77';
5772: my $mail_read_hover = '#999944';
5773: my $mail_replied = '#AAAA88';
5774: my $mail_replied_hover = '#888855';
5775: my $mail_other = '#99BBBB';
5776: my $mail_other_hover = '#669999';
1.391 albertel 5777: my $table_header = '#DDDDDD';
1.489 raeburn 5778: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5779: my $lg_border_color = '#C8C8C8';
1.952 onken 5780: my $button_hover = '#BF2317';
1.392 albertel 5781:
1.608 albertel 5782: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5783: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5784: : '0 3px 0 4px';
1.448 albertel 5785:
1.523 albertel 5786:
1.343 albertel 5787: return <<END;
1.947 droeschl 5788:
5789: /* needed for iframe to allow 100% height in FF */
5790: body, html {
5791: margin: 0;
5792: padding: 0 0.5%;
5793: height: 99%; /* to avoid scrollbars */
5794: }
5795:
1.795 www 5796: body {
1.911 bisitz 5797: font-family: $sans;
5798: line-height:130%;
5799: font-size:0.83em;
5800: color:$font;
1.795 www 5801: }
5802:
1.959 onken 5803: a:focus,
5804: a:focus img {
1.795 www 5805: color: red;
5806: }
1.698 harmsja 5807:
1.911 bisitz 5808: form, .inline {
5809: display: inline;
1.795 www 5810: }
1.721 harmsja 5811:
1.795 www 5812: .LC_right {
1.911 bisitz 5813: text-align:right;
1.795 www 5814: }
5815:
5816: .LC_middle {
1.911 bisitz 5817: vertical-align:middle;
1.795 www 5818: }
1.721 harmsja 5819:
1.1130 raeburn 5820: .LC_floatleft {
5821: float: left;
5822: }
5823:
5824: .LC_floatright {
5825: float: right;
5826: }
5827:
1.911 bisitz 5828: .LC_400Box {
5829: width:400px;
5830: }
1.721 harmsja 5831:
1.947 droeschl 5832: .LC_iframecontainer {
5833: width: 98%;
5834: margin: 0;
5835: position: fixed;
5836: top: 8.5em;
5837: bottom: 0;
5838: }
5839:
5840: .LC_iframecontainer iframe{
5841: border: none;
5842: width: 100%;
5843: height: 100%;
5844: }
5845:
1.778 bisitz 5846: .LC_filename {
5847: font-family: $mono;
5848: white-space:pre;
1.921 bisitz 5849: font-size: 120%;
1.778 bisitz 5850: }
5851:
5852: .LC_fileicon {
5853: border: none;
5854: height: 1.3em;
5855: vertical-align: text-bottom;
5856: margin-right: 0.3em;
5857: text-decoration:none;
5858: }
5859:
1.1008 www 5860: .LC_setting {
5861: text-decoration:underline;
5862: }
5863:
1.350 albertel 5864: .LC_error {
5865: color: red;
5866: }
1.795 www 5867:
1.1097 bisitz 5868: .LC_warning {
5869: color: darkorange;
5870: }
5871:
1.457 albertel 5872: .LC_diff_removed {
1.733 bisitz 5873: color: red;
1.394 albertel 5874: }
1.532 albertel 5875:
5876: .LC_info,
1.457 albertel 5877: .LC_success,
5878: .LC_diff_added {
1.350 albertel 5879: color: green;
5880: }
1.795 www 5881:
1.802 bisitz 5882: div.LC_confirm_box {
5883: background-color: #FAFAFA;
5884: border: 1px solid $lg_border_color;
5885: margin-right: 0;
5886: padding: 5px;
5887: }
5888:
5889: div.LC_confirm_box .LC_error img,
5890: div.LC_confirm_box .LC_success img {
5891: vertical-align: middle;
5892: }
5893:
1.440 albertel 5894: .LC_icon {
1.771 droeschl 5895: border: none;
1.790 droeschl 5896: vertical-align: middle;
1.771 droeschl 5897: }
5898:
1.543 albertel 5899: .LC_docs_spacer {
5900: width: 25px;
5901: height: 1px;
1.771 droeschl 5902: border: none;
1.543 albertel 5903: }
1.346 albertel 5904:
1.532 albertel 5905: .LC_internal_info {
1.735 bisitz 5906: color: #999999;
1.532 albertel 5907: }
5908:
1.794 www 5909: .LC_discussion {
1.1050 www 5910: background: $data_table_dark;
1.911 bisitz 5911: border: 1px solid black;
5912: margin: 2px;
1.794 www 5913: }
5914:
5915: .LC_disc_action_left {
1.1050 www 5916: background: $sidebg;
1.911 bisitz 5917: text-align: left;
1.1050 www 5918: padding: 4px;
5919: margin: 2px;
1.794 www 5920: }
5921:
5922: .LC_disc_action_right {
1.1050 www 5923: background: $sidebg;
1.911 bisitz 5924: text-align: right;
1.1050 www 5925: padding: 4px;
5926: margin: 2px;
1.794 www 5927: }
5928:
5929: .LC_disc_new_item {
1.911 bisitz 5930: background: white;
5931: border: 2px solid red;
1.1050 www 5932: margin: 4px;
5933: padding: 4px;
1.794 www 5934: }
5935:
5936: .LC_disc_old_item {
1.911 bisitz 5937: background: white;
1.1050 www 5938: margin: 4px;
5939: padding: 4px;
1.794 www 5940: }
5941:
1.458 albertel 5942: table.LC_pastsubmission {
5943: border: 1px solid black;
5944: margin: 2px;
5945: }
5946:
1.924 bisitz 5947: table#LC_menubuttons {
1.345 albertel 5948: width: 100%;
5949: background: $pgbg;
1.392 albertel 5950: border: 2px;
1.402 albertel 5951: border-collapse: separate;
1.803 bisitz 5952: padding: 0;
1.345 albertel 5953: }
1.392 albertel 5954:
1.801 tempelho 5955: table#LC_title_bar a {
5956: color: $fontmenu;
5957: }
1.836 bisitz 5958:
1.807 droeschl 5959: table#LC_title_bar {
1.819 tempelho 5960: clear: both;
1.836 bisitz 5961: display: none;
1.807 droeschl 5962: }
5963:
1.795 www 5964: table#LC_title_bar,
1.933 droeschl 5965: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5966: table#LC_title_bar.LC_with_remote {
1.359 albertel 5967: width: 100%;
1.392 albertel 5968: border-color: $pgbg;
5969: border-style: solid;
5970: border-width: $border;
1.379 albertel 5971: background: $pgbg;
1.801 tempelho 5972: color: $fontmenu;
1.392 albertel 5973: border-collapse: collapse;
1.803 bisitz 5974: padding: 0;
1.819 tempelho 5975: margin: 0;
1.359 albertel 5976: }
1.795 www 5977:
1.933 droeschl 5978: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5979: margin: 0;
5980: padding: 0;
1.933 droeschl 5981: position: relative;
5982: list-style: none;
1.913 droeschl 5983: }
1.933 droeschl 5984: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5985: display: inline;
5986: }
1.933 droeschl 5987:
5988: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5989: padding: 0;
1.933 droeschl 5990: margin: 0;
5991: float: left;
1.913 droeschl 5992: }
1.933 droeschl 5993: .LC_breadcrumb_tools_tools {
5994: padding: 0;
5995: margin: 0;
1.913 droeschl 5996: float: right;
5997: }
5998:
1.359 albertel 5999: table#LC_title_bar td {
6000: background: $tabbg;
6001: }
1.795 www 6002:
1.911 bisitz 6003: table#LC_menubuttons img {
1.803 bisitz 6004: border: none;
1.346 albertel 6005: }
1.795 www 6006:
1.842 droeschl 6007: .LC_breadcrumbs_component {
1.911 bisitz 6008: float: right;
6009: margin: 0 1em;
1.357 albertel 6010: }
1.842 droeschl 6011: .LC_breadcrumbs_component img {
1.911 bisitz 6012: vertical-align: middle;
1.777 tempelho 6013: }
1.795 www 6014:
1.383 albertel 6015: td.LC_table_cell_checkbox {
6016: text-align: center;
6017: }
1.795 www 6018:
6019: .LC_fontsize_small {
1.911 bisitz 6020: font-size: 70%;
1.705 tempelho 6021: }
6022:
1.844 bisitz 6023: #LC_breadcrumbs {
1.911 bisitz 6024: clear:both;
6025: background: $sidebg;
6026: border-bottom: 1px solid $lg_border_color;
6027: line-height: 2.5em;
1.933 droeschl 6028: overflow: hidden;
1.911 bisitz 6029: margin: 0;
6030: padding: 0;
1.995 raeburn 6031: text-align: left;
1.819 tempelho 6032: }
1.862 bisitz 6033:
1.1098 bisitz 6034: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6035: clear:both;
6036: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6037: border: 1px solid $sidebg;
1.1098 bisitz 6038: margin: 0 0 10px 0;
1.966 bisitz 6039: padding: 3px;
1.995 raeburn 6040: text-align: left;
1.822 bisitz 6041: }
6042:
1.795 www 6043: .LC_fontsize_medium {
1.911 bisitz 6044: font-size: 85%;
1.705 tempelho 6045: }
6046:
1.795 www 6047: .LC_fontsize_large {
1.911 bisitz 6048: font-size: 120%;
1.705 tempelho 6049: }
6050:
1.346 albertel 6051: .LC_menubuttons_inline_text {
6052: color: $font;
1.698 harmsja 6053: font-size: 90%;
1.701 harmsja 6054: padding-left:3px;
1.346 albertel 6055: }
6056:
1.934 droeschl 6057: .LC_menubuttons_inline_text img{
6058: vertical-align: middle;
6059: }
6060:
1.1051 www 6061: li.LC_menubuttons_inline_text img {
1.951 onken 6062: cursor:pointer;
1.1002 droeschl 6063: text-decoration: none;
1.951 onken 6064: }
6065:
1.526 www 6066: .LC_menubuttons_link {
6067: text-decoration: none;
6068: }
1.795 www 6069:
1.522 albertel 6070: .LC_menubuttons_category {
1.521 www 6071: color: $font;
1.526 www 6072: background: $pgbg;
1.521 www 6073: font-size: larger;
6074: font-weight: bold;
6075: }
6076:
1.346 albertel 6077: td.LC_menubuttons_text {
1.911 bisitz 6078: color: $font;
1.346 albertel 6079: }
1.706 harmsja 6080:
1.346 albertel 6081: .LC_current_location {
6082: background: $tabbg;
6083: }
1.795 www 6084:
1.938 bisitz 6085: table.LC_data_table {
1.347 albertel 6086: border: 1px solid #000000;
1.402 albertel 6087: border-collapse: separate;
1.426 albertel 6088: border-spacing: 1px;
1.610 albertel 6089: background: $pgbg;
1.347 albertel 6090: }
1.795 www 6091:
1.422 albertel 6092: .LC_data_table_dense {
6093: font-size: small;
6094: }
1.795 www 6095:
1.507 raeburn 6096: table.LC_nested_outer {
6097: border: 1px solid #000000;
1.589 raeburn 6098: border-collapse: collapse;
1.803 bisitz 6099: border-spacing: 0;
1.507 raeburn 6100: width: 100%;
6101: }
1.795 www 6102:
1.879 raeburn 6103: table.LC_innerpickbox,
1.507 raeburn 6104: table.LC_nested {
1.803 bisitz 6105: border: none;
1.589 raeburn 6106: border-collapse: collapse;
1.803 bisitz 6107: border-spacing: 0;
1.507 raeburn 6108: width: 100%;
6109: }
1.795 www 6110:
1.911 bisitz 6111: table.LC_data_table tr th,
6112: table.LC_calendar tr th,
1.879 raeburn 6113: table.LC_prior_tries tr th,
6114: table.LC_innerpickbox tr th {
1.349 albertel 6115: font-weight: bold;
6116: background-color: $data_table_head;
1.801 tempelho 6117: color:$fontmenu;
1.701 harmsja 6118: font-size:90%;
1.347 albertel 6119: }
1.795 www 6120:
1.879 raeburn 6121: table.LC_innerpickbox tr th,
6122: table.LC_innerpickbox tr td {
6123: vertical-align: top;
6124: }
6125:
1.711 raeburn 6126: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6127: background-color: #CCCCCC;
1.711 raeburn 6128: font-weight: bold;
6129: text-align: left;
6130: }
1.795 www 6131:
1.912 bisitz 6132: table.LC_data_table tr.LC_odd_row > td {
6133: background-color: $data_table_light;
6134: padding: 2px;
6135: vertical-align: top;
6136: }
6137:
1.809 bisitz 6138: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6139: background-color: $data_table_light;
1.912 bisitz 6140: vertical-align: top;
6141: }
6142:
6143: table.LC_data_table tr.LC_even_row > td {
6144: background-color: $data_table_dark;
1.425 albertel 6145: padding: 2px;
1.900 bisitz 6146: vertical-align: top;
1.347 albertel 6147: }
1.795 www 6148:
1.809 bisitz 6149: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6150: background-color: $data_table_dark;
1.900 bisitz 6151: vertical-align: top;
1.347 albertel 6152: }
1.795 www 6153:
1.425 albertel 6154: table.LC_data_table tr.LC_data_table_highlight td {
6155: background-color: $data_table_darker;
6156: }
1.795 www 6157:
1.639 raeburn 6158: table.LC_data_table tr td.LC_leftcol_header {
6159: background-color: $data_table_head;
6160: font-weight: bold;
6161: }
1.795 www 6162:
1.451 albertel 6163: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6164: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6165: font-weight: bold;
6166: font-style: italic;
6167: text-align: center;
6168: padding: 8px;
1.347 albertel 6169: }
1.795 www 6170:
1.1114 raeburn 6171: table.LC_data_table tr.LC_empty_row td,
6172: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6173: background-color: $sidebg;
6174: }
6175:
6176: table.LC_nested tr.LC_empty_row td {
6177: background-color: #FFFFFF;
6178: }
6179:
1.890 droeschl 6180: table.LC_caption {
6181: }
6182:
1.507 raeburn 6183: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6184: padding: 4ex
6185: }
1.795 www 6186:
1.507 raeburn 6187: table.LC_nested_outer tr th {
6188: font-weight: bold;
1.801 tempelho 6189: color:$fontmenu;
1.507 raeburn 6190: background-color: $data_table_head;
1.701 harmsja 6191: font-size: small;
1.507 raeburn 6192: border-bottom: 1px solid #000000;
6193: }
1.795 www 6194:
1.507 raeburn 6195: table.LC_nested_outer tr td.LC_subheader {
6196: background-color: $data_table_head;
6197: font-weight: bold;
6198: font-size: small;
6199: border-bottom: 1px solid #000000;
6200: text-align: right;
1.451 albertel 6201: }
1.795 www 6202:
1.507 raeburn 6203: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6204: background-color: #CCCCCC;
1.451 albertel 6205: font-weight: bold;
6206: font-size: small;
1.507 raeburn 6207: text-align: center;
6208: }
1.795 www 6209:
1.589 raeburn 6210: table.LC_nested tr.LC_info_row td.LC_left_item,
6211: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6212: text-align: left;
1.451 albertel 6213: }
1.795 www 6214:
1.507 raeburn 6215: table.LC_nested td {
1.735 bisitz 6216: background-color: #FFFFFF;
1.451 albertel 6217: font-size: small;
1.507 raeburn 6218: }
1.795 www 6219:
1.507 raeburn 6220: table.LC_nested_outer tr th.LC_right_item,
6221: table.LC_nested tr.LC_info_row td.LC_right_item,
6222: table.LC_nested tr.LC_odd_row td.LC_right_item,
6223: table.LC_nested tr td.LC_right_item {
1.451 albertel 6224: text-align: right;
6225: }
6226:
1.507 raeburn 6227: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6228: background-color: #EEEEEE;
1.451 albertel 6229: }
6230:
1.473 raeburn 6231: table.LC_createuser {
6232: }
6233:
6234: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6235: font-size: small;
1.473 raeburn 6236: }
6237:
6238: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6239: background-color: #CCCCCC;
1.473 raeburn 6240: font-weight: bold;
6241: text-align: center;
6242: }
6243:
1.349 albertel 6244: table.LC_calendar {
6245: border: 1px solid #000000;
6246: border-collapse: collapse;
1.917 raeburn 6247: width: 98%;
1.349 albertel 6248: }
1.795 www 6249:
1.349 albertel 6250: table.LC_calendar_pickdate {
6251: font-size: xx-small;
6252: }
1.795 www 6253:
1.349 albertel 6254: table.LC_calendar tr td {
6255: border: 1px solid #000000;
6256: vertical-align: top;
1.917 raeburn 6257: width: 14%;
1.349 albertel 6258: }
1.795 www 6259:
1.349 albertel 6260: table.LC_calendar tr td.LC_calendar_day_empty {
6261: background-color: $data_table_dark;
6262: }
1.795 www 6263:
1.779 bisitz 6264: table.LC_calendar tr td.LC_calendar_day_current {
6265: background-color: $data_table_highlight;
1.777 tempelho 6266: }
1.795 www 6267:
1.938 bisitz 6268: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6269: background-color: $mail_new;
6270: }
1.795 www 6271:
1.938 bisitz 6272: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6273: background-color: $mail_new_hover;
6274: }
1.795 www 6275:
1.938 bisitz 6276: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6277: background-color: $mail_read;
6278: }
1.795 www 6279:
1.938 bisitz 6280: /*
6281: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6282: background-color: $mail_read_hover;
6283: }
1.938 bisitz 6284: */
1.795 www 6285:
1.938 bisitz 6286: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6287: background-color: $mail_replied;
6288: }
1.795 www 6289:
1.938 bisitz 6290: /*
6291: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6292: background-color: $mail_replied_hover;
6293: }
1.938 bisitz 6294: */
1.795 www 6295:
1.938 bisitz 6296: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6297: background-color: $mail_other;
6298: }
1.795 www 6299:
1.938 bisitz 6300: /*
6301: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6302: background-color: $mail_other_hover;
6303: }
1.938 bisitz 6304: */
1.494 raeburn 6305:
1.777 tempelho 6306: table.LC_data_table tr > td.LC_browser_file,
6307: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6308: background: #AAEE77;
1.389 albertel 6309: }
1.795 www 6310:
1.777 tempelho 6311: table.LC_data_table tr > td.LC_browser_file_locked,
6312: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6313: background: #FFAA99;
1.387 albertel 6314: }
1.795 www 6315:
1.777 tempelho 6316: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6317: background: #888888;
1.779 bisitz 6318: }
1.795 www 6319:
1.777 tempelho 6320: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6321: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6322: background: #F8F866;
1.777 tempelho 6323: }
1.795 www 6324:
1.696 bisitz 6325: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6326: background: #E0E8FF;
1.387 albertel 6327: }
1.696 bisitz 6328:
1.707 bisitz 6329: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6330: /* background: #77FF77; */
1.707 bisitz 6331: }
1.795 www 6332:
1.707 bisitz 6333: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6334: border-right: 8px solid #FFFF77;
1.707 bisitz 6335: }
1.795 www 6336:
1.707 bisitz 6337: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6338: border-right: 8px solid #FFAA77;
1.707 bisitz 6339: }
1.795 www 6340:
1.707 bisitz 6341: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6342: border-right: 8px solid #FF7777;
1.707 bisitz 6343: }
1.795 www 6344:
1.707 bisitz 6345: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6346: border-right: 8px solid #AAFF77;
1.707 bisitz 6347: }
1.795 www 6348:
1.707 bisitz 6349: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6350: border-right: 8px solid #11CC55;
1.707 bisitz 6351: }
6352:
1.388 albertel 6353: span.LC_current_location {
1.701 harmsja 6354: font-size:larger;
1.388 albertel 6355: background: $pgbg;
6356: }
1.387 albertel 6357:
1.1029 www 6358: span.LC_current_nav_location {
6359: font-weight:bold;
6360: background: $sidebg;
6361: }
6362:
1.395 albertel 6363: span.LC_parm_menu_item {
6364: font-size: larger;
6365: }
1.795 www 6366:
1.395 albertel 6367: span.LC_parm_scope_all {
6368: color: red;
6369: }
1.795 www 6370:
1.395 albertel 6371: span.LC_parm_scope_folder {
6372: color: green;
6373: }
1.795 www 6374:
1.395 albertel 6375: span.LC_parm_scope_resource {
6376: color: orange;
6377: }
1.795 www 6378:
1.395 albertel 6379: span.LC_parm_part {
6380: color: blue;
6381: }
1.795 www 6382:
1.911 bisitz 6383: span.LC_parm_folder,
6384: span.LC_parm_symb {
1.395 albertel 6385: font-size: x-small;
6386: font-family: $mono;
6387: color: #AAAAAA;
6388: }
6389:
1.977 bisitz 6390: ul.LC_parm_parmlist li {
6391: display: inline-block;
6392: padding: 0.3em 0.8em;
6393: vertical-align: top;
6394: width: 150px;
6395: border-top:1px solid $lg_border_color;
6396: }
6397:
1.795 www 6398: td.LC_parm_overview_level_menu,
6399: td.LC_parm_overview_map_menu,
6400: td.LC_parm_overview_parm_selectors,
6401: td.LC_parm_overview_restrictions {
1.396 albertel 6402: border: 1px solid black;
6403: border-collapse: collapse;
6404: }
1.795 www 6405:
1.396 albertel 6406: table.LC_parm_overview_restrictions td {
6407: border-width: 1px 4px 1px 4px;
6408: border-style: solid;
6409: border-color: $pgbg;
6410: text-align: center;
6411: }
1.795 www 6412:
1.396 albertel 6413: table.LC_parm_overview_restrictions th {
6414: background: $tabbg;
6415: border-width: 1px 4px 1px 4px;
6416: border-style: solid;
6417: border-color: $pgbg;
6418: }
1.795 www 6419:
1.398 albertel 6420: table#LC_helpmenu {
1.803 bisitz 6421: border: none;
1.398 albertel 6422: height: 55px;
1.803 bisitz 6423: border-spacing: 0;
1.398 albertel 6424: }
6425:
6426: table#LC_helpmenu fieldset legend {
6427: font-size: larger;
6428: }
1.795 www 6429:
1.397 albertel 6430: table#LC_helpmenu_links {
6431: width: 100%;
6432: border: 1px solid black;
6433: background: $pgbg;
1.803 bisitz 6434: padding: 0;
1.397 albertel 6435: border-spacing: 1px;
6436: }
1.795 www 6437:
1.397 albertel 6438: table#LC_helpmenu_links tr td {
6439: padding: 1px;
6440: background: $tabbg;
1.399 albertel 6441: text-align: center;
6442: font-weight: bold;
1.397 albertel 6443: }
1.396 albertel 6444:
1.795 www 6445: table#LC_helpmenu_links a:link,
6446: table#LC_helpmenu_links a:visited,
1.397 albertel 6447: table#LC_helpmenu_links a:active {
6448: text-decoration: none;
6449: color: $font;
6450: }
1.795 www 6451:
1.397 albertel 6452: table#LC_helpmenu_links a:hover {
6453: text-decoration: underline;
6454: color: $vlink;
6455: }
1.396 albertel 6456:
1.417 albertel 6457: .LC_chrt_popup_exists {
6458: border: 1px solid #339933;
6459: margin: -1px;
6460: }
1.795 www 6461:
1.417 albertel 6462: .LC_chrt_popup_up {
6463: border: 1px solid yellow;
6464: margin: -1px;
6465: }
1.795 www 6466:
1.417 albertel 6467: .LC_chrt_popup {
6468: border: 1px solid #8888FF;
6469: background: #CCCCFF;
6470: }
1.795 www 6471:
1.421 albertel 6472: table.LC_pick_box {
6473: border-collapse: separate;
6474: background: white;
6475: border: 1px solid black;
6476: border-spacing: 1px;
6477: }
1.795 www 6478:
1.421 albertel 6479: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6480: background: $sidebg;
1.421 albertel 6481: font-weight: bold;
1.900 bisitz 6482: text-align: left;
1.740 bisitz 6483: vertical-align: top;
1.421 albertel 6484: width: 184px;
6485: padding: 8px;
6486: }
1.795 www 6487:
1.579 raeburn 6488: table.LC_pick_box td.LC_pick_box_value {
6489: text-align: left;
6490: padding: 8px;
6491: }
1.795 www 6492:
1.579 raeburn 6493: table.LC_pick_box td.LC_pick_box_select {
6494: text-align: left;
6495: padding: 8px;
6496: }
1.795 www 6497:
1.424 albertel 6498: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6499: padding: 0;
1.421 albertel 6500: height: 1px;
6501: background: black;
6502: }
1.795 www 6503:
1.421 albertel 6504: table.LC_pick_box td.LC_pick_box_submit {
6505: text-align: right;
6506: }
1.795 www 6507:
1.579 raeburn 6508: table.LC_pick_box td.LC_evenrow_value {
6509: text-align: left;
6510: padding: 8px;
6511: background-color: $data_table_light;
6512: }
1.795 www 6513:
1.579 raeburn 6514: table.LC_pick_box td.LC_oddrow_value {
6515: text-align: left;
6516: padding: 8px;
6517: background-color: $data_table_light;
6518: }
1.795 www 6519:
1.579 raeburn 6520: span.LC_helpform_receipt_cat {
6521: font-weight: bold;
6522: }
1.795 www 6523:
1.424 albertel 6524: table.LC_group_priv_box {
6525: background: white;
6526: border: 1px solid black;
6527: border-spacing: 1px;
6528: }
1.795 www 6529:
1.424 albertel 6530: table.LC_group_priv_box td.LC_pick_box_title {
6531: background: $tabbg;
6532: font-weight: bold;
6533: text-align: right;
6534: width: 184px;
6535: }
1.795 www 6536:
1.424 albertel 6537: table.LC_group_priv_box td.LC_groups_fixed {
6538: background: $data_table_light;
6539: text-align: center;
6540: }
1.795 www 6541:
1.424 albertel 6542: table.LC_group_priv_box td.LC_groups_optional {
6543: background: $data_table_dark;
6544: text-align: center;
6545: }
1.795 www 6546:
1.424 albertel 6547: table.LC_group_priv_box td.LC_groups_functionality {
6548: background: $data_table_darker;
6549: text-align: center;
6550: font-weight: bold;
6551: }
1.795 www 6552:
1.424 albertel 6553: table.LC_group_priv td {
6554: text-align: left;
1.803 bisitz 6555: padding: 0;
1.424 albertel 6556: }
6557:
6558: .LC_navbuttons {
6559: margin: 2ex 0ex 2ex 0ex;
6560: }
1.795 www 6561:
1.423 albertel 6562: .LC_topic_bar {
6563: font-weight: bold;
6564: background: $tabbg;
1.918 wenzelju 6565: margin: 1em 0em 1em 2em;
1.805 bisitz 6566: padding: 3px;
1.918 wenzelju 6567: font-size: 1.2em;
1.423 albertel 6568: }
1.795 www 6569:
1.423 albertel 6570: .LC_topic_bar span {
1.918 wenzelju 6571: left: 0.5em;
6572: position: absolute;
1.423 albertel 6573: vertical-align: middle;
1.918 wenzelju 6574: font-size: 1.2em;
1.423 albertel 6575: }
1.795 www 6576:
1.423 albertel 6577: table.LC_course_group_status {
6578: margin: 20px;
6579: }
1.795 www 6580:
1.423 albertel 6581: table.LC_status_selector td {
6582: vertical-align: top;
6583: text-align: center;
1.424 albertel 6584: padding: 4px;
6585: }
1.795 www 6586:
1.599 albertel 6587: div.LC_feedback_link {
1.616 albertel 6588: clear: both;
1.829 kalberla 6589: background: $sidebg;
1.779 bisitz 6590: width: 100%;
1.829 kalberla 6591: padding-bottom: 10px;
6592: border: 1px $tabbg solid;
1.833 kalberla 6593: height: 22px;
6594: line-height: 22px;
6595: padding-top: 5px;
6596: }
6597:
6598: div.LC_feedback_link img {
6599: height: 22px;
1.867 kalberla 6600: vertical-align:middle;
1.829 kalberla 6601: }
6602:
1.911 bisitz 6603: div.LC_feedback_link a {
1.829 kalberla 6604: text-decoration: none;
1.489 raeburn 6605: }
1.795 www 6606:
1.867 kalberla 6607: div.LC_comblock {
1.911 bisitz 6608: display:inline;
1.867 kalberla 6609: color:$font;
6610: font-size:90%;
6611: }
6612:
6613: div.LC_feedback_link div.LC_comblock {
6614: padding-left:5px;
6615: }
6616:
6617: div.LC_feedback_link div.LC_comblock a {
6618: color:$font;
6619: }
6620:
1.489 raeburn 6621: span.LC_feedback_link {
1.858 bisitz 6622: /* background: $feedback_link_bg; */
1.599 albertel 6623: font-size: larger;
6624: }
1.795 www 6625:
1.599 albertel 6626: span.LC_message_link {
1.858 bisitz 6627: /* background: $feedback_link_bg; */
1.599 albertel 6628: font-size: larger;
6629: position: absolute;
6630: right: 1em;
1.489 raeburn 6631: }
1.421 albertel 6632:
1.515 albertel 6633: table.LC_prior_tries {
1.524 albertel 6634: border: 1px solid #000000;
6635: border-collapse: separate;
6636: border-spacing: 1px;
1.515 albertel 6637: }
1.523 albertel 6638:
1.515 albertel 6639: table.LC_prior_tries td {
1.524 albertel 6640: padding: 2px;
1.515 albertel 6641: }
1.523 albertel 6642:
6643: .LC_answer_correct {
1.795 www 6644: background: lightgreen;
6645: color: darkgreen;
6646: padding: 6px;
1.523 albertel 6647: }
1.795 www 6648:
1.523 albertel 6649: .LC_answer_charged_try {
1.797 www 6650: background: #FFAAAA;
1.795 www 6651: color: darkred;
6652: padding: 6px;
1.523 albertel 6653: }
1.795 www 6654:
1.779 bisitz 6655: .LC_answer_not_charged_try,
1.523 albertel 6656: .LC_answer_no_grade,
6657: .LC_answer_late {
1.795 www 6658: background: lightyellow;
1.523 albertel 6659: color: black;
1.795 www 6660: padding: 6px;
1.523 albertel 6661: }
1.795 www 6662:
1.523 albertel 6663: .LC_answer_previous {
1.795 www 6664: background: lightblue;
6665: color: darkblue;
6666: padding: 6px;
1.523 albertel 6667: }
1.795 www 6668:
1.779 bisitz 6669: .LC_answer_no_message {
1.777 tempelho 6670: background: #FFFFFF;
6671: color: black;
1.795 www 6672: padding: 6px;
1.779 bisitz 6673: }
1.795 www 6674:
1.779 bisitz 6675: .LC_answer_unknown {
6676: background: orange;
6677: color: black;
1.795 www 6678: padding: 6px;
1.777 tempelho 6679: }
1.795 www 6680:
1.529 albertel 6681: span.LC_prior_numerical,
6682: span.LC_prior_string,
6683: span.LC_prior_custom,
6684: span.LC_prior_reaction,
6685: span.LC_prior_math {
1.925 bisitz 6686: font-family: $mono;
1.523 albertel 6687: white-space: pre;
6688: }
6689:
1.525 albertel 6690: span.LC_prior_string {
1.925 bisitz 6691: font-family: $mono;
1.525 albertel 6692: white-space: pre;
6693: }
6694:
1.523 albertel 6695: table.LC_prior_option {
6696: width: 100%;
6697: border-collapse: collapse;
6698: }
1.795 www 6699:
1.911 bisitz 6700: table.LC_prior_rank,
1.795 www 6701: table.LC_prior_match {
1.528 albertel 6702: border-collapse: collapse;
6703: }
1.795 www 6704:
1.528 albertel 6705: table.LC_prior_option tr td,
6706: table.LC_prior_rank tr td,
6707: table.LC_prior_match tr td {
1.524 albertel 6708: border: 1px solid #000000;
1.515 albertel 6709: }
6710:
1.855 bisitz 6711: .LC_nobreak {
1.544 albertel 6712: white-space: nowrap;
1.519 raeburn 6713: }
6714:
1.576 raeburn 6715: span.LC_cusr_emph {
6716: font-style: italic;
6717: }
6718:
1.633 raeburn 6719: span.LC_cusr_subheading {
6720: font-weight: normal;
6721: font-size: 85%;
6722: }
6723:
1.861 bisitz 6724: div.LC_docs_entry_move {
1.859 bisitz 6725: border: 1px solid #BBBBBB;
1.545 albertel 6726: background: #DDDDDD;
1.861 bisitz 6727: width: 22px;
1.859 bisitz 6728: padding: 1px;
6729: margin: 0;
1.545 albertel 6730: }
6731:
1.861 bisitz 6732: table.LC_data_table tr > td.LC_docs_entry_commands,
6733: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6734: font-size: x-small;
6735: }
1.795 www 6736:
1.861 bisitz 6737: .LC_docs_entry_parameter {
6738: white-space: nowrap;
6739: }
6740:
1.544 albertel 6741: .LC_docs_copy {
1.545 albertel 6742: color: #000099;
1.544 albertel 6743: }
1.795 www 6744:
1.544 albertel 6745: .LC_docs_cut {
1.545 albertel 6746: color: #550044;
1.544 albertel 6747: }
1.795 www 6748:
1.544 albertel 6749: .LC_docs_rename {
1.545 albertel 6750: color: #009900;
1.544 albertel 6751: }
1.795 www 6752:
1.544 albertel 6753: .LC_docs_remove {
1.545 albertel 6754: color: #990000;
6755: }
6756:
1.547 albertel 6757: .LC_docs_reinit_warn,
6758: .LC_docs_ext_edit {
6759: font-size: x-small;
6760: }
6761:
1.545 albertel 6762: table.LC_docs_adddocs td,
6763: table.LC_docs_adddocs th {
6764: border: 1px solid #BBBBBB;
6765: padding: 4px;
6766: background: #DDDDDD;
1.543 albertel 6767: }
6768:
1.584 albertel 6769: table.LC_sty_begin {
6770: background: #BBFFBB;
6771: }
1.795 www 6772:
1.584 albertel 6773: table.LC_sty_end {
6774: background: #FFBBBB;
6775: }
6776:
1.589 raeburn 6777: table.LC_double_column {
1.803 bisitz 6778: border-width: 0;
1.589 raeburn 6779: border-collapse: collapse;
6780: width: 100%;
6781: padding: 2px;
6782: }
6783:
6784: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6785: top: 2px;
1.589 raeburn 6786: left: 2px;
6787: width: 47%;
6788: vertical-align: top;
6789: }
6790:
6791: table.LC_double_column tr td.LC_right_col {
6792: top: 2px;
1.779 bisitz 6793: right: 2px;
1.589 raeburn 6794: width: 47%;
6795: vertical-align: top;
6796: }
6797:
1.591 raeburn 6798: div.LC_left_float {
6799: float: left;
6800: padding-right: 5%;
1.597 albertel 6801: padding-bottom: 4px;
1.591 raeburn 6802: }
6803:
6804: div.LC_clear_float_header {
1.597 albertel 6805: padding-bottom: 2px;
1.591 raeburn 6806: }
6807:
6808: div.LC_clear_float_footer {
1.597 albertel 6809: padding-top: 10px;
1.591 raeburn 6810: clear: both;
6811: }
6812:
1.597 albertel 6813: div.LC_grade_show_user {
1.941 bisitz 6814: /* border-left: 5px solid $sidebg; */
6815: border-top: 5px solid #000000;
6816: margin: 50px 0 0 0;
1.936 bisitz 6817: padding: 15px 0 5px 10px;
1.597 albertel 6818: }
1.795 www 6819:
1.936 bisitz 6820: div.LC_grade_show_user_odd_row {
1.941 bisitz 6821: /* border-left: 5px solid #000000; */
6822: }
6823:
6824: div.LC_grade_show_user div.LC_Box {
6825: margin-right: 50px;
1.597 albertel 6826: }
6827:
6828: div.LC_grade_submissions,
6829: div.LC_grade_message_center,
1.936 bisitz 6830: div.LC_grade_info_links {
1.597 albertel 6831: margin: 5px;
6832: width: 99%;
6833: background: #FFFFFF;
6834: }
1.795 www 6835:
1.597 albertel 6836: div.LC_grade_submissions_header,
1.936 bisitz 6837: div.LC_grade_message_center_header {
1.705 tempelho 6838: font-weight: bold;
6839: font-size: large;
1.597 albertel 6840: }
1.795 www 6841:
1.597 albertel 6842: div.LC_grade_submissions_body,
1.936 bisitz 6843: div.LC_grade_message_center_body {
1.597 albertel 6844: border: 1px solid black;
6845: width: 99%;
6846: background: #FFFFFF;
6847: }
1.795 www 6848:
1.613 albertel 6849: table.LC_scantron_action {
6850: width: 100%;
6851: }
1.795 www 6852:
1.613 albertel 6853: table.LC_scantron_action tr th {
1.698 harmsja 6854: font-weight:bold;
6855: font-style:normal;
1.613 albertel 6856: }
1.795 www 6857:
1.779 bisitz 6858: .LC_edit_problem_header,
1.614 albertel 6859: div.LC_edit_problem_footer {
1.705 tempelho 6860: font-weight: normal;
6861: font-size: medium;
1.602 albertel 6862: margin: 2px;
1.1060 bisitz 6863: background-color: $sidebg;
1.600 albertel 6864: }
1.795 www 6865:
1.600 albertel 6866: div.LC_edit_problem_header,
1.602 albertel 6867: div.LC_edit_problem_header div,
1.614 albertel 6868: div.LC_edit_problem_footer,
6869: div.LC_edit_problem_footer div,
1.602 albertel 6870: div.LC_edit_problem_editxml_header,
6871: div.LC_edit_problem_editxml_header div {
1.1205 golterma 6872: z-index: 100;
1.600 albertel 6873: }
1.795 www 6874:
1.600 albertel 6875: div.LC_edit_problem_header_title {
1.705 tempelho 6876: font-weight: bold;
6877: font-size: larger;
1.602 albertel 6878: background: $tabbg;
6879: padding: 3px;
1.1060 bisitz 6880: margin: 0 0 5px 0;
1.602 albertel 6881: }
1.795 www 6882:
1.602 albertel 6883: table.LC_edit_problem_header_title {
6884: width: 100%;
1.600 albertel 6885: background: $tabbg;
1.602 albertel 6886: }
6887:
1.1205 golterma 6888: div.LC_edit_actionbar {
6889: background-color: $sidebg;
1.1218 droeschl 6890: margin: 0;
6891: padding: 0;
6892: line-height: 200%;
1.602 albertel 6893: }
1.795 www 6894:
1.1218 droeschl 6895: div.LC_edit_actionbar div{
6896: padding: 0;
6897: margin: 0;
6898: display: inline-block;
1.600 albertel 6899: }
1.795 www 6900:
1.1124 bisitz 6901: .LC_edit_opt {
6902: padding-left: 1em;
6903: white-space: nowrap;
6904: }
6905:
1.1152 golterma 6906: .LC_edit_problem_latexhelper{
6907: text-align: right;
6908: }
6909:
6910: #LC_edit_problem_colorful div{
6911: margin-left: 40px;
6912: }
6913:
1.1205 golterma 6914: #LC_edit_problem_codemirror div{
6915: margin-left: 0px;
6916: }
6917:
1.911 bisitz 6918: img.stift {
1.803 bisitz 6919: border-width: 0;
6920: vertical-align: middle;
1.677 riegler 6921: }
1.680 riegler 6922:
1.923 bisitz 6923: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6924: vertical-align: top;
1.777 tempelho 6925: }
1.795 www 6926:
1.716 raeburn 6927: div.LC_createcourse {
1.911 bisitz 6928: margin: 10px 10px 10px 10px;
1.716 raeburn 6929: }
6930:
1.917 raeburn 6931: .LC_dccid {
1.1130 raeburn 6932: float: right;
1.917 raeburn 6933: margin: 0.2em 0 0 0;
6934: padding: 0;
6935: font-size: 90%;
6936: display:none;
6937: }
6938:
1.897 wenzelju 6939: ol.LC_primary_menu a:hover,
1.721 harmsja 6940: ol#LC_MenuBreadcrumbs a:hover,
6941: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6942: ul#LC_secondary_menu a:hover,
1.721 harmsja 6943: .LC_FormSectionClearButton input:hover
1.795 www 6944: ul.LC_TabContent li:hover a {
1.952 onken 6945: color:$button_hover;
1.911 bisitz 6946: text-decoration:none;
1.693 droeschl 6947: }
6948:
1.779 bisitz 6949: h1 {
1.911 bisitz 6950: padding: 0;
6951: line-height:130%;
1.693 droeschl 6952: }
1.698 harmsja 6953:
1.911 bisitz 6954: h2,
6955: h3,
6956: h4,
6957: h5,
6958: h6 {
6959: margin: 5px 0 5px 0;
6960: padding: 0;
6961: line-height:130%;
1.693 droeschl 6962: }
1.795 www 6963:
6964: .LC_hcell {
1.911 bisitz 6965: padding:3px 15px 3px 15px;
6966: margin: 0;
6967: background-color:$tabbg;
6968: color:$fontmenu;
6969: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6970: }
1.795 www 6971:
1.840 bisitz 6972: .LC_Box > .LC_hcell {
1.911 bisitz 6973: margin: 0 -10px 10px -10px;
1.835 bisitz 6974: }
6975:
1.721 harmsja 6976: .LC_noBorder {
1.911 bisitz 6977: border: 0;
1.698 harmsja 6978: }
1.693 droeschl 6979:
1.721 harmsja 6980: .LC_FormSectionClearButton input {
1.911 bisitz 6981: background-color:transparent;
6982: border: none;
6983: cursor:pointer;
6984: text-decoration:underline;
1.693 droeschl 6985: }
1.763 bisitz 6986:
6987: .LC_help_open_topic {
1.911 bisitz 6988: color: #FFFFFF;
6989: background-color: #EEEEFF;
6990: margin: 1px;
6991: padding: 4px;
6992: border: 1px solid #000033;
6993: white-space: nowrap;
6994: /* vertical-align: middle; */
1.759 neumanie 6995: }
1.693 droeschl 6996:
1.911 bisitz 6997: dl,
6998: ul,
6999: div,
7000: fieldset {
7001: margin: 10px 10px 10px 0;
7002: /* overflow: hidden; */
1.693 droeschl 7003: }
1.795 www 7004:
1.1211 raeburn 7005: article.geogebraweb div {
7006: margin: 0;
7007: }
7008:
1.838 bisitz 7009: fieldset > legend {
1.911 bisitz 7010: font-weight: bold;
7011: padding: 0 5px 0 5px;
1.838 bisitz 7012: }
7013:
1.813 bisitz 7014: #LC_nav_bar {
1.911 bisitz 7015: float: left;
1.995 raeburn 7016: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7017: margin: 0 0 2px 0;
1.807 droeschl 7018: }
7019:
1.916 droeschl 7020: #LC_realm {
7021: margin: 0.2em 0 0 0;
7022: padding: 0;
7023: font-weight: bold;
7024: text-align: center;
1.995 raeburn 7025: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7026: }
7027:
1.911 bisitz 7028: #LC_nav_bar em {
7029: font-weight: bold;
7030: font-style: normal;
1.807 droeschl 7031: }
7032:
1.897 wenzelju 7033: ol.LC_primary_menu {
1.934 droeschl 7034: margin: 0;
1.1076 raeburn 7035: padding: 0;
1.807 droeschl 7036: }
7037:
1.852 droeschl 7038: ol#LC_PathBreadcrumbs {
1.911 bisitz 7039: margin: 0;
1.693 droeschl 7040: }
7041:
1.897 wenzelju 7042: ol.LC_primary_menu li {
1.1076 raeburn 7043: color: RGB(80, 80, 80);
7044: vertical-align: middle;
7045: text-align: left;
7046: list-style: none;
1.1205 golterma 7047: position: relative;
1.1076 raeburn 7048: float: left;
1.1205 golterma 7049: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7050: line-height: 1.5em;
1.1076 raeburn 7051: }
7052:
1.1205 golterma 7053: ol.LC_primary_menu li a,
7054: ol.LC_primary_menu li p {
1.1076 raeburn 7055: display: block;
7056: margin: 0;
7057: padding: 0 5px 0 10px;
7058: text-decoration: none;
7059: }
7060:
1.1205 golterma 7061: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7062: display: inline-block;
7063: width: 95%;
7064: text-align: left;
7065: }
7066:
7067: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7068: display: inline-block;
7069: width: 5%;
7070: float: right;
7071: text-align: right;
7072: font-size: 70%;
7073: }
7074:
7075: ol.LC_primary_menu ul {
1.1076 raeburn 7076: display: none;
1.1205 golterma 7077: width: 15em;
1.1076 raeburn 7078: background-color: $data_table_light;
1.1205 golterma 7079: position: absolute;
7080: top: 100%;
1.1076 raeburn 7081: }
7082:
1.1205 golterma 7083: ol.LC_primary_menu ul ul {
7084: left: 100%;
7085: top: 0;
7086: }
7087:
7088: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7089: display: block;
7090: position: absolute;
7091: margin: 0;
7092: padding: 0;
1.1078 raeburn 7093: z-index: 2;
1.1076 raeburn 7094: }
7095:
7096: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7097: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7098: font-size: 90%;
1.911 bisitz 7099: vertical-align: top;
1.1076 raeburn 7100: float: none;
1.1079 raeburn 7101: border-left: 1px solid black;
7102: border-right: 1px solid black;
1.1205 golterma 7103: /* A dark bottom border to visualize different menu options;
7104: overwritten in the create_submenu routine for the last border-bottom of the menu */
7105: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7106: }
7107:
1.1205 golterma 7108: ol.LC_primary_menu li li p:hover {
7109: color:$button_hover;
7110: text-decoration:none;
7111: background-color:$data_table_dark;
1.1076 raeburn 7112: }
7113:
7114: ol.LC_primary_menu li li a:hover {
7115: color:$button_hover;
7116: background-color:$data_table_dark;
1.693 droeschl 7117: }
7118:
1.1205 golterma 7119: /* Font-size equal to the size of the predecessors*/
7120: ol.LC_primary_menu li:hover li li {
7121: font-size: 100%;
7122: }
7123:
1.897 wenzelju 7124: ol.LC_primary_menu li img {
1.911 bisitz 7125: vertical-align: bottom;
1.934 droeschl 7126: height: 1.1em;
1.1077 raeburn 7127: margin: 0.2em 0 0 0;
1.693 droeschl 7128: }
7129:
1.897 wenzelju 7130: ol.LC_primary_menu a {
1.911 bisitz 7131: color: RGB(80, 80, 80);
7132: text-decoration: none;
1.693 droeschl 7133: }
1.795 www 7134:
1.949 droeschl 7135: ol.LC_primary_menu a.LC_new_message {
7136: font-weight:bold;
7137: color: darkred;
7138: }
7139:
1.975 raeburn 7140: ol.LC_docs_parameters {
7141: margin-left: 0;
7142: padding: 0;
7143: list-style: none;
7144: }
7145:
7146: ol.LC_docs_parameters li {
7147: margin: 0;
7148: padding-right: 20px;
7149: display: inline;
7150: }
7151:
1.976 raeburn 7152: ol.LC_docs_parameters li:before {
7153: content: "\\002022 \\0020";
7154: }
7155:
7156: li.LC_docs_parameters_title {
7157: font-weight: bold;
7158: }
7159:
7160: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7161: content: "";
7162: }
7163:
1.897 wenzelju 7164: ul#LC_secondary_menu {
1.1107 raeburn 7165: clear: right;
1.911 bisitz 7166: color: $fontmenu;
7167: background: $tabbg;
7168: list-style: none;
7169: padding: 0;
7170: margin: 0;
7171: width: 100%;
1.995 raeburn 7172: text-align: left;
1.1107 raeburn 7173: float: left;
1.808 droeschl 7174: }
7175:
1.897 wenzelju 7176: ul#LC_secondary_menu li {
1.911 bisitz 7177: font-weight: bold;
7178: line-height: 1.8em;
1.1107 raeburn 7179: border-right: 1px solid black;
7180: float: left;
7181: }
7182:
7183: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7184: background-color: $data_table_light;
7185: }
7186:
7187: ul#LC_secondary_menu li a {
1.911 bisitz 7188: padding: 0 0.8em;
1.1107 raeburn 7189: }
7190:
7191: ul#LC_secondary_menu li ul {
7192: display: none;
7193: }
7194:
7195: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7196: display: block;
7197: position: absolute;
7198: margin: 0;
7199: padding: 0;
7200: list-style:none;
7201: float: none;
7202: background-color: $data_table_light;
7203: z-index: 2;
7204: margin-left: -1px;
7205: }
7206:
7207: ul#LC_secondary_menu li ul li {
7208: font-size: 90%;
7209: vertical-align: top;
7210: border-left: 1px solid black;
1.911 bisitz 7211: border-right: 1px solid black;
1.1119 raeburn 7212: background-color: $data_table_light;
1.1107 raeburn 7213: list-style:none;
7214: float: none;
7215: }
7216:
7217: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7218: background-color: $data_table_dark;
1.807 droeschl 7219: }
7220:
1.847 tempelho 7221: ul.LC_TabContent {
1.911 bisitz 7222: display:block;
7223: background: $sidebg;
7224: border-bottom: solid 1px $lg_border_color;
7225: list-style:none;
1.1020 raeburn 7226: margin: -1px -10px 0 -10px;
1.911 bisitz 7227: padding: 0;
1.693 droeschl 7228: }
7229:
1.795 www 7230: ul.LC_TabContent li,
7231: ul.LC_TabContentBigger li {
1.911 bisitz 7232: float:left;
1.741 harmsja 7233: }
1.795 www 7234:
1.897 wenzelju 7235: ul#LC_secondary_menu li a {
1.911 bisitz 7236: color: $fontmenu;
7237: text-decoration: none;
1.693 droeschl 7238: }
1.795 www 7239:
1.721 harmsja 7240: ul.LC_TabContent {
1.952 onken 7241: min-height:20px;
1.721 harmsja 7242: }
1.795 www 7243:
7244: ul.LC_TabContent li {
1.911 bisitz 7245: vertical-align:middle;
1.959 onken 7246: padding: 0 16px 0 10px;
1.911 bisitz 7247: background-color:$tabbg;
7248: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7249: border-left: solid 1px $font;
1.721 harmsja 7250: }
1.795 www 7251:
1.847 tempelho 7252: ul.LC_TabContent .right {
1.911 bisitz 7253: float:right;
1.847 tempelho 7254: }
7255:
1.911 bisitz 7256: ul.LC_TabContent li a,
7257: ul.LC_TabContent li {
7258: color:rgb(47,47,47);
7259: text-decoration:none;
7260: font-size:95%;
7261: font-weight:bold;
1.952 onken 7262: min-height:20px;
7263: }
7264:
1.959 onken 7265: ul.LC_TabContent li a:hover,
7266: ul.LC_TabContent li a:focus {
1.952 onken 7267: color: $button_hover;
1.959 onken 7268: background:none;
7269: outline:none;
1.952 onken 7270: }
7271:
7272: ul.LC_TabContent li:hover {
7273: color: $button_hover;
7274: cursor:pointer;
1.721 harmsja 7275: }
1.795 www 7276:
1.911 bisitz 7277: ul.LC_TabContent li.active {
1.952 onken 7278: color: $font;
1.911 bisitz 7279: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7280: border-bottom:solid 1px #FFFFFF;
7281: cursor: default;
1.744 ehlerst 7282: }
1.795 www 7283:
1.959 onken 7284: ul.LC_TabContent li.active a {
7285: color:$font;
7286: background:#FFFFFF;
7287: outline: none;
7288: }
1.1047 raeburn 7289:
7290: ul.LC_TabContent li.goback {
7291: float: left;
7292: border-left: none;
7293: }
7294:
1.870 tempelho 7295: #maincoursedoc {
1.911 bisitz 7296: clear:both;
1.870 tempelho 7297: }
7298:
7299: ul.LC_TabContentBigger {
1.911 bisitz 7300: display:block;
7301: list-style:none;
7302: padding: 0;
1.870 tempelho 7303: }
7304:
1.795 www 7305: ul.LC_TabContentBigger li {
1.911 bisitz 7306: vertical-align:bottom;
7307: height: 30px;
7308: font-size:110%;
7309: font-weight:bold;
7310: color: #737373;
1.841 tempelho 7311: }
7312:
1.957 onken 7313: ul.LC_TabContentBigger li.active {
7314: position: relative;
7315: top: 1px;
7316: }
7317:
1.870 tempelho 7318: ul.LC_TabContentBigger li a {
1.911 bisitz 7319: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7320: height: 30px;
7321: line-height: 30px;
7322: text-align: center;
7323: display: block;
7324: text-decoration: none;
1.958 onken 7325: outline: none;
1.741 harmsja 7326: }
1.795 www 7327:
1.870 tempelho 7328: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7329: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7330: color:$font;
1.744 ehlerst 7331: }
1.795 www 7332:
1.870 tempelho 7333: ul.LC_TabContentBigger li b {
1.911 bisitz 7334: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7335: display: block;
7336: float: left;
7337: padding: 0 30px;
1.957 onken 7338: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7339: }
7340:
1.956 onken 7341: ul.LC_TabContentBigger li:hover b {
7342: color:$button_hover;
7343: }
7344:
1.870 tempelho 7345: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7346: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7347: color:$font;
1.957 onken 7348: border: 0;
1.741 harmsja 7349: }
1.693 droeschl 7350:
1.870 tempelho 7351:
1.862 bisitz 7352: ul.LC_CourseBreadcrumbs {
7353: background: $sidebg;
1.1020 raeburn 7354: height: 2em;
1.862 bisitz 7355: padding-left: 10px;
1.1020 raeburn 7356: margin: 0;
1.862 bisitz 7357: list-style-position: inside;
7358: }
7359:
1.911 bisitz 7360: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7361: ol#LC_PathBreadcrumbs {
1.911 bisitz 7362: padding-left: 10px;
7363: margin: 0;
1.933 droeschl 7364: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7365: }
7366:
1.911 bisitz 7367: ol#LC_MenuBreadcrumbs li,
7368: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7369: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7370: display: inline;
1.933 droeschl 7371: white-space: normal;
1.693 droeschl 7372: }
7373:
1.823 bisitz 7374: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7375: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7376: text-decoration: none;
7377: font-size:90%;
1.693 droeschl 7378: }
1.795 www 7379:
1.969 droeschl 7380: ol#LC_MenuBreadcrumbs h1 {
7381: display: inline;
7382: font-size: 90%;
7383: line-height: 2.5em;
7384: margin: 0;
7385: padding: 0;
7386: }
7387:
1.795 www 7388: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7389: text-decoration:none;
7390: font-size:100%;
7391: font-weight:bold;
1.693 droeschl 7392: }
1.795 www 7393:
1.840 bisitz 7394: .LC_Box {
1.911 bisitz 7395: border: solid 1px $lg_border_color;
7396: padding: 0 10px 10px 10px;
1.746 neumanie 7397: }
1.795 www 7398:
1.1020 raeburn 7399: .LC_DocsBox {
7400: border: solid 1px $lg_border_color;
7401: padding: 0 0 10px 10px;
7402: }
7403:
1.795 www 7404: .LC_AboutMe_Image {
1.911 bisitz 7405: float:left;
7406: margin-right:10px;
1.747 neumanie 7407: }
1.795 www 7408:
7409: .LC_Clear_AboutMe_Image {
1.911 bisitz 7410: clear:left;
1.747 neumanie 7411: }
1.795 www 7412:
1.721 harmsja 7413: dl.LC_ListStyleClean dt {
1.911 bisitz 7414: padding-right: 5px;
7415: display: table-header-group;
1.693 droeschl 7416: }
7417:
1.721 harmsja 7418: dl.LC_ListStyleClean dd {
1.911 bisitz 7419: display: table-row;
1.693 droeschl 7420: }
7421:
1.721 harmsja 7422: .LC_ListStyleClean,
7423: .LC_ListStyleSimple,
7424: .LC_ListStyleNormal,
1.795 www 7425: .LC_ListStyleSpecial {
1.911 bisitz 7426: /* display:block; */
7427: list-style-position: inside;
7428: list-style-type: none;
7429: overflow: hidden;
7430: padding: 0;
1.693 droeschl 7431: }
7432:
1.721 harmsja 7433: .LC_ListStyleSimple li,
7434: .LC_ListStyleSimple dd,
7435: .LC_ListStyleNormal li,
7436: .LC_ListStyleNormal dd,
7437: .LC_ListStyleSpecial li,
1.795 www 7438: .LC_ListStyleSpecial dd {
1.911 bisitz 7439: margin: 0;
7440: padding: 5px 5px 5px 10px;
7441: clear: both;
1.693 droeschl 7442: }
7443:
1.721 harmsja 7444: .LC_ListStyleClean li,
7445: .LC_ListStyleClean dd {
1.911 bisitz 7446: padding-top: 0;
7447: padding-bottom: 0;
1.693 droeschl 7448: }
7449:
1.721 harmsja 7450: .LC_ListStyleSimple dd,
1.795 www 7451: .LC_ListStyleSimple li {
1.911 bisitz 7452: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7453: }
7454:
1.721 harmsja 7455: .LC_ListStyleSpecial li,
7456: .LC_ListStyleSpecial dd {
1.911 bisitz 7457: list-style-type: none;
7458: background-color: RGB(220, 220, 220);
7459: margin-bottom: 4px;
1.693 droeschl 7460: }
7461:
1.721 harmsja 7462: table.LC_SimpleTable {
1.911 bisitz 7463: margin:5px;
7464: border:solid 1px $lg_border_color;
1.795 www 7465: }
1.693 droeschl 7466:
1.721 harmsja 7467: table.LC_SimpleTable tr {
1.911 bisitz 7468: padding: 0;
7469: border:solid 1px $lg_border_color;
1.693 droeschl 7470: }
1.795 www 7471:
7472: table.LC_SimpleTable thead {
1.911 bisitz 7473: background:rgb(220,220,220);
1.693 droeschl 7474: }
7475:
1.721 harmsja 7476: div.LC_columnSection {
1.911 bisitz 7477: display: block;
7478: clear: both;
7479: overflow: hidden;
7480: margin: 0;
1.693 droeschl 7481: }
7482:
1.721 harmsja 7483: div.LC_columnSection>* {
1.911 bisitz 7484: float: left;
7485: margin: 10px 20px 10px 0;
7486: overflow:hidden;
1.693 droeschl 7487: }
1.721 harmsja 7488:
1.795 www 7489: table em {
1.911 bisitz 7490: font-weight: bold;
7491: font-style: normal;
1.748 schulted 7492: }
1.795 www 7493:
1.779 bisitz 7494: table.LC_tableBrowseRes,
1.795 www 7495: table.LC_tableOfContent {
1.911 bisitz 7496: border:none;
7497: border-spacing: 1px;
7498: padding: 3px;
7499: background-color: #FFFFFF;
7500: font-size: 90%;
1.753 droeschl 7501: }
1.789 droeschl 7502:
1.911 bisitz 7503: table.LC_tableOfContent {
7504: border-collapse: collapse;
1.789 droeschl 7505: }
7506:
1.771 droeschl 7507: table.LC_tableBrowseRes a,
1.768 schulted 7508: table.LC_tableOfContent a {
1.911 bisitz 7509: background-color: transparent;
7510: text-decoration: none;
1.753 droeschl 7511: }
7512:
1.795 www 7513: table.LC_tableOfContent img {
1.911 bisitz 7514: border: none;
7515: height: 1.3em;
7516: vertical-align: text-bottom;
7517: margin-right: 0.3em;
1.753 droeschl 7518: }
1.757 schulted 7519:
1.795 www 7520: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7521: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7522: }
7523:
1.795 www 7524: a#LC_content_toolbar_everything {
1.911 bisitz 7525: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7526: }
7527:
1.795 www 7528: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7529: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7530: }
7531:
1.795 www 7532: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7533: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7534: }
7535:
1.795 www 7536: a#LC_content_toolbar_changefolder {
1.911 bisitz 7537: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7538: }
7539:
1.795 www 7540: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7541: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7542: }
7543:
1.1043 raeburn 7544: a#LC_content_toolbar_edittoplevel {
7545: background-image:url(/res/adm/pages/edittoplevel.gif);
7546: }
7547:
1.795 www 7548: ul#LC_toolbar li a:hover {
1.911 bisitz 7549: background-position: bottom center;
1.757 schulted 7550: }
7551:
1.795 www 7552: ul#LC_toolbar {
1.911 bisitz 7553: padding: 0;
7554: margin: 2px;
7555: list-style:none;
7556: position:relative;
7557: background-color:white;
1.1082 raeburn 7558: overflow: auto;
1.757 schulted 7559: }
7560:
1.795 www 7561: ul#LC_toolbar li {
1.911 bisitz 7562: border:1px solid white;
7563: padding: 0;
7564: margin: 0;
7565: float: left;
7566: display:inline;
7567: vertical-align:middle;
1.1082 raeburn 7568: white-space: nowrap;
1.911 bisitz 7569: }
1.757 schulted 7570:
1.783 amueller 7571:
1.795 www 7572: a.LC_toolbarItem {
1.911 bisitz 7573: display:block;
7574: padding: 0;
7575: margin: 0;
7576: height: 32px;
7577: width: 32px;
7578: color:white;
7579: border: none;
7580: background-repeat:no-repeat;
7581: background-color:transparent;
1.757 schulted 7582: }
7583:
1.915 droeschl 7584: ul.LC_funclist {
7585: margin: 0;
7586: padding: 0.5em 1em 0.5em 0;
7587: }
7588:
1.933 droeschl 7589: ul.LC_funclist > li:first-child {
7590: font-weight:bold;
7591: margin-left:0.8em;
7592: }
7593:
1.915 droeschl 7594: ul.LC_funclist + ul.LC_funclist {
7595: /*
7596: left border as a seperator if we have more than
7597: one list
7598: */
7599: border-left: 1px solid $sidebg;
7600: /*
7601: this hides the left border behind the border of the
7602: outer box if element is wrapped to the next 'line'
7603: */
7604: margin-left: -1px;
7605: }
7606:
1.843 bisitz 7607: ul.LC_funclist li {
1.915 droeschl 7608: display: inline;
1.782 bisitz 7609: white-space: nowrap;
1.915 droeschl 7610: margin: 0 0 0 25px;
7611: line-height: 150%;
1.782 bisitz 7612: }
7613:
1.974 wenzelju 7614: .LC_hidden {
7615: display: none;
7616: }
7617:
1.1030 www 7618: .LCmodal-overlay {
7619: position:fixed;
7620: top:0;
7621: right:0;
7622: bottom:0;
7623: left:0;
7624: height:100%;
7625: width:100%;
7626: margin:0;
7627: padding:0;
7628: background:#999;
7629: opacity:.75;
7630: filter: alpha(opacity=75);
7631: -moz-opacity: 0.75;
7632: z-index:101;
7633: }
7634:
7635: * html .LCmodal-overlay {
7636: position: absolute;
7637: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7638: }
7639:
7640: .LCmodal-window {
7641: position:fixed;
7642: top:50%;
7643: left:50%;
7644: margin:0;
7645: padding:0;
7646: z-index:102;
7647: }
7648:
7649: * html .LCmodal-window {
7650: position:absolute;
7651: }
7652:
7653: .LCclose-window {
7654: position:absolute;
7655: width:32px;
7656: height:32px;
7657: right:8px;
7658: top:8px;
7659: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7660: text-indent:-99999px;
7661: overflow:hidden;
7662: cursor:pointer;
7663: }
7664:
1.1100 raeburn 7665: /*
1.1231 damieng 7666: styles used for response display
7667: */
7668: div.LC_radiofoil, div.LC_rankfoil {
7669: margin: .5em 0em .5em 0em;
7670: }
7671: table.LC_itemgroup {
7672: margin-top: 1em;
7673: }
7674:
7675: /*
1.1100 raeburn 7676: styles used by TTH when "Default set of options to pass to tth/m
7677: when converting TeX" in course settings has been set
7678:
7679: option passed: -t
7680:
7681: */
7682:
7683: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7684: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7685: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7686: td div.norm {line-height:normal;}
7687:
7688: /*
7689: option passed -y3
7690: */
7691:
7692: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7693: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7694: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7695:
1.1230 damieng 7696: /*
7697: sections with roles, for content only
7698: */
7699: section[class^="role-"] {
7700: padding-left: 10px;
7701: padding-right: 5px;
7702: margin-top: 8px;
7703: margin-bottom: 8px;
7704: border: 1px solid #2A4;
7705: border-radius: 5px;
7706: box-shadow: 0px 1px 1px #BBB;
7707: }
7708: section[class^="role-"]>h1 {
7709: position: relative;
7710: margin: 0px;
7711: padding-top: 10px;
7712: padding-left: 40px;
7713: }
7714: section[class^="role-"]>h1:before {
7715: position: absolute;
7716: left: -5px;
7717: top: 5px;
7718: }
7719: section.role-activity>h1:before {
7720: content:url('/adm/daxe/images/section_icons/activity.png');
7721: }
7722: section.role-advice>h1:before {
7723: content:url('/adm/daxe/images/section_icons/advice.png');
7724: }
7725: section.role-bibliography>h1:before {
7726: content:url('/adm/daxe/images/section_icons/bibliography.png');
7727: }
7728: section.role-citation>h1:before {
7729: content:url('/adm/daxe/images/section_icons/citation.png');
7730: }
7731: section.role-conclusion>h1:before {
7732: content:url('/adm/daxe/images/section_icons/conclusion.png');
7733: }
7734: section.role-definition>h1:before {
7735: content:url('/adm/daxe/images/section_icons/definition.png');
7736: }
7737: section.role-demonstration>h1:before {
7738: content:url('/adm/daxe/images/section_icons/demonstration.png');
7739: }
7740: section.role-example>h1:before {
7741: content:url('/adm/daxe/images/section_icons/example.png');
7742: }
7743: section.role-explanation>h1:before {
7744: content:url('/adm/daxe/images/section_icons/explanation.png');
7745: }
7746: section.role-introduction>h1:before {
7747: content:url('/adm/daxe/images/section_icons/introduction.png');
7748: }
7749: section.role-method>h1:before {
7750: content:url('/adm/daxe/images/section_icons/method.png');
7751: }
7752: section.role-more_information>h1:before {
7753: content:url('/adm/daxe/images/section_icons/more_information.png');
7754: }
7755: section.role-objectives>h1:before {
7756: content:url('/adm/daxe/images/section_icons/objectives.png');
7757: }
7758: section.role-prerequisites>h1:before {
7759: content:url('/adm/daxe/images/section_icons/prerequisites.png');
7760: }
7761: section.role-remark>h1:before {
7762: content:url('/adm/daxe/images/section_icons/remark.png');
7763: }
7764: section.role-reminder>h1:before {
7765: content:url('/adm/daxe/images/section_icons/reminder.png');
7766: }
7767: section.role-summary>h1:before {
7768: content:url('/adm/daxe/images/section_icons/summary.png');
7769: }
7770: section.role-syntax>h1:before {
7771: content:url('/adm/daxe/images/section_icons/syntax.png');
7772: }
7773: section.role-warning>h1:before {
7774: content:url('/adm/daxe/images/section_icons/warning.png');
7775: }
7776:
1.343 albertel 7777: END
7778: }
7779:
1.306 albertel 7780: =pod
7781:
7782: =item * &headtag()
7783:
7784: Returns a uniform footer for LON-CAPA web pages.
7785:
1.307 albertel 7786: Inputs: $title - optional title for the head
7787: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7788: $args - optional arguments
1.319 albertel 7789: force_register - if is true call registerurl so the remote is
7790: informed
1.415 albertel 7791: redirect -> array ref of
7792: 1- seconds before redirect occurs
7793: 2- url to redirect to
7794: 3- whether the side effect should occur
1.315 albertel 7795: (side effect of setting
7796: $env{'internal.head.redirect'} to the url
7797: redirected too)
1.352 albertel 7798: domain -> force to color decorate a page for a specific
7799: domain
7800: function -> force usage of a specific rolish color scheme
7801: bgcolor -> override the default page bgcolor
1.460 albertel 7802: no_auto_mt_title
7803: -> prevent &mt()ing the title arg
1.464 albertel 7804:
1.306 albertel 7805: =cut
7806:
7807: sub headtag {
1.313 albertel 7808: my ($title,$head_extra,$args) = @_;
1.306 albertel 7809:
1.363 albertel 7810: my $function = $args->{'function'} || &get_users_function();
7811: my $domain = $args->{'domain'} || &determinedomain();
7812: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7813: my $httphost = $args->{'use_absolute'};
1.418 albertel 7814: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7815: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7816: #time(),
1.418 albertel 7817: $env{'environment.color.timestamp'},
1.363 albertel 7818: $function,$domain,$bgcolor);
7819:
1.369 www 7820: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7821:
1.308 albertel 7822: my $result =
7823: '<head>'.
1.1160 raeburn 7824: &font_settings($args);
1.319 albertel 7825:
1.1188 raeburn 7826: my $inhibitprint;
7827: if ($args->{'print_suppress'}) {
7828: $inhibitprint = &print_suppression();
7829: }
1.1064 raeburn 7830:
1.461 albertel 7831: if (!$args->{'frameset'}) {
7832: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7833: }
1.962 droeschl 7834: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7835: $result .= Apache::lonxml::display_title();
1.319 albertel 7836: }
1.436 albertel 7837: if (!$args->{'no_nav_bar'}
7838: && !$args->{'only_body'}
7839: && !$args->{'frameset'}) {
1.1154 raeburn 7840: $result .= &help_menu_js($httphost);
1.1032 www 7841: $result.=&modal_window();
1.1038 www 7842: $result.=&togglebox_script();
1.1034 www 7843: $result.=&wishlist_window();
1.1041 www 7844: $result.=&LCprogressbarUpdate_script();
1.1034 www 7845: } else {
7846: if ($args->{'add_modal'}) {
7847: $result.=&modal_window();
7848: }
7849: if ($args->{'add_wishlist'}) {
7850: $result.=&wishlist_window();
7851: }
1.1038 www 7852: if ($args->{'add_togglebox'}) {
7853: $result.=&togglebox_script();
7854: }
1.1041 www 7855: if ($args->{'add_progressbar'}) {
7856: $result.=&LCprogressbarUpdate_script();
7857: }
1.436 albertel 7858: }
1.314 albertel 7859: if (ref($args->{'redirect'})) {
1.414 albertel 7860: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7861: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7862: if (!$inhibit_continue) {
7863: $env{'internal.head.redirect'} = $url;
7864: }
1.313 albertel 7865: $result.=<<ADDMETA
7866: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7867: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7868: ADDMETA
1.1210 raeburn 7869: } else {
7870: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7871: my $requrl = $env{'request.uri'};
7872: if ($requrl eq '') {
7873: $requrl = $ENV{'REQUEST_URI'};
7874: $requrl =~ s/\?.+$//;
7875: }
7876: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7877: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7878: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7879: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7880: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7881: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7882: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7883: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7884: if ($domdefs{'offloadnow'}{$lonhost}) {
7885: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7886: if (($newserver) && ($newserver ne $lonhost)) {
7887: my $numsec = 5;
7888: my $timeout = $numsec * 1000;
7889: my ($newurl,$locknum,%locks,$msg);
7890: if ($env{'request.role.adv'}) {
7891: ($locknum,%locks) = &Apache::lonnet::get_locks();
7892: }
7893: my $disable_submit = 0;
7894: if ($requrl =~ /$LONCAPA::assess_re/) {
7895: $disable_submit = 1;
7896: }
7897: if ($locknum) {
7898: my @lockinfo = sort(values(%locks));
7899: $msg = &mt('Once the following tasks are complete: ')."\\n".
7900: join(", ",sort(values(%locks)))."\\n".
7901: &mt('your session will be transferred to a different server, after you click "Roles".');
7902: } else {
7903: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7904: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7905: }
7906: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7907: $newurl = '/adm/switchserver?otherserver='.$newserver;
7908: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7909: $newurl .= '&role='.$env{'request.role'};
7910: }
7911: if ($env{'request.symb'}) {
7912: $newurl .= '&symb='.$env{'request.symb'};
7913: } else {
7914: $newurl .= '&origurl='.$requrl;
7915: }
7916: }
1.1222 damieng 7917: &js_escape(\$msg);
1.1210 raeburn 7918: $result.=<<OFFLOAD
7919: <meta http-equiv="pragma" content="no-cache" />
7920: <script type="text/javascript">
1.1215 raeburn 7921: // <![CDATA[
1.1210 raeburn 7922: function LC_Offload_Now() {
7923: var dest = "$newurl";
7924: if (dest != '') {
7925: window.location.href="$newurl";
7926: }
7927: }
1.1214 raeburn 7928: \$(document).ready(function () {
7929: window.alert('$msg');
7930: if ($disable_submit) {
1.1210 raeburn 7931: \$(".LC_hwk_submit").prop("disabled", true);
7932: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 7933: }
7934: setTimeout('LC_Offload_Now()', $timeout);
7935: });
1.1215 raeburn 7936: // ]]>
1.1210 raeburn 7937: </script>
7938: OFFLOAD
7939: }
7940: }
7941: }
7942: }
7943: }
7944: }
1.313 albertel 7945: }
1.306 albertel 7946: if (!defined($title)) {
7947: $title = 'The LearningOnline Network with CAPA';
7948: }
1.460 albertel 7949: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7950: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7951: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7952: if (!$args->{'frameset'}) {
7953: $result .= ' /';
7954: }
7955: $result .= '>'
1.1064 raeburn 7956: .$inhibitprint
1.414 albertel 7957: .$head_extra;
1.1137 raeburn 7958: if ($env{'browser.mobile'}) {
7959: $result .= '
7960: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7961: <meta name="apple-mobile-web-app-capable" content="yes" />';
7962: }
1.962 droeschl 7963: return $result.'</head>';
1.306 albertel 7964: }
7965:
7966: =pod
7967:
1.340 albertel 7968: =item * &font_settings()
7969:
7970: Returns neccessary <meta> to set the proper encoding
7971:
1.1160 raeburn 7972: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7973:
7974: =cut
7975:
7976: sub font_settings {
1.1160 raeburn 7977: my ($args) = @_;
1.340 albertel 7978: my $headerstring='';
1.1160 raeburn 7979: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7980: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7981: $headerstring.=
7982: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7983: if (!$args->{'frameset'}) {
7984: $headerstring.= ' /';
7985: }
7986: $headerstring .= '>'."\n";
1.340 albertel 7987: }
7988: return $headerstring;
7989: }
7990:
1.341 albertel 7991: =pod
7992:
1.1064 raeburn 7993: =item * &print_suppression()
7994:
7995: In course context returns css which causes the body to be blank when media="print",
7996: if printout generation is unavailable for the current resource.
7997:
7998: This could be because:
7999:
8000: (a) printstartdate is in the future
8001:
8002: (b) printenddate is in the past
8003:
8004: (c) there is an active exam block with "printout"
8005: functionality blocked
8006:
8007: Users with pav, pfo or evb privileges are exempt.
8008:
8009: Inputs: none
8010:
8011: =cut
8012:
8013:
8014: sub print_suppression {
8015: my $noprint;
8016: if ($env{'request.course.id'}) {
8017: my $scope = $env{'request.course.id'};
8018: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8019: (&Apache::lonnet::allowed('pfo',$scope))) {
8020: return;
8021: }
8022: if ($env{'request.course.sec'} ne '') {
8023: $scope .= "/$env{'request.course.sec'}";
8024: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8025: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8026: return;
1.1064 raeburn 8027: }
8028: }
8029: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8030: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8031: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8032: if ($blocked) {
8033: my $checkrole = "cm./$cdom/$cnum";
8034: if ($env{'request.course.sec'} ne '') {
8035: $checkrole .= "/$env{'request.course.sec'}";
8036: }
8037: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8038: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8039: $noprint = 1;
8040: }
8041: }
8042: unless ($noprint) {
8043: my $symb = &Apache::lonnet::symbread();
8044: if ($symb ne '') {
8045: my $navmap = Apache::lonnavmaps::navmap->new();
8046: if (ref($navmap)) {
8047: my $res = $navmap->getBySymb($symb);
8048: if (ref($res)) {
8049: if (!$res->resprintable()) {
8050: $noprint = 1;
8051: }
8052: }
8053: }
8054: }
8055: }
8056: if ($noprint) {
8057: return <<"ENDSTYLE";
8058: <style type="text/css" media="print">
8059: body { display:none }
8060: </style>
8061: ENDSTYLE
8062: }
8063: }
8064: return;
8065: }
8066:
8067: =pod
8068:
1.341 albertel 8069: =item * &xml_begin()
8070:
8071: Returns the needed doctype and <html>
8072:
8073: Inputs: none
8074:
8075: =cut
8076:
8077: sub xml_begin {
1.1168 raeburn 8078: my ($is_frameset) = @_;
1.341 albertel 8079: my $output='';
8080:
8081: if ($env{'browser.mathml'}) {
8082: $output='<?xml version="1.0"?>'
8083: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8084: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8085:
8086: # .'<!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">] >'
8087: .'<!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">'
8088: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8089: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8090: } elsif ($is_frameset) {
8091: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8092: '<html>'."\n";
1.341 albertel 8093: } else {
1.1168 raeburn 8094: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8095: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8096: }
8097: return $output;
8098: }
1.340 albertel 8099:
8100: =pod
8101:
1.306 albertel 8102: =item * &start_page()
8103:
8104: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8105:
1.648 raeburn 8106: Inputs:
8107:
8108: =over 4
8109:
8110: $title - optional title for the page
8111:
8112: $head_extra - optional extra HTML to incude inside the <head>
8113:
8114: $args - additional optional args supported are:
8115:
8116: =over 8
8117:
8118: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8119: arg on
1.814 bisitz 8120: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8121: add_entries -> additional attributes to add to the <body>
8122: domain -> force to color decorate a page for a
1.317 albertel 8123: specific domain
1.648 raeburn 8124: function -> force usage of a specific rolish color
1.317 albertel 8125: scheme
1.648 raeburn 8126: redirect -> see &headtag()
8127: bgcolor -> override the default page bg color
8128: js_ready -> return a string ready for being used in
1.317 albertel 8129: a javascript writeln
1.648 raeburn 8130: html_encode -> return a string ready for being used in
1.320 albertel 8131: a html attribute
1.648 raeburn 8132: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8133: $forcereg arg
1.648 raeburn 8134: frameset -> if true will start with a <frameset>
1.330 albertel 8135: rather than <body>
1.648 raeburn 8136: skip_phases -> hash ref of
1.338 albertel 8137: head -> skip the <html><head> generation
8138: body -> skip all <body> generation
1.648 raeburn 8139: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8140: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8141: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8142: group -> includes the current group, if page is for a
8143: specific group
1.361 albertel 8144:
1.648 raeburn 8145: =back
1.460 albertel 8146:
1.648 raeburn 8147: =back
1.562 albertel 8148:
1.306 albertel 8149: =cut
8150:
8151: sub start_page {
1.309 albertel 8152: my ($title,$head_extra,$args) = @_;
1.318 albertel 8153: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8154:
1.315 albertel 8155: $env{'internal.start_page'}++;
1.1096 raeburn 8156: my ($result,@advtools);
1.964 droeschl 8157:
1.338 albertel 8158: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8159: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8160: }
8161:
8162: if (! exists($args->{'skip_phases'}{'body'}) ) {
8163: if ($args->{'frameset'}) {
8164: my $attr_string = &make_attr_string($args->{'force_register'},
8165: $args->{'add_entries'});
8166: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8167: } else {
8168: $result .=
8169: &bodytag($title,
8170: $args->{'function'}, $args->{'add_entries'},
8171: $args->{'only_body'}, $args->{'domain'},
8172: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8173: $args->{'bgcolor'}, $args,
8174: \@advtools);
1.831 bisitz 8175: }
1.330 albertel 8176: }
1.338 albertel 8177:
1.315 albertel 8178: if ($args->{'js_ready'}) {
1.713 kaisler 8179: $result = &js_ready($result);
1.315 albertel 8180: }
1.320 albertel 8181: if ($args->{'html_encode'}) {
1.713 kaisler 8182: $result = &html_encode($result);
8183: }
8184:
1.813 bisitz 8185: # Preparation for new and consistent functionlist at top of screen
8186: # if ($args->{'functionlist'}) {
8187: # $result .= &build_functionlist();
8188: #}
8189:
1.964 droeschl 8190: # Don't add anything more if only_body wanted or in const space
8191: return $result if $args->{'only_body'}
8192: || $env{'request.state'} eq 'construct';
1.813 bisitz 8193:
8194: #Breadcrumbs
1.758 kaisler 8195: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8196: &Apache::lonhtmlcommon::clear_breadcrumbs();
8197: #if any br links exists, add them to the breadcrumbs
8198: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8199: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8200: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8201: }
8202: }
1.1096 raeburn 8203: # if @advtools array contains items add then to the breadcrumbs
8204: if (@advtools > 0) {
8205: &Apache::lonmenu::advtools_crumbs(@advtools);
8206: }
1.758 kaisler 8207:
8208: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8209: if(exists($args->{'bread_crumbs_component'})){
8210: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237 raeburn 8211: } elsif ($args->{'crstype'} eq 'Placement') {
8212: $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
8213: $args->{'crstype'});
8214: } else {
1.758 kaisler 8215: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8216: }
1.320 albertel 8217: }
1.315 albertel 8218: return $result;
1.306 albertel 8219: }
8220:
8221: sub end_page {
1.315 albertel 8222: my ($args) = @_;
8223: $env{'internal.end_page'}++;
1.330 albertel 8224: my $result;
1.335 albertel 8225: if ($args->{'discussion'}) {
8226: my ($target,$parser);
8227: if (ref($args->{'discussion'})) {
8228: ($target,$parser) =($args->{'discussion'}{'target'},
8229: $args->{'discussion'}{'parser'});
8230: }
8231: $result .= &Apache::lonxml::xmlend($target,$parser);
8232: }
1.330 albertel 8233: if ($args->{'frameset'}) {
8234: $result .= '</frameset>';
8235: } else {
1.635 raeburn 8236: $result .= &endbodytag($args);
1.330 albertel 8237: }
1.1080 raeburn 8238: unless ($args->{'notbody'}) {
8239: $result .= "\n</html>";
8240: }
1.330 albertel 8241:
1.315 albertel 8242: if ($args->{'js_ready'}) {
1.317 albertel 8243: $result = &js_ready($result);
1.315 albertel 8244: }
1.335 albertel 8245:
1.320 albertel 8246: if ($args->{'html_encode'}) {
8247: $result = &html_encode($result);
8248: }
1.335 albertel 8249:
1.315 albertel 8250: return $result;
8251: }
8252:
1.1034 www 8253: sub wishlist_window {
8254: return(<<'ENDWISHLIST');
1.1046 raeburn 8255: <script type="text/javascript">
1.1034 www 8256: // <![CDATA[
8257: // <!-- BEGIN LON-CAPA Internal
8258: function set_wishlistlink(title, path) {
8259: if (!title) {
8260: title = document.title;
8261: title = title.replace(/^LON-CAPA /,'');
8262: }
1.1175 raeburn 8263: title = encodeURIComponent(title);
1.1203 raeburn 8264: title = title.replace("'","\\\'");
1.1034 www 8265: if (!path) {
8266: path = location.pathname;
8267: }
1.1175 raeburn 8268: path = encodeURIComponent(path);
1.1203 raeburn 8269: path = path.replace("'","\\\'");
1.1034 www 8270: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8271: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8272: }
8273: // END LON-CAPA Internal -->
8274: // ]]>
8275: </script>
8276: ENDWISHLIST
8277: }
8278:
1.1030 www 8279: sub modal_window {
8280: return(<<'ENDMODAL');
1.1046 raeburn 8281: <script type="text/javascript">
1.1030 www 8282: // <![CDATA[
8283: // <!-- BEGIN LON-CAPA Internal
8284: var modalWindow = {
8285: parent:"body",
8286: windowId:null,
8287: content:null,
8288: width:null,
8289: height:null,
8290: close:function()
8291: {
8292: $(".LCmodal-window").remove();
8293: $(".LCmodal-overlay").remove();
8294: },
8295: open:function()
8296: {
8297: var modal = "";
8298: modal += "<div class=\"LCmodal-overlay\"></div>";
8299: 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;\">";
8300: modal += this.content;
8301: modal += "</div>";
8302:
8303: $(this.parent).append(modal);
8304:
8305: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8306: $(".LCclose-window").click(function(){modalWindow.close();});
8307: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8308: }
8309: };
1.1140 raeburn 8310: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8311: {
1.1203 raeburn 8312: source = source.replace("'","'");
1.1030 www 8313: modalWindow.windowId = "myModal";
8314: modalWindow.width = width;
8315: modalWindow.height = height;
1.1196 raeburn 8316: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8317: modalWindow.open();
1.1208 raeburn 8318: };
1.1030 www 8319: // END LON-CAPA Internal -->
8320: // ]]>
8321: </script>
8322: ENDMODAL
8323: }
8324:
8325: sub modal_link {
1.1140 raeburn 8326: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8327: unless ($width) { $width=480; }
8328: unless ($height) { $height=400; }
1.1031 www 8329: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8330: unless ($transparency) { $transparency='true'; }
8331:
1.1074 raeburn 8332: my $target_attr;
8333: if (defined($target)) {
8334: $target_attr = 'target="'.$target.'"';
8335: }
8336: return <<"ENDLINK";
1.1140 raeburn 8337: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8338: $linktext</a>
8339: ENDLINK
1.1030 www 8340: }
8341:
1.1032 www 8342: sub modal_adhoc_script {
8343: my ($funcname,$width,$height,$content)=@_;
8344: return (<<ENDADHOC);
1.1046 raeburn 8345: <script type="text/javascript">
1.1032 www 8346: // <![CDATA[
8347: var $funcname = function()
8348: {
8349: modalWindow.windowId = "myModal";
8350: modalWindow.width = $width;
8351: modalWindow.height = $height;
8352: modalWindow.content = '$content';
8353: modalWindow.open();
8354: };
8355: // ]]>
8356: </script>
8357: ENDADHOC
8358: }
8359:
1.1041 www 8360: sub modal_adhoc_inner {
8361: my ($funcname,$width,$height,$content)=@_;
8362: my $innerwidth=$width-20;
8363: $content=&js_ready(
1.1140 raeburn 8364: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8365: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8366: $content.
1.1041 www 8367: &end_scrollbox().
1.1140 raeburn 8368: &end_page()
1.1041 www 8369: );
8370: return &modal_adhoc_script($funcname,$width,$height,$content);
8371: }
8372:
8373: sub modal_adhoc_window {
8374: my ($funcname,$width,$height,$content,$linktext)=@_;
8375: return &modal_adhoc_inner($funcname,$width,$height,$content).
8376: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8377: }
8378:
8379: sub modal_adhoc_launch {
8380: my ($funcname,$width,$height,$content)=@_;
8381: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8382: <script type="text/javascript">
8383: // <![CDATA[
8384: $funcname();
8385: // ]]>
8386: </script>
8387: ENDLAUNCH
8388: }
8389:
8390: sub modal_adhoc_close {
8391: return (<<ENDCLOSE);
8392: <script type="text/javascript">
8393: // <![CDATA[
8394: modalWindow.close();
8395: // ]]>
8396: </script>
8397: ENDCLOSE
8398: }
8399:
1.1038 www 8400: sub togglebox_script {
8401: return(<<ENDTOGGLE);
8402: <script type="text/javascript">
8403: // <![CDATA[
8404: function LCtoggleDisplay(id,hidetext,showtext) {
8405: link = document.getElementById(id + "link").childNodes[0];
8406: with (document.getElementById(id).style) {
8407: if (display == "none" ) {
8408: display = "inline";
8409: link.nodeValue = hidetext;
8410: } else {
8411: display = "none";
8412: link.nodeValue = showtext;
8413: }
8414: }
8415: }
8416: // ]]>
8417: </script>
8418: ENDTOGGLE
8419: }
8420:
1.1039 www 8421: sub start_togglebox {
8422: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8423: unless ($heading) { $heading=''; } else { $heading.=' '; }
8424: unless ($showtext) { $showtext=&mt('show'); }
8425: unless ($hidetext) { $hidetext=&mt('hide'); }
8426: unless ($headerbg) { $headerbg='#FFFFFF'; }
8427: return &start_data_table().
8428: &start_data_table_header_row().
8429: '<td bgcolor="'.$headerbg.'">'.$heading.
8430: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8431: $showtext.'\')">'.$showtext.'</a>]</td>'.
8432: &end_data_table_header_row().
8433: '<tr id="'.$id.'" style="display:none""><td>';
8434: }
8435:
8436: sub end_togglebox {
8437: return '</td></tr>'.&end_data_table();
8438: }
8439:
1.1041 www 8440: sub LCprogressbar_script {
1.1045 www 8441: my ($id)=@_;
1.1041 www 8442: return(<<ENDPROGRESS);
8443: <script type="text/javascript">
8444: // <![CDATA[
1.1045 www 8445: \$('#progressbar$id').progressbar({
1.1041 www 8446: value: 0,
8447: change: function(event, ui) {
8448: var newVal = \$(this).progressbar('option', 'value');
8449: \$('.pblabel', this).text(LCprogressTxt);
8450: }
8451: });
8452: // ]]>
8453: </script>
8454: ENDPROGRESS
8455: }
8456:
8457: sub LCprogressbarUpdate_script {
8458: return(<<ENDPROGRESSUPDATE);
8459: <style type="text/css">
8460: .ui-progressbar { position:relative; }
8461: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8462: </style>
8463: <script type="text/javascript">
8464: // <![CDATA[
1.1045 www 8465: var LCprogressTxt='---';
8466:
8467: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8468: LCprogressTxt=progresstext;
1.1045 www 8469: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8470: }
8471: // ]]>
8472: </script>
8473: ENDPROGRESSUPDATE
8474: }
8475:
1.1042 www 8476: my $LClastpercent;
1.1045 www 8477: my $LCidcnt;
8478: my $LCcurrentid;
1.1042 www 8479:
1.1041 www 8480: sub LCprogressbar {
1.1042 www 8481: my ($r)=(@_);
8482: $LClastpercent=0;
1.1045 www 8483: $LCidcnt++;
8484: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8485: my $starting=&mt('Starting');
8486: my $content=(<<ENDPROGBAR);
1.1045 www 8487: <div id="progressbar$LCcurrentid">
1.1041 www 8488: <span class="pblabel">$starting</span>
8489: </div>
8490: ENDPROGBAR
1.1045 www 8491: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8492: }
8493:
8494: sub LCprogressbarUpdate {
1.1042 www 8495: my ($r,$val,$text)=@_;
8496: unless ($val) {
8497: if ($LClastpercent) {
8498: $val=$LClastpercent;
8499: } else {
8500: $val=0;
8501: }
8502: }
1.1041 www 8503: if ($val<0) { $val=0; }
8504: if ($val>100) { $val=0; }
1.1042 www 8505: $LClastpercent=$val;
1.1041 www 8506: unless ($text) { $text=$val.'%'; }
8507: $text=&js_ready($text);
1.1044 www 8508: &r_print($r,<<ENDUPDATE);
1.1041 www 8509: <script type="text/javascript">
8510: // <![CDATA[
1.1045 www 8511: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8512: // ]]>
8513: </script>
8514: ENDUPDATE
1.1035 www 8515: }
8516:
1.1042 www 8517: sub LCprogressbarClose {
8518: my ($r)=@_;
8519: $LClastpercent=0;
1.1044 www 8520: &r_print($r,<<ENDCLOSE);
1.1042 www 8521: <script type="text/javascript">
8522: // <![CDATA[
1.1045 www 8523: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8524: // ]]>
8525: </script>
8526: ENDCLOSE
1.1044 www 8527: }
8528:
8529: sub r_print {
8530: my ($r,$to_print)=@_;
8531: if ($r) {
8532: $r->print($to_print);
8533: $r->rflush();
8534: } else {
8535: print($to_print);
8536: }
1.1042 www 8537: }
8538:
1.320 albertel 8539: sub html_encode {
8540: my ($result) = @_;
8541:
1.322 albertel 8542: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8543:
8544: return $result;
8545: }
1.1044 www 8546:
1.317 albertel 8547: sub js_ready {
8548: my ($result) = @_;
8549:
1.323 albertel 8550: $result =~ s/[\n\r]/ /xmsg;
8551: $result =~ s/\\/\\\\/xmsg;
8552: $result =~ s/'/\\'/xmsg;
1.372 albertel 8553: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8554:
8555: return $result;
8556: }
8557:
1.315 albertel 8558: sub validate_page {
8559: if ( exists($env{'internal.start_page'})
1.316 albertel 8560: && $env{'internal.start_page'} > 1) {
8561: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8562: $env{'internal.start_page'}.' '.
1.316 albertel 8563: $ENV{'request.filename'});
1.315 albertel 8564: }
8565: if ( exists($env{'internal.end_page'})
1.316 albertel 8566: && $env{'internal.end_page'} > 1) {
8567: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8568: $env{'internal.end_page'}.' '.
1.316 albertel 8569: $env{'request.filename'});
1.315 albertel 8570: }
8571: if ( exists($env{'internal.start_page'})
8572: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8573: &Apache::lonnet::logthis('start_page called without end_page '.
8574: $env{'request.filename'});
1.315 albertel 8575: }
8576: if ( ! exists($env{'internal.start_page'})
8577: && exists($env{'internal.end_page'})) {
1.316 albertel 8578: &Apache::lonnet::logthis('end_page called without start_page'.
8579: $env{'request.filename'});
1.315 albertel 8580: }
1.306 albertel 8581: }
1.315 albertel 8582:
1.996 www 8583:
8584: sub start_scrollbox {
1.1140 raeburn 8585: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8586: unless ($outerwidth) { $outerwidth='520px'; }
8587: unless ($width) { $width='500px'; }
8588: unless ($height) { $height='200px'; }
1.1075 raeburn 8589: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8590: if ($id ne '') {
1.1140 raeburn 8591: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8592: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8593: }
1.1075 raeburn 8594: if ($bgcolor ne '') {
8595: $tdcol = "background-color: $bgcolor;";
8596: }
1.1137 raeburn 8597: my $nicescroll_js;
8598: if ($env{'browser.mobile'}) {
1.1140 raeburn 8599: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8600: }
8601: return <<"END";
8602: $nicescroll_js
8603:
8604: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8605: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8606: END
8607: }
8608:
8609: sub end_scrollbox {
8610: return '</div></td></tr></table>';
8611: }
8612:
8613: sub nicescroll_javascript {
8614: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8615: my %options;
8616: if (ref($cursor) eq 'HASH') {
8617: %options = %{$cursor};
8618: }
8619: unless ($options{'railalign'} =~ /^left|right$/) {
8620: $options{'railalign'} = 'left';
8621: }
8622: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8623: my $function = &get_users_function();
8624: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8625: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8626: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8627: }
1.1140 raeburn 8628: }
8629: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8630: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8631: $options{'cursoropacity'}='1.0';
8632: }
1.1140 raeburn 8633: } else {
8634: $options{'cursoropacity'}='1.0';
8635: }
8636: if ($options{'cursorfixedheight'} eq 'none') {
8637: delete($options{'cursorfixedheight'});
8638: } else {
8639: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8640: }
8641: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8642: delete($options{'railoffset'});
8643: }
8644: my @niceoptions;
8645: while (my($key,$value) = each(%options)) {
8646: if ($value =~ /^\{.+\}$/) {
8647: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8648: } else {
1.1140 raeburn 8649: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8650: }
1.1140 raeburn 8651: }
8652: my $nicescroll_js = '
1.1137 raeburn 8653: $(document).ready(
1.1140 raeburn 8654: function() {
8655: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8656: }
1.1137 raeburn 8657: );
8658: ';
1.1140 raeburn 8659: if ($framecheck) {
8660: $nicescroll_js .= '
8661: function expand_div(caller) {
8662: if (top === self) {
8663: document.getElementById("'.$id.'").style.width = "auto";
8664: document.getElementById("'.$id.'").style.height = "auto";
8665: } else {
8666: try {
8667: if (parent.frames) {
8668: if (parent.frames.length > 1) {
8669: var framesrc = parent.frames[1].location.href;
8670: var currsrc = framesrc.replace(/\#.*$/,"");
8671: if ((caller == "search") || (currsrc == "'.$location.'")) {
8672: document.getElementById("'.$id.'").style.width = "auto";
8673: document.getElementById("'.$id.'").style.height = "auto";
8674: }
8675: }
8676: }
8677: } catch (e) {
8678: return;
8679: }
1.1137 raeburn 8680: }
1.1140 raeburn 8681: return;
1.996 www 8682: }
1.1140 raeburn 8683: ';
8684: }
8685: if ($needjsready) {
8686: $nicescroll_js = '
8687: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8688: } else {
8689: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8690: }
8691: return $nicescroll_js;
1.996 www 8692: }
8693:
1.318 albertel 8694: sub simple_error_page {
1.1150 bisitz 8695: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8696: if (ref($args) eq 'HASH') {
8697: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8698: } else {
8699: $msg = &mt($msg);
8700: }
1.1150 bisitz 8701:
1.318 albertel 8702: my $page =
8703: &Apache::loncommon::start_page($title).
1.1150 bisitz 8704: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8705: &Apache::loncommon::end_page();
8706: if (ref($r)) {
8707: $r->print($page);
1.327 albertel 8708: return;
1.318 albertel 8709: }
8710: return $page;
8711: }
1.347 albertel 8712:
8713: {
1.610 albertel 8714: my @row_count;
1.961 onken 8715:
8716: sub start_data_table_count {
8717: unshift(@row_count, 0);
8718: return;
8719: }
8720:
8721: sub end_data_table_count {
8722: shift(@row_count);
8723: return;
8724: }
8725:
1.347 albertel 8726: sub start_data_table {
1.1018 raeburn 8727: my ($add_class,$id) = @_;
1.422 albertel 8728: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8729: my $table_id;
8730: if (defined($id)) {
8731: $table_id = ' id="'.$id.'"';
8732: }
1.961 onken 8733: &start_data_table_count();
1.1018 raeburn 8734: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8735: }
8736:
8737: sub end_data_table {
1.961 onken 8738: &end_data_table_count();
1.389 albertel 8739: return '</table>'."\n";;
1.347 albertel 8740: }
8741:
8742: sub start_data_table_row {
1.974 wenzelju 8743: my ($add_class, $id) = @_;
1.610 albertel 8744: $row_count[0]++;
8745: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8746: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8747: $id = (' id="'.$id.'"') unless ($id eq '');
8748: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8749: }
1.471 banghart 8750:
8751: sub continue_data_table_row {
1.974 wenzelju 8752: my ($add_class, $id) = @_;
1.610 albertel 8753: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8754: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8755: $id = (' id="'.$id.'"') unless ($id eq '');
8756: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8757: }
1.347 albertel 8758:
8759: sub end_data_table_row {
1.389 albertel 8760: return '</tr>'."\n";;
1.347 albertel 8761: }
1.367 www 8762:
1.421 albertel 8763: sub start_data_table_empty_row {
1.707 bisitz 8764: # $row_count[0]++;
1.421 albertel 8765: return '<tr class="LC_empty_row" >'."\n";;
8766: }
8767:
8768: sub end_data_table_empty_row {
8769: return '</tr>'."\n";;
8770: }
8771:
1.367 www 8772: sub start_data_table_header_row {
1.389 albertel 8773: return '<tr class="LC_header_row">'."\n";;
1.367 www 8774: }
8775:
8776: sub end_data_table_header_row {
1.389 albertel 8777: return '</tr>'."\n";;
1.367 www 8778: }
1.890 droeschl 8779:
8780: sub data_table_caption {
8781: my $caption = shift;
8782: return "<caption class=\"LC_caption\">$caption</caption>";
8783: }
1.347 albertel 8784: }
8785:
1.548 albertel 8786: =pod
8787:
8788: =item * &inhibit_menu_check($arg)
8789:
8790: Checks for a inhibitmenu state and generates output to preserve it
8791:
8792: Inputs: $arg - can be any of
8793: - undef - in which case the return value is a string
8794: to add into arguments list of a uri
8795: - 'input' - in which case the return value is a HTML
8796: <form> <input> field of type hidden to
8797: preserve the value
8798: - a url - in which case the return value is the url with
8799: the neccesary cgi args added to preserve the
8800: inhibitmenu state
8801: - a ref to a url - no return value, but the string is
8802: updated to include the neccessary cgi
8803: args to preserve the inhibitmenu state
8804:
8805: =cut
8806:
8807: sub inhibit_menu_check {
8808: my ($arg) = @_;
8809: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8810: if ($arg eq 'input') {
8811: if ($env{'form.inhibitmenu'}) {
8812: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8813: } else {
8814: return
8815: }
8816: }
8817: if ($env{'form.inhibitmenu'}) {
8818: if (ref($arg)) {
8819: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8820: } elsif ($arg eq '') {
8821: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8822: } else {
8823: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8824: }
8825: }
8826: if (!ref($arg)) {
8827: return $arg;
8828: }
8829: }
8830:
1.251 albertel 8831: ###############################################
1.182 matthew 8832:
8833: =pod
8834:
1.549 albertel 8835: =back
8836:
8837: =head1 User Information Routines
8838:
8839: =over 4
8840:
1.405 albertel 8841: =item * &get_users_function()
1.182 matthew 8842:
8843: Used by &bodytag to determine the current users primary role.
8844: Returns either 'student','coordinator','admin', or 'author'.
8845:
8846: =cut
8847:
8848: ###############################################
8849: sub get_users_function {
1.815 tempelho 8850: my $function = 'norole';
1.818 tempelho 8851: if ($env{'request.role'}=~/^(st)/) {
8852: $function='student';
8853: }
1.907 raeburn 8854: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8855: $function='coordinator';
8856: }
1.258 albertel 8857: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8858: $function='admin';
8859: }
1.826 bisitz 8860: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8861: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8862: $function='author';
8863: }
8864: return $function;
1.54 www 8865: }
1.99 www 8866:
8867: ###############################################
8868:
1.233 raeburn 8869: =pod
8870:
1.821 raeburn 8871: =item * &show_course()
8872:
8873: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8874: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8875:
8876: Inputs:
8877: None
8878:
8879: Outputs:
8880: Scalar: 1 if 'Course' to be used, 0 otherwise.
8881:
8882: =cut
8883:
8884: ###############################################
8885: sub show_course {
8886: my $course = !$env{'user.adv'};
8887: if (!$env{'user.adv'}) {
8888: foreach my $env (keys(%env)) {
8889: next if ($env !~ m/^user\.priv\./);
8890: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8891: $course = 0;
8892: last;
8893: }
8894: }
8895: }
8896: return $course;
8897: }
8898:
8899: ###############################################
8900:
8901: =pod
8902:
1.542 raeburn 8903: =item * &check_user_status()
1.274 raeburn 8904:
8905: Determines current status of supplied role for a
8906: specific user. Roles can be active, previous or future.
8907:
8908: Inputs:
8909: user's domain, user's username, course's domain,
1.375 raeburn 8910: course's number, optional section ID.
1.274 raeburn 8911:
8912: Outputs:
8913: role status: active, previous or future.
8914:
8915: =cut
8916:
8917: sub check_user_status {
1.412 raeburn 8918: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8919: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 8920: my @uroles = keys(%userinfo);
1.274 raeburn 8921: my $srchstr;
8922: my $active_chk = 'none';
1.412 raeburn 8923: my $now = time;
1.274 raeburn 8924: if (@uroles > 0) {
1.908 raeburn 8925: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8926: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8927: } else {
1.412 raeburn 8928: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8929: }
8930: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8931: my $role_end = 0;
8932: my $role_start = 0;
8933: $active_chk = 'active';
1.412 raeburn 8934: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8935: $role_end = $1;
8936: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8937: $role_start = $1;
1.274 raeburn 8938: }
8939: }
8940: if ($role_start > 0) {
1.412 raeburn 8941: if ($now < $role_start) {
1.274 raeburn 8942: $active_chk = 'future';
8943: }
8944: }
8945: if ($role_end > 0) {
1.412 raeburn 8946: if ($now > $role_end) {
1.274 raeburn 8947: $active_chk = 'previous';
8948: }
8949: }
8950: }
8951: }
8952: return $active_chk;
8953: }
8954:
8955: ###############################################
8956:
8957: =pod
8958:
1.405 albertel 8959: =item * &get_sections()
1.233 raeburn 8960:
8961: Determines all the sections for a course including
8962: sections with students and sections containing other roles.
1.419 raeburn 8963: Incoming parameters:
8964:
8965: 1. domain
8966: 2. course number
8967: 3. reference to array containing roles for which sections should
8968: be gathered (optional).
8969: 4. reference to array containing status types for which sections
8970: should be gathered (optional).
8971:
8972: If the third argument is undefined, sections are gathered for any role.
8973: If the fourth argument is undefined, sections are gathered for any status.
8974: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8975:
1.374 raeburn 8976: Returns section hash (keys are section IDs, values are
8977: number of users in each section), subject to the
1.419 raeburn 8978: optional roles filter, optional status filter
1.233 raeburn 8979:
8980: =cut
8981:
8982: ###############################################
8983: sub get_sections {
1.419 raeburn 8984: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8985: if (!defined($cdom) || !defined($cnum)) {
8986: my $cid = $env{'request.course.id'};
8987:
8988: return if (!defined($cid));
8989:
8990: $cdom = $env{'course.'.$cid.'.domain'};
8991: $cnum = $env{'course.'.$cid.'.num'};
8992: }
8993:
8994: my %sectioncount;
1.419 raeburn 8995: my $now = time;
1.240 albertel 8996:
1.1118 raeburn 8997: my $check_students = 1;
8998: my $only_students = 0;
8999: if (ref($possible_roles) eq 'ARRAY') {
9000: if (grep(/^st$/,@{$possible_roles})) {
9001: if (@{$possible_roles} == 1) {
9002: $only_students = 1;
9003: }
9004: } else {
9005: $check_students = 0;
9006: }
9007: }
9008:
9009: if ($check_students) {
1.276 albertel 9010: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9011: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9012: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9013: my $start_index = &Apache::loncoursedata::CL_START();
9014: my $end_index = &Apache::loncoursedata::CL_END();
9015: my $status;
1.366 albertel 9016: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9017: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9018: $data->[$status_index],
9019: $data->[$start_index],
9020: $data->[$end_index]);
9021: if ($stu_status eq 'Active') {
9022: $status = 'active';
9023: } elsif ($end < $now) {
9024: $status = 'previous';
9025: } elsif ($start > $now) {
9026: $status = 'future';
9027: }
9028: if ($section ne '-1' && $section !~ /^\s*$/) {
9029: if ((!defined($possible_status)) || (($status ne '') &&
9030: (grep/^\Q$status\E$/,@{$possible_status}))) {
9031: $sectioncount{$section}++;
9032: }
1.240 albertel 9033: }
9034: }
9035: }
1.1118 raeburn 9036: if ($only_students) {
9037: return %sectioncount;
9038: }
1.240 albertel 9039: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9040: foreach my $user (sort(keys(%courseroles))) {
9041: if ($user !~ /^(\w{2})/) { next; }
9042: my ($role) = ($user =~ /^(\w{2})/);
9043: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9044: my ($section,$status);
1.240 albertel 9045: if ($role eq 'cr' &&
9046: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9047: $section=$1;
9048: }
9049: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9050: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9051: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9052: if ($end == -1 && $start == -1) {
9053: next; #deleted role
9054: }
9055: if (!defined($possible_status)) {
9056: $sectioncount{$section}++;
9057: } else {
9058: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9059: $status = 'active';
9060: } elsif ($end < $now) {
9061: $status = 'future';
9062: } elsif ($start > $now) {
9063: $status = 'previous';
9064: }
9065: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9066: $sectioncount{$section}++;
9067: }
9068: }
1.233 raeburn 9069: }
1.366 albertel 9070: return %sectioncount;
1.233 raeburn 9071: }
9072:
1.274 raeburn 9073: ###############################################
1.294 raeburn 9074:
9075: =pod
1.405 albertel 9076:
9077: =item * &get_course_users()
9078:
1.275 raeburn 9079: Retrieves usernames:domains for users in the specified course
9080: with specific role(s), and access status.
9081:
9082: Incoming parameters:
1.277 albertel 9083: 1. course domain
9084: 2. course number
9085: 3. access status: users must have - either active,
1.275 raeburn 9086: previous, future, or all.
1.277 albertel 9087: 4. reference to array of permissible roles
1.288 raeburn 9088: 5. reference to array of section restrictions (optional)
9089: 6. reference to results object (hash of hashes).
9090: 7. reference to optional userdata hash
1.609 raeburn 9091: 8. reference to optional statushash
1.630 raeburn 9092: 9. flag if privileged users (except those set to unhide in
9093: course settings) should be excluded
1.609 raeburn 9094: Keys of top level results hash are roles.
1.275 raeburn 9095: Keys of inner hashes are username:domain, with
9096: values set to access type.
1.288 raeburn 9097: Optional userdata hash returns an array with arguments in the
9098: same order as loncoursedata::get_classlist() for student data.
9099:
1.609 raeburn 9100: Optional statushash returns
9101:
1.288 raeburn 9102: Entries for end, start, section and status are blank because
9103: of the possibility of multiple values for non-student roles.
9104:
1.275 raeburn 9105: =cut
1.405 albertel 9106:
1.275 raeburn 9107: ###############################################
1.405 albertel 9108:
1.275 raeburn 9109: sub get_course_users {
1.630 raeburn 9110: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9111: my %idx = ();
1.419 raeburn 9112: my %seclists;
1.288 raeburn 9113:
9114: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9115: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9116: $idx{end} = &Apache::loncoursedata::CL_END();
9117: $idx{start} = &Apache::loncoursedata::CL_START();
9118: $idx{id} = &Apache::loncoursedata::CL_ID();
9119: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9120: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9121: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9122:
1.290 albertel 9123: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9124: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9125: my $now = time;
1.277 albertel 9126: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9127: my $match = 0;
1.412 raeburn 9128: my $secmatch = 0;
1.419 raeburn 9129: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9130: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9131: if ($section eq '') {
9132: $section = 'none';
9133: }
1.291 albertel 9134: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9135: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9136: $secmatch = 1;
9137: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9138: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9139: $secmatch = 1;
9140: }
9141: } else {
1.419 raeburn 9142: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9143: $secmatch = 1;
9144: }
1.290 albertel 9145: }
1.412 raeburn 9146: if (!$secmatch) {
9147: next;
9148: }
1.419 raeburn 9149: }
1.275 raeburn 9150: if (defined($$types{'active'})) {
1.288 raeburn 9151: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9152: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9153: $match = 1;
1.275 raeburn 9154: }
9155: }
9156: if (defined($$types{'previous'})) {
1.609 raeburn 9157: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9158: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9159: $match = 1;
1.275 raeburn 9160: }
9161: }
9162: if (defined($$types{'future'})) {
1.609 raeburn 9163: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9164: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9165: $match = 1;
1.275 raeburn 9166: }
9167: }
1.609 raeburn 9168: if ($match) {
9169: push(@{$seclists{$student}},$section);
9170: if (ref($userdata) eq 'HASH') {
9171: $$userdata{$student} = $$classlist{$student};
9172: }
9173: if (ref($statushash) eq 'HASH') {
9174: $statushash->{$student}{'st'}{$section} = $status;
9175: }
1.288 raeburn 9176: }
1.275 raeburn 9177: }
9178: }
1.412 raeburn 9179: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9180: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9181: my $now = time;
1.609 raeburn 9182: my %displaystatus = ( previous => 'Expired',
9183: active => 'Active',
9184: future => 'Future',
9185: );
1.1121 raeburn 9186: my (%nothide,@possdoms);
1.630 raeburn 9187: if ($hidepriv) {
9188: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9189: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9190: if ($user !~ /:/) {
9191: $nothide{join(':',split(/[\@]/,$user))}=1;
9192: } else {
9193: $nothide{$user} = 1;
9194: }
9195: }
1.1121 raeburn 9196: my @possdoms = ($cdom);
9197: if ($coursehash{'checkforpriv'}) {
9198: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9199: }
1.630 raeburn 9200: }
1.439 raeburn 9201: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9202: my $match = 0;
1.412 raeburn 9203: my $secmatch = 0;
1.439 raeburn 9204: my $status;
1.412 raeburn 9205: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9206: $user =~ s/:$//;
1.439 raeburn 9207: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9208: if ($end == -1 || $start == -1) {
9209: next;
9210: }
9211: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9212: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9213: my ($uname,$udom) = split(/:/,$user);
9214: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9215: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9216: $secmatch = 1;
9217: } elsif ($usec eq '') {
1.420 albertel 9218: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9219: $secmatch = 1;
9220: }
9221: } else {
9222: if (grep(/^\Q$usec\E$/,@{$sections})) {
9223: $secmatch = 1;
9224: }
9225: }
9226: if (!$secmatch) {
9227: next;
9228: }
1.288 raeburn 9229: }
1.419 raeburn 9230: if ($usec eq '') {
9231: $usec = 'none';
9232: }
1.275 raeburn 9233: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9234: if ($hidepriv) {
1.1121 raeburn 9235: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9236: (!$nothide{$uname.':'.$udom})) {
9237: next;
9238: }
9239: }
1.503 raeburn 9240: if ($end > 0 && $end < $now) {
1.439 raeburn 9241: $status = 'previous';
9242: } elsif ($start > $now) {
9243: $status = 'future';
9244: } else {
9245: $status = 'active';
9246: }
1.277 albertel 9247: foreach my $type (keys(%{$types})) {
1.275 raeburn 9248: if ($status eq $type) {
1.420 albertel 9249: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9250: push(@{$$users{$role}{$user}},$type);
9251: }
1.288 raeburn 9252: $match = 1;
9253: }
9254: }
1.419 raeburn 9255: if (($match) && (ref($userdata) eq 'HASH')) {
9256: if (!exists($$userdata{$uname.':'.$udom})) {
9257: &get_user_info($udom,$uname,\%idx,$userdata);
9258: }
1.420 albertel 9259: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9260: push(@{$seclists{$uname.':'.$udom}},$usec);
9261: }
1.609 raeburn 9262: if (ref($statushash) eq 'HASH') {
9263: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9264: }
1.275 raeburn 9265: }
9266: }
9267: }
9268: }
1.290 albertel 9269: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9270: if ((defined($cdom)) && (defined($cnum))) {
9271: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9272: if ( defined($csettings{'internal.courseowner'}) ) {
9273: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9274: next if ($owner eq '');
9275: my ($ownername,$ownerdom);
9276: if ($owner =~ /^([^:]+):([^:]+)$/) {
9277: $ownername = $1;
9278: $ownerdom = $2;
9279: } else {
9280: $ownername = $owner;
9281: $ownerdom = $cdom;
9282: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9283: }
9284: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9285: if (defined($userdata) &&
1.609 raeburn 9286: !exists($$userdata{$owner})) {
9287: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9288: if (!grep(/^none$/,@{$seclists{$owner}})) {
9289: push(@{$seclists{$owner}},'none');
9290: }
9291: if (ref($statushash) eq 'HASH') {
9292: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9293: }
1.290 albertel 9294: }
1.279 raeburn 9295: }
9296: }
9297: }
1.419 raeburn 9298: foreach my $user (keys(%seclists)) {
9299: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9300: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9301: }
1.275 raeburn 9302: }
9303: return;
9304: }
9305:
1.288 raeburn 9306: sub get_user_info {
9307: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9308: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9309: &plainname($uname,$udom,'lastname');
1.291 albertel 9310: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9311: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9312: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9313: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9314: return;
9315: }
1.275 raeburn 9316:
1.472 raeburn 9317: ###############################################
9318:
9319: =pod
9320:
9321: =item * &get_user_quota()
9322:
1.1134 raeburn 9323: Retrieves quota assigned for storage of user files.
9324: Default is to report quota for portfolio files.
1.472 raeburn 9325:
9326: Incoming parameters:
9327: 1. user's username
9328: 2. user's domain
1.1134 raeburn 9329: 3. quota name - portfolio, author, or course
1.1136 raeburn 9330: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9331: 4. crstype - official, unofficial, textbook, placement or community,
9332: if quota name is course
1.472 raeburn 9333:
9334: Returns:
1.1163 raeburn 9335: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9336: 2. (Optional) Type of setting: custom or default
9337: (individually assigned or default for user's
9338: institutional status).
9339: 3. (Optional) - User's institutional status (e.g., faculty, staff
9340: or student - types as defined in localenroll::inst_usertypes
9341: for user's domain, which determines default quota for user.
9342: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9343:
9344: If a value has been stored in the user's environment,
1.536 raeburn 9345: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9346: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9347:
9348: =cut
9349:
9350: ###############################################
9351:
9352:
9353: sub get_user_quota {
1.1136 raeburn 9354: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9355: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9356: if (!defined($udom)) {
9357: $udom = $env{'user.domain'};
9358: }
9359: if (!defined($uname)) {
9360: $uname = $env{'user.name'};
9361: }
9362: if (($udom eq '' || $uname eq '') ||
9363: ($udom eq 'public') && ($uname eq 'public')) {
9364: $quota = 0;
1.536 raeburn 9365: $quotatype = 'default';
9366: $defquota = 0;
1.472 raeburn 9367: } else {
1.536 raeburn 9368: my $inststatus;
1.1134 raeburn 9369: if ($quotaname eq 'course') {
9370: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9371: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9372: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9373: } else {
9374: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9375: $quota = $cenv{'internal.uploadquota'};
9376: }
1.536 raeburn 9377: } else {
1.1134 raeburn 9378: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9379: if ($quotaname eq 'author') {
9380: $quota = $env{'environment.authorquota'};
9381: } else {
9382: $quota = $env{'environment.portfolioquota'};
9383: }
9384: $inststatus = $env{'environment.inststatus'};
9385: } else {
9386: my %userenv =
9387: &Apache::lonnet::get('environment',['portfolioquota',
9388: 'authorquota','inststatus'],$udom,$uname);
9389: my ($tmp) = keys(%userenv);
9390: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9391: if ($quotaname eq 'author') {
9392: $quota = $userenv{'authorquota'};
9393: } else {
9394: $quota = $userenv{'portfolioquota'};
9395: }
9396: $inststatus = $userenv{'inststatus'};
9397: } else {
9398: undef(%userenv);
9399: }
9400: }
9401: }
9402: if ($quota eq '' || wantarray) {
9403: if ($quotaname eq 'course') {
9404: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9405: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9406: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9407: ($crstype eq 'placement')) {
1.1136 raeburn 9408: $defquota = $domdefs{$crstype.'quota'};
9409: }
9410: if ($defquota eq '') {
9411: $defquota = 500;
9412: }
1.1134 raeburn 9413: } else {
9414: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9415: }
9416: if ($quota eq '') {
9417: $quota = $defquota;
9418: $quotatype = 'default';
9419: } else {
9420: $quotatype = 'custom';
9421: }
1.472 raeburn 9422: }
9423: }
1.536 raeburn 9424: if (wantarray) {
9425: return ($quota,$quotatype,$settingstatus,$defquota);
9426: } else {
9427: return $quota;
9428: }
1.472 raeburn 9429: }
9430:
9431: ###############################################
9432:
9433: =pod
9434:
9435: =item * &default_quota()
9436:
1.536 raeburn 9437: Retrieves default quota assigned for storage of user portfolio files,
9438: given an (optional) user's institutional status.
1.472 raeburn 9439:
9440: Incoming parameters:
1.1142 raeburn 9441:
1.472 raeburn 9442: 1. domain
1.536 raeburn 9443: 2. (Optional) institutional status(es). This is a : separated list of
9444: status types (e.g., faculty, staff, student etc.)
9445: which apply to the user for whom the default is being retrieved.
9446: If the institutional status string in undefined, the domain
1.1134 raeburn 9447: default quota will be returned.
9448: 3. quota name - portfolio, author, or course
9449: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9450:
9451: Returns:
1.1142 raeburn 9452:
1.1163 raeburn 9453: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9454: 2. (Optional) institutional type which determined the value of the
9455: default quota.
1.472 raeburn 9456:
9457: If a value has been stored in the domain's configuration db,
9458: it will return that, otherwise it returns 20 (for backwards
9459: compatibility with domains which have not set up a configuration
1.1163 raeburn 9460: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9461:
1.536 raeburn 9462: If the user's status includes multiple types (e.g., staff and student),
9463: the largest default quota which applies to the user determines the
9464: default quota returned.
9465:
1.472 raeburn 9466: =cut
9467:
9468: ###############################################
9469:
9470:
9471: sub default_quota {
1.1134 raeburn 9472: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9473: my ($defquota,$settingstatus);
9474: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9475: ['quotas'],$udom);
1.1134 raeburn 9476: my $key = 'defaultquota';
9477: if ($quotaname eq 'author') {
9478: $key = 'authorquota';
9479: }
1.622 raeburn 9480: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9481: if ($inststatus ne '') {
1.765 raeburn 9482: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9483: foreach my $item (@statuses) {
1.1134 raeburn 9484: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9485: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9486: if ($defquota eq '') {
1.1134 raeburn 9487: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9488: $settingstatus = $item;
1.1134 raeburn 9489: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9490: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9491: $settingstatus = $item;
9492: }
9493: }
1.1134 raeburn 9494: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9495: if ($quotahash{'quotas'}{$item} ne '') {
9496: if ($defquota eq '') {
9497: $defquota = $quotahash{'quotas'}{$item};
9498: $settingstatus = $item;
9499: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9500: $defquota = $quotahash{'quotas'}{$item};
9501: $settingstatus = $item;
9502: }
1.536 raeburn 9503: }
9504: }
9505: }
9506: }
9507: if ($defquota eq '') {
1.1134 raeburn 9508: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9509: $defquota = $quotahash{'quotas'}{$key}{'default'};
9510: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9511: $defquota = $quotahash{'quotas'}{'default'};
9512: }
1.536 raeburn 9513: $settingstatus = 'default';
1.1139 raeburn 9514: if ($defquota eq '') {
9515: if ($quotaname eq 'author') {
9516: $defquota = 500;
9517: }
9518: }
1.536 raeburn 9519: }
9520: } else {
9521: $settingstatus = 'default';
1.1134 raeburn 9522: if ($quotaname eq 'author') {
9523: $defquota = 500;
9524: } else {
9525: $defquota = 20;
9526: }
1.536 raeburn 9527: }
9528: if (wantarray) {
9529: return ($defquota,$settingstatus);
1.472 raeburn 9530: } else {
1.536 raeburn 9531: return $defquota;
1.472 raeburn 9532: }
9533: }
9534:
1.1135 raeburn 9535: ###############################################
9536:
9537: =pod
9538:
1.1136 raeburn 9539: =item * &excess_filesize_warning()
1.1135 raeburn 9540:
9541: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9542: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9543: space to be exceeded.
1.1136 raeburn 9544:
9545: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9546: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9547:
1.1165 raeburn 9548: Inputs: 7
1.1136 raeburn 9549: 1. username or coursenum
1.1135 raeburn 9550: 2. domain
1.1136 raeburn 9551: 3. context ('author' or 'course')
1.1135 raeburn 9552: 4. filename of file for which action is being requested
9553: 5. filesize (kB) of file
9554: 6. action being taken: copy or upload.
1.1237 raeburn 9555: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 9556:
9557: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9558: otherwise return null.
9559:
9560: =back
1.1135 raeburn 9561:
9562: =cut
9563:
1.1136 raeburn 9564: sub excess_filesize_warning {
1.1165 raeburn 9565: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9566: my $current_disk_usage = 0;
1.1165 raeburn 9567: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9568: if ($context eq 'author') {
9569: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9570: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9571: } else {
9572: foreach my $subdir ('docs','supplemental') {
9573: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9574: }
9575: }
1.1135 raeburn 9576: $disk_quota = int($disk_quota * 1000);
9577: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9578: return '<p class="LC_warning">'.
1.1135 raeburn 9579: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9580: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9581: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9582: $disk_quota,$current_disk_usage).
9583: '</p>';
9584: }
9585: return;
9586: }
9587:
9588: ###############################################
9589:
9590:
1.1136 raeburn 9591:
9592:
1.384 raeburn 9593: sub get_secgrprole_info {
9594: my ($cdom,$cnum,$needroles,$type) = @_;
9595: my %sections_count = &get_sections($cdom,$cnum);
9596: my @sections = (sort {$a <=> $b} keys(%sections_count));
9597: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9598: my @groups = sort(keys(%curr_groups));
9599: my $allroles = [];
9600: my $rolehash;
9601: my $accesshash = {
9602: active => 'Currently has access',
9603: future => 'Will have future access',
9604: previous => 'Previously had access',
9605: };
9606: if ($needroles) {
9607: $rolehash = {'all' => 'all'};
1.385 albertel 9608: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9609: if (&Apache::lonnet::error(%user_roles)) {
9610: undef(%user_roles);
9611: }
9612: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9613: my ($role)=split(/\:/,$item,2);
9614: if ($role eq 'cr') { next; }
9615: if ($role =~ /^cr/) {
9616: $$rolehash{$role} = (split('/',$role))[3];
9617: } else {
9618: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9619: }
9620: }
9621: foreach my $key (sort(keys(%{$rolehash}))) {
9622: push(@{$allroles},$key);
9623: }
9624: push (@{$allroles},'st');
9625: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9626: }
9627: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9628: }
9629:
1.555 raeburn 9630: sub user_picker {
1.994 raeburn 9631: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9632: my $currdom = $dom;
9633: my %curr_selected = (
9634: srchin => 'dom',
1.580 raeburn 9635: srchby => 'lastname',
1.555 raeburn 9636: );
9637: my $srchterm;
1.625 raeburn 9638: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9639: if ($srch->{'srchby'} ne '') {
9640: $curr_selected{'srchby'} = $srch->{'srchby'};
9641: }
9642: if ($srch->{'srchin'} ne '') {
9643: $curr_selected{'srchin'} = $srch->{'srchin'};
9644: }
9645: if ($srch->{'srchtype'} ne '') {
9646: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9647: }
9648: if ($srch->{'srchdomain'} ne '') {
9649: $currdom = $srch->{'srchdomain'};
9650: }
9651: $srchterm = $srch->{'srchterm'};
9652: }
1.1222 damieng 9653: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 9654: 'usr' => 'Search criteria',
1.563 raeburn 9655: 'doma' => 'Domain/institution to search',
1.558 albertel 9656: 'uname' => 'username',
9657: 'lastname' => 'last name',
1.555 raeburn 9658: 'lastfirst' => 'last name, first name',
1.558 albertel 9659: 'crs' => 'in this course',
1.576 raeburn 9660: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9661: 'alc' => 'all LON-CAPA',
1.573 raeburn 9662: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9663: 'exact' => 'is',
9664: 'contains' => 'contains',
1.569 raeburn 9665: 'begins' => 'begins with',
1.1222 damieng 9666: );
9667: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 9668: 'youm' => "You must include some text to search for.",
9669: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9670: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9671: 'yomc' => "You must choose a domain when using an institutional directory search.",
9672: 'ymcd' => "You must choose a domain when using a domain search.",
9673: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9674: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9675: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9676: );
1.1222 damieng 9677: &html_escape(\%html_lt);
9678: &js_escape(\%js_lt);
1.563 raeburn 9679: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9680: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9681:
9682: my @srchins = ('crs','dom','alc','instd');
9683:
9684: foreach my $option (@srchins) {
9685: # FIXME 'alc' option unavailable until
9686: # loncreateuser::print_user_query_page()
9687: # has been completed.
9688: next if ($option eq 'alc');
1.880 raeburn 9689: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9690: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9691: if ($curr_selected{'srchin'} eq $option) {
9692: $srchinsel .= '
1.1222 damieng 9693: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 9694: } else {
9695: $srchinsel .= '
1.1222 damieng 9696: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 9697: }
1.555 raeburn 9698: }
1.563 raeburn 9699: $srchinsel .= "\n </select>\n";
1.555 raeburn 9700:
9701: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9702: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9703: if ($curr_selected{'srchby'} eq $option) {
9704: $srchbysel .= '
1.1222 damieng 9705: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9706: } else {
9707: $srchbysel .= '
1.1222 damieng 9708: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9709: }
9710: }
9711: $srchbysel .= "\n </select>\n";
9712:
9713: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9714: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9715: if ($curr_selected{'srchtype'} eq $option) {
9716: $srchtypesel .= '
1.1222 damieng 9717: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9718: } else {
9719: $srchtypesel .= '
1.1222 damieng 9720: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9721: }
9722: }
9723: $srchtypesel .= "\n </select>\n";
9724:
1.558 albertel 9725: my ($newuserscript,$new_user_create);
1.994 raeburn 9726: my $context_dom = $env{'request.role.domain'};
9727: if ($context eq 'requestcrs') {
9728: if ($env{'form.coursedom'} ne '') {
9729: $context_dom = $env{'form.coursedom'};
9730: }
9731: }
1.556 raeburn 9732: if ($forcenewuser) {
1.576 raeburn 9733: if (ref($srch) eq 'HASH') {
1.994 raeburn 9734: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9735: if ($cancreate) {
9736: $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>';
9737: } else {
1.799 bisitz 9738: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9739: my %usertypetext = (
9740: official => 'institutional',
9741: unofficial => 'non-institutional',
9742: );
1.799 bisitz 9743: $new_user_create = '<p class="LC_warning">'
9744: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9745: .' '
9746: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9747: ,'<a href="'.$helplink.'">','</a>')
9748: .'</p><br />';
1.627 raeburn 9749: }
1.576 raeburn 9750: }
9751: }
9752:
1.556 raeburn 9753: $newuserscript = <<"ENDSCRIPT";
9754:
1.570 raeburn 9755: function setSearch(createnew,callingForm) {
1.556 raeburn 9756: if (createnew == 1) {
1.570 raeburn 9757: for (var i=0; i<callingForm.srchby.length; i++) {
9758: if (callingForm.srchby.options[i].value == 'uname') {
9759: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9760: }
9761: }
1.570 raeburn 9762: for (var i=0; i<callingForm.srchin.length; i++) {
9763: if ( callingForm.srchin.options[i].value == 'dom') {
9764: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9765: }
9766: }
1.570 raeburn 9767: for (var i=0; i<callingForm.srchtype.length; i++) {
9768: if (callingForm.srchtype.options[i].value == 'exact') {
9769: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9770: }
9771: }
1.570 raeburn 9772: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9773: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9774: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9775: }
9776: }
9777: }
9778: }
9779: ENDSCRIPT
1.558 albertel 9780:
1.556 raeburn 9781: }
9782:
1.555 raeburn 9783: my $output = <<"END_BLOCK";
1.556 raeburn 9784: <script type="text/javascript">
1.824 bisitz 9785: // <![CDATA[
1.570 raeburn 9786: function validateEntry(callingForm) {
1.558 albertel 9787:
1.556 raeburn 9788: var checkok = 1;
1.558 albertel 9789: var srchin;
1.570 raeburn 9790: for (var i=0; i<callingForm.srchin.length; i++) {
9791: if ( callingForm.srchin[i].checked ) {
9792: srchin = callingForm.srchin[i].value;
1.558 albertel 9793: }
9794: }
9795:
1.570 raeburn 9796: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9797: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9798: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9799: var srchterm = callingForm.srchterm.value;
9800: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9801: var msg = "";
9802:
9803: if (srchterm == "") {
9804: checkok = 0;
1.1222 damieng 9805: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 9806: }
9807:
1.569 raeburn 9808: if (srchtype== 'begins') {
9809: if (srchterm.length < 2) {
9810: checkok = 0;
1.1222 damieng 9811: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 9812: }
9813: }
9814:
1.556 raeburn 9815: if (srchtype== 'contains') {
9816: if (srchterm.length < 3) {
9817: checkok = 0;
1.1222 damieng 9818: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 9819: }
9820: }
9821: if (srchin == 'instd') {
9822: if (srchdomain == '') {
9823: checkok = 0;
1.1222 damieng 9824: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 9825: }
9826: }
9827: if (srchin == 'dom') {
9828: if (srchdomain == '') {
9829: checkok = 0;
1.1222 damieng 9830: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 9831: }
9832: }
9833: if (srchby == 'lastfirst') {
9834: if (srchterm.indexOf(",") == -1) {
9835: checkok = 0;
1.1222 damieng 9836: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 9837: }
9838: if (srchterm.indexOf(",") == srchterm.length -1) {
9839: checkok = 0;
1.1222 damieng 9840: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 9841: }
9842: }
9843: if (checkok == 0) {
1.1222 damieng 9844: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 9845: return;
9846: }
9847: if (checkok == 1) {
1.570 raeburn 9848: callingForm.submit();
1.556 raeburn 9849: }
9850: }
9851:
9852: $newuserscript
9853:
1.824 bisitz 9854: // ]]>
1.556 raeburn 9855: </script>
1.558 albertel 9856:
9857: $new_user_create
9858:
1.555 raeburn 9859: END_BLOCK
1.558 albertel 9860:
1.876 raeburn 9861: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 9862: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 9863: $domform.
9864: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 9865: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 9866: $srchbysel.
9867: $srchtypesel.
9868: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9869: $srchinsel.
9870: &Apache::lonhtmlcommon::row_closure(1).
9871: &Apache::lonhtmlcommon::end_pick_box().
9872: '<br />';
1.555 raeburn 9873: return $output;
9874: }
9875:
1.612 raeburn 9876: sub user_rule_check {
1.615 raeburn 9877: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 9878: my ($response,%inst_response);
1.612 raeburn 9879: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 9880: if (keys(%{$usershash}) > 1) {
9881: my (%by_username,%by_id,%userdoms);
9882: my $checkid;
9883: if (ref($checks) eq 'HASH') {
9884: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
9885: $checkid = 1;
9886: }
9887: }
9888: foreach my $user (keys(%{$usershash})) {
9889: my ($uname,$udom) = split(/:/,$user);
9890: if ($checkid) {
9891: if (ref($usershash->{$user}) eq 'HASH') {
9892: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 9893: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 9894: $userdoms{$udom} = 1;
1.1227 raeburn 9895: if (ref($inst_results) eq 'HASH') {
9896: $inst_results->{$uname.':'.$udom} = {};
9897: }
1.1226 raeburn 9898: }
9899: }
9900: } else {
9901: $by_username{$udom}{$uname} = 1;
9902: $userdoms{$udom} = 1;
1.1227 raeburn 9903: if (ref($inst_results) eq 'HASH') {
9904: $inst_results->{$uname.':'.$udom} = {};
9905: }
1.1226 raeburn 9906: }
9907: }
9908: foreach my $udom (keys(%userdoms)) {
9909: if (!$got_rules->{$udom}) {
9910: my %domconfig = &Apache::lonnet::get_dom('configuration',
9911: ['usercreation'],$udom);
9912: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9913: foreach my $item ('username','id') {
9914: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 9915: $$curr_rules{$udom}{$item} =
9916: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 9917: }
9918: }
9919: }
9920: $got_rules->{$udom} = 1;
9921: }
1.612 raeburn 9922: }
1.1226 raeburn 9923: if ($checkid) {
9924: foreach my $udom (keys(%by_id)) {
9925: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
9926: if ($outcome eq 'ok') {
1.1227 raeburn 9927: foreach my $id (keys(%{$by_id{$udom}})) {
9928: my $uname = $by_id{$udom}{$id};
9929: $inst_response{$uname.':'.$udom} = $outcome;
9930: }
1.1226 raeburn 9931: if (ref($results) eq 'HASH') {
9932: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 9933: if (exists($inst_response{$uname.':'.$udom})) {
9934: $inst_response{$uname.':'.$udom} = $outcome;
9935: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9936: }
1.1226 raeburn 9937: }
9938: }
9939: }
1.612 raeburn 9940: }
1.615 raeburn 9941: } else {
1.1226 raeburn 9942: foreach my $udom (keys(%by_username)) {
9943: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
9944: if ($outcome eq 'ok') {
1.1227 raeburn 9945: foreach my $uname (keys(%{$by_username{$udom}})) {
9946: $inst_response{$uname.':'.$udom} = $outcome;
9947: }
1.1226 raeburn 9948: if (ref($results) eq 'HASH') {
9949: foreach my $uname (keys(%{$results})) {
9950: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9951: }
9952: }
9953: }
9954: }
1.612 raeburn 9955: }
1.1226 raeburn 9956: } elsif (keys(%{$usershash}) == 1) {
9957: my $user = (keys(%{$usershash}))[0];
9958: my ($uname,$udom) = split(/:/,$user);
9959: if (($udom ne '') && ($uname ne '')) {
9960: if (ref($usershash->{$user}) eq 'HASH') {
9961: if (ref($checks) eq 'HASH') {
9962: if (defined($checks->{'username'})) {
9963: ($inst_response{$user},%{$inst_results->{$user}}) =
9964: &Apache::lonnet::get_instuser($udom,$uname);
9965: } elsif (defined($checks->{'id'})) {
9966: if ($usershash->{$user}->{'id'} ne '') {
9967: ($inst_response{$user},%{$inst_results->{$user}}) =
9968: &Apache::lonnet::get_instuser($udom,undef,
9969: $usershash->{$user}->{'id'});
9970: } else {
9971: ($inst_response{$user},%{$inst_results->{$user}}) =
9972: &Apache::lonnet::get_instuser($udom,$uname);
9973: }
1.585 raeburn 9974: }
1.1226 raeburn 9975: } else {
9976: ($inst_response{$user},%{$inst_results->{$user}}) =
9977: &Apache::lonnet::get_instuser($udom,$uname);
9978: return;
9979: }
9980: if (!$got_rules->{$udom}) {
9981: my %domconfig = &Apache::lonnet::get_dom('configuration',
9982: ['usercreation'],$udom);
9983: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9984: foreach my $item ('username','id') {
9985: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9986: $$curr_rules{$udom}{$item} =
9987: $domconfig{'usercreation'}{$item.'_rule'};
9988: }
9989: }
9990: }
9991: $got_rules->{$udom} = 1;
1.585 raeburn 9992: }
9993: }
1.1226 raeburn 9994: } else {
9995: return;
9996: }
9997: } else {
9998: return;
9999: }
10000: foreach my $user (keys(%{$usershash})) {
10001: my ($uname,$udom) = split(/:/,$user);
10002: next if (($udom eq '') || ($uname eq ''));
10003: my $id;
1.1227 raeburn 10004: if (ref($inst_results) eq 'HASH') {
10005: if (ref($inst_results->{$user}) eq 'HASH') {
10006: $id = $inst_results->{$user}->{'id'};
10007: }
10008: }
10009: if ($id eq '') {
10010: if (ref($usershash->{$user})) {
10011: $id = $usershash->{$user}->{'id'};
10012: }
1.585 raeburn 10013: }
1.612 raeburn 10014: foreach my $item (keys(%{$checks})) {
10015: if (ref($$curr_rules{$udom}) eq 'HASH') {
10016: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10017: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10018: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10019: $$curr_rules{$udom}{$item});
1.612 raeburn 10020: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10021: if ($rule_check{$rule}) {
10022: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10023: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10024: if (ref($inst_results) eq 'HASH') {
10025: if (ref($inst_results->{$user}) eq 'HASH') {
10026: if (keys(%{$inst_results->{$user}}) == 0) {
10027: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10028: } elsif ($item eq 'id') {
10029: if ($inst_results->{$user}->{'id'} eq '') {
10030: $$alerts{$item}{$udom}{$uname} = 1;
10031: }
1.615 raeburn 10032: }
1.612 raeburn 10033: }
10034: }
1.615 raeburn 10035: }
10036: last;
1.585 raeburn 10037: }
10038: }
10039: }
10040: }
10041: }
10042: }
10043: }
10044: }
1.612 raeburn 10045: return;
10046: }
10047:
10048: sub user_rule_formats {
10049: my ($domain,$domdesc,$curr_rules,$check) = @_;
10050: my %text = (
10051: 'username' => 'Usernames',
10052: 'id' => 'IDs',
10053: );
10054: my $output;
10055: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10056: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10057: if (@{$ruleorder} > 0) {
1.1102 raeburn 10058: $output = '<br />'.
10059: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10060: '<span class="LC_cusr_emph">','</span>',$domdesc).
10061: ' <ul>';
1.612 raeburn 10062: foreach my $rule (@{$ruleorder}) {
10063: if (ref($curr_rules) eq 'ARRAY') {
10064: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10065: if (ref($rules->{$rule}) eq 'HASH') {
10066: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10067: $rules->{$rule}{'desc'}.'</li>';
10068: }
10069: }
10070: }
10071: }
10072: $output .= '</ul>';
10073: }
10074: }
10075: return $output;
10076: }
10077:
10078: sub instrule_disallow_msg {
1.615 raeburn 10079: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10080: my $response;
10081: my %text = (
10082: item => 'username',
10083: items => 'usernames',
10084: match => 'matches',
10085: do => 'does',
10086: action => 'a username',
10087: one => 'one',
10088: );
10089: if ($count > 1) {
10090: $text{'item'} = 'usernames';
10091: $text{'match'} ='match';
10092: $text{'do'} = 'do';
10093: $text{'action'} = 'usernames',
10094: $text{'one'} = 'ones';
10095: }
10096: if ($checkitem eq 'id') {
10097: $text{'items'} = 'IDs';
10098: $text{'item'} = 'ID';
10099: $text{'action'} = 'an ID';
1.615 raeburn 10100: if ($count > 1) {
10101: $text{'item'} = 'IDs';
10102: $text{'action'} = 'IDs';
10103: }
1.612 raeburn 10104: }
1.674 bisitz 10105: $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 10106: if ($mode eq 'upload') {
10107: if ($checkitem eq 'username') {
10108: $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'}.");
10109: } elsif ($checkitem eq 'id') {
1.674 bisitz 10110: $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 10111: }
1.669 raeburn 10112: } elsif ($mode eq 'selfcreate') {
10113: if ($checkitem eq 'id') {
10114: $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.");
10115: }
1.615 raeburn 10116: } else {
10117: if ($checkitem eq 'username') {
10118: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10119: } elsif ($checkitem eq 'id') {
10120: $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.");
10121: }
1.612 raeburn 10122: }
10123: return $response;
1.585 raeburn 10124: }
10125:
1.624 raeburn 10126: sub personal_data_fieldtitles {
10127: my %fieldtitles = &Apache::lonlocal::texthash (
10128: id => 'Student/Employee ID',
10129: permanentemail => 'E-mail address',
10130: lastname => 'Last Name',
10131: firstname => 'First Name',
10132: middlename => 'Middle Name',
10133: generation => 'Generation',
10134: gen => 'Generation',
1.765 raeburn 10135: inststatus => 'Affiliation',
1.624 raeburn 10136: );
10137: return %fieldtitles;
10138: }
10139:
1.642 raeburn 10140: sub sorted_inst_types {
10141: my ($dom) = @_;
1.1185 raeburn 10142: my ($usertypes,$order);
10143: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10144: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10145: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10146: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10147: } else {
10148: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10149: }
1.642 raeburn 10150: my $othertitle = &mt('All users');
10151: if ($env{'request.course.id'}) {
1.668 raeburn 10152: $othertitle = &mt('Any users');
1.642 raeburn 10153: }
10154: my @types;
10155: if (ref($order) eq 'ARRAY') {
10156: @types = @{$order};
10157: }
10158: if (@types == 0) {
10159: if (ref($usertypes) eq 'HASH') {
10160: @types = sort(keys(%{$usertypes}));
10161: }
10162: }
10163: if (keys(%{$usertypes}) > 0) {
10164: $othertitle = &mt('Other users');
10165: }
10166: return ($othertitle,$usertypes,\@types);
10167: }
10168:
1.645 raeburn 10169: sub get_institutional_codes {
10170: my ($settings,$allcourses,$LC_code) = @_;
10171: # Get complete list of course sections to update
10172: my @currsections = ();
10173: my @currxlists = ();
10174: my $coursecode = $$settings{'internal.coursecode'};
10175:
10176: if ($$settings{'internal.sectionnums'} ne '') {
10177: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10178: }
10179:
10180: if ($$settings{'internal.crosslistings'} ne '') {
10181: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10182: }
10183:
10184: if (@currxlists > 0) {
10185: foreach (@currxlists) {
10186: if (m/^([^:]+):(\w*)$/) {
10187: unless (grep/^$1$/,@{$allcourses}) {
10188: push @{$allcourses},$1;
10189: $$LC_code{$1} = $2;
10190: }
10191: }
10192: }
10193: }
10194:
10195: if (@currsections > 0) {
10196: foreach (@currsections) {
10197: if (m/^(\w+):(\w*)$/) {
10198: my $sec = $coursecode.$1;
10199: my $lc_sec = $2;
10200: unless (grep/^$sec$/,@{$allcourses}) {
10201: push @{$allcourses},$sec;
10202: $$LC_code{$sec} = $lc_sec;
10203: }
10204: }
10205: }
10206: }
10207: return;
10208: }
10209:
1.971 raeburn 10210: sub get_standard_codeitems {
10211: return ('Year','Semester','Department','Number','Section');
10212: }
10213:
1.112 bowersj2 10214: =pod
10215:
1.780 raeburn 10216: =head1 Slot Helpers
10217:
10218: =over 4
10219:
10220: =item * sorted_slots()
10221:
1.1040 raeburn 10222: Sorts an array of slot names in order of an optional sort key,
10223: default sort is by slot start time (earliest first).
1.780 raeburn 10224:
10225: Inputs:
10226:
10227: =over 4
10228:
10229: slotsarr - Reference to array of unsorted slot names.
10230:
10231: slots - Reference to hash of hash, where outer hash keys are slot names.
10232:
1.1040 raeburn 10233: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10234:
1.549 albertel 10235: =back
10236:
1.780 raeburn 10237: Returns:
10238:
10239: =over 4
10240:
1.1040 raeburn 10241: sorted - An array of slot names sorted by a specified sort key
10242: (default sort key is start time of the slot).
1.780 raeburn 10243:
10244: =back
10245:
10246: =cut
10247:
10248:
10249: sub sorted_slots {
1.1040 raeburn 10250: my ($slotsarr,$slots,$sortkey) = @_;
10251: if ($sortkey eq '') {
10252: $sortkey = 'starttime';
10253: }
1.780 raeburn 10254: my @sorted;
10255: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10256: @sorted =
10257: sort {
10258: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10259: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10260: }
10261: if (ref($slots->{$a})) { return -1;}
10262: if (ref($slots->{$b})) { return 1;}
10263: return 0;
10264: } @{$slotsarr};
10265: }
10266: return @sorted;
10267: }
10268:
1.1040 raeburn 10269: =pod
10270:
10271: =item * get_future_slots()
10272:
10273: Inputs:
10274:
10275: =over 4
10276:
10277: cnum - course number
10278:
10279: cdom - course domain
10280:
10281: now - current UNIX time
10282:
10283: symb - optional symb
10284:
10285: =back
10286:
10287: Returns:
10288:
10289: =over 4
10290:
10291: sorted_reservable - ref to array of student_schedulable slots currently
10292: reservable, ordered by end date of reservation period.
10293:
10294: reservable_now - ref to hash of student_schedulable slots currently
10295: reservable.
10296:
10297: Keys in inner hash are:
10298: (a) symb: either blank or symb to which slot use is restricted.
10299: (b) endreserve: end date of reservation period.
10300:
10301: sorted_future - ref to array of student_schedulable slots reservable in
10302: the future, ordered by start date of reservation period.
10303:
10304: future_reservable - ref to hash of student_schedulable slots reservable
10305: in the future.
10306:
10307: Keys in inner hash are:
10308: (a) symb: either blank or symb to which slot use is restricted.
10309: (b) startreserve: start date of reservation period.
10310:
10311: =back
10312:
10313: =cut
10314:
10315: sub get_future_slots {
10316: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10317: my $map;
10318: if ($symb) {
10319: ($map) = &Apache::lonnet::decode_symb($symb);
10320: }
1.1040 raeburn 10321: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10322: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10323: foreach my $slot (keys(%slots)) {
10324: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10325: if ($symb) {
1.1229 raeburn 10326: if ($slots{$slot}->{'symb'} ne '') {
10327: my $canuse;
10328: my %oksymbs;
10329: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10330: map { $oksymbs{$_} = 1; } @slotsymbs;
10331: if ($oksymbs{$symb}) {
10332: $canuse = 1;
10333: } else {
10334: foreach my $item (@slotsymbs) {
10335: if ($item =~ /\.(page|sequence)$/) {
10336: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10337: if (($map ne '') && ($map eq $sloturl)) {
10338: $canuse = 1;
10339: last;
10340: }
10341: }
10342: }
10343: }
10344: next unless ($canuse);
10345: }
1.1040 raeburn 10346: }
10347: if (($slots{$slot}->{'starttime'} > $now) &&
10348: ($slots{$slot}->{'endtime'} > $now)) {
10349: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10350: my $userallowed = 0;
10351: if ($slots{$slot}->{'allowedsections'}) {
10352: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10353: if (!defined($env{'request.role.sec'})
10354: && grep(/^No section assigned$/,@allowed_sec)) {
10355: $userallowed=1;
10356: } else {
10357: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10358: $userallowed=1;
10359: }
10360: }
10361: unless ($userallowed) {
10362: if (defined($env{'request.course.groups'})) {
10363: my @groups = split(/:/,$env{'request.course.groups'});
10364: foreach my $group (@groups) {
10365: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10366: $userallowed=1;
10367: last;
10368: }
10369: }
10370: }
10371: }
10372: }
10373: if ($slots{$slot}->{'allowedusers'}) {
10374: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10375: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10376: if (grep(/^\Q$user\E$/,@allowed_users)) {
10377: $userallowed = 1;
10378: }
10379: }
10380: next unless($userallowed);
10381: }
10382: my $startreserve = $slots{$slot}->{'startreserve'};
10383: my $endreserve = $slots{$slot}->{'endreserve'};
10384: my $symb = $slots{$slot}->{'symb'};
10385: if (($startreserve < $now) &&
10386: (!$endreserve || $endreserve > $now)) {
10387: my $lastres = $endreserve;
10388: if (!$lastres) {
10389: $lastres = $slots{$slot}->{'starttime'};
10390: }
10391: $reservable_now{$slot} = {
10392: symb => $symb,
10393: endreserve => $lastres
10394: };
10395: } elsif (($startreserve > $now) &&
10396: (!$endreserve || $endreserve > $startreserve)) {
10397: $future_reservable{$slot} = {
10398: symb => $symb,
10399: startreserve => $startreserve
10400: };
10401: }
10402: }
10403: }
10404: my @unsorted_reservable = keys(%reservable_now);
10405: if (@unsorted_reservable > 0) {
10406: @sorted_reservable =
10407: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10408: }
10409: my @unsorted_future = keys(%future_reservable);
10410: if (@unsorted_future > 0) {
10411: @sorted_future =
10412: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10413: }
10414: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10415: }
1.780 raeburn 10416:
10417: =pod
10418:
1.1057 foxr 10419: =back
10420:
1.549 albertel 10421: =head1 HTTP Helpers
10422:
10423: =over 4
10424:
1.648 raeburn 10425: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10426:
1.258 albertel 10427: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10428: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10429: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10430:
10431: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10432: $possible_names is an ref to an array of form element names. As an example:
10433: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10434: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10435:
10436: =cut
1.1 albertel 10437:
1.6 albertel 10438: sub get_unprocessed_cgi {
1.25 albertel 10439: my ($query,$possible_names)= @_;
1.26 matthew 10440: # $Apache::lonxml::debug=1;
1.356 albertel 10441: foreach my $pair (split(/&/,$query)) {
10442: my ($name, $value) = split(/=/,$pair);
1.369 www 10443: $name = &unescape($name);
1.25 albertel 10444: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10445: $value =~ tr/+/ /;
10446: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10447: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10448: }
1.16 harris41 10449: }
1.6 albertel 10450: }
10451:
1.112 bowersj2 10452: =pod
10453:
1.648 raeburn 10454: =item * &cacheheader()
1.112 bowersj2 10455:
10456: returns cache-controlling header code
10457:
10458: =cut
10459:
1.7 albertel 10460: sub cacheheader {
1.258 albertel 10461: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10462: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10463: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10464: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10465: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10466: return $output;
1.7 albertel 10467: }
10468:
1.112 bowersj2 10469: =pod
10470:
1.648 raeburn 10471: =item * &no_cache($r)
1.112 bowersj2 10472:
10473: specifies header code to not have cache
10474:
10475: =cut
10476:
1.9 albertel 10477: sub no_cache {
1.216 albertel 10478: my ($r) = @_;
10479: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10480: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10481: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10482: $r->no_cache(1);
10483: $r->header_out("Expires" => $date);
10484: $r->header_out("Pragma" => "no-cache");
1.123 www 10485: }
10486:
10487: sub content_type {
1.181 albertel 10488: my ($r,$type,$charset) = @_;
1.299 foxr 10489: if ($r) {
10490: # Note that printout.pl calls this with undef for $r.
10491: &no_cache($r);
10492: }
1.258 albertel 10493: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10494: unless ($charset) {
10495: $charset=&Apache::lonlocal::current_encoding;
10496: }
10497: if ($charset) { $type.='; charset='.$charset; }
10498: if ($r) {
10499: $r->content_type($type);
10500: } else {
10501: print("Content-type: $type\n\n");
10502: }
1.9 albertel 10503: }
1.25 albertel 10504:
1.112 bowersj2 10505: =pod
10506:
1.648 raeburn 10507: =item * &add_to_env($name,$value)
1.112 bowersj2 10508:
1.258 albertel 10509: adds $name to the %env hash with value
1.112 bowersj2 10510: $value, if $name already exists, the entry is converted to an array
10511: reference and $value is added to the array.
10512:
10513: =cut
10514:
1.25 albertel 10515: sub add_to_env {
10516: my ($name,$value)=@_;
1.258 albertel 10517: if (defined($env{$name})) {
10518: if (ref($env{$name})) {
1.25 albertel 10519: #already have multiple values
1.258 albertel 10520: push(@{ $env{$name} },$value);
1.25 albertel 10521: } else {
10522: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10523: my $first=$env{$name};
10524: undef($env{$name});
10525: push(@{ $env{$name} },$first,$value);
1.25 albertel 10526: }
10527: } else {
1.258 albertel 10528: $env{$name}=$value;
1.25 albertel 10529: }
1.31 albertel 10530: }
1.149 albertel 10531:
10532: =pod
10533:
1.648 raeburn 10534: =item * &get_env_multiple($name)
1.149 albertel 10535:
1.258 albertel 10536: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10537: values may be defined and end up as an array ref.
10538:
10539: returns an array of values
10540:
10541: =cut
10542:
10543: sub get_env_multiple {
10544: my ($name) = @_;
10545: my @values;
1.258 albertel 10546: if (defined($env{$name})) {
1.149 albertel 10547: # exists is it an array
1.258 albertel 10548: if (ref($env{$name})) {
10549: @values=@{ $env{$name} };
1.149 albertel 10550: } else {
1.258 albertel 10551: $values[0]=$env{$name};
1.149 albertel 10552: }
10553: }
10554: return(@values);
10555: }
10556:
1.660 raeburn 10557: sub ask_for_embedded_content {
10558: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10559: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10560: %currsubfile,%unused,$rem);
1.1071 raeburn 10561: my $counter = 0;
10562: my $numnew = 0;
1.987 raeburn 10563: my $numremref = 0;
10564: my $numinvalid = 0;
10565: my $numpathchg = 0;
10566: my $numexisting = 0;
1.1071 raeburn 10567: my $numunused = 0;
10568: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10569: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10570: my $heading = &mt('Upload embedded files');
10571: my $buttontext = &mt('Upload');
10572:
1.1085 raeburn 10573: if ($env{'request.course.id'}) {
1.1123 raeburn 10574: if ($actionurl eq '/adm/dependencies') {
10575: $navmap = Apache::lonnavmaps::navmap->new();
10576: }
10577: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10578: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10579: }
1.1123 raeburn 10580: if (($actionurl eq '/adm/portfolio') ||
10581: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10582: my $current_path='/';
10583: if ($env{'form.currentpath'}) {
10584: $current_path = $env{'form.currentpath'};
10585: }
10586: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10587: $udom = $cdom;
10588: $uname = $cnum;
1.984 raeburn 10589: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10590: } else {
10591: $udom = $env{'user.domain'};
10592: $uname = $env{'user.name'};
10593: $url = '/userfiles/portfolio';
10594: }
1.987 raeburn 10595: $toplevel = $url.'/';
1.984 raeburn 10596: $url .= $current_path;
10597: $getpropath = 1;
1.987 raeburn 10598: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10599: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10600: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10601: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10602: $toplevel = $url;
1.984 raeburn 10603: if ($rest ne '') {
1.987 raeburn 10604: $url .= $rest;
10605: }
10606: } elsif ($actionurl eq '/adm/coursedocs') {
10607: if (ref($args) eq 'HASH') {
1.1071 raeburn 10608: $url = $args->{'docs_url'};
10609: $toplevel = $url;
1.1084 raeburn 10610: if ($args->{'context'} eq 'paste') {
10611: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10612: ($path) =
10613: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10614: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10615: $fileloc =~ s{^/}{};
10616: }
1.1071 raeburn 10617: }
1.1084 raeburn 10618: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 10619: if ($env{'request.course.id'} ne '') {
10620: if (ref($args) eq 'HASH') {
10621: $url = $args->{'docs_url'};
10622: $title = $args->{'docs_title'};
1.1126 raeburn 10623: $toplevel = $url;
10624: unless ($toplevel =~ m{^/}) {
10625: $toplevel = "/$url";
10626: }
1.1085 raeburn 10627: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 10628: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10629: $path = $1;
10630: } else {
10631: ($path) =
10632: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10633: }
1.1195 raeburn 10634: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10635: $fileloc = $toplevel;
10636: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10637: my ($udom,$uname,$fname) =
10638: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10639: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10640: } else {
10641: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10642: }
1.1071 raeburn 10643: $fileloc =~ s{^/}{};
10644: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10645: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10646: }
1.987 raeburn 10647: }
1.1123 raeburn 10648: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10649: $udom = $cdom;
10650: $uname = $cnum;
10651: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10652: $toplevel = $url;
10653: $path = $url;
10654: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10655: $fileloc =~ s{^/}{};
1.987 raeburn 10656: }
1.1126 raeburn 10657: foreach my $file (keys(%{$allfiles})) {
10658: my $embed_file;
10659: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10660: $embed_file = $1;
10661: } else {
10662: $embed_file = $file;
10663: }
1.1158 raeburn 10664: my ($absolutepath,$cleaned_file);
10665: if ($embed_file =~ m{^\w+://}) {
10666: $cleaned_file = $embed_file;
1.1147 raeburn 10667: $newfiles{$cleaned_file} = 1;
10668: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10669: } else {
1.1158 raeburn 10670: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10671: if ($embed_file =~ m{^/}) {
10672: $absolutepath = $embed_file;
10673: }
1.1147 raeburn 10674: if ($cleaned_file =~ m{/}) {
10675: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10676: $path = &check_for_traversal($path,$url,$toplevel);
10677: my $item = $fname;
10678: if ($path ne '') {
10679: $item = $path.'/'.$fname;
10680: $subdependencies{$path}{$fname} = 1;
10681: } else {
10682: $dependencies{$item} = 1;
10683: }
10684: if ($absolutepath) {
10685: $mapping{$item} = $absolutepath;
10686: } else {
10687: $mapping{$item} = $embed_file;
10688: }
10689: } else {
10690: $dependencies{$embed_file} = 1;
10691: if ($absolutepath) {
1.1147 raeburn 10692: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10693: } else {
1.1147 raeburn 10694: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10695: }
10696: }
1.984 raeburn 10697: }
10698: }
1.1071 raeburn 10699: my $dirptr = 16384;
1.984 raeburn 10700: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10701: $currsubfile{$path} = {};
1.1123 raeburn 10702: if (($actionurl eq '/adm/portfolio') ||
10703: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10704: my ($sublistref,$listerror) =
10705: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10706: if (ref($sublistref) eq 'ARRAY') {
10707: foreach my $line (@{$sublistref}) {
10708: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10709: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10710: }
1.984 raeburn 10711: }
1.987 raeburn 10712: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10713: if (opendir(my $dir,$url.'/'.$path)) {
10714: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10715: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10716: }
1.1084 raeburn 10717: } elsif (($actionurl eq '/adm/dependencies') ||
10718: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10719: ($args->{'context'} eq 'paste')) ||
10720: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10721: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10722: my $dir;
10723: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10724: $dir = $fileloc;
10725: } else {
10726: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10727: }
1.1071 raeburn 10728: if ($dir ne '') {
10729: my ($sublistref,$listerror) =
10730: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10731: if (ref($sublistref) eq 'ARRAY') {
10732: foreach my $line (@{$sublistref}) {
10733: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10734: undef,$mtime)=split(/\&/,$line,12);
10735: unless (($testdir&$dirptr) ||
10736: ($file_name =~ /^\.\.?$/)) {
10737: $currsubfile{$path}{$file_name} = [$size,$mtime];
10738: }
10739: }
10740: }
10741: }
1.984 raeburn 10742: }
10743: }
10744: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10745: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10746: my $item = $path.'/'.$file;
10747: unless ($mapping{$item} eq $item) {
10748: $pathchanges{$item} = 1;
10749: }
10750: $existing{$item} = 1;
10751: $numexisting ++;
10752: } else {
10753: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10754: }
10755: }
1.1071 raeburn 10756: if ($actionurl eq '/adm/dependencies') {
10757: foreach my $path (keys(%currsubfile)) {
10758: if (ref($currsubfile{$path}) eq 'HASH') {
10759: foreach my $file (keys(%{$currsubfile{$path}})) {
10760: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10761: next if (($rem ne '') &&
10762: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10763: (ref($navmap) &&
10764: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10765: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10766: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10767: $unused{$path.'/'.$file} = 1;
10768: }
10769: }
10770: }
10771: }
10772: }
1.984 raeburn 10773: }
1.987 raeburn 10774: my %currfile;
1.1123 raeburn 10775: if (($actionurl eq '/adm/portfolio') ||
10776: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10777: my ($dirlistref,$listerror) =
10778: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10779: if (ref($dirlistref) eq 'ARRAY') {
10780: foreach my $line (@{$dirlistref}) {
10781: my ($file_name,$rest) = split(/\&/,$line,2);
10782: $currfile{$file_name} = 1;
10783: }
1.984 raeburn 10784: }
1.987 raeburn 10785: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10786: if (opendir(my $dir,$url)) {
1.987 raeburn 10787: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10788: map {$currfile{$_} = 1;} @dir_list;
10789: }
1.1084 raeburn 10790: } elsif (($actionurl eq '/adm/dependencies') ||
10791: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10792: ($args->{'context'} eq 'paste')) ||
10793: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10794: if ($env{'request.course.id'} ne '') {
10795: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10796: if ($dir ne '') {
10797: my ($dirlistref,$listerror) =
10798: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10799: if (ref($dirlistref) eq 'ARRAY') {
10800: foreach my $line (@{$dirlistref}) {
10801: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10802: $size,undef,$mtime)=split(/\&/,$line,12);
10803: unless (($testdir&$dirptr) ||
10804: ($file_name =~ /^\.\.?$/)) {
10805: $currfile{$file_name} = [$size,$mtime];
10806: }
10807: }
10808: }
10809: }
10810: }
1.984 raeburn 10811: }
10812: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10813: if (exists($currfile{$file})) {
1.987 raeburn 10814: unless ($mapping{$file} eq $file) {
10815: $pathchanges{$file} = 1;
10816: }
10817: $existing{$file} = 1;
10818: $numexisting ++;
10819: } else {
1.984 raeburn 10820: $newfiles{$file} = 1;
10821: }
10822: }
1.1071 raeburn 10823: foreach my $file (keys(%currfile)) {
10824: unless (($file eq $filename) ||
10825: ($file eq $filename.'.bak') ||
10826: ($dependencies{$file})) {
1.1085 raeburn 10827: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10828: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10829: next if (($rem ne '') &&
10830: (($env{"httpref.$rem".$file} ne '') ||
10831: (ref($navmap) &&
10832: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10833: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10834: ($navmap->getResourceByUrl($rem.$1)))))));
10835: }
1.1085 raeburn 10836: }
1.1071 raeburn 10837: $unused{$file} = 1;
10838: }
10839: }
1.1084 raeburn 10840: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10841: ($args->{'context'} eq 'paste')) {
10842: $counter = scalar(keys(%existing));
10843: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10844: return ($output,$counter,$numpathchg,\%existing);
10845: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10846: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10847: $counter = scalar(keys(%existing));
10848: $numpathchg = scalar(keys(%pathchanges));
10849: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10850: }
1.984 raeburn 10851: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10852: if ($actionurl eq '/adm/dependencies') {
10853: next if ($embed_file =~ m{^\w+://});
10854: }
1.660 raeburn 10855: $upload_output .= &start_data_table_row().
1.1123 raeburn 10856: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10857: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10858: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10859: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10860: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10861: }
1.1123 raeburn 10862: $upload_output .= '</td>';
1.1071 raeburn 10863: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10864: $upload_output.='<td align="right">'.
10865: '<span class="LC_info LC_fontsize_medium">'.
10866: &mt("URL points to web address").'</span>';
1.987 raeburn 10867: $numremref++;
1.660 raeburn 10868: } elsif ($args->{'error_on_invalid_names'}
10869: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10870: $upload_output.='<td align="right"><span class="LC_warning">'.
10871: &mt('Invalid characters').'</span>';
1.987 raeburn 10872: $numinvalid++;
1.660 raeburn 10873: } else {
1.1123 raeburn 10874: $upload_output .= '<td>'.
10875: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10876: $embed_file,\%mapping,
1.1071 raeburn 10877: $allfiles,$codebase,'upload');
10878: $counter ++;
10879: $numnew ++;
1.987 raeburn 10880: }
10881: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10882: }
10883: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10884: if ($actionurl eq '/adm/dependencies') {
10885: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10886: $modify_output .= &start_data_table_row().
10887: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10888: '<img src="'.&icon($embed_file).'" border="0" />'.
10889: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10890: '<td>'.$size.'</td>'.
10891: '<td>'.$mtime.'</td>'.
10892: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10893: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10894: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10895: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10896: &embedded_file_element('upload_embedded',$counter,
10897: $embed_file,\%mapping,
10898: $allfiles,$codebase,'modify').
10899: '</div></td>'.
10900: &end_data_table_row()."\n";
10901: $counter ++;
10902: } else {
10903: $upload_output .= &start_data_table_row().
1.1123 raeburn 10904: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10905: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10906: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10907: &Apache::loncommon::end_data_table_row()."\n";
10908: }
10909: }
10910: my $delidx = $counter;
10911: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10912: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10913: $delete_output .= &start_data_table_row().
10914: '<td><img src="'.&icon($oldfile).'" />'.
10915: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10916: '<td>'.$size.'</td>'.
10917: '<td>'.$mtime.'</td>'.
10918: '<td><label><input type="checkbox" name="del_upload_dep" '.
10919: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10920: &embedded_file_element('upload_embedded',$delidx,
10921: $oldfile,\%mapping,$allfiles,
10922: $codebase,'delete').'</td>'.
10923: &end_data_table_row()."\n";
10924: $numunused ++;
10925: $delidx ++;
1.987 raeburn 10926: }
10927: if ($upload_output) {
10928: $upload_output = &start_data_table().
10929: $upload_output.
10930: &end_data_table()."\n";
10931: }
1.1071 raeburn 10932: if ($modify_output) {
10933: $modify_output = &start_data_table().
10934: &start_data_table_header_row().
10935: '<th>'.&mt('File').'</th>'.
10936: '<th>'.&mt('Size (KB)').'</th>'.
10937: '<th>'.&mt('Modified').'</th>'.
10938: '<th>'.&mt('Upload replacement?').'</th>'.
10939: &end_data_table_header_row().
10940: $modify_output.
10941: &end_data_table()."\n";
10942: }
10943: if ($delete_output) {
10944: $delete_output = &start_data_table().
10945: &start_data_table_header_row().
10946: '<th>'.&mt('File').'</th>'.
10947: '<th>'.&mt('Size (KB)').'</th>'.
10948: '<th>'.&mt('Modified').'</th>'.
10949: '<th>'.&mt('Delete?').'</th>'.
10950: &end_data_table_header_row().
10951: $delete_output.
10952: &end_data_table()."\n";
10953: }
1.987 raeburn 10954: my $applies = 0;
10955: if ($numremref) {
10956: $applies ++;
10957: }
10958: if ($numinvalid) {
10959: $applies ++;
10960: }
10961: if ($numexisting) {
10962: $applies ++;
10963: }
1.1071 raeburn 10964: if ($counter || $numunused) {
1.987 raeburn 10965: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10966: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10967: $state.'<h3>'.$heading.'</h3>';
10968: if ($actionurl eq '/adm/dependencies') {
10969: if ($numnew) {
10970: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10971: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10972: $upload_output.'<br />'."\n";
10973: }
10974: if ($numexisting) {
10975: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10976: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10977: $modify_output.'<br />'."\n";
10978: $buttontext = &mt('Save changes');
10979: }
10980: if ($numunused) {
10981: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10982: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10983: $delete_output.'<br />'."\n";
10984: $buttontext = &mt('Save changes');
10985: }
10986: } else {
10987: $output .= $upload_output.'<br />'."\n";
10988: }
10989: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10990: $counter.'" />'."\n";
10991: if ($actionurl eq '/adm/dependencies') {
10992: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10993: $numnew.'" />'."\n";
10994: } elsif ($actionurl eq '') {
1.987 raeburn 10995: $output .= '<input type="hidden" name="phase" value="three" />';
10996: }
10997: } elsif ($applies) {
10998: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10999: if ($applies > 1) {
11000: $output .=
1.1123 raeburn 11001: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11002: if ($numremref) {
11003: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11004: }
11005: if ($numinvalid) {
11006: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11007: }
11008: if ($numexisting) {
11009: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11010: }
11011: $output .= '</ul><br />';
11012: } elsif ($numremref) {
11013: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11014: } elsif ($numinvalid) {
11015: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11016: } elsif ($numexisting) {
11017: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11018: }
11019: $output .= $upload_output.'<br />';
11020: }
11021: my ($pathchange_output,$chgcount);
1.1071 raeburn 11022: $chgcount = $counter;
1.987 raeburn 11023: if (keys(%pathchanges) > 0) {
11024: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11025: if ($counter) {
1.987 raeburn 11026: $output .= &embedded_file_element('pathchange',$chgcount,
11027: $embed_file,\%mapping,
1.1071 raeburn 11028: $allfiles,$codebase,'change');
1.987 raeburn 11029: } else {
11030: $pathchange_output .=
11031: &start_data_table_row().
11032: '<td><input type ="checkbox" name="namechange" value="'.
11033: $chgcount.'" checked="checked" /></td>'.
11034: '<td>'.$mapping{$embed_file}.'</td>'.
11035: '<td>'.$embed_file.
11036: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11037: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11038: '</td>'.&end_data_table_row();
1.660 raeburn 11039: }
1.987 raeburn 11040: $numpathchg ++;
11041: $chgcount ++;
1.660 raeburn 11042: }
11043: }
1.1127 raeburn 11044: if (($counter) || ($numunused)) {
1.987 raeburn 11045: if ($numpathchg) {
11046: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11047: $numpathchg.'" />'."\n";
11048: }
11049: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11050: ($actionurl eq '/adm/imsimport')) {
11051: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11052: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11053: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11054: } elsif ($actionurl eq '/adm/dependencies') {
11055: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11056: }
1.1123 raeburn 11057: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11058: } elsif ($numpathchg) {
11059: my %pathchange = ();
11060: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11061: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11062: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11063: }
1.987 raeburn 11064: }
1.1071 raeburn 11065: return ($output,$counter,$numpathchg);
1.987 raeburn 11066: }
11067:
1.1147 raeburn 11068: =pod
11069:
11070: =item * clean_path($name)
11071:
11072: Performs clean-up of directories, subdirectories and filename in an
11073: embedded object, referenced in an HTML file which is being uploaded
11074: to a course or portfolio, where
11075: "Upload embedded images/multimedia files if HTML file" checkbox was
11076: checked.
11077:
11078: Clean-up is similar to replacements in lonnet::clean_filename()
11079: except each / between sub-directory and next level is preserved.
11080:
11081: =cut
11082:
11083: sub clean_path {
11084: my ($embed_file) = @_;
11085: $embed_file =~s{^/+}{};
11086: my @contents;
11087: if ($embed_file =~ m{/}) {
11088: @contents = split(/\//,$embed_file);
11089: } else {
11090: @contents = ($embed_file);
11091: }
11092: my $lastidx = scalar(@contents)-1;
11093: for (my $i=0; $i<=$lastidx; $i++) {
11094: $contents[$i]=~s{\\}{/}g;
11095: $contents[$i]=~s/\s+/\_/g;
11096: $contents[$i]=~s{[^/\w\.\-]}{}g;
11097: if ($i == $lastidx) {
11098: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11099: }
11100: }
11101: if ($lastidx > 0) {
11102: return join('/',@contents);
11103: } else {
11104: return $contents[0];
11105: }
11106: }
11107:
1.987 raeburn 11108: sub embedded_file_element {
1.1071 raeburn 11109: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11110: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11111: (ref($codebase) eq 'HASH'));
11112: my $output;
1.1071 raeburn 11113: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11114: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11115: }
11116: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11117: &escape($embed_file).'" />';
11118: unless (($context eq 'upload_embedded') &&
11119: ($mapping->{$embed_file} eq $embed_file)) {
11120: $output .='
11121: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11122: }
11123: my $attrib;
11124: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11125: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11126: }
11127: $output .=
11128: "\n\t\t".
11129: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11130: $attrib.'" />';
11131: if (exists($codebase->{$mapping->{$embed_file}})) {
11132: $output .=
11133: "\n\t\t".
11134: '<input name="codebase_'.$num.'" type="hidden" value="'.
11135: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11136: }
1.987 raeburn 11137: return $output;
1.660 raeburn 11138: }
11139:
1.1071 raeburn 11140: sub get_dependency_details {
11141: my ($currfile,$currsubfile,$embed_file) = @_;
11142: my ($size,$mtime,$showsize,$showmtime);
11143: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11144: if ($embed_file =~ m{/}) {
11145: my ($path,$fname) = split(/\//,$embed_file);
11146: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11147: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11148: }
11149: } else {
11150: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11151: ($size,$mtime) = @{$currfile->{$embed_file}};
11152: }
11153: }
11154: $showsize = $size/1024.0;
11155: $showsize = sprintf("%.1f",$showsize);
11156: if ($mtime > 0) {
11157: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11158: }
11159: }
11160: return ($showsize,$showmtime);
11161: }
11162:
11163: sub ask_embedded_js {
11164: return <<"END";
11165: <script type="text/javascript"">
11166: // <![CDATA[
11167: function toggleBrowse(counter) {
11168: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11169: var fileid = document.getElementById('embedded_item_'+counter);
11170: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11171: if (chkboxid.checked == true) {
11172: uploaddivid.style.display='block';
11173: } else {
11174: uploaddivid.style.display='none';
11175: fileid.value = '';
11176: }
11177: }
11178: // ]]>
11179: </script>
11180:
11181: END
11182: }
11183:
1.661 raeburn 11184: sub upload_embedded {
11185: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11186: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11187: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11188: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11189: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11190: my $orig_uploaded_filename =
11191: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11192: foreach my $type ('orig','ref','attrib','codebase') {
11193: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11194: $env{'form.embedded_'.$type.'_'.$i} =
11195: &unescape($env{'form.embedded_'.$type.'_'.$i});
11196: }
11197: }
1.661 raeburn 11198: my ($path,$fname) =
11199: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11200: # no path, whole string is fname
11201: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11202: $fname = &Apache::lonnet::clean_filename($fname);
11203: # See if there is anything left
11204: next if ($fname eq '');
11205:
11206: # Check if file already exists as a file or directory.
11207: my ($state,$msg);
11208: if ($context eq 'portfolio') {
11209: my $port_path = $dirpath;
11210: if ($group ne '') {
11211: $port_path = "groups/$group/$port_path";
11212: }
1.987 raeburn 11213: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11214: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11215: $dir_root,$port_path,$disk_quota,
11216: $current_disk_usage,$uname,$udom);
11217: if ($state eq 'will_exceed_quota'
1.984 raeburn 11218: || $state eq 'file_locked') {
1.661 raeburn 11219: $output .= $msg;
11220: next;
11221: }
11222: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11223: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11224: if ($state eq 'exists') {
11225: $output .= $msg;
11226: next;
11227: }
11228: }
11229: # Check if extension is valid
11230: if (($fname =~ /\.(\w+)$/) &&
11231: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11232: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11233: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11234: next;
11235: } elsif (($fname =~ /\.(\w+)$/) &&
11236: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11237: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11238: next;
11239: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11240: $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 11241: next;
11242: }
11243: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11244: my $subdir = $path;
11245: $subdir =~ s{/+$}{};
1.661 raeburn 11246: if ($context eq 'portfolio') {
1.984 raeburn 11247: my $result;
11248: if ($state eq 'existingfile') {
11249: $result=
11250: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11251: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11252: } else {
1.984 raeburn 11253: $result=
11254: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11255: $dirpath.
1.1123 raeburn 11256: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11257: if ($result !~ m|^/uploaded/|) {
11258: $output .= '<span class="LC_error">'
11259: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11260: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11261: .'</span><br />';
11262: next;
11263: } else {
1.987 raeburn 11264: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11265: $path.$fname.'</span>').'<br />';
1.984 raeburn 11266: }
1.661 raeburn 11267: }
1.1123 raeburn 11268: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11269: my $extendedsubdir = $dirpath.'/'.$subdir;
11270: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11271: my $result =
1.1126 raeburn 11272: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11273: if ($result !~ m|^/uploaded/|) {
11274: $output .= '<span class="LC_error">'
11275: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11276: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11277: .'</span><br />';
11278: next;
11279: } else {
11280: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11281: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11282: if ($context eq 'syllabus') {
11283: &Apache::lonnet::make_public_indefinitely($result);
11284: }
1.987 raeburn 11285: }
1.661 raeburn 11286: } else {
11287: # Save the file
11288: my $target = $env{'form.embedded_item_'.$i};
11289: my $fullpath = $dir_root.$dirpath.'/'.$path;
11290: my $dest = $fullpath.$fname;
11291: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11292: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11293: my $count;
11294: my $filepath = $dir_root;
1.1027 raeburn 11295: foreach my $subdir (@parts) {
11296: $filepath .= "/$subdir";
11297: if (!-e $filepath) {
1.661 raeburn 11298: mkdir($filepath,0770);
11299: }
11300: }
11301: my $fh;
11302: if (!open($fh,'>'.$dest)) {
11303: &Apache::lonnet::logthis('Failed to create '.$dest);
11304: $output .= '<span class="LC_error">'.
1.1071 raeburn 11305: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11306: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11307: '</span><br />';
11308: } else {
11309: if (!print $fh $env{'form.embedded_item_'.$i}) {
11310: &Apache::lonnet::logthis('Failed to write to '.$dest);
11311: $output .= '<span class="LC_error">'.
1.1071 raeburn 11312: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11313: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11314: '</span><br />';
11315: } else {
1.987 raeburn 11316: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11317: $url.'</span>').'<br />';
11318: unless ($context eq 'testbank') {
11319: $footer .= &mt('View embedded file: [_1]',
11320: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11321: }
11322: }
11323: close($fh);
11324: }
11325: }
11326: if ($env{'form.embedded_ref_'.$i}) {
11327: $pathchange{$i} = 1;
11328: }
11329: }
11330: if ($output) {
11331: $output = '<p>'.$output.'</p>';
11332: }
11333: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11334: $returnflag = 'ok';
1.1071 raeburn 11335: my $numpathchgs = scalar(keys(%pathchange));
11336: if ($numpathchgs > 0) {
1.987 raeburn 11337: if ($context eq 'portfolio') {
11338: $output .= '<p>'.&mt('or').'</p>';
11339: } elsif ($context eq 'testbank') {
1.1071 raeburn 11340: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11341: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11342: $returnflag = 'modify_orightml';
11343: }
11344: }
1.1071 raeburn 11345: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11346: }
11347:
11348: sub modify_html_form {
11349: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11350: my $end = 0;
11351: my $modifyform;
11352: if ($context eq 'upload_embedded') {
11353: return unless (ref($pathchange) eq 'HASH');
11354: if ($env{'form.number_embedded_items'}) {
11355: $end += $env{'form.number_embedded_items'};
11356: }
11357: if ($env{'form.number_pathchange_items'}) {
11358: $end += $env{'form.number_pathchange_items'};
11359: }
11360: if ($end) {
11361: for (my $i=0; $i<$end; $i++) {
11362: if ($i < $env{'form.number_embedded_items'}) {
11363: next unless($pathchange->{$i});
11364: }
11365: $modifyform .=
11366: &start_data_table_row().
11367: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11368: 'checked="checked" /></td>'.
11369: '<td>'.$env{'form.embedded_ref_'.$i}.
11370: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11371: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11372: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11373: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11374: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11375: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11376: '<td>'.$env{'form.embedded_orig_'.$i}.
11377: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11378: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11379: &end_data_table_row();
1.1071 raeburn 11380: }
1.987 raeburn 11381: }
11382: } else {
11383: $modifyform = $pathchgtable;
11384: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11385: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11386: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11387: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11388: }
11389: }
11390: if ($modifyform) {
1.1071 raeburn 11391: if ($actionurl eq '/adm/dependencies') {
11392: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11393: }
1.987 raeburn 11394: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11395: '<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".
11396: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11397: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11398: '</ol></p>'."\n".'<p>'.
11399: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11400: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11401: &start_data_table()."\n".
11402: &start_data_table_header_row().
11403: '<th>'.&mt('Change?').'</th>'.
11404: '<th>'.&mt('Current reference').'</th>'.
11405: '<th>'.&mt('Required reference').'</th>'.
11406: &end_data_table_header_row()."\n".
11407: $modifyform.
11408: &end_data_table().'<br />'."\n".$hiddenstate.
11409: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11410: '</form>'."\n";
11411: }
11412: return;
11413: }
11414:
11415: sub modify_html_refs {
1.1123 raeburn 11416: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11417: my $container;
11418: if ($context eq 'portfolio') {
11419: $container = $env{'form.container'};
11420: } elsif ($context eq 'coursedoc') {
11421: $container = $env{'form.primaryurl'};
1.1071 raeburn 11422: } elsif ($context eq 'manage_dependencies') {
11423: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11424: $container = "/$container";
1.1123 raeburn 11425: } elsif ($context eq 'syllabus') {
11426: $container = $url;
1.987 raeburn 11427: } else {
1.1027 raeburn 11428: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11429: }
11430: my (%allfiles,%codebase,$output,$content);
11431: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11432: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11433: if (wantarray) {
11434: return ('',0,0);
11435: } else {
11436: return;
11437: }
11438: }
11439: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11440: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11441: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11442: if (wantarray) {
11443: return ('',0,0);
11444: } else {
11445: return;
11446: }
11447: }
1.987 raeburn 11448: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11449: if ($content eq '-1') {
11450: if (wantarray) {
11451: return ('',0,0);
11452: } else {
11453: return;
11454: }
11455: }
1.987 raeburn 11456: } else {
1.1071 raeburn 11457: unless ($container =~ /^\Q$dir_root\E/) {
11458: if (wantarray) {
11459: return ('',0,0);
11460: } else {
11461: return;
11462: }
11463: }
1.987 raeburn 11464: if (open(my $fh,"<$container")) {
11465: $content = join('', <$fh>);
11466: close($fh);
11467: } else {
1.1071 raeburn 11468: if (wantarray) {
11469: return ('',0,0);
11470: } else {
11471: return;
11472: }
1.987 raeburn 11473: }
11474: }
11475: my ($count,$codebasecount) = (0,0);
11476: my $mm = new File::MMagic;
11477: my $mime_type = $mm->checktype_contents($content);
11478: if ($mime_type eq 'text/html') {
11479: my $parse_result =
11480: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11481: \%codebase,\$content);
11482: if ($parse_result eq 'ok') {
11483: foreach my $i (@changes) {
11484: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11485: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11486: if ($allfiles{$ref}) {
11487: my $newname = $orig;
11488: my ($attrib_regexp,$codebase);
1.1006 raeburn 11489: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11490: if ($attrib_regexp =~ /:/) {
11491: $attrib_regexp =~ s/\:/|/g;
11492: }
11493: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11494: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11495: $count += $numchg;
1.1123 raeburn 11496: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11497: delete($allfiles{$ref});
1.987 raeburn 11498: }
11499: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11500: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11501: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11502: $codebasecount ++;
11503: }
11504: }
11505: }
1.1123 raeburn 11506: my $skiprewrites;
1.987 raeburn 11507: if ($count || $codebasecount) {
11508: my $saveresult;
1.1071 raeburn 11509: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11510: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11511: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11512: if ($url eq $container) {
11513: my ($fname) = ($container =~ m{/([^/]+)$});
11514: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11515: $count,'<span class="LC_filename">'.
1.1071 raeburn 11516: $fname.'</span>').'</p>';
1.987 raeburn 11517: } else {
11518: $output = '<p class="LC_error">'.
11519: &mt('Error: update failed for: [_1].',
11520: '<span class="LC_filename">'.
11521: $container.'</span>').'</p>';
11522: }
1.1123 raeburn 11523: if ($context eq 'syllabus') {
11524: unless ($saveresult eq 'ok') {
11525: $skiprewrites = 1;
11526: }
11527: }
1.987 raeburn 11528: } else {
11529: if (open(my $fh,">$container")) {
11530: print $fh $content;
11531: close($fh);
11532: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11533: $count,'<span class="LC_filename">'.
11534: $container.'</span>').'</p>';
1.661 raeburn 11535: } else {
1.987 raeburn 11536: $output = '<p class="LC_error">'.
11537: &mt('Error: could not update [_1].',
11538: '<span class="LC_filename">'.
11539: $container.'</span>').'</p>';
1.661 raeburn 11540: }
11541: }
11542: }
1.1123 raeburn 11543: if (($context eq 'syllabus') && (!$skiprewrites)) {
11544: my ($actionurl,$state);
11545: $actionurl = "/public/$udom/$uname/syllabus";
11546: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11547: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11548: \%codebase,
11549: {'context' => 'rewrites',
11550: 'ignore_remote_references' => 1,});
11551: if (ref($mapping) eq 'HASH') {
11552: my $rewrites = 0;
11553: foreach my $key (keys(%{$mapping})) {
11554: next if ($key =~ m{^https?://});
11555: my $ref = $mapping->{$key};
11556: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11557: my $attrib;
11558: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11559: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11560: }
11561: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11562: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11563: $rewrites += $numchg;
11564: }
11565: }
11566: if ($rewrites) {
11567: my $saveresult;
11568: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11569: if ($url eq $container) {
11570: my ($fname) = ($container =~ m{/([^/]+)$});
11571: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11572: $count,'<span class="LC_filename">'.
11573: $fname.'</span>').'</p>';
11574: } else {
11575: $output .= '<p class="LC_error">'.
11576: &mt('Error: could not update links in [_1].',
11577: '<span class="LC_filename">'.
11578: $container.'</span>').'</p>';
11579:
11580: }
11581: }
11582: }
11583: }
1.987 raeburn 11584: } else {
11585: &logthis('Failed to parse '.$container.
11586: ' to modify references: '.$parse_result);
1.661 raeburn 11587: }
11588: }
1.1071 raeburn 11589: if (wantarray) {
11590: return ($output,$count,$codebasecount);
11591: } else {
11592: return $output;
11593: }
1.661 raeburn 11594: }
11595:
11596: sub check_for_existing {
11597: my ($path,$fname,$element) = @_;
11598: my ($state,$msg);
11599: if (-d $path.'/'.$fname) {
11600: $state = 'exists';
11601: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11602: } elsif (-e $path.'/'.$fname) {
11603: $state = 'exists';
11604: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11605: }
11606: if ($state eq 'exists') {
11607: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11608: }
11609: return ($state,$msg);
11610: }
11611:
11612: sub check_for_upload {
11613: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11614: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11615: my $filesize = length($env{'form.'.$element});
11616: if (!$filesize) {
11617: my $msg = '<span class="LC_error">'.
11618: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11619: '<span class="LC_filename">'.$fname.'</span>',
11620: $filesize).'<br />'.
1.1007 raeburn 11621: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11622: '</span>';
11623: return ('zero_bytes',$msg);
11624: }
11625: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11626: my $getpropath = 1;
1.1021 raeburn 11627: my ($dirlistref,$listerror) =
11628: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11629: my $found_file = 0;
11630: my $locked_file = 0;
1.991 raeburn 11631: my @lockers;
11632: my $navmap;
11633: if ($env{'request.course.id'}) {
11634: $navmap = Apache::lonnavmaps::navmap->new();
11635: }
1.1021 raeburn 11636: if (ref($dirlistref) eq 'ARRAY') {
11637: foreach my $line (@{$dirlistref}) {
11638: my ($file_name,$rest)=split(/\&/,$line,2);
11639: if ($file_name eq $fname){
11640: $file_name = $path.$file_name;
11641: if ($group ne '') {
11642: $file_name = $group.$file_name;
11643: }
11644: $found_file = 1;
11645: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11646: foreach my $lock (@lockers) {
11647: if (ref($lock) eq 'ARRAY') {
11648: my ($symb,$crsid) = @{$lock};
11649: if ($crsid eq $env{'request.course.id'}) {
11650: if (ref($navmap)) {
11651: my $res = $navmap->getBySymb($symb);
11652: foreach my $part (@{$res->parts()}) {
11653: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11654: unless (($slot_status == $res->RESERVED) ||
11655: ($slot_status == $res->RESERVED_LOCATION)) {
11656: $locked_file = 1;
11657: }
1.991 raeburn 11658: }
1.1021 raeburn 11659: } else {
11660: $locked_file = 1;
1.991 raeburn 11661: }
11662: } else {
11663: $locked_file = 1;
11664: }
11665: }
1.1021 raeburn 11666: }
11667: } else {
11668: my @info = split(/\&/,$rest);
11669: my $currsize = $info[6]/1000;
11670: if ($currsize < $filesize) {
11671: my $extra = $filesize - $currsize;
11672: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11673: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11674: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1179 bisitz 11675: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11676: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11677: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11678: return ('will_exceed_quota',$msg);
11679: }
1.984 raeburn 11680: }
11681: }
1.661 raeburn 11682: }
11683: }
11684: }
11685: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11686: my $msg = '<p class="LC_warning">'.
11687: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11688: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11689: return ('will_exceed_quota',$msg);
11690: } elsif ($found_file) {
11691: if ($locked_file) {
1.1179 bisitz 11692: my $msg = '<p class="LC_warning">';
1.661 raeburn 11693: $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1179 bisitz 11694: $msg .= '</p>';
1.661 raeburn 11695: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11696: return ('file_locked',$msg);
11697: } else {
1.1179 bisitz 11698: my $msg = '<p class="LC_error">';
1.984 raeburn 11699: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179 bisitz 11700: $msg .= '</p>';
1.984 raeburn 11701: return ('existingfile',$msg);
1.661 raeburn 11702: }
11703: }
11704: }
11705:
1.987 raeburn 11706: sub check_for_traversal {
11707: my ($path,$url,$toplevel) = @_;
11708: my @parts=split(/\//,$path);
11709: my $cleanpath;
11710: my $fullpath = $url;
11711: for (my $i=0;$i<@parts;$i++) {
11712: next if ($parts[$i] eq '.');
11713: if ($parts[$i] eq '..') {
11714: $fullpath =~ s{([^/]+/)$}{};
11715: } else {
11716: $fullpath .= $parts[$i].'/';
11717: }
11718: }
11719: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11720: $cleanpath = $1;
11721: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11722: my $curr_toprel = $1;
11723: my @parts = split(/\//,$curr_toprel);
11724: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11725: my @urlparts = split(/\//,$url_toprel);
11726: my $doubledots;
11727: my $startdiff = -1;
11728: for (my $i=0; $i<@urlparts; $i++) {
11729: if ($startdiff == -1) {
11730: unless ($urlparts[$i] eq $parts[$i]) {
11731: $startdiff = $i;
11732: $doubledots .= '../';
11733: }
11734: } else {
11735: $doubledots .= '../';
11736: }
11737: }
11738: if ($startdiff > -1) {
11739: $cleanpath = $doubledots;
11740: for (my $i=$startdiff; $i<@parts; $i++) {
11741: $cleanpath .= $parts[$i].'/';
11742: }
11743: }
11744: }
11745: $cleanpath =~ s{(/)$}{};
11746: return $cleanpath;
11747: }
1.31 albertel 11748:
1.1053 raeburn 11749: sub is_archive_file {
11750: my ($mimetype) = @_;
11751: if (($mimetype eq 'application/octet-stream') ||
11752: ($mimetype eq 'application/x-stuffit') ||
11753: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11754: return 1;
11755: }
11756: return;
11757: }
11758:
11759: sub decompress_form {
1.1065 raeburn 11760: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11761: my %lt = &Apache::lonlocal::texthash (
11762: this => 'This file is an archive file.',
1.1067 raeburn 11763: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11764: itsc => 'Its contents are as follows:',
1.1053 raeburn 11765: youm => 'You may wish to extract its contents.',
11766: extr => 'Extract contents',
1.1067 raeburn 11767: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11768: proa => 'Process automatically?',
1.1053 raeburn 11769: yes => 'Yes',
11770: no => 'No',
1.1067 raeburn 11771: fold => 'Title for folder containing movie',
11772: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11773: );
1.1065 raeburn 11774: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11775: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11776: my $info = &list_archive_contents($fileloc,\@paths);
11777: if (@paths) {
11778: foreach my $path (@paths) {
11779: $path =~ s{^/}{};
1.1067 raeburn 11780: if ($path =~ m{^([^/]+)/$}) {
11781: $topdir = $1;
11782: }
1.1065 raeburn 11783: if ($path =~ m{^([^/]+)/}) {
11784: $toplevel{$1} = $path;
11785: } else {
11786: $toplevel{$path} = $path;
11787: }
11788: }
11789: }
1.1067 raeburn 11790: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11791: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11792: "$topdir/media/",
11793: "$topdir/media/$topdir.mp4",
11794: "$topdir/media/FirstFrame.png",
11795: "$topdir/media/player.swf",
11796: "$topdir/media/swfobject.js",
11797: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11798: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11799: "$topdir/$topdir.mp4",
11800: "$topdir/$topdir\_config.xml",
11801: "$topdir/$topdir\_controller.swf",
11802: "$topdir/$topdir\_embed.css",
11803: "$topdir/$topdir\_First_Frame.png",
11804: "$topdir/$topdir\_player.html",
11805: "$topdir/$topdir\_Thumbnails.png",
11806: "$topdir/playerProductInstall.swf",
11807: "$topdir/scripts/",
11808: "$topdir/scripts/config_xml.js",
11809: "$topdir/scripts/handlebars.js",
11810: "$topdir/scripts/jquery-1.7.1.min.js",
11811: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11812: "$topdir/scripts/modernizr.js",
11813: "$topdir/scripts/player-min.js",
11814: "$topdir/scripts/swfobject.js",
11815: "$topdir/skins/",
11816: "$topdir/skins/configuration_express.xml",
11817: "$topdir/skins/express_show/",
11818: "$topdir/skins/express_show/player-min.css",
11819: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11820: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11821: "$topdir/$topdir.mp4",
11822: "$topdir/$topdir\_config.xml",
11823: "$topdir/$topdir\_controller.swf",
11824: "$topdir/$topdir\_embed.css",
11825: "$topdir/$topdir\_First_Frame.png",
11826: "$topdir/$topdir\_player.html",
11827: "$topdir/$topdir\_Thumbnails.png",
11828: "$topdir/playerProductInstall.swf",
11829: "$topdir/scripts/",
11830: "$topdir/scripts/config_xml.js",
11831: "$topdir/scripts/techsmith-smart-player.min.js",
11832: "$topdir/skins/",
11833: "$topdir/skins/configuration_express.xml",
11834: "$topdir/skins/express_show/",
11835: "$topdir/skins/express_show/spritesheet.min.css",
11836: "$topdir/skins/express_show/spritesheet.png",
11837: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11838: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11839: if (@diffs == 0) {
1.1164 raeburn 11840: $is_camtasia = 6;
11841: } else {
1.1197 raeburn 11842: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11843: if (@diffs == 0) {
11844: $is_camtasia = 8;
1.1197 raeburn 11845: } else {
11846: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11847: if (@diffs == 0) {
11848: $is_camtasia = 8;
11849: }
1.1164 raeburn 11850: }
1.1067 raeburn 11851: }
11852: }
11853: my $output;
11854: if ($is_camtasia) {
11855: $output = <<"ENDCAM";
11856: <script type="text/javascript" language="Javascript">
11857: // <![CDATA[
11858:
11859: function camtasiaToggle() {
11860: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11861: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11862: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11863: document.getElementById('camtasia_titles').style.display='block';
11864: } else {
11865: document.getElementById('camtasia_titles').style.display='none';
11866: }
11867: }
11868: }
11869: return;
11870: }
11871:
11872: // ]]>
11873: </script>
11874: <p>$lt{'camt'}</p>
11875: ENDCAM
1.1065 raeburn 11876: } else {
1.1067 raeburn 11877: $output = '<p>'.$lt{'this'};
11878: if ($info eq '') {
11879: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11880: } else {
11881: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11882: '<div><pre>'.$info.'</pre></div>';
11883: }
1.1065 raeburn 11884: }
1.1067 raeburn 11885: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11886: my $duplicates;
11887: my $num = 0;
11888: if (ref($dirlist) eq 'ARRAY') {
11889: foreach my $item (@{$dirlist}) {
11890: if (ref($item) eq 'ARRAY') {
11891: if (exists($toplevel{$item->[0]})) {
11892: $duplicates .=
11893: &start_data_table_row().
11894: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11895: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11896: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11897: 'value="1" />'.&mt('Yes').'</label>'.
11898: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11899: '<td>'.$item->[0].'</td>';
11900: if ($item->[2]) {
11901: $duplicates .= '<td>'.&mt('Directory').'</td>';
11902: } else {
11903: $duplicates .= '<td>'.&mt('File').'</td>';
11904: }
11905: $duplicates .= '<td>'.$item->[3].'</td>'.
11906: '<td>'.
11907: &Apache::lonlocal::locallocaltime($item->[4]).
11908: '</td>'.
11909: &end_data_table_row();
11910: $num ++;
11911: }
11912: }
11913: }
11914: }
11915: my $itemcount;
11916: if (@paths > 0) {
11917: $itemcount = scalar(@paths);
11918: } else {
11919: $itemcount = 1;
11920: }
1.1067 raeburn 11921: if ($is_camtasia) {
11922: $output .= $lt{'auto'}.'<br />'.
11923: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11924: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11925: $lt{'yes'}.'</label> <label>'.
11926: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11927: $lt{'no'}.'</label></span><br />'.
11928: '<div id="camtasia_titles" style="display:block">'.
11929: &Apache::lonhtmlcommon::start_pick_box().
11930: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11931: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11932: &Apache::lonhtmlcommon::row_closure().
11933: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11934: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11935: &Apache::lonhtmlcommon::row_closure(1).
11936: &Apache::lonhtmlcommon::end_pick_box().
11937: '</div>';
11938: }
1.1065 raeburn 11939: $output .=
11940: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11941: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11942: "\n";
1.1065 raeburn 11943: if ($duplicates ne '') {
11944: $output .= '<p><span class="LC_warning">'.
11945: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11946: &start_data_table().
11947: &start_data_table_header_row().
11948: '<th>'.&mt('Overwrite?').'</th>'.
11949: '<th>'.&mt('Name').'</th>'.
11950: '<th>'.&mt('Type').'</th>'.
11951: '<th>'.&mt('Size').'</th>'.
11952: '<th>'.&mt('Last modified').'</th>'.
11953: &end_data_table_header_row().
11954: $duplicates.
11955: &end_data_table().
11956: '</p>';
11957: }
1.1067 raeburn 11958: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11959: if (ref($hiddenelements) eq 'HASH') {
11960: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11961: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11962: }
11963: }
11964: $output .= <<"END";
1.1067 raeburn 11965: <br />
1.1053 raeburn 11966: <input type="submit" name="decompress" value="$lt{'extr'}" />
11967: </form>
11968: $noextract
11969: END
11970: return $output;
11971: }
11972:
1.1065 raeburn 11973: sub decompression_utility {
11974: my ($program) = @_;
11975: my @utilities = ('tar','gunzip','bunzip2','unzip');
11976: my $location;
11977: if (grep(/^\Q$program\E$/,@utilities)) {
11978: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11979: '/usr/sbin/') {
11980: if (-x $dir.$program) {
11981: $location = $dir.$program;
11982: last;
11983: }
11984: }
11985: }
11986: return $location;
11987: }
11988:
11989: sub list_archive_contents {
11990: my ($file,$pathsref) = @_;
11991: my (@cmd,$output);
11992: my $needsregexp;
11993: if ($file =~ /\.zip$/) {
11994: @cmd = (&decompression_utility('unzip'),"-l");
11995: $needsregexp = 1;
11996: } elsif (($file =~ m/\.tar\.gz$/) ||
11997: ($file =~ /\.tgz$/)) {
11998: @cmd = (&decompression_utility('tar'),"-ztf");
11999: } elsif ($file =~ /\.tar\.bz2$/) {
12000: @cmd = (&decompression_utility('tar'),"-jtf");
12001: } elsif ($file =~ m|\.tar$|) {
12002: @cmd = (&decompression_utility('tar'),"-tf");
12003: }
12004: if (@cmd) {
12005: undef($!);
12006: undef($@);
12007: if (open(my $fh,"-|", @cmd, $file)) {
12008: while (my $line = <$fh>) {
12009: $output .= $line;
12010: chomp($line);
12011: my $item;
12012: if ($needsregexp) {
12013: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12014: } else {
12015: $item = $line;
12016: }
12017: if ($item ne '') {
12018: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12019: push(@{$pathsref},$item);
12020: }
12021: }
12022: }
12023: close($fh);
12024: }
12025: }
12026: return $output;
12027: }
12028:
1.1053 raeburn 12029: sub decompress_uploaded_file {
12030: my ($file,$dir) = @_;
12031: &Apache::lonnet::appenv({'cgi.file' => $file});
12032: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12033: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12034: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12035: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12036: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12037: my $decompressed = $env{'cgi.decompressed'};
12038: &Apache::lonnet::delenv('cgi.file');
12039: &Apache::lonnet::delenv('cgi.dir');
12040: &Apache::lonnet::delenv('cgi.decompressed');
12041: return ($decompressed,$result);
12042: }
12043:
1.1055 raeburn 12044: sub process_decompression {
12045: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
12046: my ($dir,$error,$warning,$output);
1.1180 raeburn 12047: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12048: $error = &mt('Filename not a supported archive file type.').
12049: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12050: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12051: } else {
12052: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12053: if ($docuhome eq 'no_host') {
12054: $error = &mt('Could not determine home server for course.');
12055: } else {
12056: my @ids=&Apache::lonnet::current_machine_ids();
12057: my $currdir = "$dir_root/$destination";
12058: if (grep(/^\Q$docuhome\E$/,@ids)) {
12059: $dir = &LONCAPA::propath($docudom,$docuname).
12060: "$dir_root/$destination";
12061: } else {
12062: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12063: "$dir_root/$docudom/$docuname/$destination";
12064: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12065: $error = &mt('Archive file not found.');
12066: }
12067: }
1.1065 raeburn 12068: my (@to_overwrite,@to_skip);
12069: if ($env{'form.archive_overwrite_total'} > 0) {
12070: my $total = $env{'form.archive_overwrite_total'};
12071: for (my $i=0; $i<$total; $i++) {
12072: if ($env{'form.archive_overwrite_'.$i} == 1) {
12073: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12074: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12075: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12076: }
12077: }
12078: }
12079: my $numskip = scalar(@to_skip);
12080: if (($numskip > 0) &&
12081: ($numskip == $env{'form.archive_itemcount'})) {
12082: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12083: } elsif ($dir eq '') {
1.1055 raeburn 12084: $error = &mt('Directory containing archive file unavailable.');
12085: } elsif (!$error) {
1.1065 raeburn 12086: my ($decompressed,$display);
12087: if ($numskip > 0) {
12088: my $tempdir = time.'_'.$$.int(rand(10000));
12089: mkdir("$dir/$tempdir",0755);
12090: system("mv $dir/$file $dir/$tempdir/$file");
12091: ($decompressed,$display) =
12092: &decompress_uploaded_file($file,"$dir/$tempdir");
12093: foreach my $item (@to_skip) {
12094: if (($item ne '') && ($item !~ /\.\./)) {
12095: if (-f "$dir/$tempdir/$item") {
12096: unlink("$dir/$tempdir/$item");
12097: } elsif (-d "$dir/$tempdir/$item") {
12098: system("rm -rf $dir/$tempdir/$item");
12099: }
12100: }
12101: }
12102: system("mv $dir/$tempdir/* $dir");
12103: rmdir("$dir/$tempdir");
12104: } else {
12105: ($decompressed,$display) =
12106: &decompress_uploaded_file($file,$dir);
12107: }
1.1055 raeburn 12108: if ($decompressed eq 'ok') {
1.1065 raeburn 12109: $output = '<p class="LC_info">'.
12110: &mt('Files extracted successfully from archive.').
12111: '</p>'."\n";
1.1055 raeburn 12112: my ($warning,$result,@contents);
12113: my ($newdirlistref,$newlisterror) =
12114: &Apache::lonnet::dirlist($currdir,$docudom,
12115: $docuname,1);
12116: my (%is_dir,%changes,@newitems);
12117: my $dirptr = 16384;
1.1065 raeburn 12118: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12119: foreach my $dir_line (@{$newdirlistref}) {
12120: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 12121: unless (($item =~ /^\.+$/) || ($item eq $file) ||
12122: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 12123: push(@newitems,$item);
12124: if ($dirptr&$testdir) {
12125: $is_dir{$item} = 1;
12126: }
12127: $changes{$item} = 1;
12128: }
12129: }
12130: }
12131: if (keys(%changes) > 0) {
12132: foreach my $item (sort(@newitems)) {
12133: if ($changes{$item}) {
12134: push(@contents,$item);
12135: }
12136: }
12137: }
12138: if (@contents > 0) {
1.1067 raeburn 12139: my $wantform;
12140: unless ($env{'form.autoextract_camtasia'}) {
12141: $wantform = 1;
12142: }
1.1056 raeburn 12143: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12144: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12145: $currdir,\%is_dir,
12146: \%children,\%parent,
1.1056 raeburn 12147: \@contents,\%dirorder,
12148: \%titles,$wantform);
1.1055 raeburn 12149: if ($datatable ne '') {
12150: $output .= &archive_options_form('decompressed',$datatable,
12151: $count,$hiddenelem);
1.1065 raeburn 12152: my $startcount = 6;
1.1055 raeburn 12153: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12154: \%titles,\%children);
1.1055 raeburn 12155: }
1.1067 raeburn 12156: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12157: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12158: my %displayed;
12159: my $total = 1;
12160: $env{'form.archive_directory'} = [];
12161: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12162: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12163: $path =~ s{/$}{};
12164: my $item;
12165: if ($path ne '') {
12166: $item = "$path/$titles{$i}";
12167: } else {
12168: $item = $titles{$i};
12169: }
12170: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12171: if ($item eq $contents[0]) {
12172: push(@{$env{'form.archive_directory'}},$i);
12173: $env{'form.archive_'.$i} = 'display';
12174: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12175: $displayed{'folder'} = $i;
1.1164 raeburn 12176: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12177: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12178: $env{'form.archive_'.$i} = 'display';
12179: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12180: $displayed{'web'} = $i;
12181: } else {
1.1164 raeburn 12182: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12183: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12184: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12185: push(@{$env{'form.archive_directory'}},$i);
12186: }
12187: $env{'form.archive_'.$i} = 'dependency';
12188: }
12189: $total ++;
12190: }
12191: for (my $i=1; $i<$total; $i++) {
12192: next if ($i == $displayed{'web'});
12193: next if ($i == $displayed{'folder'});
12194: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12195: }
12196: $env{'form.phase'} = 'decompress_cleanup';
12197: $env{'form.archivedelete'} = 1;
12198: $env{'form.archive_count'} = $total-1;
12199: $output .=
12200: &process_extracted_files('coursedocs',$docudom,
12201: $docuname,$destination,
12202: $dir_root,$hiddenelem);
12203: }
1.1055 raeburn 12204: } else {
12205: $warning = &mt('No new items extracted from archive file.');
12206: }
12207: } else {
12208: $output = $display;
12209: $error = &mt('An error occurred during extraction from the archive file.');
12210: }
12211: }
12212: }
12213: }
12214: if ($error) {
12215: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12216: $error.'</p>'."\n";
12217: }
12218: if ($warning) {
12219: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12220: }
12221: return $output;
12222: }
12223:
12224: sub get_extracted {
1.1056 raeburn 12225: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12226: $titles,$wantform) = @_;
1.1055 raeburn 12227: my $count = 0;
12228: my $depth = 0;
12229: my $datatable;
1.1056 raeburn 12230: my @hierarchy;
1.1055 raeburn 12231: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12232: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12233: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12234: foreach my $item (@{$contents}) {
12235: $count ++;
1.1056 raeburn 12236: @{$dirorder->{$count}} = @hierarchy;
12237: $titles->{$count} = $item;
1.1055 raeburn 12238: &archive_hierarchy($depth,$count,$parent,$children);
12239: if ($wantform) {
12240: $datatable .= &archive_row($is_dir->{$item},$item,
12241: $currdir,$depth,$count);
12242: }
12243: if ($is_dir->{$item}) {
12244: $depth ++;
1.1056 raeburn 12245: push(@hierarchy,$count);
12246: $parent->{$depth} = $count;
1.1055 raeburn 12247: $datatable .=
12248: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12249: \$depth,\$count,\@hierarchy,$dirorder,
12250: $children,$parent,$titles,$wantform);
1.1055 raeburn 12251: $depth --;
1.1056 raeburn 12252: pop(@hierarchy);
1.1055 raeburn 12253: }
12254: }
12255: return ($count,$datatable);
12256: }
12257:
12258: sub recurse_extracted_archive {
1.1056 raeburn 12259: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12260: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12261: my $result='';
1.1056 raeburn 12262: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12263: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12264: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12265: return $result;
12266: }
12267: my $dirptr = 16384;
12268: my ($newdirlistref,$newlisterror) =
12269: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12270: if (ref($newdirlistref) eq 'ARRAY') {
12271: foreach my $dir_line (@{$newdirlistref}) {
12272: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12273: unless ($item =~ /^\.+$/) {
12274: $$count ++;
1.1056 raeburn 12275: @{$dirorder->{$$count}} = @{$hierarchy};
12276: $titles->{$$count} = $item;
1.1055 raeburn 12277: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12278:
1.1055 raeburn 12279: my $is_dir;
12280: if ($dirptr&$testdir) {
12281: $is_dir = 1;
12282: }
12283: if ($wantform) {
12284: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12285: }
12286: if ($is_dir) {
12287: $$depth ++;
1.1056 raeburn 12288: push(@{$hierarchy},$$count);
12289: $parent->{$$depth} = $$count;
1.1055 raeburn 12290: $result .=
12291: &recurse_extracted_archive("$currdir/$item",$docudom,
12292: $docuname,$depth,$count,
1.1056 raeburn 12293: $hierarchy,$dirorder,$children,
12294: $parent,$titles,$wantform);
1.1055 raeburn 12295: $$depth --;
1.1056 raeburn 12296: pop(@{$hierarchy});
1.1055 raeburn 12297: }
12298: }
12299: }
12300: }
12301: return $result;
12302: }
12303:
12304: sub archive_hierarchy {
12305: my ($depth,$count,$parent,$children) =@_;
12306: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12307: if (exists($parent->{$depth})) {
12308: $children->{$parent->{$depth}} .= $count.':';
12309: }
12310: }
12311: return;
12312: }
12313:
12314: sub archive_row {
12315: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12316: my ($name) = ($item =~ m{([^/]+)$});
12317: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12318: 'display' => 'Add as file',
1.1055 raeburn 12319: 'dependency' => 'Include as dependency',
12320: 'discard' => 'Discard',
12321: );
12322: if ($is_dir) {
1.1059 raeburn 12323: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12324: }
1.1056 raeburn 12325: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12326: my $offset = 0;
1.1055 raeburn 12327: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12328: $offset ++;
1.1065 raeburn 12329: if ($action ne 'display') {
12330: $offset ++;
12331: }
1.1055 raeburn 12332: $output .= '<td><span class="LC_nobreak">'.
12333: '<label><input type="radio" name="archive_'.$count.
12334: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12335: my $text = $choices{$action};
12336: if ($is_dir) {
12337: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12338: if ($action eq 'display') {
1.1059 raeburn 12339: $text = &mt('Add as folder');
1.1055 raeburn 12340: }
1.1056 raeburn 12341: } else {
12342: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12343:
12344: }
12345: $output .= ' /> '.$choices{$action}.'</label></span>';
12346: if ($action eq 'dependency') {
12347: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12348: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12349: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12350: '<option value=""></option>'."\n".
12351: '</select>'."\n".
12352: '</div>';
1.1059 raeburn 12353: } elsif ($action eq 'display') {
12354: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12355: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12356: '</div>';
1.1055 raeburn 12357: }
1.1056 raeburn 12358: $output .= '</td>';
1.1055 raeburn 12359: }
12360: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12361: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12362: for (my $i=0; $i<$depth; $i++) {
12363: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12364: }
12365: if ($is_dir) {
12366: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12367: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12368: } else {
12369: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12370: }
12371: $output .= ' '.$name.'</td>'."\n".
12372: &end_data_table_row();
12373: return $output;
12374: }
12375:
12376: sub archive_options_form {
1.1065 raeburn 12377: my ($form,$display,$count,$hiddenelem) = @_;
12378: my %lt = &Apache::lonlocal::texthash(
12379: perm => 'Permanently remove archive file?',
12380: hows => 'How should each extracted item be incorporated in the course?',
12381: cont => 'Content actions for all',
12382: addf => 'Add as folder/file',
12383: incd => 'Include as dependency for a displayed file',
12384: disc => 'Discard',
12385: no => 'No',
12386: yes => 'Yes',
12387: save => 'Save',
12388: );
12389: my $output = <<"END";
12390: <form name="$form" method="post" action="">
12391: <p><span class="LC_nobreak">$lt{'perm'}
12392: <label>
12393: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12394: </label>
12395:
12396: <label>
12397: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12398: </span>
12399: </p>
12400: <input type="hidden" name="phase" value="decompress_cleanup" />
12401: <br />$lt{'hows'}
12402: <div class="LC_columnSection">
12403: <fieldset>
12404: <legend>$lt{'cont'}</legend>
12405: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12406: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12407: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12408: </fieldset>
12409: </div>
12410: END
12411: return $output.
1.1055 raeburn 12412: &start_data_table()."\n".
1.1065 raeburn 12413: $display."\n".
1.1055 raeburn 12414: &end_data_table()."\n".
12415: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12416: $hiddenelem.
1.1065 raeburn 12417: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12418: '</form>';
12419: }
12420:
12421: sub archive_javascript {
1.1056 raeburn 12422: my ($startcount,$numitems,$titles,$children) = @_;
12423: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12424: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12425: my $scripttag = <<START;
12426: <script type="text/javascript">
12427: // <![CDATA[
12428:
12429: function checkAll(form,prefix) {
12430: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12431: for (var i=0; i < form.elements.length; i++) {
12432: var id = form.elements[i].id;
12433: if ((id != '') && (id != undefined)) {
12434: if (idstr.test(id)) {
12435: if (form.elements[i].type == 'radio') {
12436: form.elements[i].checked = true;
1.1056 raeburn 12437: var nostart = i-$startcount;
1.1059 raeburn 12438: var offset = nostart%7;
12439: var count = (nostart-offset)/7;
1.1056 raeburn 12440: dependencyCheck(form,count,offset);
1.1055 raeburn 12441: }
12442: }
12443: }
12444: }
12445: }
12446:
12447: function propagateCheck(form,count) {
12448: if (count > 0) {
1.1059 raeburn 12449: var startelement = $startcount + ((count-1) * 7);
12450: for (var j=1; j<6; j++) {
12451: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12452: var item = startelement + j;
12453: if (form.elements[item].type == 'radio') {
12454: if (form.elements[item].checked) {
12455: containerCheck(form,count,j);
12456: break;
12457: }
1.1055 raeburn 12458: }
12459: }
12460: }
12461: }
12462: }
12463:
12464: numitems = $numitems
1.1056 raeburn 12465: var titles = new Array(numitems);
12466: var parents = new Array(numitems);
1.1055 raeburn 12467: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12468: parents[i] = new Array;
1.1055 raeburn 12469: }
1.1059 raeburn 12470: var maintitle = '$maintitle';
1.1055 raeburn 12471:
12472: START
12473:
1.1056 raeburn 12474: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12475: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12476: for (my $i=0; $i<@contents; $i ++) {
12477: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12478: }
12479: }
12480:
1.1056 raeburn 12481: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12482: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12483: }
12484:
1.1055 raeburn 12485: $scripttag .= <<END;
12486:
12487: function containerCheck(form,count,offset) {
12488: if (count > 0) {
1.1056 raeburn 12489: dependencyCheck(form,count,offset);
1.1059 raeburn 12490: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12491: form.elements[item].checked = true;
12492: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12493: if (parents[count].length > 0) {
12494: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12495: containerCheck(form,parents[count][j],offset);
12496: }
12497: }
12498: }
12499: }
12500: }
12501:
12502: function dependencyCheck(form,count,offset) {
12503: if (count > 0) {
1.1059 raeburn 12504: var chosen = (offset+$startcount)+7*(count-1);
12505: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12506: var currtype = form.elements[depitem].type;
12507: if (form.elements[chosen].value == 'dependency') {
12508: document.getElementById('arc_depon_'+count).style.display='block';
12509: form.elements[depitem].options.length = 0;
12510: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12511: for (var i=1; i<=numitems; i++) {
12512: if (i == count) {
12513: continue;
12514: }
1.1059 raeburn 12515: var startelement = $startcount + (i-1) * 7;
12516: for (var j=1; j<6; j++) {
12517: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12518: var item = startelement + j;
12519: if (form.elements[item].type == 'radio') {
12520: if (form.elements[item].checked) {
12521: if (form.elements[item].value == 'display') {
12522: var n = form.elements[depitem].options.length;
12523: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12524: }
12525: }
12526: }
12527: }
12528: }
12529: }
12530: } else {
12531: document.getElementById('arc_depon_'+count).style.display='none';
12532: form.elements[depitem].options.length = 0;
12533: form.elements[depitem].options[0] = new Option('Select','',true,true);
12534: }
1.1059 raeburn 12535: titleCheck(form,count,offset);
1.1056 raeburn 12536: }
12537: }
12538:
12539: function propagateSelect(form,count,offset) {
12540: if (count > 0) {
1.1065 raeburn 12541: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12542: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12543: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12544: if (parents[count].length > 0) {
12545: for (var j=0; j<parents[count].length; j++) {
12546: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12547: }
12548: }
12549: }
12550: }
12551: }
1.1056 raeburn 12552:
12553: function containerSelect(form,count,offset,picked) {
12554: if (count > 0) {
1.1065 raeburn 12555: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12556: if (form.elements[item].type == 'radio') {
12557: if (form.elements[item].value == 'dependency') {
12558: if (form.elements[item+1].type == 'select-one') {
12559: for (var i=0; i<form.elements[item+1].options.length; i++) {
12560: if (form.elements[item+1].options[i].value == picked) {
12561: form.elements[item+1].selectedIndex = i;
12562: break;
12563: }
12564: }
12565: }
12566: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12567: if (parents[count].length > 0) {
12568: for (var j=0; j<parents[count].length; j++) {
12569: containerSelect(form,parents[count][j],offset,picked);
12570: }
12571: }
12572: }
12573: }
12574: }
12575: }
12576: }
12577:
1.1059 raeburn 12578: function titleCheck(form,count,offset) {
12579: if (count > 0) {
12580: var chosen = (offset+$startcount)+7*(count-1);
12581: var depitem = $startcount + ((count-1) * 7) + 2;
12582: var currtype = form.elements[depitem].type;
12583: if (form.elements[chosen].value == 'display') {
12584: document.getElementById('arc_title_'+count).style.display='block';
12585: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12586: document.getElementById('archive_title_'+count).value=maintitle;
12587: }
12588: } else {
12589: document.getElementById('arc_title_'+count).style.display='none';
12590: if (currtype == 'text') {
12591: document.getElementById('archive_title_'+count).value='';
12592: }
12593: }
12594: }
12595: return;
12596: }
12597:
1.1055 raeburn 12598: // ]]>
12599: </script>
12600: END
12601: return $scripttag;
12602: }
12603:
12604: sub process_extracted_files {
1.1067 raeburn 12605: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12606: my $numitems = $env{'form.archive_count'};
12607: return unless ($numitems);
12608: my @ids=&Apache::lonnet::current_machine_ids();
12609: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12610: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12611: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12612: if (grep(/^\Q$docuhome\E$/,@ids)) {
12613: $prefix = &LONCAPA::propath($docudom,$docuname);
12614: $pathtocheck = "$dir_root/$destination";
12615: $dir = $dir_root;
12616: $ishome = 1;
12617: } else {
12618: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12619: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12620: $dir = "$dir_root/$docudom/$docuname";
12621: }
12622: my $currdir = "$dir_root/$destination";
12623: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12624: if ($env{'form.folderpath'}) {
12625: my @items = split('&',$env{'form.folderpath'});
12626: $folders{'0'} = $items[-2];
1.1099 raeburn 12627: if ($env{'form.folderpath'} =~ /\:1$/) {
12628: $containers{'0'}='page';
12629: } else {
12630: $containers{'0'}='sequence';
12631: }
1.1055 raeburn 12632: }
12633: my @archdirs = &get_env_multiple('form.archive_directory');
12634: if ($numitems) {
12635: for (my $i=1; $i<=$numitems; $i++) {
12636: my $path = $env{'form.archive_content_'.$i};
12637: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12638: my $item = $1;
12639: $toplevelitems{$item} = $i;
12640: if (grep(/^\Q$i\E$/,@archdirs)) {
12641: $is_dir{$item} = 1;
12642: }
12643: }
12644: }
12645: }
1.1067 raeburn 12646: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12647: if (keys(%toplevelitems) > 0) {
12648: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12649: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12650: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12651: }
1.1066 raeburn 12652: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12653: if ($numitems) {
12654: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 12655: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12656: my $path = $env{'form.archive_content_'.$i};
12657: if ($path =~ /^\Q$pathtocheck\E/) {
12658: if ($env{'form.archive_'.$i} eq 'discard') {
12659: if ($prefix ne '' && $path ne '') {
12660: if (-e $prefix.$path) {
1.1066 raeburn 12661: if ((@archdirs > 0) &&
12662: (grep(/^\Q$i\E$/,@archdirs))) {
12663: $todeletedir{$prefix.$path} = 1;
12664: } else {
12665: $todelete{$prefix.$path} = 1;
12666: }
1.1055 raeburn 12667: }
12668: }
12669: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12670: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12671: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12672: $docstitle = $env{'form.archive_title_'.$i};
12673: if ($docstitle eq '') {
12674: $docstitle = $title;
12675: }
1.1055 raeburn 12676: $outer = 0;
1.1056 raeburn 12677: if (ref($dirorder{$i}) eq 'ARRAY') {
12678: if (@{$dirorder{$i}} > 0) {
12679: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12680: if ($env{'form.archive_'.$item} eq 'display') {
12681: $outer = $item;
12682: last;
12683: }
12684: }
12685: }
12686: }
12687: my ($errtext,$fatal) =
12688: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12689: '/'.$folders{$outer}.'.'.
12690: $containers{$outer});
12691: next if ($fatal);
12692: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12693: if ($context eq 'coursedocs') {
1.1056 raeburn 12694: $mapinner{$i} = time;
1.1055 raeburn 12695: $folders{$i} = 'default_'.$mapinner{$i};
12696: $containers{$i} = 'sequence';
12697: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12698: $folders{$i}.'.'.$containers{$i};
12699: my $newidx = &LONCAPA::map::getresidx();
12700: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12701: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12702: push(@LONCAPA::map::order,$newidx);
12703: my ($outtext,$errtext) =
12704: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12705: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12706: '.'.$containers{$outer},1,1);
1.1056 raeburn 12707: $newseqid{$i} = $newidx;
1.1067 raeburn 12708: unless ($errtext) {
12709: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12710: }
1.1055 raeburn 12711: }
12712: } else {
12713: if ($context eq 'coursedocs') {
12714: my $newidx=&LONCAPA::map::getresidx();
12715: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12716: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12717: $title;
12718: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12719: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12720: }
12721: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12722: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12723: }
12724: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12725: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12726: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12727: unless ($ishome) {
12728: my $fetch = "$newdest{$i}/$title";
12729: $fetch =~ s/^\Q$prefix$dir\E//;
12730: $prompttofetch{$fetch} = 1;
12731: }
1.1055 raeburn 12732: }
12733: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12734: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12735: push(@LONCAPA::map::order, $newidx);
12736: my ($outtext,$errtext)=
12737: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12738: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12739: '.'.$containers{$outer},1,1);
1.1067 raeburn 12740: unless ($errtext) {
12741: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12742: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12743: }
12744: }
1.1055 raeburn 12745: }
12746: }
1.1086 raeburn 12747: }
12748: } else {
12749: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12750: }
12751: }
12752: for (my $i=1; $i<=$numitems; $i++) {
12753: next unless ($env{'form.archive_'.$i} eq 'dependency');
12754: my $path = $env{'form.archive_content_'.$i};
12755: if ($path =~ /^\Q$pathtocheck\E/) {
12756: my ($title) = ($path =~ m{/([^/]+)$});
12757: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12758: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12759: if (ref($dirorder{$i}) eq 'ARRAY') {
12760: my ($itemidx,$fullpath,$relpath);
12761: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12762: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12763: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12764: if ($dirorder{$i}->[$j] eq $container) {
12765: $itemidx = $j;
1.1056 raeburn 12766: }
12767: }
1.1086 raeburn 12768: }
12769: if ($itemidx eq '') {
12770: $itemidx = 0;
12771: }
12772: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12773: if ($mapinner{$referrer{$i}}) {
12774: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12775: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12776: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12777: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12778: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12779: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12780: if (!-e $fullpath) {
12781: mkdir($fullpath,0755);
1.1056 raeburn 12782: }
12783: }
1.1086 raeburn 12784: } else {
12785: last;
1.1056 raeburn 12786: }
1.1086 raeburn 12787: }
12788: }
12789: } elsif ($newdest{$referrer{$i}}) {
12790: $fullpath = $newdest{$referrer{$i}};
12791: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12792: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12793: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12794: last;
12795: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12796: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12797: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12798: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12799: if (!-e $fullpath) {
12800: mkdir($fullpath,0755);
1.1056 raeburn 12801: }
12802: }
1.1086 raeburn 12803: } else {
12804: last;
1.1056 raeburn 12805: }
1.1055 raeburn 12806: }
12807: }
1.1086 raeburn 12808: if ($fullpath ne '') {
12809: if (-e "$prefix$path") {
12810: system("mv $prefix$path $fullpath/$title");
12811: }
12812: if (-e "$fullpath/$title") {
12813: my $showpath;
12814: if ($relpath ne '') {
12815: $showpath = "$relpath/$title";
12816: } else {
12817: $showpath = "/$title";
12818: }
12819: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12820: }
12821: unless ($ishome) {
12822: my $fetch = "$fullpath/$title";
12823: $fetch =~ s/^\Q$prefix$dir\E//;
12824: $prompttofetch{$fetch} = 1;
12825: }
12826: }
1.1055 raeburn 12827: }
1.1086 raeburn 12828: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12829: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12830: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12831: }
12832: } else {
12833: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12834: }
12835: }
12836: if (keys(%todelete)) {
12837: foreach my $key (keys(%todelete)) {
12838: unlink($key);
1.1066 raeburn 12839: }
12840: }
12841: if (keys(%todeletedir)) {
12842: foreach my $key (keys(%todeletedir)) {
12843: rmdir($key);
12844: }
12845: }
12846: foreach my $dir (sort(keys(%is_dir))) {
12847: if (($pathtocheck ne '') && ($dir ne '')) {
12848: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12849: }
12850: }
1.1067 raeburn 12851: if ($result ne '') {
12852: $output .= '<ul>'."\n".
12853: $result."\n".
12854: '</ul>';
12855: }
12856: unless ($ishome) {
12857: my $replicationfail;
12858: foreach my $item (keys(%prompttofetch)) {
12859: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12860: unless ($fetchresult eq 'ok') {
12861: $replicationfail .= '<li>'.$item.'</li>'."\n";
12862: }
12863: }
12864: if ($replicationfail) {
12865: $output .= '<p class="LC_error">'.
12866: &mt('Course home server failed to retrieve:').'<ul>'.
12867: $replicationfail.
12868: '</ul></p>';
12869: }
12870: }
1.1055 raeburn 12871: } else {
12872: $warning = &mt('No items found in archive.');
12873: }
12874: if ($error) {
12875: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12876: $error.'</p>'."\n";
12877: }
12878: if ($warning) {
12879: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12880: }
12881: return $output;
12882: }
12883:
1.1066 raeburn 12884: sub cleanup_empty_dirs {
12885: my ($path) = @_;
12886: if (($path ne '') && (-d $path)) {
12887: if (opendir(my $dirh,$path)) {
12888: my @dircontents = grep(!/^\./,readdir($dirh));
12889: my $numitems = 0;
12890: foreach my $item (@dircontents) {
12891: if (-d "$path/$item") {
1.1111 raeburn 12892: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12893: if (-e "$path/$item") {
12894: $numitems ++;
12895: }
12896: } else {
12897: $numitems ++;
12898: }
12899: }
12900: if ($numitems == 0) {
12901: rmdir($path);
12902: }
12903: closedir($dirh);
12904: }
12905: }
12906: return;
12907: }
12908:
1.41 ng 12909: =pod
1.45 matthew 12910:
1.1162 raeburn 12911: =item * &get_folder_hierarchy()
1.1068 raeburn 12912:
12913: Provides hierarchy of names of folders/sub-folders containing the current
12914: item,
12915:
12916: Inputs: 3
12917: - $navmap - navmaps object
12918:
12919: - $map - url for map (either the trigger itself, or map containing
12920: the resource, which is the trigger).
12921:
12922: - $showitem - 1 => show title for map itself; 0 => do not show.
12923:
12924: Outputs: 1 @pathitems - array of folder/subfolder names.
12925:
12926: =cut
12927:
12928: sub get_folder_hierarchy {
12929: my ($navmap,$map,$showitem) = @_;
12930: my @pathitems;
12931: if (ref($navmap)) {
12932: my $mapres = $navmap->getResourceByUrl($map);
12933: if (ref($mapres)) {
12934: my $pcslist = $mapres->map_hierarchy();
12935: if ($pcslist ne '') {
12936: my @pcs = split(/,/,$pcslist);
12937: foreach my $pc (@pcs) {
12938: if ($pc == 1) {
1.1129 raeburn 12939: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12940: } else {
12941: my $res = $navmap->getByMapPc($pc);
12942: if (ref($res)) {
12943: my $title = $res->compTitle();
12944: $title =~ s/\W+/_/g;
12945: if ($title ne '') {
12946: push(@pathitems,$title);
12947: }
12948: }
12949: }
12950: }
12951: }
1.1071 raeburn 12952: if ($showitem) {
12953: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12954: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12955: } else {
12956: my $maptitle = $mapres->compTitle();
12957: $maptitle =~ s/\W+/_/g;
12958: if ($maptitle ne '') {
12959: push(@pathitems,$maptitle);
12960: }
1.1068 raeburn 12961: }
12962: }
12963: }
12964: }
12965: return @pathitems;
12966: }
12967:
12968: =pod
12969:
1.1015 raeburn 12970: =item * &get_turnedin_filepath()
12971:
12972: Determines path in a user's portfolio file for storage of files uploaded
12973: to a specific essayresponse or dropbox item.
12974:
12975: Inputs: 3 required + 1 optional.
12976: $symb is symb for resource, $uname and $udom are for current user (required).
12977: $caller is optional (can be "submission", if routine is called when storing
12978: an upoaded file when "Submit Answer" button was pressed).
12979:
12980: Returns array containing $path and $multiresp.
12981: $path is path in portfolio. $multiresp is 1 if this resource contains more
12982: than one file upload item. Callers of routine should append partid as a
12983: subdirectory to $path in cases where $multiresp is 1.
12984:
12985: Called by: homework/essayresponse.pm and homework/structuretags.pm
12986:
12987: =cut
12988:
12989: sub get_turnedin_filepath {
12990: my ($symb,$uname,$udom,$caller) = @_;
12991: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12992: my $turnindir;
12993: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12994: $turnindir = $userhash{'turnindir'};
12995: my ($path,$multiresp);
12996: if ($turnindir eq '') {
12997: if ($caller eq 'submission') {
12998: $turnindir = &mt('turned in');
12999: $turnindir =~ s/\W+/_/g;
13000: my %newhash = (
13001: 'turnindir' => $turnindir,
13002: );
13003: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13004: }
13005: }
13006: if ($turnindir ne '') {
13007: $path = '/'.$turnindir.'/';
13008: my ($multipart,$turnin,@pathitems);
13009: my $navmap = Apache::lonnavmaps::navmap->new();
13010: if (defined($navmap)) {
13011: my $mapres = $navmap->getResourceByUrl($map);
13012: if (ref($mapres)) {
13013: my $pcslist = $mapres->map_hierarchy();
13014: if ($pcslist ne '') {
13015: foreach my $pc (split(/,/,$pcslist)) {
13016: my $res = $navmap->getByMapPc($pc);
13017: if (ref($res)) {
13018: my $title = $res->compTitle();
13019: $title =~ s/\W+/_/g;
13020: if ($title ne '') {
1.1149 raeburn 13021: if (($pc > 1) && (length($title) > 12)) {
13022: $title = substr($title,0,12);
13023: }
1.1015 raeburn 13024: push(@pathitems,$title);
13025: }
13026: }
13027: }
13028: }
13029: my $maptitle = $mapres->compTitle();
13030: $maptitle =~ s/\W+/_/g;
13031: if ($maptitle ne '') {
1.1149 raeburn 13032: if (length($maptitle) > 12) {
13033: $maptitle = substr($maptitle,0,12);
13034: }
1.1015 raeburn 13035: push(@pathitems,$maptitle);
13036: }
13037: unless ($env{'request.state'} eq 'construct') {
13038: my $res = $navmap->getBySymb($symb);
13039: if (ref($res)) {
13040: my $partlist = $res->parts();
13041: my $totaluploads = 0;
13042: if (ref($partlist) eq 'ARRAY') {
13043: foreach my $part (@{$partlist}) {
13044: my @types = $res->responseType($part);
13045: my @ids = $res->responseIds($part);
13046: for (my $i=0; $i < scalar(@ids); $i++) {
13047: if ($types[$i] eq 'essay') {
13048: my $partid = $part.'_'.$ids[$i];
13049: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13050: $totaluploads ++;
13051: }
13052: }
13053: }
13054: }
13055: if ($totaluploads > 1) {
13056: $multiresp = 1;
13057: }
13058: }
13059: }
13060: }
13061: } else {
13062: return;
13063: }
13064: } else {
13065: return;
13066: }
13067: my $restitle=&Apache::lonnet::gettitle($symb);
13068: $restitle =~ s/\W+/_/g;
13069: if ($restitle eq '') {
13070: $restitle = ($resurl =~ m{/[^/]+$});
13071: if ($restitle eq '') {
13072: $restitle = time;
13073: }
13074: }
1.1149 raeburn 13075: if (length($restitle) > 12) {
13076: $restitle = substr($restitle,0,12);
13077: }
1.1015 raeburn 13078: push(@pathitems,$restitle);
13079: $path .= join('/',@pathitems);
13080: }
13081: return ($path,$multiresp);
13082: }
13083:
13084: =pod
13085:
1.464 albertel 13086: =back
1.41 ng 13087:
1.112 bowersj2 13088: =head1 CSV Upload/Handling functions
1.38 albertel 13089:
1.41 ng 13090: =over 4
13091:
1.648 raeburn 13092: =item * &upfile_store($r)
1.41 ng 13093:
13094: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13095: needs $env{'form.upfile'}
1.41 ng 13096: returns $datatoken to be put into hidden field
13097:
13098: =cut
1.31 albertel 13099:
13100: sub upfile_store {
13101: my $r=shift;
1.258 albertel 13102: $env{'form.upfile'}=~s/\r/\n/gs;
13103: $env{'form.upfile'}=~s/\f/\n/gs;
13104: $env{'form.upfile'}=~s/\n+/\n/gs;
13105: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13106:
1.258 albertel 13107: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
13108: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 13109: {
1.158 raeburn 13110: my $datafile = $r->dir_config('lonDaemons').
13111: '/tmp/'.$datatoken.'.tmp';
13112: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13113: print $fh $env{'form.upfile'};
1.158 raeburn 13114: close($fh);
13115: }
1.31 albertel 13116: }
13117: return $datatoken;
13118: }
13119:
1.56 matthew 13120: =pod
13121:
1.648 raeburn 13122: =item * &load_tmp_file($r)
1.41 ng 13123:
13124: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 13125: needs $env{'form.datatoken'},
13126: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13127:
13128: =cut
1.31 albertel 13129:
13130: sub load_tmp_file {
13131: my $r=shift;
13132: my @studentdata=();
13133: {
1.158 raeburn 13134: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 13135: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 13136: if ( open(my $fh,"<$studentfile") ) {
13137: @studentdata=<$fh>;
13138: close($fh);
13139: }
1.31 albertel 13140: }
1.258 albertel 13141: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13142: }
13143:
1.56 matthew 13144: =pod
13145:
1.648 raeburn 13146: =item * &upfile_record_sep()
1.41 ng 13147:
13148: Separate uploaded file into records
13149: returns array of records,
1.258 albertel 13150: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13151:
13152: =cut
1.31 albertel 13153:
13154: sub upfile_record_sep {
1.258 albertel 13155: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13156: } else {
1.248 albertel 13157: my @records;
1.258 albertel 13158: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13159: if ($line=~/^\s*$/) { next; }
13160: push(@records,$line);
13161: }
13162: return @records;
1.31 albertel 13163: }
13164: }
13165:
1.56 matthew 13166: =pod
13167:
1.648 raeburn 13168: =item * &record_sep($record)
1.41 ng 13169:
1.258 albertel 13170: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13171:
13172: =cut
13173:
1.263 www 13174: sub takeleft {
13175: my $index=shift;
13176: return substr('0000'.$index,-4,4);
13177: }
13178:
1.31 albertel 13179: sub record_sep {
13180: my $record=shift;
13181: my %components=();
1.258 albertel 13182: if ($env{'form.upfiletype'} eq 'xml') {
13183: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13184: my $i=0;
1.356 albertel 13185: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13186: $field=~s/^(\"|\')//;
13187: $field=~s/(\"|\')$//;
1.263 www 13188: $components{&takeleft($i)}=$field;
1.31 albertel 13189: $i++;
13190: }
1.258 albertel 13191: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13192: my $i=0;
1.356 albertel 13193: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13194: $field=~s/^(\"|\')//;
13195: $field=~s/(\"|\')$//;
1.263 www 13196: $components{&takeleft($i)}=$field;
1.31 albertel 13197: $i++;
13198: }
13199: } else {
1.561 www 13200: my $separator=',';
1.480 banghart 13201: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13202: $separator=';';
1.480 banghart 13203: }
1.31 albertel 13204: my $i=0;
1.561 www 13205: # the character we are looking for to indicate the end of a quote or a record
13206: my $looking_for=$separator;
13207: # do not add the characters to the fields
13208: my $ignore=0;
13209: # we just encountered a separator (or the beginning of the record)
13210: my $just_found_separator=1;
13211: # store the field we are working on here
13212: my $field='';
13213: # work our way through all characters in record
13214: foreach my $character ($record=~/(.)/g) {
13215: if ($character eq $looking_for) {
13216: if ($character ne $separator) {
13217: # Found the end of a quote, again looking for separator
13218: $looking_for=$separator;
13219: $ignore=1;
13220: } else {
13221: # Found a separator, store away what we got
13222: $components{&takeleft($i)}=$field;
13223: $i++;
13224: $just_found_separator=1;
13225: $ignore=0;
13226: $field='';
13227: }
13228: next;
13229: }
13230: # single or double quotation marks after a separator indicate beginning of a quote
13231: # we are now looking for the end of the quote and need to ignore separators
13232: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13233: $looking_for=$character;
13234: next;
13235: }
13236: # ignore would be true after we reached the end of a quote
13237: if ($ignore) { next; }
13238: if (($just_found_separator) && ($character=~/\s/)) { next; }
13239: $field.=$character;
13240: $just_found_separator=0;
1.31 albertel 13241: }
1.561 www 13242: # catch the very last entry, since we never encountered the separator
13243: $components{&takeleft($i)}=$field;
1.31 albertel 13244: }
13245: return %components;
13246: }
13247:
1.144 matthew 13248: ######################################################
13249: ######################################################
13250:
1.56 matthew 13251: =pod
13252:
1.648 raeburn 13253: =item * &upfile_select_html()
1.41 ng 13254:
1.144 matthew 13255: Return HTML code to select a file from the users machine and specify
13256: the file type.
1.41 ng 13257:
13258: =cut
13259:
1.144 matthew 13260: ######################################################
13261: ######################################################
1.31 albertel 13262: sub upfile_select_html {
1.144 matthew 13263: my %Types = (
13264: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13265: semisv => &mt('Semicolon separated values'),
1.144 matthew 13266: space => &mt('Space separated'),
13267: tab => &mt('Tabulator separated'),
13268: # xml => &mt('HTML/XML'),
13269: );
13270: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13271: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13272: foreach my $type (sort(keys(%Types))) {
13273: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13274: }
13275: $Str .= "</select>\n";
13276: return $Str;
1.31 albertel 13277: }
13278:
1.301 albertel 13279: sub get_samples {
13280: my ($records,$toget) = @_;
13281: my @samples=({});
13282: my $got=0;
13283: foreach my $rec (@$records) {
13284: my %temp = &record_sep($rec);
13285: if (! grep(/\S/, values(%temp))) { next; }
13286: if (%temp) {
13287: $samples[$got]=\%temp;
13288: $got++;
13289: if ($got == $toget) { last; }
13290: }
13291: }
13292: return \@samples;
13293: }
13294:
1.144 matthew 13295: ######################################################
13296: ######################################################
13297:
1.56 matthew 13298: =pod
13299:
1.648 raeburn 13300: =item * &csv_print_samples($r,$records)
1.41 ng 13301:
13302: Prints a table of sample values from each column uploaded $r is an
13303: Apache Request ref, $records is an arrayref from
13304: &Apache::loncommon::upfile_record_sep
13305:
13306: =cut
13307:
1.144 matthew 13308: ######################################################
13309: ######################################################
1.31 albertel 13310: sub csv_print_samples {
13311: my ($r,$records) = @_;
1.662 bisitz 13312: my $samples = &get_samples($records,5);
1.301 albertel 13313:
1.594 raeburn 13314: $r->print(&mt('Samples').'<br />'.&start_data_table().
13315: &start_data_table_header_row());
1.356 albertel 13316: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13317: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13318: $r->print(&end_data_table_header_row());
1.301 albertel 13319: foreach my $hash (@$samples) {
1.594 raeburn 13320: $r->print(&start_data_table_row());
1.356 albertel 13321: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13322: $r->print('<td>');
1.356 albertel 13323: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13324: $r->print('</td>');
13325: }
1.594 raeburn 13326: $r->print(&end_data_table_row());
1.31 albertel 13327: }
1.594 raeburn 13328: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13329: }
13330:
1.144 matthew 13331: ######################################################
13332: ######################################################
13333:
1.56 matthew 13334: =pod
13335:
1.648 raeburn 13336: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13337:
13338: Prints a table to create associations between values and table columns.
1.144 matthew 13339:
1.41 ng 13340: $r is an Apache Request ref,
13341: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13342: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13343:
13344: =cut
13345:
1.144 matthew 13346: ######################################################
13347: ######################################################
1.31 albertel 13348: sub csv_print_select_table {
13349: my ($r,$records,$d) = @_;
1.301 albertel 13350: my $i=0;
13351: my $samples = &get_samples($records,1);
1.144 matthew 13352: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13353: &start_data_table().&start_data_table_header_row().
1.144 matthew 13354: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13355: '<th>'.&mt('Column').'</th>'.
13356: &end_data_table_header_row()."\n");
1.356 albertel 13357: foreach my $array_ref (@$d) {
13358: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13359: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13360:
1.875 bisitz 13361: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13362: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13363: $r->print('<option value="none"></option>');
1.356 albertel 13364: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13365: $r->print('<option value="'.$sample.'"'.
13366: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13367: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13368: }
1.594 raeburn 13369: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13370: $i++;
13371: }
1.594 raeburn 13372: $r->print(&end_data_table());
1.31 albertel 13373: $i--;
13374: return $i;
13375: }
1.56 matthew 13376:
1.144 matthew 13377: ######################################################
13378: ######################################################
13379:
1.56 matthew 13380: =pod
1.31 albertel 13381:
1.648 raeburn 13382: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13383:
13384: Prints a table of sample values from the upload and can make associate samples to internal names.
13385:
13386: $r is an Apache Request ref,
13387: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13388: $d is an array of 2 element arrays (internal name, displayed name)
13389:
13390: =cut
13391:
1.144 matthew 13392: ######################################################
13393: ######################################################
1.31 albertel 13394: sub csv_samples_select_table {
13395: my ($r,$records,$d) = @_;
13396: my $i=0;
1.144 matthew 13397: #
1.662 bisitz 13398: my $max_samples = 5;
13399: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13400: $r->print(&start_data_table().
13401: &start_data_table_header_row().'<th>'.
13402: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13403: &end_data_table_header_row());
1.301 albertel 13404:
13405: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13406: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13407: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13408: foreach my $option (@$d) {
13409: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13410: $r->print('<option value="'.$value.'"'.
1.253 albertel 13411: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13412: $display.'</option>');
1.31 albertel 13413: }
13414: $r->print('</select></td><td>');
1.662 bisitz 13415: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13416: if (defined($samples->[$line]{$key})) {
13417: $r->print($samples->[$line]{$key}."<br />\n");
13418: }
13419: }
1.594 raeburn 13420: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13421: $i++;
13422: }
1.594 raeburn 13423: $r->print(&end_data_table());
1.31 albertel 13424: $i--;
13425: return($i);
1.115 matthew 13426: }
13427:
1.144 matthew 13428: ######################################################
13429: ######################################################
13430:
1.115 matthew 13431: =pod
13432:
1.648 raeburn 13433: =item * &clean_excel_name($name)
1.115 matthew 13434:
13435: Returns a replacement for $name which does not contain any illegal characters.
13436:
13437: =cut
13438:
1.144 matthew 13439: ######################################################
13440: ######################################################
1.115 matthew 13441: sub clean_excel_name {
13442: my ($name) = @_;
13443: $name =~ s/[:\*\?\/\\]//g;
13444: if (length($name) > 31) {
13445: $name = substr($name,0,31);
13446: }
13447: return $name;
1.25 albertel 13448: }
1.84 albertel 13449:
1.85 albertel 13450: =pod
13451:
1.648 raeburn 13452: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13453:
13454: Returns either 1 or undef
13455:
13456: 1 if the part is to be hidden, undef if it is to be shown
13457:
13458: Arguments are:
13459:
13460: $id the id of the part to be checked
13461: $symb, optional the symb of the resource to check
13462: $udom, optional the domain of the user to check for
13463: $uname, optional the username of the user to check for
13464:
13465: =cut
1.84 albertel 13466:
13467: sub check_if_partid_hidden {
13468: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13469: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13470: $symb,$udom,$uname);
1.141 albertel 13471: my $truth=1;
13472: #if the string starts with !, then the list is the list to show not hide
13473: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13474: my @hiddenlist=split(/,/,$hiddenparts);
13475: foreach my $checkid (@hiddenlist) {
1.141 albertel 13476: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13477: }
1.141 albertel 13478: return !$truth;
1.84 albertel 13479: }
1.127 matthew 13480:
1.138 matthew 13481:
13482: ############################################################
13483: ############################################################
13484:
13485: =pod
13486:
1.157 matthew 13487: =back
13488:
1.138 matthew 13489: =head1 cgi-bin script and graphing routines
13490:
1.157 matthew 13491: =over 4
13492:
1.648 raeburn 13493: =item * &get_cgi_id()
1.138 matthew 13494:
13495: Inputs: none
13496:
13497: Returns an id which can be used to pass environment variables
13498: to various cgi-bin scripts. These environment variables will
13499: be removed from the users environment after a given time by
13500: the routine &Apache::lonnet::transfer_profile_to_env.
13501:
13502: =cut
13503:
13504: ############################################################
13505: ############################################################
1.152 albertel 13506: my $uniq=0;
1.136 matthew 13507: sub get_cgi_id {
1.154 albertel 13508: $uniq=($uniq+1)%100000;
1.280 albertel 13509: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13510: }
13511:
1.127 matthew 13512: ############################################################
13513: ############################################################
13514:
13515: =pod
13516:
1.648 raeburn 13517: =item * &DrawBarGraph()
1.127 matthew 13518:
1.138 matthew 13519: Facilitates the plotting of data in a (stacked) bar graph.
13520: Puts plot definition data into the users environment in order for
13521: graph.png to plot it. Returns an <img> tag for the plot.
13522: The bars on the plot are labeled '1','2',...,'n'.
13523:
13524: Inputs:
13525:
13526: =over 4
13527:
13528: =item $Title: string, the title of the plot
13529:
13530: =item $xlabel: string, text describing the X-axis of the plot
13531:
13532: =item $ylabel: string, text describing the Y-axis of the plot
13533:
13534: =item $Max: scalar, the maximum Y value to use in the plot
13535: If $Max is < any data point, the graph will not be rendered.
13536:
1.140 matthew 13537: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13538: they are plotted. If undefined, default values will be used.
13539:
1.178 matthew 13540: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13541:
1.138 matthew 13542: =item @Values: An array of array references. Each array reference holds data
13543: to be plotted in a stacked bar chart.
13544:
1.239 matthew 13545: =item If the final element of @Values is a hash reference the key/value
13546: pairs will be added to the graph definition.
13547:
1.138 matthew 13548: =back
13549:
13550: Returns:
13551:
13552: An <img> tag which references graph.png and the appropriate identifying
13553: information for the plot.
13554:
1.127 matthew 13555: =cut
13556:
13557: ############################################################
13558: ############################################################
1.134 matthew 13559: sub DrawBarGraph {
1.178 matthew 13560: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13561: #
13562: if (! defined($colors)) {
13563: $colors = ['#33ff00',
13564: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13565: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13566: ];
13567: }
1.228 matthew 13568: my $extra_settings = {};
13569: if (ref($Values[-1]) eq 'HASH') {
13570: $extra_settings = pop(@Values);
13571: }
1.127 matthew 13572: #
1.136 matthew 13573: my $identifier = &get_cgi_id();
13574: my $id = 'cgi.'.$identifier;
1.129 matthew 13575: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13576: return '';
13577: }
1.225 matthew 13578: #
13579: my @Labels;
13580: if (defined($labels)) {
13581: @Labels = @$labels;
13582: } else {
13583: for (my $i=0;$i<@{$Values[0]};$i++) {
13584: push (@Labels,$i+1);
13585: }
13586: }
13587: #
1.129 matthew 13588: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13589: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13590: my %ValuesHash;
13591: my $NumSets=1;
13592: foreach my $array (@Values) {
13593: next if (! ref($array));
1.136 matthew 13594: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13595: join(',',@$array);
1.129 matthew 13596: }
1.127 matthew 13597: #
1.136 matthew 13598: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13599: if ($NumBars < 3) {
13600: $width = 120+$NumBars*32;
1.220 matthew 13601: $xskip = 1;
1.225 matthew 13602: $bar_width = 30;
13603: } elsif ($NumBars < 5) {
13604: $width = 120+$NumBars*20;
13605: $xskip = 1;
13606: $bar_width = 20;
1.220 matthew 13607: } elsif ($NumBars < 10) {
1.136 matthew 13608: $width = 120+$NumBars*15;
13609: $xskip = 1;
13610: $bar_width = 15;
13611: } elsif ($NumBars <= 25) {
13612: $width = 120+$NumBars*11;
13613: $xskip = 5;
13614: $bar_width = 8;
13615: } elsif ($NumBars <= 50) {
13616: $width = 120+$NumBars*8;
13617: $xskip = 5;
13618: $bar_width = 4;
13619: } else {
13620: $width = 120+$NumBars*8;
13621: $xskip = 5;
13622: $bar_width = 4;
13623: }
13624: #
1.137 matthew 13625: $Max = 1 if ($Max < 1);
13626: if ( int($Max) < $Max ) {
13627: $Max++;
13628: $Max = int($Max);
13629: }
1.127 matthew 13630: $Title = '' if (! defined($Title));
13631: $xlabel = '' if (! defined($xlabel));
13632: $ylabel = '' if (! defined($ylabel));
1.369 www 13633: $ValuesHash{$id.'.title'} = &escape($Title);
13634: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13635: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13636: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13637: $ValuesHash{$id.'.NumBars'} = $NumBars;
13638: $ValuesHash{$id.'.NumSets'} = $NumSets;
13639: $ValuesHash{$id.'.PlotType'} = 'bar';
13640: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13641: $ValuesHash{$id.'.height'} = $height;
13642: $ValuesHash{$id.'.width'} = $width;
13643: $ValuesHash{$id.'.xskip'} = $xskip;
13644: $ValuesHash{$id.'.bar_width'} = $bar_width;
13645: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13646: #
1.228 matthew 13647: # Deal with other parameters
13648: while (my ($key,$value) = each(%$extra_settings)) {
13649: $ValuesHash{$id.'.'.$key} = $value;
13650: }
13651: #
1.646 raeburn 13652: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13653: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13654: }
13655:
13656: ############################################################
13657: ############################################################
13658:
13659: =pod
13660:
1.648 raeburn 13661: =item * &DrawXYGraph()
1.137 matthew 13662:
1.138 matthew 13663: Facilitates the plotting of data in an XY graph.
13664: Puts plot definition data into the users environment in order for
13665: graph.png to plot it. Returns an <img> tag for the plot.
13666:
13667: Inputs:
13668:
13669: =over 4
13670:
13671: =item $Title: string, the title of the plot
13672:
13673: =item $xlabel: string, text describing the X-axis of the plot
13674:
13675: =item $ylabel: string, text describing the Y-axis of the plot
13676:
13677: =item $Max: scalar, the maximum Y value to use in the plot
13678: If $Max is < any data point, the graph will not be rendered.
13679:
13680: =item $colors: Array ref containing the hex color codes for the data to be
13681: plotted in. If undefined, default values will be used.
13682:
13683: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13684:
13685: =item $Ydata: Array ref containing Array refs.
1.185 www 13686: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13687:
13688: =item %Values: hash indicating or overriding any default values which are
13689: passed to graph.png.
13690: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13691:
13692: =back
13693:
13694: Returns:
13695:
13696: An <img> tag which references graph.png and the appropriate identifying
13697: information for the plot.
13698:
1.137 matthew 13699: =cut
13700:
13701: ############################################################
13702: ############################################################
13703: sub DrawXYGraph {
13704: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13705: #
13706: # Create the identifier for the graph
13707: my $identifier = &get_cgi_id();
13708: my $id = 'cgi.'.$identifier;
13709: #
13710: $Title = '' if (! defined($Title));
13711: $xlabel = '' if (! defined($xlabel));
13712: $ylabel = '' if (! defined($ylabel));
13713: my %ValuesHash =
13714: (
1.369 www 13715: $id.'.title' => &escape($Title),
13716: $id.'.xlabel' => &escape($xlabel),
13717: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13718: $id.'.y_max_value'=> $Max,
13719: $id.'.labels' => join(',',@$Xlabels),
13720: $id.'.PlotType' => 'XY',
13721: );
13722: #
13723: if (defined($colors) && ref($colors) eq 'ARRAY') {
13724: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13725: }
13726: #
13727: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13728: return '';
13729: }
13730: my $NumSets=1;
1.138 matthew 13731: foreach my $array (@{$Ydata}){
1.137 matthew 13732: next if (! ref($array));
13733: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13734: }
1.138 matthew 13735: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13736: #
13737: # Deal with other parameters
13738: while (my ($key,$value) = each(%Values)) {
13739: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13740: }
13741: #
1.646 raeburn 13742: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13743: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13744: }
13745:
13746: ############################################################
13747: ############################################################
13748:
13749: =pod
13750:
1.648 raeburn 13751: =item * &DrawXYYGraph()
1.138 matthew 13752:
13753: Facilitates the plotting of data in an XY graph with two Y axes.
13754: Puts plot definition data into the users environment in order for
13755: graph.png to plot it. Returns an <img> tag for the plot.
13756:
13757: Inputs:
13758:
13759: =over 4
13760:
13761: =item $Title: string, the title of the plot
13762:
13763: =item $xlabel: string, text describing the X-axis of the plot
13764:
13765: =item $ylabel: string, text describing the Y-axis of the plot
13766:
13767: =item $colors: Array ref containing the hex color codes for the data to be
13768: plotted in. If undefined, default values will be used.
13769:
13770: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13771:
13772: =item $Ydata1: The first data set
13773:
13774: =item $Min1: The minimum value of the left Y-axis
13775:
13776: =item $Max1: The maximum value of the left Y-axis
13777:
13778: =item $Ydata2: The second data set
13779:
13780: =item $Min2: The minimum value of the right Y-axis
13781:
13782: =item $Max2: The maximum value of the left Y-axis
13783:
13784: =item %Values: hash indicating or overriding any default values which are
13785: passed to graph.png.
13786: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13787:
13788: =back
13789:
13790: Returns:
13791:
13792: An <img> tag which references graph.png and the appropriate identifying
13793: information for the plot.
1.136 matthew 13794:
13795: =cut
13796:
13797: ############################################################
13798: ############################################################
1.137 matthew 13799: sub DrawXYYGraph {
13800: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13801: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13802: #
13803: # Create the identifier for the graph
13804: my $identifier = &get_cgi_id();
13805: my $id = 'cgi.'.$identifier;
13806: #
13807: $Title = '' if (! defined($Title));
13808: $xlabel = '' if (! defined($xlabel));
13809: $ylabel = '' if (! defined($ylabel));
13810: my %ValuesHash =
13811: (
1.369 www 13812: $id.'.title' => &escape($Title),
13813: $id.'.xlabel' => &escape($xlabel),
13814: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13815: $id.'.labels' => join(',',@$Xlabels),
13816: $id.'.PlotType' => 'XY',
13817: $id.'.NumSets' => 2,
1.137 matthew 13818: $id.'.two_axes' => 1,
13819: $id.'.y1_max_value' => $Max1,
13820: $id.'.y1_min_value' => $Min1,
13821: $id.'.y2_max_value' => $Max2,
13822: $id.'.y2_min_value' => $Min2,
1.136 matthew 13823: );
13824: #
1.137 matthew 13825: if (defined($colors) && ref($colors) eq 'ARRAY') {
13826: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13827: }
13828: #
13829: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13830: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13831: return '';
13832: }
13833: my $NumSets=1;
1.137 matthew 13834: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13835: next if (! ref($array));
13836: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13837: }
13838: #
13839: # Deal with other parameters
13840: while (my ($key,$value) = each(%Values)) {
13841: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13842: }
13843: #
1.646 raeburn 13844: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13845: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13846: }
13847:
13848: ############################################################
13849: ############################################################
13850:
13851: =pod
13852:
1.157 matthew 13853: =back
13854:
1.139 matthew 13855: =head1 Statistics helper routines?
13856:
13857: Bad place for them but what the hell.
13858:
1.157 matthew 13859: =over 4
13860:
1.648 raeburn 13861: =item * &chartlink()
1.139 matthew 13862:
13863: Returns a link to the chart for a specific student.
13864:
13865: Inputs:
13866:
13867: =over 4
13868:
13869: =item $linktext: The text of the link
13870:
13871: =item $sname: The students username
13872:
13873: =item $sdomain: The students domain
13874:
13875: =back
13876:
1.157 matthew 13877: =back
13878:
1.139 matthew 13879: =cut
13880:
13881: ############################################################
13882: ############################################################
13883: sub chartlink {
13884: my ($linktext, $sname, $sdomain) = @_;
13885: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13886: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13887: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13888: '">'.$linktext.'</a>';
1.153 matthew 13889: }
13890:
13891: #######################################################
13892: #######################################################
13893:
13894: =pod
13895:
13896: =head1 Course Environment Routines
1.157 matthew 13897:
13898: =over 4
1.153 matthew 13899:
1.648 raeburn 13900: =item * &restore_course_settings()
1.153 matthew 13901:
1.648 raeburn 13902: =item * &store_course_settings()
1.153 matthew 13903:
13904: Restores/Store indicated form parameters from the course environment.
13905: Will not overwrite existing values of the form parameters.
13906:
13907: Inputs:
13908: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13909:
13910: a hash ref describing the data to be stored. For example:
13911:
13912: %Save_Parameters = ('Status' => 'scalar',
13913: 'chartoutputmode' => 'scalar',
13914: 'chartoutputdata' => 'scalar',
13915: 'Section' => 'array',
1.373 raeburn 13916: 'Group' => 'array',
1.153 matthew 13917: 'StudentData' => 'array',
13918: 'Maps' => 'array');
13919:
13920: Returns: both routines return nothing
13921:
1.631 raeburn 13922: =back
13923:
1.153 matthew 13924: =cut
13925:
13926: #######################################################
13927: #######################################################
13928: sub store_course_settings {
1.496 albertel 13929: return &store_settings($env{'request.course.id'},@_);
13930: }
13931:
13932: sub store_settings {
1.153 matthew 13933: # save to the environment
13934: # appenv the same items, just to be safe
1.300 albertel 13935: my $udom = $env{'user.domain'};
13936: my $uname = $env{'user.name'};
1.496 albertel 13937: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13938: my %SaveHash;
13939: my %AppHash;
13940: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13941: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13942: my $envname = 'environment.'.$basename;
1.258 albertel 13943: if (exists($env{'form.'.$setting})) {
1.153 matthew 13944: # Save this value away
13945: if ($type eq 'scalar' &&
1.258 albertel 13946: (! exists($env{$envname}) ||
13947: $env{$envname} ne $env{'form.'.$setting})) {
13948: $SaveHash{$basename} = $env{'form.'.$setting};
13949: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13950: } elsif ($type eq 'array') {
13951: my $stored_form;
1.258 albertel 13952: if (ref($env{'form.'.$setting})) {
1.153 matthew 13953: $stored_form = join(',',
13954: map {
1.369 www 13955: &escape($_);
1.258 albertel 13956: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13957: } else {
13958: $stored_form =
1.369 www 13959: &escape($env{'form.'.$setting});
1.153 matthew 13960: }
13961: # Determine if the array contents are the same.
1.258 albertel 13962: if ($stored_form ne $env{$envname}) {
1.153 matthew 13963: $SaveHash{$basename} = $stored_form;
13964: $AppHash{$envname} = $stored_form;
13965: }
13966: }
13967: }
13968: }
13969: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13970: $udom,$uname);
1.153 matthew 13971: if ($put_result !~ /^(ok|delayed)/) {
13972: &Apache::lonnet::logthis('unable to save form parameters, '.
13973: 'got error:'.$put_result);
13974: }
13975: # Make sure these settings stick around in this session, too
1.646 raeburn 13976: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13977: return;
13978: }
13979:
13980: sub restore_course_settings {
1.499 albertel 13981: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13982: }
13983:
13984: sub restore_settings {
13985: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13986: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13987: next if (exists($env{'form.'.$setting}));
1.496 albertel 13988: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13989: '.'.$setting;
1.258 albertel 13990: if (exists($env{$envname})) {
1.153 matthew 13991: if ($type eq 'scalar') {
1.258 albertel 13992: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13993: } elsif ($type eq 'array') {
1.258 albertel 13994: $env{'form.'.$setting} = [
1.153 matthew 13995: map {
1.369 www 13996: &unescape($_);
1.258 albertel 13997: } split(',',$env{$envname})
1.153 matthew 13998: ];
13999: }
14000: }
14001: }
1.127 matthew 14002: }
14003:
1.618 raeburn 14004: #######################################################
14005: #######################################################
14006:
14007: =pod
14008:
14009: =head1 Domain E-mail Routines
14010:
14011: =over 4
14012:
1.648 raeburn 14013: =item * &build_recipient_list()
1.618 raeburn 14014:
1.1144 raeburn 14015: Build recipient lists for following types of e-mail:
1.766 raeburn 14016: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14017: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14018: module change checking, student/employee ID conflict checks, as
14019: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14020: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14021:
14022: Inputs:
1.619 raeburn 14023: defmail (scalar - email address of default recipient),
1.1144 raeburn 14024: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14025: requestsmail, updatesmail, or idconflictsmail).
14026:
1.619 raeburn 14027: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14028:
1.619 raeburn 14029: origmail (scalar - email address of recipient from loncapa.conf,
14030: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14031:
1.655 raeburn 14032: Returns: comma separated list of addresses to which to send e-mail.
14033:
14034: =back
1.618 raeburn 14035:
14036: =cut
14037:
14038: ############################################################
14039: ############################################################
14040: sub build_recipient_list {
1.619 raeburn 14041: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 14042: my @recipients;
14043: my $otheremails;
14044: my %domconfig =
14045: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
14046: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14047: if (exists($domconfig{'contacts'}{$mailing})) {
14048: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14049: my @contacts = ('adminemail','supportemail');
14050: foreach my $item (@contacts) {
14051: if ($domconfig{'contacts'}{$mailing}{$item}) {
14052: my $addr = $domconfig{'contacts'}{$item};
14053: if (!grep(/^\Q$addr\E$/,@recipients)) {
14054: push(@recipients,$addr);
14055: }
1.619 raeburn 14056: }
1.766 raeburn 14057: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 14058: }
14059: }
1.766 raeburn 14060: } elsif ($origmail ne '') {
14061: push(@recipients,$origmail);
1.618 raeburn 14062: }
1.619 raeburn 14063: } elsif ($origmail ne '') {
14064: push(@recipients,$origmail);
1.618 raeburn 14065: }
1.688 raeburn 14066: if (defined($defmail)) {
14067: if ($defmail ne '') {
14068: push(@recipients,$defmail);
14069: }
1.618 raeburn 14070: }
14071: if ($otheremails) {
1.619 raeburn 14072: my @others;
14073: if ($otheremails =~ /,/) {
14074: @others = split(/,/,$otheremails);
1.618 raeburn 14075: } else {
1.619 raeburn 14076: push(@others,$otheremails);
14077: }
14078: foreach my $addr (@others) {
14079: if (!grep(/^\Q$addr\E$/,@recipients)) {
14080: push(@recipients,$addr);
14081: }
1.618 raeburn 14082: }
14083: }
1.619 raeburn 14084: my $recipientlist = join(',',@recipients);
1.618 raeburn 14085: return $recipientlist;
14086: }
14087:
1.127 matthew 14088: ############################################################
14089: ############################################################
1.154 albertel 14090:
1.655 raeburn 14091: =pod
14092:
1.1224 musolffc 14093: =over 4
14094:
1.1223 musolffc 14095: =item * &mime_email()
14096:
14097: Sends an email with a possible attachment
14098:
14099: Inputs:
14100:
14101: =over 4
14102:
14103: from - Sender's email address
14104:
14105: to - Email address of recipient
14106:
14107: subject - Subject of email
14108:
14109: body - Body of email
14110:
14111: cc_string - Carbon copy email address
14112:
14113: bcc - Blind carbon copy email address
14114:
14115: type - File type of attachment
14116:
14117: attachment_path - Path of file to be attached
14118:
14119: file_name - Name of file to be attached
14120:
14121: attachment_text - The body of an attachment of type "TEXT"
14122:
14123: =back
14124:
14125: =back
14126:
14127: =cut
14128:
14129: ############################################################
14130: ############################################################
14131:
14132: sub mime_email {
14133: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14134: $file_name, $attachment_text) = @_;
14135: my $msg = MIME::Lite->new(
14136: From => $from,
14137: To => $to,
14138: Subject => $subject,
14139: Type =>'TEXT',
14140: Data => $body,
14141: );
14142: if ($cc_string ne '') {
14143: $msg->add("Cc" => $cc_string);
14144: }
14145: if ($bcc ne '') {
14146: $msg->add("Bcc" => $bcc);
14147: }
14148: $msg->attr("content-type" => "text/plain");
14149: $msg->attr("content-type.charset" => "UTF-8");
14150: # Attach file if given
14151: if ($attachment_path) {
14152: unless ($file_name) {
14153: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
14154: }
14155: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
14156: $msg->attach(Type => $type,
14157: Path => $attachment_path,
14158: Filename => $file_name
14159: );
14160: # Otherwise attach text if given
14161: } elsif ($attachment_text) {
14162: $msg->attach(Type => 'TEXT',
14163: Data => $attachment_text);
14164: }
14165: # Send it
14166: $msg->send('sendmail');
14167: }
14168:
14169: ############################################################
14170: ############################################################
14171:
14172: =pod
14173:
1.655 raeburn 14174: =head1 Course Catalog Routines
14175:
14176: =over 4
14177:
14178: =item * &gather_categories()
14179:
14180: Converts category definitions - keys of categories hash stored in
14181: coursecategories in configuration.db on the primary library server in a
14182: domain - to an array. Also generates javascript and idx hash used to
14183: generate Domain Coordinator interface for editing Course Categories.
14184:
14185: Inputs:
1.663 raeburn 14186:
1.655 raeburn 14187: categories (reference to hash of category definitions).
1.663 raeburn 14188:
1.655 raeburn 14189: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14190: categories and subcategories).
1.663 raeburn 14191:
1.655 raeburn 14192: idx (reference to hash of counters used in Domain Coordinator interface for
14193: editing Course Categories).
1.663 raeburn 14194:
1.655 raeburn 14195: jsarray (reference to array of categories used to create Javascript arrays for
14196: Domain Coordinator interface for editing Course Categories).
14197:
14198: Returns: nothing
14199:
14200: Side effects: populates cats, idx and jsarray.
14201:
14202: =cut
14203:
14204: sub gather_categories {
14205: my ($categories,$cats,$idx,$jsarray) = @_;
14206: my %counters;
14207: my $num = 0;
14208: foreach my $item (keys(%{$categories})) {
14209: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14210: if ($container eq '' && $depth == 0) {
14211: $cats->[$depth][$categories->{$item}] = $cat;
14212: } else {
14213: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14214: }
14215: my ($escitem,$tail) = split(/:/,$item,2);
14216: if ($counters{$tail} eq '') {
14217: $counters{$tail} = $num;
14218: $num ++;
14219: }
14220: if (ref($idx) eq 'HASH') {
14221: $idx->{$item} = $counters{$tail};
14222: }
14223: if (ref($jsarray) eq 'ARRAY') {
14224: push(@{$jsarray->[$counters{$tail}]},$item);
14225: }
14226: }
14227: return;
14228: }
14229:
14230: =pod
14231:
14232: =item * &extract_categories()
14233:
14234: Used to generate breadcrumb trails for course categories.
14235:
14236: Inputs:
1.663 raeburn 14237:
1.655 raeburn 14238: categories (reference to hash of category definitions).
1.663 raeburn 14239:
1.655 raeburn 14240: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14241: categories and subcategories).
1.663 raeburn 14242:
1.655 raeburn 14243: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14244:
1.655 raeburn 14245: allitems (reference to hash - key is category key
14246: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14247:
1.655 raeburn 14248: idx (reference to hash of counters used in Domain Coordinator interface for
14249: editing Course Categories).
1.663 raeburn 14250:
1.655 raeburn 14251: jsarray (reference to array of categories used to create Javascript arrays for
14252: Domain Coordinator interface for editing Course Categories).
14253:
1.665 raeburn 14254: subcats (reference to hash of arrays containing all subcategories within each
14255: category, -recursive)
14256:
1.655 raeburn 14257: Returns: nothing
14258:
14259: Side effects: populates trails and allitems hash references.
14260:
14261: =cut
14262:
14263: sub extract_categories {
1.665 raeburn 14264: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 14265: if (ref($categories) eq 'HASH') {
14266: &gather_categories($categories,$cats,$idx,$jsarray);
14267: if (ref($cats->[0]) eq 'ARRAY') {
14268: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14269: my $name = $cats->[0][$i];
14270: my $item = &escape($name).'::0';
14271: my $trailstr;
14272: if ($name eq 'instcode') {
14273: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14274: } elsif ($name eq 'communities') {
14275: $trailstr = &mt('Communities');
1.1239 ! raeburn 14276: } elsif ($name eq 'placement') {
! 14277: $trailstr = &mt('Placement Tests');
1.655 raeburn 14278: } else {
14279: $trailstr = $name;
14280: }
14281: if ($allitems->{$item} eq '') {
14282: push(@{$trails},$trailstr);
14283: $allitems->{$item} = scalar(@{$trails})-1;
14284: }
14285: my @parents = ($name);
14286: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14287: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14288: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14289: if (ref($subcats) eq 'HASH') {
14290: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14291: }
14292: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
14293: }
14294: } else {
14295: if (ref($subcats) eq 'HASH') {
14296: $subcats->{$item} = [];
1.655 raeburn 14297: }
14298: }
14299: }
14300: }
14301: }
14302: return;
14303: }
14304:
14305: =pod
14306:
1.1162 raeburn 14307: =item * &recurse_categories()
1.655 raeburn 14308:
14309: Recursively used to generate breadcrumb trails for course categories.
14310:
14311: Inputs:
1.663 raeburn 14312:
1.655 raeburn 14313: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14314: categories and subcategories).
1.663 raeburn 14315:
1.655 raeburn 14316: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14317:
14318: category (current course category, for which breadcrumb trail is being generated).
14319:
14320: trails (reference to array of breadcrumb trails for each category).
14321:
1.655 raeburn 14322: allitems (reference to hash - key is category key
14323: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14324:
1.655 raeburn 14325: parents (array containing containers directories for current category,
14326: back to top level).
14327:
14328: Returns: nothing
14329:
14330: Side effects: populates trails and allitems hash references
14331:
14332: =cut
14333:
14334: sub recurse_categories {
1.665 raeburn 14335: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14336: my $shallower = $depth - 1;
14337: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14338: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14339: my $name = $cats->[$depth]{$category}[$k];
14340: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14341: my $trailstr = join(' -> ',(@{$parents},$category));
14342: if ($allitems->{$item} eq '') {
14343: push(@{$trails},$trailstr);
14344: $allitems->{$item} = scalar(@{$trails})-1;
14345: }
14346: my $deeper = $depth+1;
14347: push(@{$parents},$category);
1.665 raeburn 14348: if (ref($subcats) eq 'HASH') {
14349: my $subcat = &escape($name).':'.$category.':'.$depth;
14350: for (my $j=@{$parents}; $j>=0; $j--) {
14351: my $higher;
14352: if ($j > 0) {
14353: $higher = &escape($parents->[$j]).':'.
14354: &escape($parents->[$j-1]).':'.$j;
14355: } else {
14356: $higher = &escape($parents->[$j]).'::'.$j;
14357: }
14358: push(@{$subcats->{$higher}},$subcat);
14359: }
14360: }
14361: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14362: $subcats);
1.655 raeburn 14363: pop(@{$parents});
14364: }
14365: } else {
14366: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14367: my $trailstr = join(' -> ',(@{$parents},$category));
14368: if ($allitems->{$item} eq '') {
14369: push(@{$trails},$trailstr);
14370: $allitems->{$item} = scalar(@{$trails})-1;
14371: }
14372: }
14373: return;
14374: }
14375:
1.663 raeburn 14376: =pod
14377:
1.1162 raeburn 14378: =item * &assign_categories_table()
1.663 raeburn 14379:
14380: Create a datatable for display of hierarchical categories in a domain,
14381: with checkboxes to allow a course to be categorized.
14382:
14383: Inputs:
14384:
14385: cathash - reference to hash of categories defined for the domain (from
14386: configuration.db)
14387:
14388: currcat - scalar with an & separated list of categories assigned to a course.
14389:
1.919 raeburn 14390: type - scalar contains course type (Course or Community).
14391:
1.663 raeburn 14392: Returns: $output (markup to be displayed)
14393:
14394: =cut
14395:
14396: sub assign_categories_table {
1.919 raeburn 14397: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14398: my $output;
14399: if (ref($cathash) eq 'HASH') {
14400: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14401: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14402: $maxdepth = scalar(@cats);
14403: if (@cats > 0) {
14404: my $itemcount = 0;
14405: if (ref($cats[0]) eq 'ARRAY') {
14406: my @currcategories;
14407: if ($currcat ne '') {
14408: @currcategories = split('&',$currcat);
14409: }
1.919 raeburn 14410: my $table;
1.663 raeburn 14411: for (my $i=0; $i<@{$cats[0]}; $i++) {
14412: my $parent = $cats[0][$i];
1.919 raeburn 14413: next if ($parent eq 'instcode');
14414: if ($type eq 'Community') {
14415: next unless ($parent eq 'communities');
1.1239 ! raeburn 14416: } elsif ($type eq 'Placement') {
! 14417: next unless ($parent eq 'placement');
1.919 raeburn 14418: } else {
1.1239 ! raeburn 14419: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 14420: }
1.663 raeburn 14421: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14422: my $item = &escape($parent).'::0';
14423: my $checked = '';
14424: if (@currcategories > 0) {
14425: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14426: $checked = ' checked="checked"';
1.663 raeburn 14427: }
14428: }
1.919 raeburn 14429: my $parent_title = $parent;
14430: if ($parent eq 'communities') {
14431: $parent_title = &mt('Communities');
1.1239 ! raeburn 14432: } elsif ($parent eq 'placement') {
! 14433: $parent_title = &mt('Placement Tests');
1.919 raeburn 14434: }
14435: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14436: '<input type="checkbox" name="usecategory" value="'.
14437: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14438: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14439: my $depth = 1;
14440: push(@path,$parent);
1.919 raeburn 14441: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14442: pop(@path);
1.919 raeburn 14443: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14444: $itemcount ++;
14445: }
1.919 raeburn 14446: if ($itemcount) {
14447: $output = &Apache::loncommon::start_data_table().
14448: $table.
14449: &Apache::loncommon::end_data_table();
14450: }
1.663 raeburn 14451: }
14452: }
14453: }
14454: return $output;
14455: }
14456:
14457: =pod
14458:
1.1162 raeburn 14459: =item * &assign_category_rows()
1.663 raeburn 14460:
14461: Create a datatable row for display of nested categories in a domain,
14462: with checkboxes to allow a course to be categorized,called recursively.
14463:
14464: Inputs:
14465:
14466: itemcount - track row number for alternating colors
14467:
14468: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14469: categories and subcategories.
14470:
14471: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14472:
14473: parent - parent of current category item
14474:
14475: path - Array containing all categories back up through the hierarchy from the
14476: current category to the top level.
14477:
14478: currcategories - reference to array of current categories assigned to the course
14479:
14480: Returns: $output (markup to be displayed).
14481:
14482: =cut
14483:
14484: sub assign_category_rows {
14485: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14486: my ($text,$name,$item,$chgstr);
14487: if (ref($cats) eq 'ARRAY') {
14488: my $maxdepth = scalar(@{$cats});
14489: if (ref($cats->[$depth]) eq 'HASH') {
14490: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14491: my $numchildren = @{$cats->[$depth]{$parent}};
14492: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14493: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14494: for (my $j=0; $j<$numchildren; $j++) {
14495: $name = $cats->[$depth]{$parent}[$j];
14496: $item = &escape($name).':'.&escape($parent).':'.$depth;
14497: my $deeper = $depth+1;
14498: my $checked = '';
14499: if (ref($currcategories) eq 'ARRAY') {
14500: if (@{$currcategories} > 0) {
14501: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14502: $checked = ' checked="checked"';
1.663 raeburn 14503: }
14504: }
14505: }
1.664 raeburn 14506: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14507: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14508: $item.'"'.$checked.' />'.$name.'</label></span>'.
14509: '<input type="hidden" name="catname" value="'.$name.'" />'.
14510: '</td><td>';
1.663 raeburn 14511: if (ref($path) eq 'ARRAY') {
14512: push(@{$path},$name);
14513: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14514: pop(@{$path});
14515: }
14516: $text .= '</td></tr>';
14517: }
14518: $text .= '</table></td>';
14519: }
14520: }
14521: }
14522: return $text;
14523: }
14524:
1.1181 raeburn 14525: =pod
14526:
14527: =back
14528:
14529: =cut
14530:
1.655 raeburn 14531: ############################################################
14532: ############################################################
14533:
14534:
1.443 albertel 14535: sub commit_customrole {
1.664 raeburn 14536: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14537: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14538: ($start?', '.&mt('starting').' '.localtime($start):'').
14539: ($end?', ending '.localtime($end):'').': <b>'.
14540: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14541: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14542: '</b><br />';
14543: return $output;
14544: }
14545:
14546: sub commit_standardrole {
1.1116 raeburn 14547: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14548: my ($output,$logmsg,$linefeed);
14549: if ($context eq 'auto') {
14550: $linefeed = "\n";
14551: } else {
14552: $linefeed = "<br />\n";
14553: }
1.443 albertel 14554: if ($three eq 'st') {
1.541 raeburn 14555: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14556: $one,$two,$sec,$context,$credits);
1.541 raeburn 14557: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14558: ($result eq 'unknown_course') || ($result eq 'refused')) {
14559: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14560: } else {
1.541 raeburn 14561: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14562: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14563: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14564: if ($context eq 'auto') {
14565: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14566: } else {
14567: $output .= '<b>'.$result.'</b>'.$linefeed.
14568: &mt('Add to classlist').': <b>ok</b>';
14569: }
14570: $output .= $linefeed;
1.443 albertel 14571: }
14572: } else {
14573: $output = &mt('Assigning').' '.$three.' in '.$url.
14574: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14575: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14576: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14577: if ($context eq 'auto') {
14578: $output .= $result.$linefeed;
14579: } else {
14580: $output .= '<b>'.$result.'</b>'.$linefeed;
14581: }
1.443 albertel 14582: }
14583: return $output;
14584: }
14585:
14586: sub commit_studentrole {
1.1116 raeburn 14587: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14588: $credits) = @_;
1.626 raeburn 14589: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14590: if ($context eq 'auto') {
14591: $linefeed = "\n";
14592: } else {
14593: $linefeed = '<br />'."\n";
14594: }
1.443 albertel 14595: if (defined($one) && defined($two)) {
14596: my $cid=$one.'_'.$two;
14597: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14598: my $secchange = 0;
14599: my $expire_role_result;
14600: my $modify_section_result;
1.628 raeburn 14601: if ($oldsec ne '-1') {
14602: if ($oldsec ne $sec) {
1.443 albertel 14603: $secchange = 1;
1.628 raeburn 14604: my $now = time;
1.443 albertel 14605: my $uurl='/'.$cid;
14606: $uurl=~s/\_/\//g;
14607: if ($oldsec) {
14608: $uurl.='/'.$oldsec;
14609: }
1.626 raeburn 14610: $oldsecurl = $uurl;
1.628 raeburn 14611: $expire_role_result =
1.652 raeburn 14612: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14613: if ($env{'request.course.sec'} ne '') {
14614: if ($expire_role_result eq 'refused') {
14615: my @roles = ('st');
14616: my @statuses = ('previous');
14617: my @roledoms = ($one);
14618: my $withsec = 1;
14619: my %roleshash =
14620: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14621: \@statuses,\@roles,\@roledoms,$withsec);
14622: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14623: my ($oldstart,$oldend) =
14624: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14625: if ($oldend > 0 && $oldend <= $now) {
14626: $expire_role_result = 'ok';
14627: }
14628: }
14629: }
14630: }
1.443 albertel 14631: $result = $expire_role_result;
14632: }
14633: }
14634: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 14635: $modify_section_result =
14636: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14637: undef,undef,undef,$sec,
14638: $end,$start,'','',$cid,
14639: '',$context,$credits);
1.443 albertel 14640: if ($modify_section_result =~ /^ok/) {
14641: if ($secchange == 1) {
1.628 raeburn 14642: if ($sec eq '') {
14643: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14644: } else {
14645: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14646: }
1.443 albertel 14647: } elsif ($oldsec eq '-1') {
1.628 raeburn 14648: if ($sec eq '') {
14649: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14650: } else {
14651: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14652: }
1.443 albertel 14653: } else {
1.628 raeburn 14654: if ($sec eq '') {
14655: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14656: } else {
14657: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14658: }
1.443 albertel 14659: }
14660: } else {
1.1115 raeburn 14661: if ($secchange) {
1.628 raeburn 14662: $$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;
14663: } else {
14664: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14665: }
1.443 albertel 14666: }
14667: $result = $modify_section_result;
14668: } elsif ($secchange == 1) {
1.628 raeburn 14669: if ($oldsec eq '') {
1.1103 raeburn 14670: $$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 14671: } else {
14672: $$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;
14673: }
1.626 raeburn 14674: if ($expire_role_result eq 'refused') {
14675: my $newsecurl = '/'.$cid;
14676: $newsecurl =~ s/\_/\//g;
14677: if ($sec ne '') {
14678: $newsecurl.='/'.$sec;
14679: }
14680: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14681: if ($sec eq '') {
14682: $$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;
14683: } else {
14684: $$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;
14685: }
14686: }
14687: }
1.443 albertel 14688: }
14689: } else {
1.626 raeburn 14690: $$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 14691: $result = "error: incomplete course id\n";
14692: }
14693: return $result;
14694: }
14695:
1.1108 raeburn 14696: sub show_role_extent {
14697: my ($scope,$context,$role) = @_;
14698: $scope =~ s{^/}{};
14699: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14700: push(@courseroles,'co');
14701: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14702: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14703: $scope =~ s{/}{_};
14704: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14705: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14706: my ($audom,$auname) = split(/\//,$scope);
14707: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14708: &Apache::loncommon::plainname($auname,$audom).'</span>');
14709: } else {
14710: $scope =~ s{/$}{};
14711: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14712: &Apache::lonnet::domain($scope,'description').'</span>');
14713: }
14714: }
14715:
1.443 albertel 14716: ############################################################
14717: ############################################################
14718:
1.566 albertel 14719: sub check_clone {
1.578 raeburn 14720: my ($args,$linefeed) = @_;
1.566 albertel 14721: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14722: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14723: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14724: my $clonemsg;
14725: my $can_clone = 0;
1.944 raeburn 14726: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14727: if ($lctype ne 'community') {
14728: $lctype = 'course';
14729: }
1.566 albertel 14730: if ($clonehome eq 'no_host') {
1.944 raeburn 14731: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14732: $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'});
14733: } else {
14734: $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'});
14735: }
1.566 albertel 14736: } else {
14737: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14738: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14739: if ($clonedesc{'type'} ne 'Community') {
14740: $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'});
14741: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14742: }
14743: }
1.882 raeburn 14744: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14745: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14746: $can_clone = 1;
14747: } else {
1.1221 raeburn 14748: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 14749: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 14750: if ($clonehash{'cloners'} eq '') {
14751: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
14752: if ($domdefs{'canclone'}) {
14753: unless ($domdefs{'canclone'} eq 'none') {
14754: if ($domdefs{'canclone'} eq 'domain') {
14755: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
14756: $can_clone = 1;
14757: }
14758: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14759: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
14760: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
14761: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
14762: $can_clone = 1;
14763: }
14764: }
14765: }
14766: }
1.578 raeburn 14767: } else {
1.1221 raeburn 14768: my @cloners = split(/,/,$clonehash{'cloners'});
14769: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 14770: $can_clone = 1;
1.1221 raeburn 14771: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 14772: $can_clone = 1;
1.1225 raeburn 14773: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14774: $can_clone = 1;
1.1221 raeburn 14775: }
14776: unless ($can_clone) {
1.1225 raeburn 14777: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14778: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 14779: my (%gotdomdefaults,%gotcodedefaults);
14780: foreach my $cloner (@cloners) {
14781: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
14782: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
14783: my (%codedefaults,@code_order);
14784: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
14785: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
14786: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
14787: }
14788: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
14789: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
14790: }
14791: } else {
14792: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
14793: \%codedefaults,
14794: \@code_order);
14795: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
14796: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
14797: }
14798: if (@code_order > 0) {
14799: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
14800: $cloner,$clonehash{'internal.coursecode'},
14801: $args->{'crscode'})) {
14802: $can_clone = 1;
14803: last;
14804: }
14805: }
14806: }
14807: }
14808: }
1.1225 raeburn 14809: }
14810: }
14811: unless ($can_clone) {
14812: my $ccrole = 'cc';
14813: if ($args->{'crstype'} eq 'Community') {
14814: $ccrole = 'co';
14815: }
14816: my %roleshash =
14817: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14818: $args->{'ccdomain'},
14819: 'userroles',['active'],[$ccrole],
14820: [$args->{'clonedomain'}]);
14821: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
14822: $can_clone = 1;
14823: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
14824: $args->{'ccuname'},$args->{'ccdomain'})) {
14825: $can_clone = 1;
1.1221 raeburn 14826: }
14827: }
14828: unless ($can_clone) {
14829: if ($args->{'crstype'} eq 'Community') {
14830: $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'});
1.942 raeburn 14831: } else {
1.1221 raeburn 14832: $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'});
14833: }
1.566 albertel 14834: }
1.578 raeburn 14835: }
1.566 albertel 14836: }
14837: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14838: }
14839:
1.444 albertel 14840: sub construct_course {
1.1166 raeburn 14841: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14842: my $outcome;
1.541 raeburn 14843: my $linefeed = '<br />'."\n";
14844: if ($context eq 'auto') {
14845: $linefeed = "\n";
14846: }
1.566 albertel 14847:
14848: #
14849: # Are we cloning?
14850: #
14851: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14852: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14853: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14854: if ($context ne 'auto') {
1.578 raeburn 14855: if ($clonemsg ne '') {
14856: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14857: }
1.566 albertel 14858: }
14859: $outcome .= $clonemsg.$linefeed;
14860:
14861: if (!$can_clone) {
14862: return (0,$outcome);
14863: }
14864: }
14865:
1.444 albertel 14866: #
14867: # Open course
14868: #
1.1239 ! raeburn 14869: my $showncrstype;
! 14870: if ($args->{'crstype'} eq 'Placement') {
! 14871: $showncrstype = 'placement test';
! 14872: } else {
! 14873: $showncrstype = lc($args->{'crstype'});
! 14874: }
1.444 albertel 14875: my %cenv=();
14876: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14877: $args->{'cdescr'},
14878: $args->{'curl'},
14879: $args->{'course_home'},
14880: $args->{'nonstandard'},
14881: $args->{'crscode'},
14882: $args->{'ccuname'}.':'.
14883: $args->{'ccdomain'},
1.882 raeburn 14884: $args->{'crstype'},
1.885 raeburn 14885: $cnum,$context,$category);
1.444 albertel 14886:
14887: # Note: The testing routines depend on this being output; see
14888: # Utils::Course. This needs to at least be output as a comment
14889: # if anyone ever decides to not show this, and Utils::Course::new
14890: # will need to be suitably modified.
1.1239 ! raeburn 14891: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 14892: if ($$courseid =~ /^error:/) {
14893: return (0,$outcome);
14894: }
14895:
1.444 albertel 14896: #
14897: # Check if created correctly
14898: #
1.479 albertel 14899: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14900: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14901: if ($crsuhome eq 'no_host') {
14902: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14903: return (0,$outcome);
14904: }
1.541 raeburn 14905: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14906:
1.444 albertel 14907: #
1.566 albertel 14908: # Do the cloning
14909: #
14910: if ($can_clone && $cloneid) {
1.1239 ! raeburn 14911: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 14912: if ($context ne 'auto') {
14913: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14914: }
14915: $outcome .= $clonemsg.$linefeed;
14916: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14917: # Copy all files
1.637 www 14918: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14919: # Restore URL
1.566 albertel 14920: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14921: # Restore title
1.566 albertel 14922: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14923: # Restore creation date, creator and creation context.
14924: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14925: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14926: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14927: # Mark as cloned
1.566 albertel 14928: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14929: # Need to clone grading mode
14930: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14931: $cenv{'grading'}=$newenv{'grading'};
14932: # Do not clone these environment entries
14933: &Apache::lonnet::del('environment',
14934: ['default_enrollment_start_date',
14935: 'default_enrollment_end_date',
14936: 'question.email',
14937: 'policy.email',
14938: 'comment.email',
14939: 'pch.users.denied',
1.725 raeburn 14940: 'plc.users.denied',
14941: 'hidefromcat',
1.1121 raeburn 14942: 'checkforpriv',
1.1166 raeburn 14943: 'categories',
14944: 'internal.uniquecode'],
1.638 www 14945: $$crsudom,$$crsunum);
1.1170 raeburn 14946: if ($args->{'textbook'}) {
14947: $cenv{'internal.textbook'} = $args->{'textbook'};
14948: }
1.444 albertel 14949: }
1.566 albertel 14950:
1.444 albertel 14951: #
14952: # Set environment (will override cloned, if existing)
14953: #
14954: my @sections = ();
14955: my @xlists = ();
14956: if ($args->{'crstype'}) {
14957: $cenv{'type'}=$args->{'crstype'};
14958: }
14959: if ($args->{'crsid'}) {
14960: $cenv{'courseid'}=$args->{'crsid'};
14961: }
14962: if ($args->{'crscode'}) {
14963: $cenv{'internal.coursecode'}=$args->{'crscode'};
14964: }
14965: if ($args->{'crsquota'} ne '') {
14966: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14967: } else {
14968: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14969: }
14970: if ($args->{'ccuname'}) {
14971: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14972: ':'.$args->{'ccdomain'};
14973: } else {
14974: $cenv{'internal.courseowner'} = $args->{'curruser'};
14975: }
1.1116 raeburn 14976: if ($args->{'defaultcredits'}) {
14977: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14978: }
1.444 albertel 14979: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14980: if ($args->{'crssections'}) {
14981: $cenv{'internal.sectionnums'} = '';
14982: if ($args->{'crssections'} =~ m/,/) {
14983: @sections = split/,/,$args->{'crssections'};
14984: } else {
14985: $sections[0] = $args->{'crssections'};
14986: }
14987: if (@sections > 0) {
14988: foreach my $item (@sections) {
14989: my ($sec,$gp) = split/:/,$item;
14990: my $class = $args->{'crscode'}.$sec;
14991: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14992: $cenv{'internal.sectionnums'} .= $item.',';
14993: unless ($addcheck eq 'ok') {
14994: push @badclasses, $class;
14995: }
14996: }
14997: $cenv{'internal.sectionnums'} =~ s/,$//;
14998: }
14999: }
15000: # do not hide course coordinator from staff listing,
15001: # even if privileged
15002: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15003: # add course coordinator's domain to domains to check for privileged users
15004: # if different to course domain
15005: if ($$crsudom ne $args->{'ccdomain'}) {
15006: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15007: }
1.444 albertel 15008: # add crosslistings
15009: if ($args->{'crsxlist'}) {
15010: $cenv{'internal.crosslistings'}='';
15011: if ($args->{'crsxlist'} =~ m/,/) {
15012: @xlists = split/,/,$args->{'crsxlist'};
15013: } else {
15014: $xlists[0] = $args->{'crsxlist'};
15015: }
15016: if (@xlists > 0) {
15017: foreach my $item (@xlists) {
15018: my ($xl,$gp) = split/:/,$item;
15019: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15020: $cenv{'internal.crosslistings'} .= $item.',';
15021: unless ($addcheck eq 'ok') {
15022: push @badclasses, $xl;
15023: }
15024: }
15025: $cenv{'internal.crosslistings'} =~ s/,$//;
15026: }
15027: }
15028: if ($args->{'autoadds'}) {
15029: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15030: }
15031: if ($args->{'autodrops'}) {
15032: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15033: }
15034: # check for notification of enrollment changes
15035: my @notified = ();
15036: if ($args->{'notify_owner'}) {
15037: if ($args->{'ccuname'} ne '') {
15038: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15039: }
15040: }
15041: if ($args->{'notify_dc'}) {
15042: if ($uname ne '') {
1.630 raeburn 15043: push(@notified,$uname.':'.$udom);
1.444 albertel 15044: }
15045: }
15046: if (@notified > 0) {
15047: my $notifylist;
15048: if (@notified > 1) {
15049: $notifylist = join(',',@notified);
15050: } else {
15051: $notifylist = $notified[0];
15052: }
15053: $cenv{'internal.notifylist'} = $notifylist;
15054: }
15055: if (@badclasses > 0) {
15056: my %lt=&Apache::lonlocal::texthash(
15057: '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',
15058: 'dnhr' => 'does not have rights to access enrollment in these classes',
15059: 'adby' => 'as determined by the policies of your institution on access to official classlists'
15060: );
1.541 raeburn 15061: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
15062: ' ('.$lt{'adby'}.')';
15063: if ($context eq 'auto') {
15064: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 15065: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 15066: foreach my $item (@badclasses) {
15067: if ($context eq 'auto') {
15068: $outcome .= " - $item\n";
15069: } else {
15070: $outcome .= "<li>$item</li>\n";
15071: }
15072: }
15073: if ($context eq 'auto') {
15074: $outcome .= $linefeed;
15075: } else {
1.566 albertel 15076: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15077: }
15078: }
1.444 albertel 15079: }
15080: if ($args->{'no_end_date'}) {
15081: $args->{'endaccess'} = 0;
15082: }
15083: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15084: $cenv{'internal.autoend'}=$args->{'enrollend'};
15085: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15086: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15087: if ($args->{'showphotos'}) {
15088: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15089: }
15090: $cenv{'internal.authtype'} = $args->{'authtype'};
15091: $cenv{'internal.autharg'} = $args->{'autharg'};
15092: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15093: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15094: 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');
15095: if ($context eq 'auto') {
15096: $outcome .= $krb_msg;
15097: } else {
1.566 albertel 15098: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15099: }
15100: $outcome .= $linefeed;
1.444 albertel 15101: }
15102: }
15103: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15104: if ($args->{'setpolicy'}) {
15105: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15106: }
15107: if ($args->{'setcontent'}) {
15108: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15109: }
15110: }
15111: if ($args->{'reshome'}) {
15112: $cenv{'reshome'}=$args->{'reshome'}.'/';
15113: $cenv{'reshome'}=~s/\/+$/\//;
15114: }
15115: #
15116: # course has keyed access
15117: #
15118: if ($args->{'setkeys'}) {
15119: $cenv{'keyaccess'}='yes';
15120: }
15121: # if specified, key authority is not course, but user
15122: # only active if keyaccess is yes
15123: if ($args->{'keyauth'}) {
1.487 albertel 15124: my ($user,$domain) = split(':',$args->{'keyauth'});
15125: $user = &LONCAPA::clean_username($user);
15126: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15127: if ($user ne '' && $domain ne '') {
1.487 albertel 15128: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15129: }
15130: }
15131:
1.1166 raeburn 15132: #
1.1167 raeburn 15133: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 15134: #
15135: if ($args->{'uniquecode'}) {
15136: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15137: if ($code) {
15138: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 15139: my %crsinfo =
15140: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15141: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15142: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15143: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15144: }
1.1166 raeburn 15145: if (ref($coderef)) {
15146: $$coderef = $code;
15147: }
15148: }
15149: }
15150:
1.444 albertel 15151: if ($args->{'disresdis'}) {
15152: $cenv{'pch.roles.denied'}='st';
15153: }
15154: if ($args->{'disablechat'}) {
15155: $cenv{'plc.roles.denied'}='st';
15156: }
15157:
15158: # Record we've not yet viewed the Course Initialization Helper for this
15159: # course
15160: $cenv{'course.helper.not.run'} = 1;
15161: #
15162: # Use new Randomseed
15163: #
15164: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15165: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15166: #
15167: # The encryption code and receipt prefix for this course
15168: #
15169: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15170: $cenv{'internal.encpref'}=100+int(9*rand(99));
15171: #
15172: # By default, use standard grading
15173: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15174:
1.541 raeburn 15175: $outcome .= $linefeed.&mt('Setting environment').': '.
15176: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15177: #
15178: # Open all assignments
15179: #
15180: if ($args->{'openall'}) {
15181: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15182: my %storecontent = ($storeunder => time,
15183: $storeunder.'.type' => 'date_start');
15184:
15185: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15186: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15187: }
15188: #
15189: # Set first page
15190: #
15191: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15192: || ($cloneid)) {
1.445 albertel 15193: use LONCAPA::map;
1.444 albertel 15194: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15195:
15196: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15197: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15198:
1.444 albertel 15199: $outcome .= ($fatal?$errtext:'read ok').' - ';
15200: my $title; my $url;
15201: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15202: $title=&mt('Syllabus');
1.444 albertel 15203: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15204: } else {
1.963 raeburn 15205: $title=&mt('Table of Contents');
1.444 albertel 15206: $url='/adm/navmaps';
15207: }
1.445 albertel 15208:
15209: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15210: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15211:
15212: if ($errtext) { $fatal=2; }
1.541 raeburn 15213: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15214: }
1.566 albertel 15215:
1.1237 raeburn 15216: #
15217: # Set params for Placement Tests
15218: #
1.1239 ! raeburn 15219: if ($args->{'crstype'} eq 'Placement') {
! 15220: my %storecontent;
! 15221: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
! 15222: my %defaults = (
! 15223: buttonshide => { value => 'yes',
! 15224: type => 'string_yesno',},
! 15225: type => { value => 'randomizetry',
! 15226: type => 'string_questiontype',},
! 15227: maxtries => { value => 1,
! 15228: type => 'int_pos',},
! 15229: problemstatus => { value => 'no',
! 15230: type => 'string_problemstatus',},
! 15231: );
! 15232: foreach my $key (keys(%defaults)) {
! 15233: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
! 15234: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
! 15235: }
1.1237 raeburn 15236: &Apache::lonnet::cput
15237: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
15238: }
15239:
1.566 albertel 15240: return (1,$outcome);
1.444 albertel 15241: }
15242:
1.1166 raeburn 15243: sub make_unique_code {
15244: my ($cdom,$cnum) = @_;
15245: # get lock on uniquecodes db
15246: my $lockhash = {
15247: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15248: ':'.$env{'user.domain'},
15249: };
15250: my $tries = 0;
15251: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15252: my ($code,$error);
15253:
15254: while (($gotlock ne 'ok') && ($tries<3)) {
15255: $tries ++;
15256: sleep 1;
15257: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15258: }
15259: if ($gotlock eq 'ok') {
15260: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15261: my $gotcode;
15262: my $attempts = 0;
15263: while ((!$gotcode) && ($attempts < 100)) {
15264: $code = &generate_code();
15265: if (!exists($currcodes{$code})) {
15266: $gotcode = 1;
15267: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15268: $error = 'nostore';
15269: }
15270: }
15271: $attempts ++;
15272: }
15273: my @del_lock = ($cnum."\0".'uniquecodes');
15274: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15275: } else {
15276: $error = 'nolock';
15277: }
15278: return ($code,$error);
15279: }
15280:
15281: sub generate_code {
15282: my $code;
15283: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15284: for (my $i=0; $i<6; $i++) {
15285: my $lettnum = int (rand 2);
15286: my $item = '';
15287: if ($lettnum) {
15288: $item = $letts[int( rand(18) )];
15289: } else {
15290: $item = 1+int( rand(8) );
15291: }
15292: $code .= $item;
15293: }
15294: return $code;
15295: }
15296:
1.444 albertel 15297: ############################################################
15298: ############################################################
15299:
1.1237 raeburn 15300: # Community, Course and Placement Test
1.378 raeburn 15301: sub course_type {
15302: my ($cid) = @_;
15303: if (!defined($cid)) {
15304: $cid = $env{'request.course.id'};
15305: }
1.404 albertel 15306: if (defined($env{'course.'.$cid.'.type'})) {
15307: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15308: } else {
15309: return 'Course';
1.377 raeburn 15310: }
15311: }
1.156 albertel 15312:
1.406 raeburn 15313: sub group_term {
15314: my $crstype = &course_type();
15315: my %names = (
15316: 'Course' => 'group',
1.865 raeburn 15317: 'Community' => 'group',
1.1237 raeburn 15318: 'Placement' => 'group',
1.406 raeburn 15319: );
15320: return $names{$crstype};
15321: }
15322:
1.902 raeburn 15323: sub course_types {
1.1237 raeburn 15324: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 15325: my %typename = (
15326: official => 'Official course',
15327: unofficial => 'Unofficial course',
15328: community => 'Community',
1.1165 raeburn 15329: textbook => 'Textbook course',
1.1237 raeburn 15330: placement => 'Placement test',
1.902 raeburn 15331: );
15332: return (\@types,\%typename);
15333: }
15334:
1.156 albertel 15335: sub icon {
15336: my ($file)=@_;
1.505 albertel 15337: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15338: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15339: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15340: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15341: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15342: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15343: $curfext.".gif") {
15344: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15345: $curfext.".gif";
15346: }
15347: }
1.249 albertel 15348: return &lonhttpdurl($iconname);
1.154 albertel 15349: }
1.84 albertel 15350:
1.575 albertel 15351: sub lonhttpdurl {
1.692 www 15352: #
15353: # Had been used for "small fry" static images on separate port 8080.
15354: # Modify here if lightweight http functionality desired again.
15355: # Currently eliminated due to increasing firewall issues.
15356: #
1.575 albertel 15357: my ($url)=@_;
1.692 www 15358: return $url;
1.215 albertel 15359: }
15360:
1.213 albertel 15361: sub connection_aborted {
15362: my ($r)=@_;
15363: $r->print(" ");$r->rflush();
15364: my $c = $r->connection;
15365: return $c->aborted();
15366: }
15367:
1.221 foxr 15368: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 15369: # strings as 'strings'.
15370: sub escape_single {
1.221 foxr 15371: my ($input) = @_;
1.223 albertel 15372: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 15373: $input =~ s/\'/\\\'/g; # Esacpe the 's....
15374: return $input;
15375: }
1.223 albertel 15376:
1.222 foxr 15377: # Same as escape_single, but escape's "'s This
15378: # can be used for "strings"
15379: sub escape_double {
15380: my ($input) = @_;
15381: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
15382: $input =~ s/\"/\\\"/g; # Esacpe the "s....
15383: return $input;
15384: }
1.223 albertel 15385:
1.222 foxr 15386: # Escapes the last element of a full URL.
15387: sub escape_url {
15388: my ($url) = @_;
1.238 raeburn 15389: my @urlslices = split(/\//, $url,-1);
1.369 www 15390: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 15391: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 15392: }
1.462 albertel 15393:
1.820 raeburn 15394: sub compare_arrays {
15395: my ($arrayref1,$arrayref2) = @_;
15396: my (@difference,%count);
15397: @difference = ();
15398: %count = ();
15399: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
15400: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
15401: foreach my $element (keys(%count)) {
15402: if ($count{$element} == 1) {
15403: push(@difference,$element);
15404: }
15405: }
15406: }
15407: return @difference;
15408: }
15409:
1.817 bisitz 15410: # -------------------------------------------------------- Initialize user login
1.462 albertel 15411: sub init_user_environment {
1.463 albertel 15412: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 15413: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
15414:
15415: my $public=($username eq 'public' && $domain eq 'public');
15416:
15417: # See if old ID present, if so, remove
15418:
1.1062 raeburn 15419: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 15420: my $now=time;
15421:
15422: if ($public) {
15423: my $max_public=100;
15424: my $oldest;
15425: my $oldest_time=0;
15426: for(my $next=1;$next<=$max_public;$next++) {
15427: if (-e $lonids."/publicuser_$next.id") {
15428: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15429: if ($mtime<$oldest_time || !$oldest_time) {
15430: $oldest_time=$mtime;
15431: $oldest=$next;
15432: }
15433: } else {
15434: $cookie="publicuser_$next";
15435: last;
15436: }
15437: }
15438: if (!$cookie) { $cookie="publicuser_$oldest"; }
15439: } else {
1.463 albertel 15440: # if this isn't a robot, kill any existing non-robot sessions
15441: if (!$args->{'robot'}) {
15442: opendir(DIR,$lonids);
15443: while ($filename=readdir(DIR)) {
15444: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15445: unlink($lonids.'/'.$filename);
15446: }
1.462 albertel 15447: }
1.463 albertel 15448: closedir(DIR);
1.1204 raeburn 15449: # If there is a undeleted lockfile for the user's paste buffer remove it.
15450: my $namespace = 'nohist_courseeditor';
15451: my $lockingkey = 'paste'."\0".'locked_num';
15452: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15453: $domain,$username);
15454: if (exists($lockhash{$lockingkey})) {
15455: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15456: unless ($delresult eq 'ok') {
15457: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15458: }
15459: }
1.462 albertel 15460: }
15461: # Give them a new cookie
1.463 albertel 15462: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15463: : $now.$$.int(rand(10000)));
1.463 albertel 15464: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15465:
15466: # Initialize roles
15467:
1.1062 raeburn 15468: ($userroles,$firstaccenv,$timerintenv) =
15469: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15470: }
15471: # ------------------------------------ Check browser type and MathML capability
15472:
1.1194 raeburn 15473: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15474: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15475:
15476: # ------------------------------------------------------------- Get environment
15477:
15478: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15479: my ($tmp) = keys(%userenv);
15480: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15481: } else {
15482: undef(%userenv);
15483: }
15484: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15485: $form->{'interface'}=$userenv{'interface'};
15486: }
15487: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15488:
15489: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15490: foreach my $option ('interface','localpath','localres') {
15491: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15492: }
15493: # --------------------------------------------------------- Write first profile
15494:
15495: {
15496: my %initial_env =
15497: ("user.name" => $username,
15498: "user.domain" => $domain,
15499: "user.home" => $authhost,
15500: "browser.type" => $clientbrowser,
15501: "browser.version" => $clientversion,
15502: "browser.mathml" => $clientmathml,
15503: "browser.unicode" => $clientunicode,
15504: "browser.os" => $clientos,
1.1137 raeburn 15505: "browser.mobile" => $clientmobile,
1.1141 raeburn 15506: "browser.info" => $clientinfo,
1.1194 raeburn 15507: "browser.osversion" => $clientosversion,
1.462 albertel 15508: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15509: "request.course.fn" => '',
15510: "request.course.uri" => '',
15511: "request.course.sec" => '',
15512: "request.role" => 'cm',
15513: "request.role.adv" => $env{'user.adv'},
15514: "request.host" => $ENV{'REMOTE_ADDR'},);
15515:
15516: if ($form->{'localpath'}) {
15517: $initial_env{"browser.localpath"} = $form->{'localpath'};
15518: $initial_env{"browser.localres"} = $form->{'localres'};
15519: }
15520:
15521: if ($form->{'interface'}) {
15522: $form->{'interface'}=~s/\W//gs;
15523: $initial_env{"browser.interface"} = $form->{'interface'};
15524: $env{'browser.interface'}=$form->{'interface'};
15525: }
15526:
1.1157 raeburn 15527: if ($form->{'iptoken'}) {
15528: my $lonhost = $r->dir_config('lonHostID');
15529: $initial_env{"user.noloadbalance"} = $lonhost;
15530: $env{'user.noloadbalance'} = $lonhost;
15531: }
15532:
1.981 raeburn 15533: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15534: my %domdef;
15535: unless ($domain eq 'public') {
15536: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15537: }
1.980 raeburn 15538:
1.1081 raeburn 15539: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15540: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15541: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15542: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15543: }
15544:
1.1237 raeburn 15545: foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765 raeburn 15546: $userenv{'canrequest.'.$crstype} =
15547: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15548: 'reload','requestcourses',
15549: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15550: }
15551:
1.1092 raeburn 15552: $userenv{'canrequest.author'} =
15553: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15554: 'reload','requestauthor',
15555: \%userenv,\%domdef,\%is_adv);
15556: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15557: $domain,$username);
15558: my $reqstatus = $reqauthor{'author_status'};
15559: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15560: if (ref($reqauthor{'author'}) eq 'HASH') {
15561: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15562: $reqauthor{'author'}{'timestamp'};
15563: }
15564: }
15565:
1.462 albertel 15566: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15567:
1.462 albertel 15568: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15569: &GDBM_WRCREAT(),0640)) {
15570: &_add_to_env(\%disk_env,\%initial_env);
15571: &_add_to_env(\%disk_env,\%userenv,'environment.');
15572: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15573: if (ref($firstaccenv) eq 'HASH') {
15574: &_add_to_env(\%disk_env,$firstaccenv);
15575: }
15576: if (ref($timerintenv) eq 'HASH') {
15577: &_add_to_env(\%disk_env,$timerintenv);
15578: }
1.463 albertel 15579: if (ref($args->{'extra_env'})) {
15580: &_add_to_env(\%disk_env,$args->{'extra_env'});
15581: }
1.462 albertel 15582: untie(%disk_env);
15583: } else {
1.705 tempelho 15584: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15585: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15586: return 'error: '.$!;
15587: }
15588: }
15589: $env{'request.role'}='cm';
15590: $env{'request.role.adv'}=$env{'user.adv'};
15591: $env{'browser.type'}=$clientbrowser;
15592:
15593: return $cookie;
15594:
15595: }
15596:
15597: sub _add_to_env {
15598: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15599: if (ref($env_data) eq 'HASH') {
15600: while (my ($key,$value) = each(%$env_data)) {
15601: $idf->{$prefix.$key} = $value;
15602: $env{$prefix.$key} = $value;
15603: }
1.462 albertel 15604: }
15605: }
15606:
1.685 tempelho 15607: # --- Get the symbolic name of a problem and the url
15608: sub get_symb {
15609: my ($request,$silent) = @_;
1.726 raeburn 15610: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15611: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15612: if ($symb eq '') {
15613: if (!$silent) {
1.1071 raeburn 15614: if (ref($request)) {
15615: $request->print("Unable to handle ambiguous references:$url:.");
15616: }
1.685 tempelho 15617: return ();
15618: }
15619: }
15620: &Apache::lonenc::check_decrypt(\$symb);
15621: return ($symb);
15622: }
15623:
15624: # --------------------------------------------------------------Get annotation
15625:
15626: sub get_annotation {
15627: my ($symb,$enc) = @_;
15628:
15629: my $key = $symb;
15630: if (!$enc) {
15631: $key =
15632: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15633: }
15634: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15635: return $annotation{$key};
15636: }
15637:
15638: sub clean_symb {
1.731 raeburn 15639: my ($symb,$delete_enc) = @_;
1.685 tempelho 15640:
15641: &Apache::lonenc::check_decrypt(\$symb);
15642: my $enc = $env{'request.enc'};
1.731 raeburn 15643: if ($delete_enc) {
1.730 raeburn 15644: delete($env{'request.enc'});
15645: }
1.685 tempelho 15646:
15647: return ($symb,$enc);
15648: }
1.462 albertel 15649:
1.1181 raeburn 15650: ############################################################
15651: ############################################################
15652:
15653: =pod
15654:
15655: =head1 Routines for building display used to search for courses
15656:
15657:
15658: =over 4
15659:
15660: =item * &build_filters()
15661:
15662: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 15663: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15664: and quotacheck.pl
15665:
1.1181 raeburn 15666:
15667: Inputs:
15668:
15669: filterlist - anonymous array of fields to include as potential filters
15670:
15671: crstype - course type
15672:
15673: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15674: to pop-open a course selector (will contain "extra element").
15675:
15676: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15677:
15678: filter - anonymous hash of criteria and their values
15679:
15680: action - form action
15681:
15682: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15683:
1.1182 raeburn 15684: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 15685:
15686: cloneruname - username of owner of new course who wants to clone
15687:
15688: clonerudom - domain of owner of new course who wants to clone
15689:
15690: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15691:
15692: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15693:
15694: codedom - domain
15695:
15696: formname - value of form element named "form".
15697:
15698: fixeddom - domain, if fixed.
15699:
15700: prevphase - value to assign to form element named "phase" when going back to the previous screen
15701:
15702: cnameelement - name of form element in form on opener page which will receive title of selected course
15703:
15704: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15705:
15706: cdomelement - name of form element in form on opener page which will receive domain of selected course
15707:
15708: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15709:
15710: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15711:
15712: clonewarning - warning message about missing information for intended course owner when DC creates a course
15713:
1.1182 raeburn 15714:
1.1181 raeburn 15715: Returns: $output - HTML for display of search criteria, and hidden form elements.
15716:
1.1182 raeburn 15717:
1.1181 raeburn 15718: Side Effects: None
15719:
15720: =cut
15721:
15722: # ---------------------------------------------- search for courses based on last activity etc.
15723:
15724: sub build_filters {
15725: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15726: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15727: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15728: $cnameelement,$cnumelement,$cdomelement,$setroles,
15729: $clonetext,$clonewarning) = @_;
1.1182 raeburn 15730: my ($list,$jscript);
1.1181 raeburn 15731: my $onchange = 'javascript:updateFilters(this)';
15732: my ($domainselectform,$sincefilterform,$createdfilterform,
15733: $ownerdomselectform,$persondomselectform,$instcodeform,
15734: $typeselectform,$instcodetitle);
15735: if ($formname eq '') {
15736: $formname = $caller;
15737: }
15738: foreach my $item (@{$filterlist}) {
15739: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15740: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15741: if ($item eq 'domainfilter') {
15742: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15743: } elsif ($item eq 'coursefilter') {
15744: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15745: } elsif ($item eq 'ownerfilter') {
15746: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15747: } elsif ($item eq 'ownerdomfilter') {
15748: $filter->{'ownerdomfilter'} =
15749: &LONCAPA::clean_domain($filter->{$item});
15750: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15751: 'ownerdomfilter',1);
15752: } elsif ($item eq 'personfilter') {
15753: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15754: } elsif ($item eq 'persondomfilter') {
15755: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15756: 'persondomfilter',1);
15757: } else {
15758: $filter->{$item} =~ s/\W//g;
15759: }
15760: if (!$filter->{$item}) {
15761: $filter->{$item} = '';
15762: }
15763: }
15764: if ($item eq 'domainfilter') {
15765: my $allow_blank = 1;
15766: if ($formname eq 'portform') {
15767: $allow_blank=0;
15768: } elsif ($formname eq 'studentform') {
15769: $allow_blank=0;
15770: }
15771: if ($fixeddom) {
15772: $domainselectform = '<input type="hidden" name="domainfilter"'.
15773: ' value="'.$codedom.'" />'.
15774: &Apache::lonnet::domain($codedom,'description');
15775: } else {
15776: $domainselectform = &select_dom_form($filter->{$item},
15777: 'domainfilter',
15778: $allow_blank,'',$onchange);
15779: }
15780: } else {
15781: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15782: }
15783: }
15784:
15785: # last course activity filter and selection
15786: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15787:
15788: # course created filter and selection
15789: if (exists($filter->{'createdfilter'})) {
15790: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15791: }
15792:
1.1239 ! raeburn 15793: my $prefix = $crstype;
! 15794: if ($crstype eq 'Placement') {
! 15795: $prefix = 'Placement Test'
! 15796: }
1.1181 raeburn 15797: my %lt = &Apache::lonlocal::texthash(
1.1239 ! raeburn 15798: 'cac' => "$prefix Activity",
! 15799: 'ccr' => "$prefix Created",
! 15800: 'cde' => "$prefix Title",
! 15801: 'cdo' => "$prefix Domain",
1.1181 raeburn 15802: 'ins' => 'Institutional Code',
15803: 'inc' => 'Institutional Categorization',
1.1239 ! raeburn 15804: 'cow' => "$prefix Owner/Co-owner",
! 15805: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 15806: 'cog' => 'Type',
15807: );
15808:
15809: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15810: my $typeval = 'Course';
15811: if ($crstype eq 'Community') {
15812: $typeval = 'Community';
1.1239 ! raeburn 15813: } elsif ($crstype eq 'Placement') {
! 15814: $typeval = 'Placement';
1.1181 raeburn 15815: }
15816: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15817: } else {
15818: $typeselectform = '<select name="type" size="1"';
15819: if ($onchange) {
15820: $typeselectform .= ' onchange="'.$onchange.'"';
15821: }
15822: $typeselectform .= '>'."\n";
1.1237 raeburn 15823: foreach my $posstype ('Course','Community','Placement') {
1.1239 ! raeburn 15824: my $shown;
! 15825: if ($posstype eq 'Placement') {
! 15826: $shown = &mt('Placement Test');
! 15827: } else {
! 15828: $shown = &mt($posstype);
! 15829: }
1.1181 raeburn 15830: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 ! raeburn 15831: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 15832: }
15833: $typeselectform.="</select>";
15834: }
15835:
15836: my ($cloneableonlyform,$cloneabletitle);
15837: if (exists($filter->{'cloneableonly'})) {
15838: my $cloneableon = '';
15839: my $cloneableoff = ' checked="checked"';
15840: if ($filter->{'cloneableonly'}) {
15841: $cloneableon = $cloneableoff;
15842: $cloneableoff = '';
15843: }
15844: $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/> '.&mt('Required').'</label>'.(' 'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' /> '.&mt('No restriction').'</label></span>';
15845: if ($formname eq 'ccrs') {
1.1187 bisitz 15846: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 15847: } else {
15848: $cloneabletitle = &mt('Cloneable by you');
15849: }
15850: }
15851: my $officialjs;
15852: if ($crstype eq 'Course') {
15853: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 15854: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15855: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15856: if ($codedom) {
1.1181 raeburn 15857: $officialjs = 1;
15858: ($instcodeform,$jscript,$$numtitlesref) =
15859: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15860: $officialjs,$codetitlesref);
15861: if ($jscript) {
1.1182 raeburn 15862: $jscript = '<script type="text/javascript">'."\n".
15863: '// <![CDATA['."\n".
15864: $jscript."\n".
15865: '// ]]>'."\n".
15866: '</script>'."\n";
1.1181 raeburn 15867: }
15868: }
15869: if ($instcodeform eq '') {
15870: $instcodeform =
15871: '<input type="text" name="instcodefilter" size="10" value="'.
15872: $list->{'instcodefilter'}.'" />';
15873: $instcodetitle = $lt{'ins'};
15874: } else {
15875: $instcodetitle = $lt{'inc'};
15876: }
15877: if ($fixeddom) {
15878: $instcodetitle .= '<br />('.$codedom.')';
15879: }
15880: }
15881: }
15882: my $output = qq|
15883: <form method="post" name="filterpicker" action="$action">
15884: <input type="hidden" name="form" value="$formname" />
15885: |;
15886: if ($formname eq 'modifycourse') {
15887: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15888: '<input type="hidden" name="prevphase" value="'.
15889: $prevphase.'" />'."\n";
1.1198 musolffc 15890: } elsif ($formname eq 'quotacheck') {
15891: $output .= qq|
15892: <input type="hidden" name="sortby" value="" />
15893: <input type="hidden" name="sortorder" value="" />
15894: |;
15895: } else {
1.1181 raeburn 15896: my $name_input;
15897: if ($cnameelement ne '') {
15898: $name_input = '<input type="hidden" name="cnameelement" value="'.
15899: $cnameelement.'" />';
15900: }
15901: $output .= qq|
1.1182 raeburn 15902: <input type="hidden" name="cnumelement" value="$cnumelement" />
15903: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15904: $name_input
15905: $roleelement
15906: $multelement
15907: $typeelement
15908: |;
15909: if ($formname eq 'portform') {
15910: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15911: }
15912: }
15913: if ($fixeddom) {
15914: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15915: }
15916: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15917: if ($sincefilterform) {
15918: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15919: .$sincefilterform
15920: .&Apache::lonhtmlcommon::row_closure();
15921: }
15922: if ($createdfilterform) {
15923: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15924: .$createdfilterform
15925: .&Apache::lonhtmlcommon::row_closure();
15926: }
15927: if ($domainselectform) {
15928: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15929: .$domainselectform
15930: .&Apache::lonhtmlcommon::row_closure();
15931: }
15932: if ($typeselectform) {
15933: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15934: $output .= $typeselectform;
15935: } else {
15936: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15937: .$typeselectform
15938: .&Apache::lonhtmlcommon::row_closure();
15939: }
15940: }
15941: if ($instcodeform) {
15942: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15943: .$instcodeform
15944: .&Apache::lonhtmlcommon::row_closure();
15945: }
15946: if (exists($filter->{'ownerfilter'})) {
15947: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15948: '<table><tr><td>'.&mt('Username').'<br />'.
15949: '<input type="text" name="ownerfilter" size="20" value="'.
15950: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15951: $ownerdomselectform.'</td></tr></table>'.
15952: &Apache::lonhtmlcommon::row_closure();
15953: }
15954: if (exists($filter->{'personfilter'})) {
15955: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15956: '<table><tr><td>'.&mt('Username').'<br />'.
15957: '<input type="text" name="personfilter" size="20" value="'.
15958: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15959: $persondomselectform.'</td></tr></table>'.
15960: &Apache::lonhtmlcommon::row_closure();
15961: }
15962: if (exists($filter->{'coursefilter'})) {
15963: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15964: .'<input type="text" name="coursefilter" size="25" value="'
15965: .$list->{'coursefilter'}.'" />'
15966: .&Apache::lonhtmlcommon::row_closure();
15967: }
15968: if ($cloneableonlyform) {
15969: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15970: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15971: }
15972: if (exists($filter->{'descriptfilter'})) {
15973: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15974: .'<input type="text" name="descriptfilter" size="40" value="'
15975: .$list->{'descriptfilter'}.'" />'
15976: .&Apache::lonhtmlcommon::row_closure(1);
15977: }
15978: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15979: '<input type="hidden" name="updater" value="" />'."\n".
15980: '<input type="submit" name="gosearch" value="'.
15981: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15982: return $jscript.$clonewarning.$output;
15983: }
15984:
15985: =pod
15986:
15987: =item * &timebased_select_form()
15988:
1.1182 raeburn 15989: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15990: filter e.g., Course Activity, Course Created, when searching for courses
15991: or communities
15992:
15993: Inputs:
15994:
15995: item - name of form element (sincefilter or createdfilter)
15996:
15997: filter - anonymous hash of criteria and their values
15998:
15999: Returns: HTML for a select box contained a blank, then six time selections,
16000: with value set in incoming form variables currently selected.
16001:
16002: Side Effects: None
16003:
16004: =cut
16005:
16006: sub timebased_select_form {
16007: my ($item,$filter) = @_;
16008: if (ref($filter) eq 'HASH') {
16009: $filter->{$item} =~ s/[^\d-]//g;
16010: if (!$filter->{$item}) { $filter->{$item}=-1; }
16011: return &select_form(
16012: $filter->{$item},
16013: $item,
16014: { '-1' => '',
16015: '86400' => &mt('today'),
16016: '604800' => &mt('last week'),
16017: '2592000' => &mt('last month'),
16018: '7776000' => &mt('last three months'),
16019: '15552000' => &mt('last six months'),
16020: '31104000' => &mt('last year'),
16021: 'select_form_order' =>
16022: ['-1','86400','604800','2592000','7776000',
16023: '15552000','31104000']});
16024: }
16025: }
16026:
16027: =pod
16028:
16029: =item * &js_changer()
16030:
16031: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 16032: when course type or domain is changed, and also to hide 'Searching ...' on
16033: page load completion for page showing search result.
1.1181 raeburn 16034:
16035: Inputs: None
16036:
1.1183 raeburn 16037: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16038:
16039: Side Effects: None
16040:
16041: =cut
16042:
16043: sub js_changer {
16044: return <<ENDJS;
16045: <script type="text/javascript">
16046: // <![CDATA[
16047: function updateFilters(caller) {
16048: if (typeof(caller) != "undefined") {
16049: document.filterpicker.updater.value = caller.name;
16050: }
16051: document.filterpicker.submit();
16052: }
1.1183 raeburn 16053:
16054: function hideSearching() {
16055: if (document.getElementById('searching')) {
16056: document.getElementById('searching').style.display = 'none';
16057: }
16058: return;
16059: }
16060:
1.1181 raeburn 16061: // ]]>
16062: </script>
16063:
16064: ENDJS
16065: }
16066:
16067: =pod
16068:
1.1182 raeburn 16069: =item * &search_courses()
16070:
16071: Process selected filters form course search form and pass to lonnet::courseiddump
16072: to retrieve a hash for which keys are courseIDs which match the selected filters.
16073:
16074: Inputs:
16075:
16076: dom - domain being searched
16077:
16078: type - course type ('Course' or 'Community' or '.' if any).
16079:
16080: filter - anonymous hash of criteria and their values
16081:
16082: numtitles - for institutional codes - number of categories
16083:
16084: cloneruname - optional username of new course owner
16085:
16086: clonerudom - optional domain of new course owner
16087:
1.1221 raeburn 16088: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 16089: (used when DC is using course creation form)
16090:
16091: codetitles - reference to array of titles of components in institutional codes (official courses).
16092:
1.1221 raeburn 16093: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16094: (and so can clone automatically)
16095:
16096: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16097:
16098: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16099: courses to clone
1.1182 raeburn 16100:
16101: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16102:
16103:
16104: Side Effects: None
16105:
16106: =cut
16107:
16108:
16109: sub search_courses {
1.1221 raeburn 16110: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16111: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 16112: my (%courses,%showcourses,$cloner);
16113: if (($filter->{'ownerfilter'} ne '') ||
16114: ($filter->{'ownerdomfilter'} ne '')) {
16115: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16116: $filter->{'ownerdomfilter'};
16117: }
16118: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16119: if (!$filter->{$item}) {
16120: $filter->{$item}='.';
16121: }
16122: }
16123: my $now = time;
16124: my $timefilter =
16125: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16126: my ($createdbefore,$createdafter);
16127: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16128: $createdbefore = $now;
16129: $createdafter = $now-$filter->{'createdfilter'};
16130: }
16131: my ($instcodefilter,$regexpok);
16132: if ($numtitles) {
16133: if ($env{'form.official'} eq 'on') {
16134: $instcodefilter =
16135: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16136: $regexpok = 1;
16137: } elsif ($env{'form.official'} eq 'off') {
16138: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16139: unless ($instcodefilter eq '') {
16140: $regexpok = -1;
16141: }
16142: }
16143: } else {
16144: $instcodefilter = $filter->{'instcodefilter'};
16145: }
16146: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16147: if ($type eq '') { $type = '.'; }
16148:
16149: if (($clonerudom ne '') && ($cloneruname ne '')) {
16150: $cloner = $cloneruname.':'.$clonerudom;
16151: }
16152: %courses = &Apache::lonnet::courseiddump($dom,
16153: $filter->{'descriptfilter'},
16154: $timefilter,
16155: $instcodefilter,
16156: $filter->{'combownerfilter'},
16157: $filter->{'coursefilter'},
16158: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 16159: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 16160: $filter->{'cloneableonly'},
16161: $createdbefore,$createdafter,undef,
1.1221 raeburn 16162: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 16163: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16164: my $ccrole;
16165: if ($type eq 'Community') {
16166: $ccrole = 'co';
16167: } else {
16168: $ccrole = 'cc';
16169: }
16170: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16171: $filter->{'persondomfilter'},
16172: 'userroles',undef,
16173: [$ccrole,'in','ad','ep','ta','cr'],
16174: $dom);
16175: foreach my $role (keys(%rolehash)) {
16176: my ($cnum,$cdom,$courserole) = split(':',$role);
16177: my $cid = $cdom.'_'.$cnum;
16178: if (exists($courses{$cid})) {
16179: if (ref($courses{$cid}) eq 'HASH') {
16180: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16181: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
16182: push (@{$courses{$cid}{roles}},$courserole);
16183: }
16184: } else {
16185: $courses{$cid}{roles} = [$courserole];
16186: }
16187: $showcourses{$cid} = $courses{$cid};
16188: }
16189: }
16190: }
16191: %courses = %showcourses;
16192: }
16193: return %courses;
16194: }
16195:
16196: =pod
16197:
1.1181 raeburn 16198: =back
16199:
1.1207 raeburn 16200: =head1 Routines for version requirements for current course.
16201:
16202: =over 4
16203:
16204: =item * &check_release_required()
16205:
16206: Compares required LON-CAPA version with version on server, and
16207: if required version is newer looks for a server with the required version.
16208:
16209: Looks first at servers in user's owen domain; if none suitable, looks at
16210: servers in course's domain are permitted to host sessions for user's domain.
16211:
16212: Inputs:
16213:
16214: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16215:
16216: $courseid - Course ID of current course
16217:
16218: $rolecode - User's current role in course (for switchserver query string).
16219:
16220: $required - LON-CAPA version needed by course (format: Major.Minor).
16221:
16222:
16223: Returns:
16224:
16225: $switchserver - query string tp append to /adm/switchserver call (if
16226: current server's LON-CAPA version is too old.
16227:
16228: $warning - Message is displayed if no suitable server could be found.
16229:
16230: =cut
16231:
16232: sub check_release_required {
16233: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16234: my ($switchserver,$warning);
16235: if ($required ne '') {
16236: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16237: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16238: if ($reqdmajor ne '' && $reqdminor ne '') {
16239: my $otherserver;
16240: if (($major eq '' && $minor eq '') ||
16241: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16242: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16243: my $switchlcrev =
16244: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16245: $userdomserver);
16246: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16247: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16248: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16249: my $cdom = $env{'course.'.$courseid.'.domain'};
16250: if ($cdom ne $env{'user.domain'}) {
16251: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16252: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16253: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16254: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16255: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16256: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16257: my $canhost =
16258: &Apache::lonnet::can_host_session($env{'user.domain'},
16259: $coursedomserver,
16260: $remoterev,
16261: $udomdefaults{'remotesessions'},
16262: $defdomdefaults{'hostedsessions'});
16263:
16264: if ($canhost) {
16265: $otherserver = $coursedomserver;
16266: } else {
16267: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
16268: }
16269: } else {
16270: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
16271: }
16272: } else {
16273: $otherserver = $userdomserver;
16274: }
16275: }
16276: if ($otherserver ne '') {
16277: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16278: }
16279: }
16280: }
16281: return ($switchserver,$warning);
16282: }
16283:
16284: =pod
16285:
16286: =item * &check_release_result()
16287:
16288: Inputs:
16289:
16290: $switchwarning - Warning message if no suitable server found to host session.
16291:
16292: $switchserver - query string to append to /adm/switchserver containing lonHostID
16293: and current role.
16294:
16295: Returns: HTML to display with information about requirement to switch server.
16296: Either displaying warning with link to Roles/Courses screen or
16297: display link to switchserver.
16298:
1.1181 raeburn 16299: =cut
16300:
1.1207 raeburn 16301: sub check_release_result {
16302: my ($switchwarning,$switchserver) = @_;
16303: my $output = &start_page('Selected course unavailable on this server').
16304: '<p class="LC_warning">';
16305: if ($switchwarning) {
16306: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16307: if (&show_course()) {
16308: $output .= &mt('Display courses');
16309: } else {
16310: $output .= &mt('Display roles');
16311: }
16312: $output .= '</a>';
16313: } elsif ($switchserver) {
16314: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
16315: '<br />'.
16316: '<a href="/adm/switchserver?'.$switchserver.'">'.
16317: &mt('Switch Server').
16318: '</a>';
16319: }
16320: $output .= '</p>'.&end_page();
16321: return $output;
16322: }
16323:
16324: =pod
16325:
16326: =item * &needs_coursereinit()
16327:
16328: Determine if course contents stored for user's session needs to be
16329: refreshed, because content has changed since "Big Hash" last tied.
16330:
16331: Check for change is made if time last checked is more than 10 minutes ago
16332: (by default).
16333:
16334: Inputs:
16335:
16336: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16337:
16338: $interval (optional) - Time which may elapse (in s) between last check for content
16339: change in current course. (default: 600 s).
16340:
16341: Returns: an array; first element is:
16342:
16343: =over 4
16344:
16345: 'switch' - if content updates mean user's session
16346: needs to be switched to a server running a newer LON-CAPA version
16347:
16348: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
16349: on current server hosting user's session
16350:
16351: '' - if no action required.
16352:
16353: =back
16354:
16355: If first item element is 'switch':
16356:
16357: second item is $switchwarning - Warning message if no suitable server found to host session.
16358:
16359: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
16360: and current role.
16361:
16362: otherwise: no other elements returned.
16363:
16364: =back
16365:
16366: =cut
16367:
16368: sub needs_coursereinit {
16369: my ($loncaparev,$interval) = @_;
16370: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
16371: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
16372: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
16373: my $now = time;
16374: if ($interval eq '') {
16375: $interval = 600;
16376: }
16377: if (($now-$env{'request.course.timechecked'})>$interval) {
16378: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
16379: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
16380: if ($lastchange > $env{'request.course.tied'}) {
16381: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16382: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
16383: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
16384: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
16385: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
16386: $curr_reqd_hash{'internal.releaserequired'}});
16387: my ($switchserver,$switchwarning) =
16388: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
16389: $curr_reqd_hash{'internal.releaserequired'});
16390: if ($switchwarning ne '' || $switchserver ne '') {
16391: return ('switch',$switchwarning,$switchserver);
16392: }
16393: }
16394: }
16395: return ('update');
16396: }
16397: }
16398: return ();
16399: }
1.1181 raeburn 16400:
1.1083 raeburn 16401: sub update_content_constraints {
16402: my ($cdom,$cnum,$chome,$cid) = @_;
16403: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16404: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
16405: my %checkresponsetypes;
16406: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 16407: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 16408: if ($item eq 'resourcetag') {
16409: if ($name eq 'responsetype') {
16410: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
16411: }
16412: }
16413: }
16414: my $navmap = Apache::lonnavmaps::navmap->new();
16415: if (defined($navmap)) {
16416: my %allresponses;
16417: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
16418: my %responses = $res->responseTypes();
16419: foreach my $key (keys(%responses)) {
16420: next unless(exists($checkresponsetypes{$key}));
16421: $allresponses{$key} += $responses{$key};
16422: }
16423: }
16424: foreach my $key (keys(%allresponses)) {
16425: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
16426: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
16427: ($reqdmajor,$reqdminor) = ($major,$minor);
16428: }
16429: }
16430: undef($navmap);
16431: }
16432: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
16433: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
16434: }
16435: return;
16436: }
16437:
1.1110 raeburn 16438: sub allmaps_incourse {
16439: my ($cdom,$cnum,$chome,$cid) = @_;
16440: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
16441: $cid = $env{'request.course.id'};
16442: $cdom = $env{'course.'.$cid.'.domain'};
16443: $cnum = $env{'course.'.$cid.'.num'};
16444: $chome = $env{'course.'.$cid.'.home'};
16445: }
16446: my %allmaps = ();
16447: my $lastchange =
16448: &Apache::lonnet::get_coursechange($cdom,$cnum);
16449: if ($lastchange > $env{'request.course.tied'}) {
16450: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16451: unless ($ferr) {
16452: &update_content_constraints($cdom,$cnum,$chome,$cid);
16453: }
16454: }
16455: my $navmap = Apache::lonnavmaps::navmap->new();
16456: if (defined($navmap)) {
16457: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16458: $allmaps{$res->src()} = 1;
16459: }
16460: }
16461: return \%allmaps;
16462: }
16463:
1.1083 raeburn 16464: sub parse_supplemental_title {
16465: my ($title) = @_;
16466:
16467: my ($foldertitle,$renametitle);
16468: if ($title =~ /&&&/) {
16469: $title = &HTML::Entites::decode($title);
16470: }
16471: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16472: $renametitle=$4;
16473: my ($time,$uname,$udom) = ($1,$2,$3);
16474: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16475: my $name = &plainname($uname,$udom);
16476: $name = &HTML::Entities::encode($name,'"<>&\'');
16477: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16478: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16479: $name.': <br />'.$foldertitle;
16480: }
16481: if (wantarray) {
16482: return ($title,$foldertitle,$renametitle);
16483: }
16484: return $title;
16485: }
16486:
1.1143 raeburn 16487: sub recurse_supplemental {
16488: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16489: if ($suppmap) {
16490: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16491: if ($fatal) {
16492: $errors ++;
16493: } else {
16494: if ($#LONCAPA::map::resources > 0) {
16495: foreach my $res (@LONCAPA::map::resources) {
16496: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16497: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16498: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16499: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16500: } else {
16501: $numfiles ++;
16502: }
16503: }
16504: }
16505: }
16506: }
16507: }
16508: return ($numfiles,$errors);
16509: }
16510:
1.1101 raeburn 16511: sub symb_to_docspath {
16512: my ($symb) = @_;
16513: return unless ($symb);
16514: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16515: if ($resurl=~/\.(sequence|page)$/) {
16516: $mapurl=$resurl;
16517: } elsif ($resurl eq 'adm/navmaps') {
16518: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16519: }
16520: my $mapresobj;
16521: my $navmap = Apache::lonnavmaps::navmap->new();
16522: if (ref($navmap)) {
16523: $mapresobj = $navmap->getResourceByUrl($mapurl);
16524: }
16525: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16526: my $type=$2;
16527: my $path;
16528: if (ref($mapresobj)) {
16529: my $pcslist = $mapresobj->map_hierarchy();
16530: if ($pcslist ne '') {
16531: foreach my $pc (split(/,/,$pcslist)) {
16532: next if ($pc <= 1);
16533: my $res = $navmap->getByMapPc($pc);
16534: if (ref($res)) {
16535: my $thisurl = $res->src();
16536: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16537: my $thistitle = $res->title();
16538: $path .= '&'.
16539: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16540: &escape($thistitle).
1.1101 raeburn 16541: ':'.$res->randompick().
16542: ':'.$res->randomout().
16543: ':'.$res->encrypted().
16544: ':'.$res->randomorder().
16545: ':'.$res->is_page();
16546: }
16547: }
16548: }
16549: $path =~ s/^\&//;
16550: my $maptitle = $mapresobj->title();
16551: if ($mapurl eq 'default') {
1.1129 raeburn 16552: $maptitle = 'Main Content';
1.1101 raeburn 16553: }
16554: $path .= (($path ne '')? '&' : '').
16555: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16556: &escape($maptitle).
1.1101 raeburn 16557: ':'.$mapresobj->randompick().
16558: ':'.$mapresobj->randomout().
16559: ':'.$mapresobj->encrypted().
16560: ':'.$mapresobj->randomorder().
16561: ':'.$mapresobj->is_page();
16562: } else {
16563: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16564: my $ispage = (($type eq 'page')? 1 : '');
16565: if ($mapurl eq 'default') {
1.1129 raeburn 16566: $maptitle = 'Main Content';
1.1101 raeburn 16567: }
16568: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16569: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16570: }
16571: unless ($mapurl eq 'default') {
16572: $path = 'default&'.
1.1146 raeburn 16573: &escape('Main Content').
1.1101 raeburn 16574: ':::::&'.$path;
16575: }
16576: return $path;
16577: }
16578:
1.1094 raeburn 16579: sub captcha_display {
16580: my ($context,$lonhost) = @_;
16581: my ($output,$error);
1.1234 raeburn 16582: my ($captcha,$pubkey,$privkey,$version) =
16583: &get_captcha_config($context,$lonhost);
1.1095 raeburn 16584: if ($captcha eq 'original') {
1.1094 raeburn 16585: $output = &create_captcha();
16586: unless ($output) {
1.1172 raeburn 16587: $error = 'captcha';
1.1094 raeburn 16588: }
16589: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 16590: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 16591: unless ($output) {
1.1172 raeburn 16592: $error = 'recaptcha';
1.1094 raeburn 16593: }
16594: }
1.1234 raeburn 16595: return ($output,$error,$captcha,$version);
1.1094 raeburn 16596: }
16597:
16598: sub captcha_response {
16599: my ($context,$lonhost) = @_;
16600: my ($captcha_chk,$captcha_error);
1.1234 raeburn 16601: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16602: if ($captcha eq 'original') {
1.1094 raeburn 16603: ($captcha_chk,$captcha_error) = &check_captcha();
16604: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 16605: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 16606: } else {
16607: $captcha_chk = 1;
16608: }
16609: return ($captcha_chk,$captcha_error);
16610: }
16611:
16612: sub get_captcha_config {
16613: my ($context,$lonhost) = @_;
1.1234 raeburn 16614: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 16615: my $hostname = &Apache::lonnet::hostname($lonhost);
16616: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16617: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 16618: if ($context eq 'usercreation') {
16619: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16620: if (ref($domconfig{$context}) eq 'HASH') {
16621: $hashtocheck = $domconfig{$context}{'cancreate'};
16622: if (ref($hashtocheck) eq 'HASH') {
16623: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16624: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16625: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16626: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16627: }
16628: if ($privkey && $pubkey) {
16629: $captcha = 'recaptcha';
1.1234 raeburn 16630: $version = $hashtocheck->{'recaptchaversion'};
16631: if ($version ne '2') {
16632: $version = 1;
16633: }
1.1095 raeburn 16634: } else {
16635: $captcha = 'original';
16636: }
16637: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16638: $captcha = 'original';
16639: }
1.1094 raeburn 16640: }
1.1095 raeburn 16641: } else {
16642: $captcha = 'captcha';
16643: }
16644: } elsif ($context eq 'login') {
16645: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16646: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16647: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16648: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 16649: if ($privkey && $pubkey) {
16650: $captcha = 'recaptcha';
1.1234 raeburn 16651: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
16652: if ($version ne '2') {
16653: $version = 1;
16654: }
1.1095 raeburn 16655: } else {
16656: $captcha = 'original';
1.1094 raeburn 16657: }
1.1095 raeburn 16658: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16659: $captcha = 'original';
1.1094 raeburn 16660: }
16661: }
1.1234 raeburn 16662: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 16663: }
16664:
16665: sub create_captcha {
16666: my %captcha_params = &captcha_settings();
16667: my ($output,$maxtries,$tries) = ('',10,0);
16668: while ($tries < $maxtries) {
16669: $tries ++;
16670: my $captcha = Authen::Captcha->new (
16671: output_folder => $captcha_params{'output_dir'},
16672: data_folder => $captcha_params{'db_dir'},
16673: );
16674: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16675:
16676: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16677: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16678: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 16679: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16680: '<br />'.
16681: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 16682: last;
16683: }
16684: }
16685: return $output;
16686: }
16687:
16688: sub captcha_settings {
16689: my %captcha_params = (
16690: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16691: www_output_dir => "/captchaspool",
16692: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16693: numchars => '5',
16694: );
16695: return %captcha_params;
16696: }
16697:
16698: sub check_captcha {
16699: my ($captcha_chk,$captcha_error);
16700: my $code = $env{'form.code'};
16701: my $md5sum = $env{'form.crypt'};
16702: my %captcha_params = &captcha_settings();
16703: my $captcha = Authen::Captcha->new(
16704: output_folder => $captcha_params{'output_dir'},
16705: data_folder => $captcha_params{'db_dir'},
16706: );
1.1109 raeburn 16707: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 16708: my %captcha_hash = (
16709: 0 => 'Code not checked (file error)',
16710: -1 => 'Failed: code expired',
16711: -2 => 'Failed: invalid code (not in database)',
16712: -3 => 'Failed: invalid code (code does not match crypt)',
16713: );
16714: if ($captcha_chk != 1) {
16715: $captcha_error = $captcha_hash{$captcha_chk}
16716: }
16717: return ($captcha_chk,$captcha_error);
16718: }
16719:
16720: sub create_recaptcha {
1.1234 raeburn 16721: my ($pubkey,$version) = @_;
16722: if ($version >= 2) {
16723: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
16724: } else {
16725: my $use_ssl;
16726: if ($ENV{'SERVER_PORT'} == 443) {
16727: $use_ssl = 1;
16728: }
16729: my $captcha = Captcha::reCAPTCHA->new;
16730: return $captcha->get_options_setter({theme => 'white'})."\n".
16731: $captcha->get_html($pubkey,undef,$use_ssl).
16732: &mt('If the text is hard to read, [_1] will replace them.',
16733: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
16734: '<br /><br />';
16735: }
1.1094 raeburn 16736: }
16737:
16738: sub check_recaptcha {
1.1234 raeburn 16739: my ($privkey,$version) = @_;
1.1094 raeburn 16740: my $captcha_chk;
1.1234 raeburn 16741: if ($version >= 2) {
16742: my $ua = LWP::UserAgent->new;
16743: $ua->timeout(10);
16744: my %info = (
16745: secret => $privkey,
16746: response => $env{'form.g-recaptcha-response'},
16747: remoteip => $ENV{'REMOTE_ADDR'},
16748: );
16749: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
16750: if ($response->is_success) {
16751: my $data = JSON::DWIW->from_json($response->decoded_content);
16752: if (ref($data) eq 'HASH') {
16753: if ($data->{'success'}) {
16754: $captcha_chk = 1;
16755: }
16756: }
16757: }
16758: } else {
16759: my $captcha = Captcha::reCAPTCHA->new;
16760: my $captcha_result =
16761: $captcha->check_answer(
16762: $privkey,
16763: $ENV{'REMOTE_ADDR'},
16764: $env{'form.recaptcha_challenge_field'},
16765: $env{'form.recaptcha_response_field'},
16766: );
16767: if ($captcha_result->{is_valid}) {
16768: $captcha_chk = 1;
16769: }
1.1094 raeburn 16770: }
16771: return $captcha_chk;
16772: }
16773:
1.1174 raeburn 16774: sub emailusername_info {
1.1177 raeburn 16775: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 16776: my %titles = &Apache::lonlocal::texthash (
16777: lastname => 'Last Name',
16778: firstname => 'First Name',
16779: institution => 'School/college/university',
16780: location => "School's city, state/province, country",
16781: web => "School's web address",
16782: officialemail => 'E-mail address at institution (if different)',
16783: );
16784: return (\@fields,\%titles);
16785: }
16786:
1.1161 raeburn 16787: sub cleanup_html {
16788: my ($incoming) = @_;
16789: my $outgoing;
16790: if ($incoming ne '') {
16791: $outgoing = $incoming;
16792: $outgoing =~ s/;/;/g;
16793: $outgoing =~ s/\#/#/g;
16794: $outgoing =~ s/\&/&/g;
16795: $outgoing =~ s/</</g;
16796: $outgoing =~ s/>/>/g;
16797: $outgoing =~ s/\(/(/g;
16798: $outgoing =~ s/\)/)/g;
16799: $outgoing =~ s/"/"/g;
16800: $outgoing =~ s/'/'/g;
16801: $outgoing =~ s/\$/$/g;
16802: $outgoing =~ s{/}{/}g;
16803: $outgoing =~ s/=/=/g;
16804: $outgoing =~ s/\\/\/g
16805: }
16806: return $outgoing;
16807: }
16808:
1.1190 musolffc 16809: # Checks for critical messages and returns a redirect url if one exists.
16810: # $interval indicates how often to check for messages.
16811: sub critical_redirect {
16812: my ($interval) = @_;
16813: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16814: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16815: $env{'user.name'});
16816: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 16817: my $redirecturl;
1.1190 musolffc 16818: if ($what[0]) {
16819: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16820: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 16821: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16822: return (1, $url);
1.1190 musolffc 16823: }
1.1191 raeburn 16824: }
16825: }
16826: return ();
1.1190 musolffc 16827: }
16828:
1.1174 raeburn 16829: # Use:
16830: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16831: #
16832: ##################################################
16833: # password associated functions #
16834: ##################################################
16835: sub des_keys {
16836: # Make a new key for DES encryption.
16837: # Each key has two parts which are returned separately.
16838: # Please note: Each key must be passed through the &hex function
16839: # before it is output to the web browser. The hex versions cannot
16840: # be used to decrypt.
16841: my @hexstr=('0','1','2','3','4','5','6','7',
16842: '8','9','a','b','c','d','e','f');
16843: my $lkey='';
16844: for (0..7) {
16845: $lkey.=$hexstr[rand(15)];
16846: }
16847: my $ukey='';
16848: for (0..7) {
16849: $ukey.=$hexstr[rand(15)];
16850: }
16851: return ($lkey,$ukey);
16852: }
16853:
16854: sub des_decrypt {
16855: my ($key,$cyphertext) = @_;
16856: my $keybin=pack("H16",$key);
16857: my $cypher;
16858: if ($Crypt::DES::VERSION>=2.03) {
16859: $cypher=new Crypt::DES $keybin;
16860: } else {
16861: $cypher=new DES $keybin;
16862: }
1.1233 raeburn 16863: my $plaintext='';
16864: my $cypherlength = length($cyphertext);
16865: my $numchunks = int($cypherlength/32);
16866: for (my $j=0; $j<$numchunks; $j++) {
16867: my $start = $j*32;
16868: my $cypherblock = substr($cyphertext,$start,32);
16869: my $chunk =
16870: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
16871: $chunk .=
16872: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
16873: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
16874: $plaintext .= $chunk;
16875: }
1.1174 raeburn 16876: return $plaintext;
16877: }
16878:
1.112 bowersj2 16879: 1;
16880: __END__;
1.41 ng 16881:
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