Annotation of loncom/interface/loncommon.pm, revision 1.1219
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1219 ! raeburn 4: # $Id: loncommon.pm,v 1.1218 2015/04/17 12:34:01 droeschl 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.1091 foxr 76: use Text::Aspell;
1.1094 raeburn 77: use Authen::Captcha;
78: use Captcha::reCAPTCHA;
1.1174 raeburn 79: use Crypt::DES;
80: use DynaLoader; # for Crypt::DES version
1.117 www 81:
1.517 raeburn 82: # ---------------------------------------------- Designs
83: use vars qw(%defaultdesign);
84:
1.22 www 85: my $readit;
86:
1.517 raeburn 87:
1.157 matthew 88: ##
89: ## Global Variables
90: ##
1.46 matthew 91:
1.643 foxr 92:
93: # ----------------------------------------------- SSI with retries:
94: #
95:
96: =pod
97:
1.648 raeburn 98: =head1 Server Side include with retries:
1.643 foxr 99:
100: =over 4
101:
1.648 raeburn 102: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 103:
104: Performs an ssi with some number of retries. Retries continue either
105: until the result is ok or until the retry count supplied by the
106: caller is exhausted.
107:
108: Inputs:
1.648 raeburn 109:
110: =over 4
111:
1.643 foxr 112: resource - Identifies the resource to insert.
1.648 raeburn 113:
1.643 foxr 114: retries - Count of the number of retries allowed.
1.648 raeburn 115:
1.643 foxr 116: form - Hash that identifies the rendering options.
117:
1.648 raeburn 118: =back
119:
120: Returns:
121:
122: =over 4
123:
1.643 foxr 124: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 125:
1.643 foxr 126: response - The response from the last attempt (which may or may not have been successful.
127:
1.648 raeburn 128: =back
129:
130: =back
131:
1.643 foxr 132: =cut
133:
134: sub ssi_with_retries {
135: my ($resource, $retries, %form) = @_;
136:
137:
138: my $ok = 0; # True if we got a good response.
139: my $content;
140: my $response;
141:
142: # Try to get the ssi done. within the retries count:
143:
144: do {
145: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
146: $ok = $response->is_success;
1.650 www 147: if (!$ok) {
148: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
149: }
1.643 foxr 150: $retries--;
151: } while (!$ok && ($retries > 0));
152:
153: if (!$ok) {
154: $content = ''; # On error return an empty content.
155: }
156: return ($content, $response);
157:
158: }
159:
160:
161:
1.20 www 162: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 163: my %language;
1.124 www 164: my %supported_language;
1.1088 foxr 165: my %supported_codes;
1.1048 foxr 166: my %latex_language; # For choosing hyphenation in <transl..>
167: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 168: my %cprtag;
1.192 taceyjo1 169: my %scprtag;
1.351 www 170: my %fe; my %fd; my %fm;
1.41 ng 171: my %category_extensions;
1.12 harris41 172:
1.46 matthew 173: # ---------------------------------------------- Thesaurus variables
1.144 matthew 174: #
175: # %Keywords:
176: # A hash used by &keyword to determine if a word is considered a keyword.
177: # $thesaurus_db_file
178: # Scalar containing the full path to the thesaurus database.
1.46 matthew 179:
180: my %Keywords;
181: my $thesaurus_db_file;
182:
1.144 matthew 183: #
184: # Initialize values from language.tab, copyright.tab, filetypes.tab,
185: # thesaurus.tab, and filecategories.tab.
186: #
1.18 www 187: BEGIN {
1.46 matthew 188: # Variable initialization
189: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
190: #
1.22 www 191: unless ($readit) {
1.12 harris41 192: # ------------------------------------------------------------------- languages
193: {
1.158 raeburn 194: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
195: '/language.tab';
196: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 197: while (my $line = <$fh>) {
198: next if ($line=~/^\#/);
199: chomp($line);
1.1088 foxr 200: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 201: $language{$key}=$val.' - '.$enc;
202: if ($sup) {
203: $supported_language{$key}=$sup;
1.1088 foxr 204: $supported_codes{$key} = $code;
1.158 raeburn 205: }
1.1048 foxr 206: if ($latex) {
207: $latex_language_bykey{$key} = $latex;
1.1088 foxr 208: $latex_language{$code} = $latex;
1.1048 foxr 209: }
1.158 raeburn 210: }
211: close($fh);
212: }
1.12 harris41 213: }
214: # ------------------------------------------------------------------ copyrights
215: {
1.158 raeburn 216: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
217: '/copyright.tab';
218: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 219: while (my $line = <$fh>) {
220: next if ($line=~/^\#/);
221: chomp($line);
222: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 223: $cprtag{$key}=$val;
224: }
225: close($fh);
226: }
1.12 harris41 227: }
1.351 www 228: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 229: {
230: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
231: '/source_copyright.tab';
232: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 233: while (my $line = <$fh>) {
234: next if ($line =~ /^\#/);
235: chomp($line);
236: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 237: $scprtag{$key}=$val;
238: }
239: close($fh);
240: }
241: }
1.63 www 242:
1.517 raeburn 243: # -------------------------------------------------------------- default domain designs
1.63 www 244: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 245: my $designfile = $designdir.'/default.tab';
246: if ( open (my $fh,"<$designfile") ) {
247: while (my $line = <$fh>) {
248: next if ($line =~ /^\#/);
249: chomp($line);
250: my ($key,$val)=(split(/\=/,$line));
251: if ($val) { $defaultdesign{$key}=$val; }
252: }
253: close($fh);
1.63 www 254: }
255:
1.15 harris41 256: # ------------------------------------------------------------- file categories
257: {
1.158 raeburn 258: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
259: '/filecategories.tab';
260: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 261: while (my $line = <$fh>) {
262: next if ($line =~ /^\#/);
263: chomp($line);
264: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 265: push @{$category_extensions{lc($category)}},$extension;
266: }
267: close($fh);
268: }
269:
1.15 harris41 270: }
1.12 harris41 271: # ------------------------------------------------------------------ file types
272: {
1.158 raeburn 273: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
274: '/filetypes.tab';
275: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 276: while (my $line = <$fh>) {
277: next if ($line =~ /^\#/);
278: chomp($line);
279: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 280: if ($descr ne '') {
281: $fe{$ending}=lc($emb);
282: $fd{$ending}=$descr;
1.351 www 283: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 284: }
285: }
286: close($fh);
287: }
1.12 harris41 288: }
1.22 www 289: &Apache::lonnet::logthis(
1.705 tempelho 290: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 291: $readit=1;
1.46 matthew 292: } # end of unless($readit)
1.32 matthew 293:
294: }
1.112 bowersj2 295:
1.42 matthew 296: ###############################################################
297: ## HTML and Javascript Helper Functions ##
298: ###############################################################
299:
300: =pod
301:
1.112 bowersj2 302: =head1 HTML and Javascript Functions
1.42 matthew 303:
1.112 bowersj2 304: =over 4
305:
1.648 raeburn 306: =item * &browser_and_searcher_javascript()
1.112 bowersj2 307:
308: X<browsing, javascript>X<searching, javascript>Returns a string
309: containing javascript with two functions, C<openbrowser> and
310: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
311: tags.
1.42 matthew 312:
1.648 raeburn 313: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 314:
315: inputs: formname, elementname, only, omit
316:
317: formname and elementname indicate the name of the html form and name of
318: the element that the results of the browsing selection are to be placed in.
319:
320: Specifying 'only' will restrict the browser to displaying only files
1.185 www 321: with the given extension. Can be a comma separated list.
1.42 matthew 322:
323: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 324: with the given extension. Can be a comma separated list.
1.42 matthew 325:
1.648 raeburn 326: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 327:
328: Inputs: formname, elementname
329:
330: formname and elementname specify the name of the html form and the name
331: of the element the selection from the search results will be placed in.
1.542 raeburn 332:
1.42 matthew 333: =cut
334:
335: sub browser_and_searcher_javascript {
1.199 albertel 336: my ($mode)=@_;
337: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 338: my $resurl=&escape_single(&lastresurl());
1.42 matthew 339: return <<END;
1.219 albertel 340: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 341: var editbrowser = null;
1.135 albertel 342: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 343: var url = '$resurl/?';
1.42 matthew 344: if (editbrowser == null) {
345: url += 'launch=1&';
346: }
347: url += 'catalogmode=interactive&';
1.199 albertel 348: url += 'mode=$mode&';
1.611 albertel 349: url += 'inhibitmenu=yes&';
1.42 matthew 350: url += 'form=' + formname + '&';
351: if (only != null) {
352: url += 'only=' + only + '&';
1.217 albertel 353: } else {
354: url += 'only=&';
355: }
1.42 matthew 356: if (omit != null) {
357: url += 'omit=' + omit + '&';
1.217 albertel 358: } else {
359: url += 'omit=&';
360: }
1.135 albertel 361: if (titleelement != null) {
362: url += 'titleelement=' + titleelement + '&';
1.217 albertel 363: } else {
364: url += 'titleelement=&';
365: }
1.42 matthew 366: url += 'element=' + elementname + '';
367: var title = 'Browser';
1.435 albertel 368: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 369: options += ',width=700,height=600';
370: editbrowser = open(url,title,options,'1');
371: editbrowser.focus();
372: }
373: var editsearcher;
1.135 albertel 374: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 375: var url = '/adm/searchcat?';
376: if (editsearcher == null) {
377: url += 'launch=1&';
378: }
379: url += 'catalogmode=interactive&';
1.199 albertel 380: url += 'mode=$mode&';
1.42 matthew 381: url += 'form=' + formname + '&';
1.135 albertel 382: if (titleelement != null) {
383: url += 'titleelement=' + titleelement + '&';
1.217 albertel 384: } else {
385: url += 'titleelement=&';
386: }
1.42 matthew 387: url += 'element=' + elementname + '';
388: var title = 'Search';
1.435 albertel 389: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 390: options += ',width=700,height=600';
391: editsearcher = open(url,title,options,'1');
392: editsearcher.focus();
393: }
1.219 albertel 394: // END LON-CAPA Internal -->
1.42 matthew 395: END
1.170 www 396: }
397:
398: sub lastresurl {
1.258 albertel 399: if ($env{'environment.lastresurl'}) {
400: return $env{'environment.lastresurl'}
1.170 www 401: } else {
402: return '/res';
403: }
404: }
405:
406: sub storeresurl {
407: my $resurl=&Apache::lonnet::clutter(shift);
408: unless ($resurl=~/^\/res/) { return 0; }
409: $resurl=~s/\/$//;
410: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 411: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 412: return 1;
1.42 matthew 413: }
414:
1.74 www 415: sub studentbrowser_javascript {
1.111 www 416: unless (
1.258 albertel 417: (($env{'request.course.id'}) &&
1.302 albertel 418: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
419: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
420: '/'.$env{'request.course.sec'})
421: ))
1.258 albertel 422: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 423: ) { return ''; }
1.74 www 424: return (<<'ENDSTDBRW');
1.776 bisitz 425: <script type="text/javascript" language="Javascript">
1.824 bisitz 426: // <![CDATA[
1.74 www 427: var stdeditbrowser;
1.999 www 428: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 429: var url = '/adm/pickstudent?';
430: var filter;
1.558 albertel 431: if (!ignorefilter) {
432: eval('filter=document.'+formname+'.'+uname+'.value;');
433: }
1.74 www 434: if (filter != null) {
435: if (filter != '') {
436: url += 'filter='+filter+'&';
437: }
438: }
439: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 440: '&udomelement='+udom+
441: '&clicker='+clicker;
1.111 www 442: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 443: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 444: var title = 'Student_Browser';
1.74 www 445: var options = 'scrollbars=1,resizable=1,menubar=0';
446: options += ',width=700,height=600';
447: stdeditbrowser = open(url,title,options,'1');
448: stdeditbrowser.focus();
449: }
1.824 bisitz 450: // ]]>
1.74 www 451: </script>
452: ENDSTDBRW
453: }
1.42 matthew 454:
1.1003 www 455: sub resourcebrowser_javascript {
456: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 457: return (<<'ENDRESBRW');
1.1003 www 458: <script type="text/javascript" language="Javascript">
459: // <![CDATA[
460: var reseditbrowser;
1.1004 www 461: function openresbrowser(formname,reslink) {
1.1005 www 462: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 463: var title = 'Resource_Browser';
464: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 465: options += ',width=700,height=500';
1.1004 www 466: reseditbrowser = open(url,title,options,'1');
467: reseditbrowser.focus();
1.1003 www 468: }
469: // ]]>
470: </script>
1.1004 www 471: ENDRESBRW
1.1003 www 472: }
473:
1.74 www 474: sub selectstudent_link {
1.999 www 475: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
476: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
477: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
478: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 479: if ($env{'request.course.id'}) {
1.302 albertel 480: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
481: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
482: '/'.$env{'request.course.sec'})) {
1.111 www 483: return '';
484: }
1.999 www 485: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 486: if ($courseadvonly) {
487: $callargs .= ",'',1,1";
488: }
489: return '<span class="LC_nobreak">'.
490: '<a href="javascript:openstdbrowser('.$callargs.');">'.
491: &mt('Select User').'</a></span>';
1.74 www 492: }
1.258 albertel 493: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 494: $callargs .= ",'',1";
1.793 raeburn 495: return '<span class="LC_nobreak">'.
496: '<a href="javascript:openstdbrowser('.$callargs.');">'.
497: &mt('Select User').'</a></span>';
1.111 www 498: }
499: return '';
1.91 www 500: }
501:
1.1004 www 502: sub selectresource_link {
503: my ($form,$reslink,$arg)=@_;
504:
505: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
506: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
507: unless ($env{'request.course.id'}) { return $arg; }
508: return '<span class="LC_nobreak">'.
509: '<a href="javascript:openresbrowser('.$callargs.');">'.
510: $arg.'</a></span>';
511: }
512:
513:
514:
1.653 raeburn 515: sub authorbrowser_javascript {
516: return <<"ENDAUTHORBRW";
1.776 bisitz 517: <script type="text/javascript" language="JavaScript">
1.824 bisitz 518: // <![CDATA[
1.653 raeburn 519: var stdeditbrowser;
520:
521: function openauthorbrowser(formname,udom) {
522: var url = '/adm/pickauthor?';
523: url += 'form='+formname+'&roledom='+udom;
524: var title = 'Author_Browser';
525: var options = 'scrollbars=1,resizable=1,menubar=0';
526: options += ',width=700,height=600';
527: stdeditbrowser = open(url,title,options,'1');
528: stdeditbrowser.focus();
529: }
530:
1.824 bisitz 531: // ]]>
1.653 raeburn 532: </script>
533: ENDAUTHORBRW
534: }
535:
1.91 www 536: sub coursebrowser_javascript {
1.1116 raeburn 537: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
538: $credits_element) = @_;
1.932 raeburn 539: my $wintitle = 'Course_Browser';
1.931 raeburn 540: if ($crstype eq 'Community') {
1.932 raeburn 541: $wintitle = 'Community_Browser';
1.909 raeburn 542: }
1.876 raeburn 543: my $id_functions = &javascript_index_functions();
544: my $output = '
1.776 bisitz 545: <script type="text/javascript" language="JavaScript">
1.824 bisitz 546: // <![CDATA[
1.468 raeburn 547: var stdeditbrowser;'."\n";
1.876 raeburn 548:
549: $output .= <<"ENDSTDBRW";
1.909 raeburn 550: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 551: var url = '/adm/pickcourse?';
1.895 raeburn 552: var formid = getFormIdByName(formname);
1.876 raeburn 553: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 554: if (domainfilter != null) {
555: if (domainfilter != '') {
556: url += 'domainfilter='+domainfilter+'&';
557: }
558: }
1.91 www 559: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 560: '&cdomelement='+udom+
561: '&cnameelement='+desc;
1.468 raeburn 562: if (extra_element !=null && extra_element != '') {
1.594 raeburn 563: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 564: url += '&roleelement='+extra_element;
565: if (domainfilter == null || domainfilter == '') {
566: url += '&domainfilter='+extra_element;
567: }
1.234 raeburn 568: }
1.468 raeburn 569: else {
570: if (formname == 'portform') {
571: url += '&setroles='+extra_element;
1.800 raeburn 572: } else {
573: if (formname == 'rules') {
574: url += '&fixeddom='+extra_element;
575: }
1.468 raeburn 576: }
577: }
1.230 raeburn 578: }
1.909 raeburn 579: if (type != null && type != '') {
580: url += '&type='+type;
581: }
582: if (type_elem != null && type_elem != '') {
583: url += '&typeelement='+type_elem;
584: }
1.872 raeburn 585: if (formname == 'ccrs') {
586: var ownername = document.forms[formid].ccuname.value;
587: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
588: url += '&cloner='+ownername+':'+ownerdom;
589: }
1.293 raeburn 590: if (multflag !=null && multflag != '') {
591: url += '&multiple='+multflag;
592: }
1.909 raeburn 593: var title = '$wintitle';
1.91 www 594: var options = 'scrollbars=1,resizable=1,menubar=0';
595: options += ',width=700,height=600';
596: stdeditbrowser = open(url,title,options,'1');
597: stdeditbrowser.focus();
598: }
1.876 raeburn 599: $id_functions
600: ENDSTDBRW
1.1116 raeburn 601: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
602: $output .= &setsec_javascript($sec_element,$formname,$role_element,
603: $credits_element);
1.876 raeburn 604: }
605: $output .= '
606: // ]]>
607: </script>';
608: return $output;
609: }
610:
611: sub javascript_index_functions {
612: return <<"ENDJS";
613:
614: function getFormIdByName(formname) {
615: for (var i=0;i<document.forms.length;i++) {
616: if (document.forms[i].name == formname) {
617: return i;
618: }
619: }
620: return -1;
621: }
622:
623: function getIndexByName(formid,item) {
624: for (var i=0;i<document.forms[formid].elements.length;i++) {
625: if (document.forms[formid].elements[i].name == item) {
626: return i;
627: }
628: }
629: return -1;
630: }
1.468 raeburn 631:
1.876 raeburn 632: function getDomainFromSelectbox(formname,udom) {
633: var userdom;
634: var formid = getFormIdByName(formname);
635: if (formid > -1) {
636: var domid = getIndexByName(formid,udom);
637: if (domid > -1) {
638: if (document.forms[formid].elements[domid].type == 'select-one') {
639: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
640: }
641: if (document.forms[formid].elements[domid].type == 'hidden') {
642: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 643: }
644: }
645: }
1.876 raeburn 646: return userdom;
647: }
648:
649: ENDJS
1.468 raeburn 650:
1.876 raeburn 651: }
652:
1.1017 raeburn 653: sub javascript_array_indexof {
1.1018 raeburn 654: return <<ENDJS;
1.1017 raeburn 655: <script type="text/javascript" language="JavaScript">
656: // <![CDATA[
657:
658: if (!Array.prototype.indexOf) {
659: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
660: "use strict";
661: if (this === void 0 || this === null) {
662: throw new TypeError();
663: }
664: var t = Object(this);
665: var len = t.length >>> 0;
666: if (len === 0) {
667: return -1;
668: }
669: var n = 0;
670: if (arguments.length > 0) {
671: n = Number(arguments[1]);
1.1088 foxr 672: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 673: n = 0;
674: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
675: n = (n > 0 || -1) * Math.floor(Math.abs(n));
676: }
677: }
678: if (n >= len) {
679: return -1;
680: }
681: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
682: for (; k < len; k++) {
683: if (k in t && t[k] === searchElement) {
684: return k;
685: }
686: }
687: return -1;
688: }
689: }
690:
691: // ]]>
692: </script>
693:
694: ENDJS
695:
696: }
697:
1.876 raeburn 698: sub userbrowser_javascript {
699: my $id_functions = &javascript_index_functions();
700: return <<"ENDUSERBRW";
701:
1.888 raeburn 702: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 703: var url = '/adm/pickuser?';
704: var userdom = getDomainFromSelectbox(formname,udom);
705: if (userdom != null) {
706: if (userdom != '') {
707: url += 'srchdom='+userdom+'&';
708: }
709: }
710: url += 'form=' + formname + '&unameelement='+uname+
711: '&udomelement='+udom+
712: '&ulastelement='+ulast+
713: '&ufirstelement='+ufirst+
714: '&uemailelement='+uemail+
1.881 raeburn 715: '&hideudomelement='+hideudom+
716: '&coursedom='+crsdom;
1.888 raeburn 717: if ((caller != null) && (caller != undefined)) {
718: url += '&caller='+caller;
719: }
1.876 raeburn 720: var title = 'User_Browser';
721: var options = 'scrollbars=1,resizable=1,menubar=0';
722: options += ',width=700,height=600';
723: var stdeditbrowser = open(url,title,options,'1');
724: stdeditbrowser.focus();
725: }
726:
1.888 raeburn 727: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 728: var formid = getFormIdByName(formname);
729: if (formid > -1) {
1.888 raeburn 730: var unameid = getIndexByName(formid,uname);
1.876 raeburn 731: var domid = getIndexByName(formid,udom);
732: var hidedomid = getIndexByName(formid,origdom);
733: if (hidedomid > -1) {
734: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 735: var unameval = document.forms[formid].elements[unameid].value;
736: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
737: if (domid > -1) {
738: var slct = document.forms[formid].elements[domid];
739: if (slct.type == 'select-one') {
740: var i;
741: for (i=0;i<slct.length;i++) {
742: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
743: }
744: }
745: if (slct.type == 'hidden') {
746: slct.value = fixeddom;
1.876 raeburn 747: }
748: }
1.468 raeburn 749: }
750: }
751: }
1.876 raeburn 752: return;
753: }
754:
755: $id_functions
756: ENDUSERBRW
1.468 raeburn 757: }
758:
759: sub setsec_javascript {
1.1116 raeburn 760: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 761: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
762: $communityrolestr);
763: if ($role_element ne '') {
764: my @allroles = ('st','ta','ep','in','ad');
765: foreach my $crstype ('Course','Community') {
766: if ($crstype eq 'Community') {
767: foreach my $role (@allroles) {
768: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
769: }
770: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
771: } else {
772: foreach my $role (@allroles) {
773: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
774: }
775: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
776: }
777: }
778: $rolestr = '"'.join('","',@allroles).'"';
779: $courserolestr = '"'.join('","',@courserolenames).'"';
780: $communityrolestr = '"'.join('","',@communityrolenames).'"';
781: }
1.468 raeburn 782: my $setsections = qq|
783: function setSect(sectionlist) {
1.629 raeburn 784: var sectionsArray = new Array();
785: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
786: sectionsArray = sectionlist.split(",");
787: }
1.468 raeburn 788: var numSections = sectionsArray.length;
789: document.$formname.$sec_element.length = 0;
790: if (numSections == 0) {
791: document.$formname.$sec_element.multiple=false;
792: document.$formname.$sec_element.size=1;
793: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
794: } else {
795: if (numSections == 1) {
796: document.$formname.$sec_element.multiple=false;
797: document.$formname.$sec_element.size=1;
798: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
799: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
800: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
801: } else {
802: for (var i=0; i<numSections; i++) {
803: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
804: }
805: document.$formname.$sec_element.multiple=true
806: if (numSections < 3) {
807: document.$formname.$sec_element.size=numSections;
808: } else {
809: document.$formname.$sec_element.size=3;
810: }
811: document.$formname.$sec_element.options[0].selected = false
812: }
813: }
1.91 www 814: }
1.905 raeburn 815:
816: function setRole(crstype) {
1.468 raeburn 817: |;
1.905 raeburn 818: if ($role_element eq '') {
819: $setsections .= ' return;
820: }
821: ';
822: } else {
823: $setsections .= qq|
824: var elementLength = document.$formname.$role_element.length;
825: var allroles = Array($rolestr);
826: var courserolenames = Array($courserolestr);
827: var communityrolenames = Array($communityrolestr);
828: if (elementLength != undefined) {
829: if (document.$formname.$role_element.options[5].value == 'cc') {
830: if (crstype == 'Course') {
831: return;
832: } else {
833: allroles[5] = 'co';
834: for (var i=0; i<6; i++) {
835: document.$formname.$role_element.options[i].value = allroles[i];
836: document.$formname.$role_element.options[i].text = communityrolenames[i];
837: }
838: }
839: } else {
840: if (crstype == 'Community') {
841: return;
842: } else {
843: allroles[5] = 'cc';
844: for (var i=0; i<6; i++) {
845: document.$formname.$role_element.options[i].value = allroles[i];
846: document.$formname.$role_element.options[i].text = courserolenames[i];
847: }
848: }
849: }
850: }
851: return;
852: }
853: |;
854: }
1.1116 raeburn 855: if ($credits_element) {
856: $setsections .= qq|
857: function setCredits(defaultcredits) {
858: document.$formname.$credits_element.value = defaultcredits;
859: return;
860: }
861: |;
862: }
1.468 raeburn 863: return $setsections;
864: }
865:
1.91 www 866: sub selectcourse_link {
1.909 raeburn 867: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
868: $typeelement) = @_;
869: my $type = $selecttype;
1.871 raeburn 870: my $linktext = &mt('Select Course');
871: if ($selecttype eq 'Community') {
1.909 raeburn 872: $linktext = &mt('Select Community');
1.906 raeburn 873: } elsif ($selecttype eq 'Course/Community') {
874: $linktext = &mt('Select Course/Community');
1.909 raeburn 875: $type = '';
1.1019 raeburn 876: } elsif ($selecttype eq 'Select') {
877: $linktext = &mt('Select');
878: $type = '';
1.871 raeburn 879: }
1.787 bisitz 880: return '<span class="LC_nobreak">'
881: ."<a href='"
882: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
883: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 884: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 885: ."'>".$linktext.'</a>'
1.787 bisitz 886: .'</span>';
1.74 www 887: }
1.42 matthew 888:
1.653 raeburn 889: sub selectauthor_link {
890: my ($form,$udom)=@_;
891: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
892: &mt('Select Author').'</a>';
893: }
894:
1.876 raeburn 895: sub selectuser_link {
1.881 raeburn 896: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 897: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 898: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 899: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 900: ');">'.$linktext.'</a>';
1.876 raeburn 901: }
902:
1.273 raeburn 903: sub check_uncheck_jscript {
904: my $jscript = <<"ENDSCRT";
905: function checkAll(field) {
906: if (field.length > 0) {
907: for (i = 0; i < field.length; i++) {
1.1093 raeburn 908: if (!field[i].disabled) {
909: field[i].checked = true;
910: }
1.273 raeburn 911: }
912: } else {
1.1093 raeburn 913: if (!field.disabled) {
914: field.checked = true;
915: }
1.273 raeburn 916: }
917: }
918:
919: function uncheckAll(field) {
920: if (field.length > 0) {
921: for (i = 0; i < field.length; i++) {
922: field[i].checked = false ;
1.543 albertel 923: }
924: } else {
1.273 raeburn 925: field.checked = false ;
926: }
927: }
928: ENDSCRT
929: return $jscript;
930: }
931:
1.656 www 932: sub select_timezone {
1.659 raeburn 933: my ($name,$selected,$onchange,$includeempty)=@_;
934: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
935: if ($includeempty) {
936: $output .= '<option value=""';
937: if (($selected eq '') || ($selected eq 'local')) {
938: $output .= ' selected="selected" ';
939: }
940: $output .= '> </option>';
941: }
1.657 raeburn 942: my @timezones = DateTime::TimeZone->all_names;
943: foreach my $tzone (@timezones) {
944: $output.= '<option value="'.$tzone.'"';
945: if ($tzone eq $selected) {
946: $output.=' selected="selected"';
947: }
948: $output.=">$tzone</option>\n";
1.656 www 949: }
950: $output.="</select>";
951: return $output;
952: }
1.273 raeburn 953:
1.687 raeburn 954: sub select_datelocale {
955: my ($name,$selected,$onchange,$includeempty)=@_;
956: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
957: if ($includeempty) {
958: $output .= '<option value=""';
959: if ($selected eq '') {
960: $output .= ' selected="selected" ';
961: }
962: $output .= '> </option>';
963: }
964: my (@possibles,%locale_names);
965: my @locales = DateTime::Locale::Catalog::Locales;
966: foreach my $locale (@locales) {
967: if (ref($locale) eq 'HASH') {
968: my $id = $locale->{'id'};
969: if ($id ne '') {
970: my $en_terr = $locale->{'en_territory'};
971: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 972: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 973: if (grep(/^en$/,@languages) || !@languages) {
974: if ($en_terr ne '') {
975: $locale_names{$id} = '('.$en_terr.')';
976: } elsif ($native_terr ne '') {
977: $locale_names{$id} = $native_terr;
978: }
979: } else {
980: if ($native_terr ne '') {
981: $locale_names{$id} = $native_terr.' ';
982: } elsif ($en_terr ne '') {
983: $locale_names{$id} = '('.$en_terr.')';
984: }
985: }
986: push (@possibles,$id);
987: }
988: }
989: }
990: foreach my $item (sort(@possibles)) {
991: $output.= '<option value="'.$item.'"';
992: if ($item eq $selected) {
993: $output.=' selected="selected"';
994: }
995: $output.=">$item";
996: if ($locale_names{$item} ne '') {
997: $output.=" $locale_names{$item}</option>\n";
998: }
999: $output.="</option>\n";
1000: }
1001: $output.="</select>";
1002: return $output;
1003: }
1004:
1.792 raeburn 1005: sub select_language {
1006: my ($name,$selected,$includeempty) = @_;
1007: my %langchoices;
1008: if ($includeempty) {
1.1117 raeburn 1009: %langchoices = ('' => 'No language preference');
1.792 raeburn 1010: }
1011: foreach my $id (&languageids()) {
1012: my $code = &supportedlanguagecode($id);
1013: if ($code) {
1014: $langchoices{$code} = &plainlanguagedescription($id);
1015: }
1016: }
1.1117 raeburn 1017: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1018: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1019: }
1020:
1.42 matthew 1021: =pod
1.36 matthew 1022:
1.1088 foxr 1023:
1024: =item * &list_languages()
1025:
1026: Returns an array reference that is suitable for use in language prompters.
1027: Each array element is itself a two element array. The first element
1028: is the language code. The second element a descsriptiuon of the
1029: language itself. This is suitable for use in e.g.
1030: &Apache::edit::select_arg (once dereferenced that is).
1031:
1032: =cut
1033:
1034: sub list_languages {
1035: my @lang_choices;
1036:
1037: foreach my $id (&languageids()) {
1038: my $code = &supportedlanguagecode($id);
1039: if ($code) {
1040: my $selector = $supported_codes{$id};
1041: my $description = &plainlanguagedescription($id);
1042: push (@lang_choices, [$selector, $description]);
1043: }
1044: }
1045: return \@lang_choices;
1046: }
1047:
1048: =pod
1049:
1.648 raeburn 1050: =item * &linked_select_forms(...)
1.36 matthew 1051:
1052: linked_select_forms returns a string containing a <script></script> block
1053: and html for two <select> menus. The select menus will be linked in that
1054: changing the value of the first menu will result in new values being placed
1055: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1056: order unless a defined order is provided.
1.36 matthew 1057:
1058: linked_select_forms takes the following ordered inputs:
1059:
1060: =over 4
1061:
1.112 bowersj2 1062: =item * $formname, the name of the <form> tag
1.36 matthew 1063:
1.112 bowersj2 1064: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1065:
1.112 bowersj2 1066: =item * $firstdefault, the default value for the first menu
1.36 matthew 1067:
1.112 bowersj2 1068: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1069:
1.112 bowersj2 1070: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1071:
1.112 bowersj2 1072: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1073:
1.609 raeburn 1074: =item * $menuorder, the order of values in the first menu
1075:
1.1115 raeburn 1076: =item * $onchangefirst, additional javascript call to execute for an onchange
1077: event for the first <select> tag
1078:
1079: =item * $onchangesecond, additional javascript call to execute for an onchange
1080: event for the second <select> tag
1081:
1.41 ng 1082: =back
1083:
1.36 matthew 1084: Below is an example of such a hash. Only the 'text', 'default', and
1085: 'select2' keys must appear as stated. keys(%menu) are the possible
1086: values for the first select menu. The text that coincides with the
1.41 ng 1087: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1088: and text for the second menu are given in the hash pointed to by
1089: $menu{$choice1}->{'select2'}.
1090:
1.112 bowersj2 1091: my %menu = ( A1 => { text =>"Choice A1" ,
1092: default => "B3",
1093: select2 => {
1094: B1 => "Choice B1",
1095: B2 => "Choice B2",
1096: B3 => "Choice B3",
1097: B4 => "Choice B4"
1.609 raeburn 1098: },
1099: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1100: },
1101: A2 => { text =>"Choice A2" ,
1102: default => "C2",
1103: select2 => {
1104: C1 => "Choice C1",
1105: C2 => "Choice C2",
1106: C3 => "Choice C3"
1.609 raeburn 1107: },
1108: order => ['C2','C1','C3'],
1.112 bowersj2 1109: },
1110: A3 => { text =>"Choice A3" ,
1111: default => "D6",
1112: select2 => {
1113: D1 => "Choice D1",
1114: D2 => "Choice D2",
1115: D3 => "Choice D3",
1116: D4 => "Choice D4",
1117: D5 => "Choice D5",
1118: D6 => "Choice D6",
1119: D7 => "Choice D7"
1.609 raeburn 1120: },
1121: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1122: }
1123: );
1.36 matthew 1124:
1125: =cut
1126:
1127: sub linked_select_forms {
1128: my ($formname,
1129: $middletext,
1130: $firstdefault,
1131: $firstselectname,
1132: $secondselectname,
1.609 raeburn 1133: $hashref,
1134: $menuorder,
1.1115 raeburn 1135: $onchangefirst,
1136: $onchangesecond
1.36 matthew 1137: ) = @_;
1138: my $second = "document.$formname.$secondselectname";
1139: my $first = "document.$formname.$firstselectname";
1140: # output the javascript to do the changing
1141: my $result = '';
1.776 bisitz 1142: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1143: $result.="// <![CDATA[\n";
1.36 matthew 1144: $result.="var select2data = new Object();\n";
1145: $" = '","';
1146: my $debug = '';
1147: foreach my $s1 (sort(keys(%$hashref))) {
1148: $result.="select2data.d_$s1 = new Object();\n";
1149: $result.="select2data.d_$s1.def = new String('".
1150: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1151: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1152: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1153: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1154: @s2values = @{$hashref->{$s1}->{'order'}};
1155: }
1.36 matthew 1156: $result.="\"@s2values\");\n";
1157: $result.="select2data.d_$s1.texts = new Array(";
1158: my @s2texts;
1159: foreach my $value (@s2values) {
1160: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1161: }
1162: $result.="\"@s2texts\");\n";
1163: }
1164: $"=' ';
1165: $result.= <<"END";
1166:
1167: function select1_changed() {
1168: // Determine new choice
1169: var newvalue = "d_" + $first.value;
1170: // update select2
1171: var values = select2data[newvalue].values;
1172: var texts = select2data[newvalue].texts;
1173: var select2def = select2data[newvalue].def;
1174: var i;
1175: // out with the old
1176: for (i = 0; i < $second.options.length; i++) {
1177: $second.options[i] = null;
1178: }
1179: // in with the nuclear
1180: for (i=0;i<values.length; i++) {
1181: $second.options[i] = new Option(values[i]);
1.143 matthew 1182: $second.options[i].value = values[i];
1.36 matthew 1183: $second.options[i].text = texts[i];
1184: if (values[i] == select2def) {
1185: $second.options[i].selected = true;
1186: }
1187: }
1188: }
1.824 bisitz 1189: // ]]>
1.36 matthew 1190: </script>
1191: END
1192: # output the initial values for the selection lists
1.1115 raeburn 1193: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1194: my @order = sort(keys(%{$hashref}));
1195: if (ref($menuorder) eq 'ARRAY') {
1196: @order = @{$menuorder};
1197: }
1198: foreach my $value (@order) {
1.36 matthew 1199: $result.=" <option value=\"$value\" ";
1.253 albertel 1200: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1201: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1202: }
1203: $result .= "</select>\n";
1204: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1205: $result .= $middletext;
1.1115 raeburn 1206: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1207: if ($onchangesecond) {
1208: $result .= ' onchange="'.$onchangesecond.'"';
1209: }
1210: $result .= ">\n";
1.36 matthew 1211: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1212:
1213: my @secondorder = sort(keys(%select2));
1214: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1215: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1216: }
1217: foreach my $value (@secondorder) {
1.36 matthew 1218: $result.=" <option value=\"$value\" ";
1.253 albertel 1219: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1220: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1221: }
1222: $result .= "</select>\n";
1223: # return $debug;
1224: return $result;
1225: } # end of sub linked_select_forms {
1226:
1.45 matthew 1227: =pod
1.44 bowersj2 1228:
1.973 raeburn 1229: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1230:
1.112 bowersj2 1231: Returns a string corresponding to an HTML link to the given help
1232: $topic, where $topic corresponds to the name of a .tex file in
1233: /home/httpd/html/adm/help/tex, with underscores replaced by
1234: spaces.
1235:
1236: $text will optionally be linked to the same topic, allowing you to
1237: link text in addition to the graphic. If you do not want to link
1238: text, but wish to specify one of the later parameters, pass an
1239: empty string.
1240:
1241: $stayOnPage is a value that will be interpreted as a boolean. If true,
1242: the link will not open a new window. If false, the link will open
1243: a new window using Javascript. (Default is false.)
1244:
1245: $width and $height are optional numerical parameters that will
1246: override the width and height of the popped up window, which may
1.973 raeburn 1247: be useful for certain help topics with big pictures included.
1248:
1249: $imgid is the id of the img tag used for the help icon. This may be
1250: used in a javascript call to switch the image src. See
1251: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1252:
1253: =cut
1254:
1255: sub help_open_topic {
1.973 raeburn 1256: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1257: $text = "" if (not defined $text);
1.44 bowersj2 1258: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1259: $width = 500 if (not defined $width);
1.44 bowersj2 1260: $height = 400 if (not defined $height);
1261: my $filename = $topic;
1262: $filename =~ s/ /_/g;
1263:
1.48 bowersj2 1264: my $template = "";
1265: my $link;
1.572 banghart 1266:
1.159 www 1267: $topic=~s/\W/\_/g;
1.44 bowersj2 1268:
1.572 banghart 1269: if (!$stayOnPage) {
1.1033 www 1270: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1271: } elsif ($stayOnPage eq 'popup') {
1272: $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 1273: } else {
1.48 bowersj2 1274: $link = "/adm/help/${filename}.hlp";
1275: }
1276:
1277: # Add the text
1.755 neumanie 1278: if ($text ne "") {
1.763 bisitz 1279: $template.='<span class="LC_help_open_topic">'
1280: .'<a target="_top" href="'.$link.'">'
1281: .$text.'</a>';
1.48 bowersj2 1282: }
1283:
1.763 bisitz 1284: # (Always) Add the graphic
1.179 matthew 1285: my $title = &mt('Online Help');
1.667 raeburn 1286: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1287: if ($imgid ne '') {
1288: $imgid = ' id="'.$imgid.'"';
1289: }
1.763 bisitz 1290: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1291: .'<img src="'.$helpicon.'" border="0"'
1292: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1293: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1294: .' /></a>';
1295: if ($text ne "") {
1296: $template.='</span>';
1297: }
1.44 bowersj2 1298: return $template;
1299:
1.106 bowersj2 1300: }
1301:
1302: # This is a quicky function for Latex cheatsheet editing, since it
1303: # appears in at least four places
1304: sub helpLatexCheatsheet {
1.1037 www 1305: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1306: my $out;
1.106 bowersj2 1307: my $addOther = '';
1.732 raeburn 1308: if ($topic) {
1.1037 www 1309: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1310: }
1311: $out = '<span>' # Start cheatsheet
1312: .$addOther
1313: .'<span>'
1.1037 www 1314: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1315: .'</span> <span>'
1.1037 www 1316: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1317: .'</span>';
1.732 raeburn 1318: unless ($not_author) {
1.1186 kruse 1319: $out .= '<span>'
1320: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1321: .'</span> <span>'
1322: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1323: .'</span>';
1.732 raeburn 1324: }
1.763 bisitz 1325: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1326: return $out;
1.172 www 1327: }
1328:
1.430 albertel 1329: sub general_help {
1330: my $helptopic='Student_Intro';
1331: if ($env{'request.role'}=~/^(ca|au)/) {
1332: $helptopic='Authoring_Intro';
1.907 raeburn 1333: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1334: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1335: } elsif ($env{'request.role'}=~/^dc/) {
1336: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1337: }
1338: return $helptopic;
1339: }
1340:
1341: sub update_help_link {
1342: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1343: my $origurl = $ENV{'REQUEST_URI'};
1344: $origurl=~s|^/~|/priv/|;
1345: my $timestamp = time;
1346: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1347: $$datum = &escape($$datum);
1348: }
1349:
1350: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1351: my $output .= <<"ENDOUTPUT";
1352: <script type="text/javascript">
1.824 bisitz 1353: // <![CDATA[
1.430 albertel 1354: banner_link = '$banner_link';
1.824 bisitz 1355: // ]]>
1.430 albertel 1356: </script>
1357: ENDOUTPUT
1358: return $output;
1359: }
1360:
1361: # now just updates the help link and generates a blue icon
1.193 raeburn 1362: sub help_open_menu {
1.430 albertel 1363: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1364: = @_;
1.949 droeschl 1365: $stayOnPage = 1;
1.430 albertel 1366: my $output;
1367: if ($component_help) {
1368: if (!$text) {
1369: $output=&help_open_topic($component_help,undef,$stayOnPage,
1370: $width,$height);
1371: } else {
1372: my $help_text;
1373: $help_text=&unescape($topic);
1374: $output='<table><tr><td>'.
1375: &help_open_topic($component_help,$help_text,$stayOnPage,
1376: $width,$height).'</td></tr></table>';
1377: }
1378: }
1379: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1380: return $output.$banner_link;
1381: }
1382:
1383: sub top_nav_help {
1384: my ($text) = @_;
1.436 albertel 1385: $text = &mt($text);
1.949 droeschl 1386: my $stay_on_page = 1;
1387:
1.1168 raeburn 1388: my ($link,$banner_link);
1389: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1390: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1391: : "javascript:helpMenu('open')";
1392: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1393: }
1.201 raeburn 1394: my $title = &mt('Get help');
1.1168 raeburn 1395: if ($link) {
1396: return <<"END";
1.436 albertel 1397: $banner_link
1.1159 raeburn 1398: <a href="$link" title="$title">$text</a>
1.436 albertel 1399: END
1.1168 raeburn 1400: } else {
1401: return ' '.$text.' ';
1402: }
1.436 albertel 1403: }
1404:
1405: sub help_menu_js {
1.1154 raeburn 1406: my ($httphost) = @_;
1.949 droeschl 1407: my $stayOnPage = 1;
1.436 albertel 1408: my $width = 620;
1409: my $height = 600;
1.430 albertel 1410: my $helptopic=&general_help();
1.1154 raeburn 1411: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1412: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1413: my $start_page =
1414: &Apache::loncommon::start_page('Help Menu', undef,
1415: {'frameset' => 1,
1416: 'js_ready' => 1,
1.1154 raeburn 1417: 'use_absolute' => $httphost,
1.331 albertel 1418: 'add_entries' => {
1.1168 raeburn 1419: 'border' => '0',
1.579 raeburn 1420: 'rows' => "110,*",},});
1.331 albertel 1421: my $end_page =
1422: &Apache::loncommon::end_page({'frameset' => 1,
1423: 'js_ready' => 1,});
1424:
1.436 albertel 1425: my $template .= <<"ENDTEMPLATE";
1426: <script type="text/javascript">
1.877 bisitz 1427: // <![CDATA[
1.253 albertel 1428: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1429: var banner_link = '';
1.243 raeburn 1430: function helpMenu(target) {
1431: var caller = this;
1432: if (target == 'open') {
1433: var newWindow = null;
1434: try {
1.262 albertel 1435: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1436: }
1437: catch(error) {
1438: writeHelp(caller);
1439: return;
1440: }
1441: if (newWindow) {
1442: caller = newWindow;
1443: }
1.193 raeburn 1444: }
1.243 raeburn 1445: writeHelp(caller);
1446: return;
1447: }
1448: function writeHelp(caller) {
1.1168 raeburn 1449: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1450: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1451: caller.document.close();
1452: caller.focus();
1.193 raeburn 1453: }
1.877 bisitz 1454: // END LON-CAPA Internal -->
1.253 albertel 1455: // ]]>
1.436 albertel 1456: </script>
1.193 raeburn 1457: ENDTEMPLATE
1458: return $template;
1459: }
1460:
1.172 www 1461: sub help_open_bug {
1462: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1463: unless ($env{'user.adv'}) { return ''; }
1.172 www 1464: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1465: $text = "" if (not defined $text);
1466: $stayOnPage=1;
1.184 albertel 1467: $width = 600 if (not defined $width);
1468: $height = 600 if (not defined $height);
1.172 www 1469:
1470: $topic=~s/\W+/\+/g;
1471: my $link='';
1472: my $template='';
1.379 albertel 1473: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1474: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1475: if (!$stayOnPage)
1476: {
1477: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1478: }
1479: else
1480: {
1481: $link = $url;
1482: }
1483: # Add the text
1484: if ($text ne "")
1485: {
1486: $template .=
1487: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1488: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1489: }
1490:
1491: # Add the graphic
1.179 matthew 1492: my $title = &mt('Report a Bug');
1.215 albertel 1493: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1494: $template .= <<"ENDTEMPLATE";
1.436 albertel 1495: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1496: ENDTEMPLATE
1497: if ($text ne '') { $template.='</td></tr></table>' };
1498: return $template;
1499:
1500: }
1501:
1502: sub help_open_faq {
1503: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1504: unless ($env{'user.adv'}) { return ''; }
1.172 www 1505: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1506: $text = "" if (not defined $text);
1507: $stayOnPage=1;
1508: $width = 350 if (not defined $width);
1509: $height = 400 if (not defined $height);
1510:
1511: $topic=~s/\W+/\+/g;
1512: my $link='';
1513: my $template='';
1514: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1515: if (!$stayOnPage)
1516: {
1517: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1518: }
1519: else
1520: {
1521: $link = $url;
1522: }
1523:
1524: # Add the text
1525: if ($text ne "")
1526: {
1527: $template .=
1.173 www 1528: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1529: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1530: }
1531:
1532: # Add the graphic
1.179 matthew 1533: my $title = &mt('View the FAQ');
1.215 albertel 1534: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1535: $template .= <<"ENDTEMPLATE";
1.436 albertel 1536: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1537: ENDTEMPLATE
1538: if ($text ne '') { $template.='</td></tr></table>' };
1539: return $template;
1540:
1.44 bowersj2 1541: }
1.37 matthew 1542:
1.180 matthew 1543: ###############################################################
1544: ###############################################################
1545:
1.45 matthew 1546: =pod
1547:
1.648 raeburn 1548: =item * &change_content_javascript():
1.256 matthew 1549:
1550: This and the next function allow you to create small sections of an
1551: otherwise static HTML page that you can update on the fly with
1552: Javascript, even in Netscape 4.
1553:
1554: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1555: must be written to the HTML page once. It will prove the Javascript
1556: function "change(name, content)". Calling the change function with the
1557: name of the section
1558: you want to update, matching the name passed to C<changable_area>, and
1559: the new content you want to put in there, will put the content into
1560: that area.
1561:
1562: B<Note>: Netscape 4 only reserves enough space for the changable area
1563: to contain room for the original contents. You need to "make space"
1564: for whatever changes you wish to make, and be B<sure> to check your
1565: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1566: it's adequate for updating a one-line status display, but little more.
1567: This script will set the space to 100% width, so you only need to
1568: worry about height in Netscape 4.
1569:
1570: Modern browsers are much less limiting, and if you can commit to the
1571: user not using Netscape 4, this feature may be used freely with
1572: pretty much any HTML.
1573:
1574: =cut
1575:
1576: sub change_content_javascript {
1577: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1578: if ($env{'browser.type'} eq 'netscape' &&
1579: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1580: return (<<NETSCAPE4);
1581: function change(name, content) {
1582: doc = document.layers[name+"___escape"].layers[0].document;
1583: doc.open();
1584: doc.write(content);
1585: doc.close();
1586: }
1587: NETSCAPE4
1588: } else {
1589: # Otherwise, we need to use semi-standards-compliant code
1590: # (technically, "innerHTML" isn't standard but the equivalent
1591: # is really scary, and every useful browser supports it
1592: return (<<DOMBASED);
1593: function change(name, content) {
1594: element = document.getElementById(name);
1595: element.innerHTML = content;
1596: }
1597: DOMBASED
1598: }
1599: }
1600:
1601: =pod
1602:
1.648 raeburn 1603: =item * &changable_area($name,$origContent):
1.256 matthew 1604:
1605: This provides a "changable area" that can be modified on the fly via
1606: the Javascript code provided in C<change_content_javascript>. $name is
1607: the name you will use to reference the area later; do not repeat the
1608: same name on a given HTML page more then once. $origContent is what
1609: the area will originally contain, which can be left blank.
1610:
1611: =cut
1612:
1613: sub changable_area {
1614: my ($name, $origContent) = @_;
1615:
1.258 albertel 1616: if ($env{'browser.type'} eq 'netscape' &&
1617: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1618: # If this is netscape 4, we need to use the Layer tag
1619: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1620: } else {
1621: return "<span id='$name'>$origContent</span>";
1622: }
1623: }
1624:
1625: =pod
1626:
1.648 raeburn 1627: =item * &viewport_geometry_js
1.590 raeburn 1628:
1629: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1630:
1631: =cut
1632:
1633:
1634: sub viewport_geometry_js {
1635: return <<"GEOMETRY";
1636: var Geometry = {};
1637: function init_geometry() {
1638: if (Geometry.init) { return };
1639: Geometry.init=1;
1640: if (window.innerHeight) {
1641: Geometry.getViewportHeight = function() { return window.innerHeight; };
1642: Geometry.getViewportWidth = function() { return window.innerWidth; };
1643: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1644: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1645: }
1646: else if (document.documentElement && document.documentElement.clientHeight) {
1647: Geometry.getViewportHeight =
1648: function() { return document.documentElement.clientHeight; };
1649: Geometry.getViewportWidth =
1650: function() { return document.documentElement.clientWidth; };
1651:
1652: Geometry.getHorizontalScroll =
1653: function() { return document.documentElement.scrollLeft; };
1654: Geometry.getVerticalScroll =
1655: function() { return document.documentElement.scrollTop; };
1656: }
1657: else if (document.body.clientHeight) {
1658: Geometry.getViewportHeight =
1659: function() { return document.body.clientHeight; };
1660: Geometry.getViewportWidth =
1661: function() { return document.body.clientWidth; };
1662: Geometry.getHorizontalScroll =
1663: function() { return document.body.scrollLeft; };
1664: Geometry.getVerticalScroll =
1665: function() { return document.body.scrollTop; };
1666: }
1667: }
1668:
1669: GEOMETRY
1670: }
1671:
1672: =pod
1673:
1.648 raeburn 1674: =item * &viewport_size_js()
1.590 raeburn 1675:
1676: 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.
1677:
1678: =cut
1679:
1680: sub viewport_size_js {
1681: my $geometry = &viewport_geometry_js();
1682: return <<"DIMS";
1683:
1684: $geometry
1685:
1686: function getViewportDims(width,height) {
1687: init_geometry();
1688: width.value = Geometry.getViewportWidth();
1689: height.value = Geometry.getViewportHeight();
1690: return;
1691: }
1692:
1693: DIMS
1694: }
1695:
1696: =pod
1697:
1.648 raeburn 1698: =item * &resize_textarea_js()
1.565 albertel 1699:
1700: emits the needed javascript to resize a textarea to be as big as possible
1701:
1702: creates a function resize_textrea that takes two IDs first should be
1703: the id of the element to resize, second should be the id of a div that
1704: surrounds everything that comes after the textarea, this routine needs
1705: to be attached to the <body> for the onload and onresize events.
1706:
1.648 raeburn 1707: =back
1.565 albertel 1708:
1709: =cut
1710:
1711: sub resize_textarea_js {
1.590 raeburn 1712: my $geometry = &viewport_geometry_js();
1.565 albertel 1713: return <<"RESIZE";
1714: <script type="text/javascript">
1.824 bisitz 1715: // <![CDATA[
1.590 raeburn 1716: $geometry
1.565 albertel 1717:
1.588 albertel 1718: function getX(element) {
1719: var x = 0;
1720: while (element) {
1721: x += element.offsetLeft;
1722: element = element.offsetParent;
1723: }
1724: return x;
1725: }
1726: function getY(element) {
1727: var y = 0;
1728: while (element) {
1729: y += element.offsetTop;
1730: element = element.offsetParent;
1731: }
1732: return y;
1733: }
1734:
1735:
1.565 albertel 1736: function resize_textarea(textarea_id,bottom_id) {
1737: init_geometry();
1738: var textarea = document.getElementById(textarea_id);
1739: //alert(textarea);
1740:
1.588 albertel 1741: var textarea_top = getY(textarea);
1.565 albertel 1742: var textarea_height = textarea.offsetHeight;
1743: var bottom = document.getElementById(bottom_id);
1.588 albertel 1744: var bottom_top = getY(bottom);
1.565 albertel 1745: var bottom_height = bottom.offsetHeight;
1746: var window_height = Geometry.getViewportHeight();
1.588 albertel 1747: var fudge = 23;
1.565 albertel 1748: var new_height = window_height-fudge-textarea_top-bottom_height;
1749: if (new_height < 300) {
1750: new_height = 300;
1751: }
1752: textarea.style.height=new_height+'px';
1753: }
1.824 bisitz 1754: // ]]>
1.565 albertel 1755: </script>
1756: RESIZE
1757:
1758: }
1759:
1.1205 golterma 1760: sub colorfuleditor_js {
1761: return <<"COLORFULEDIT"
1762: <script type="text/javascript">
1763: // <![CDATA[>
1764: function fold_box(curDepth, lastresource){
1765:
1766: // we need a list because there can be several blocks you need to fold in one tag
1767: var block = document.getElementsByName('foldblock_'+curDepth);
1768: // but there is only one folding button per tag
1769: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1770:
1771: if(block.item(0).style.display == 'none'){
1772:
1773: foldbutton.value = '@{[&mt("Hide")]}';
1774: for (i = 0; i < block.length; i++){
1775: block.item(i).style.display = '';
1776: }
1777: }else{
1778:
1779: foldbutton.value = '@{[&mt("Show")]}';
1780: for (i = 0; i < block.length; i++){
1781: // block.item(i).style.visibility = 'collapse';
1782: block.item(i).style.display = 'none';
1783: }
1784: };
1785: saveState(lastresource);
1786: }
1787:
1788: function saveState (lastresource) {
1789:
1790: var tag_list = getTagList();
1791: if(tag_list != null){
1792: var timestamp = new Date().getTime();
1793: var key = lastresource;
1794:
1795: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1796: // starting with timestamp
1797: var value = timestamp+';';
1798:
1799: // building the list of key-value pairs
1800: for(var i = 0; i < tag_list.length; i++){
1801: value += tag_list[i]+',';
1802: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1803: }
1804:
1805: // only iterate whole storage if nothing to override
1806: if(localStorage.getItem(key) == null){
1807:
1808: // prevent storage from growing large
1809: if(localStorage.length > 50){
1810: var regex_getTimestamp = /^(?:\d)+;/;
1811: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1812: var oldest_key;
1813:
1814: for(var i = 1; i < localStorage.length; i++){
1815: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1816: oldest_key = localStorage.key(i);
1817: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1818: }
1819: }
1820: localStorage.removeItem(oldest_key);
1821: }
1822: }
1823: localStorage.setItem(key,value);
1824: }
1825: }
1826:
1827: // restore folding status of blocks (on page load)
1828: function restoreState (lastresource) {
1829: if(localStorage.getItem(lastresource) != null){
1830: var key = lastresource;
1831: var value = localStorage.getItem(key);
1832: var regex_delTimestamp = /^\d+;/;
1833:
1834: value.replace(regex_delTimestamp, '');
1835:
1836: var valueArr = value.split(';');
1837: var pairs;
1838: var elements;
1839: for (var i = 0; i < valueArr.length; i++){
1840: pairs = valueArr[i].split(',');
1841: elements = document.getElementsByName(pairs[0]);
1842:
1843: for (var j = 0; j < elements.length; j++){
1844: elements[j].style.display = pairs[1];
1845: if (pairs[1] == "none"){
1846: var regex_id = /([_\\d]+)\$/;
1847: regex_id.exec(pairs[0]);
1848: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1849: }
1850: }
1851: }
1852: }
1853: }
1854:
1855: function getTagList () {
1856:
1857: var stringToSearch = document.lonhomework.innerHTML;
1858:
1859: var ret = new Array();
1860: var regex_findBlock = /(foldblock_.*?)"/g;
1861: var tag_list = stringToSearch.match(regex_findBlock);
1862:
1863: if(tag_list != null){
1864: for(var i = 0; i < tag_list.length; i++){
1865: ret.push(tag_list[i].replace(/"/, ''));
1866: }
1867: }
1868: return ret;
1869: }
1870:
1871: function saveScrollPosition (resource) {
1872: var tag_list = getTagList();
1873:
1874: // we dont always want to jump to the first block
1875: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1876: if(\$(window).scrollTop() > 170){
1877: if(tag_list != null){
1878: var result;
1879: for(var i = 0; i < tag_list.length; i++){
1880: if(isElementInViewport(tag_list[i])){
1881: result += tag_list[i]+';';
1882: }
1883: }
1884: sessionStorage.setItem('anchor_'+resource, result);
1885: }
1886: } else {
1887: // we dont need to save zero, just delete the item to leave everything tidy
1888: sessionStorage.removeItem('anchor_'+resource);
1889: }
1890: }
1891:
1892: function restoreScrollPosition(resource){
1893:
1894: var elem = sessionStorage.getItem('anchor_'+resource);
1895: if(elem != null){
1896: var tag_list = elem.split(';');
1897: var elem_list;
1898:
1899: for(var i = 0; i < tag_list.length; i++){
1900: elem_list = document.getElementsByName(tag_list[i]);
1901:
1902: if(elem_list.length > 0){
1903: elem = elem_list[0];
1904: break;
1905: }
1906: }
1907: elem.scrollIntoView();
1908: }
1909: }
1910:
1911: function isElementInViewport(el) {
1912:
1913: // change to last element instead of first
1914: var elem = document.getElementsByName(el);
1915: var rect = elem[0].getBoundingClientRect();
1916:
1917: return (
1918: rect.top >= 0 &&
1919: rect.left >= 0 &&
1920: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1921: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1922: );
1923: }
1924:
1925: function autosize(depth){
1926: var cmInst = window['cm'+depth];
1927: var fitsizeButton = document.getElementById('fitsize'+depth);
1928:
1929: // is fixed size, switching to dynamic
1930: if (sessionStorage.getItem("autosized_"+depth) == null) {
1931: cmInst.setSize("","auto");
1932: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1933: sessionStorage.setItem("autosized_"+depth, "yes");
1934:
1935: // is dynamic size, switching to fixed
1936: } else {
1937: cmInst.setSize("","300px");
1938: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1939: sessionStorage.removeItem("autosized_"+depth);
1940: }
1941: }
1942:
1943:
1944:
1945: // ]]>
1946: </script>
1947: COLORFULEDIT
1948: }
1949:
1950: sub xmleditor_js {
1951: return <<XMLEDIT
1952: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1953: <script type="text/javascript">
1954: // <![CDATA[>
1955:
1956: function saveScrollPosition (resource) {
1957:
1958: var scrollPos = \$(window).scrollTop();
1959: sessionStorage.setItem(resource,scrollPos);
1960: }
1961:
1962: function restoreScrollPosition(resource){
1963:
1964: var scrollPos = sessionStorage.getItem(resource);
1965: \$(window).scrollTop(scrollPos);
1966: }
1967:
1968: // unless internet explorer
1969: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1970:
1971: \$(document).ready(function() {
1972: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1973: });
1974: }
1975:
1976: // inserts text at cursor position into codemirror (xml editor only)
1977: function insertText(text){
1978: cm.focus();
1979: var curPos = cm.getCursor();
1980: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1981: }
1982: // ]]>
1983: </script>
1984: XMLEDIT
1985: }
1986:
1987: sub insert_folding_button {
1988: my $curDepth = $Apache::lonxml::curdepth;
1989: my $lastresource = $env{'request.ambiguous'};
1990:
1991: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
1992: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
1993: }
1994:
1.565 albertel 1995: =pod
1996:
1.256 matthew 1997: =head1 Excel and CSV file utility routines
1998:
1999: =cut
2000:
2001: ###############################################################
2002: ###############################################################
2003:
2004: =pod
2005:
1.1162 raeburn 2006: =over 4
2007:
1.648 raeburn 2008: =item * &csv_translate($text)
1.37 matthew 2009:
1.185 www 2010: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2011: format.
2012:
2013: =cut
2014:
1.180 matthew 2015: ###############################################################
2016: ###############################################################
1.37 matthew 2017: sub csv_translate {
2018: my $text = shift;
2019: $text =~ s/\"/\"\"/g;
1.209 albertel 2020: $text =~ s/\n/ /g;
1.37 matthew 2021: return $text;
2022: }
1.180 matthew 2023:
2024: ###############################################################
2025: ###############################################################
2026:
2027: =pod
2028:
1.648 raeburn 2029: =item * &define_excel_formats()
1.180 matthew 2030:
2031: Define some commonly used Excel cell formats.
2032:
2033: Currently supported formats:
2034:
2035: =over 4
2036:
2037: =item header
2038:
2039: =item bold
2040:
2041: =item h1
2042:
2043: =item h2
2044:
2045: =item h3
2046:
1.256 matthew 2047: =item h4
2048:
2049: =item i
2050:
1.180 matthew 2051: =item date
2052:
2053: =back
2054:
2055: Inputs: $workbook
2056:
2057: Returns: $format, a hash reference.
2058:
1.1057 foxr 2059:
1.180 matthew 2060: =cut
2061:
2062: ###############################################################
2063: ###############################################################
2064: sub define_excel_formats {
2065: my ($workbook) = @_;
2066: my $format;
2067: $format->{'header'} = $workbook->add_format(bold => 1,
2068: bottom => 1,
2069: align => 'center');
2070: $format->{'bold'} = $workbook->add_format(bold=>1);
2071: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2072: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2073: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2074: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2075: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2076: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2077: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2078: return $format;
2079: }
2080:
2081: ###############################################################
2082: ###############################################################
1.113 bowersj2 2083:
2084: =pod
2085:
1.648 raeburn 2086: =item * &create_workbook()
1.255 matthew 2087:
2088: Create an Excel worksheet. If it fails, output message on the
2089: request object and return undefs.
2090:
2091: Inputs: Apache request object
2092:
2093: Returns (undef) on failure,
2094: Excel worksheet object, scalar with filename, and formats
2095: from &Apache::loncommon::define_excel_formats on success
2096:
2097: =cut
2098:
2099: ###############################################################
2100: ###############################################################
2101: sub create_workbook {
2102: my ($r) = @_;
2103: #
2104: # Create the excel spreadsheet
2105: my $filename = '/prtspool/'.
1.258 albertel 2106: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2107: time.'_'.rand(1000000000).'.xls';
2108: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2109: if (! defined($workbook)) {
2110: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2111: $r->print(
2112: '<p class="LC_error">'
2113: .&mt('Problems occurred in creating the new Excel file.')
2114: .' '.&mt('This error has been logged.')
2115: .' '.&mt('Please alert your LON-CAPA administrator.')
2116: .'</p>'
2117: );
1.255 matthew 2118: return (undef);
2119: }
2120: #
1.1014 foxr 2121: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2122: #
2123: my $format = &Apache::loncommon::define_excel_formats($workbook);
2124: return ($workbook,$filename,$format);
2125: }
2126:
2127: ###############################################################
2128: ###############################################################
2129:
2130: =pod
2131:
1.648 raeburn 2132: =item * &create_text_file()
1.113 bowersj2 2133:
1.542 raeburn 2134: Create a file to write to and eventually make available to the user.
1.256 matthew 2135: If file creation fails, outputs an error message on the request object and
2136: return undefs.
1.113 bowersj2 2137:
1.256 matthew 2138: Inputs: Apache request object, and file suffix
1.113 bowersj2 2139:
1.256 matthew 2140: Returns (undef) on failure,
2141: Filehandle and filename on success.
1.113 bowersj2 2142:
2143: =cut
2144:
1.256 matthew 2145: ###############################################################
2146: ###############################################################
2147: sub create_text_file {
2148: my ($r,$suffix) = @_;
2149: if (! defined($suffix)) { $suffix = 'txt'; };
2150: my $fh;
2151: my $filename = '/prtspool/'.
1.258 albertel 2152: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2153: time.'_'.rand(1000000000).'.'.$suffix;
2154: $fh = Apache::File->new('>/home/httpd'.$filename);
2155: if (! defined($fh)) {
2156: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2157: $r->print(
2158: '<p class="LC_error">'
2159: .&mt('Problems occurred in creating the output file.')
2160: .' '.&mt('This error has been logged.')
2161: .' '.&mt('Please alert your LON-CAPA administrator.')
2162: .'</p>'
2163: );
1.113 bowersj2 2164: }
1.256 matthew 2165: return ($fh,$filename)
1.113 bowersj2 2166: }
2167:
2168:
1.256 matthew 2169: =pod
1.113 bowersj2 2170:
2171: =back
2172:
2173: =cut
1.37 matthew 2174:
2175: ###############################################################
1.33 matthew 2176: ## Home server <option> list generating code ##
2177: ###############################################################
1.35 matthew 2178:
1.169 www 2179: # ------------------------------------------
2180:
2181: sub domain_select {
2182: my ($name,$value,$multiple)=@_;
2183: my %domains=map {
1.514 albertel 2184: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2185: } &Apache::lonnet::all_domains();
1.169 www 2186: if ($multiple) {
2187: $domains{''}=&mt('Any domain');
1.550 albertel 2188: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2189: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2190: } else {
1.550 albertel 2191: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2192: return &select_form($name,$value,\%domains);
1.169 www 2193: }
2194: }
2195:
1.282 albertel 2196: #-------------------------------------------
2197:
2198: =pod
2199:
1.519 raeburn 2200: =head1 Routines for form select boxes
2201:
2202: =over 4
2203:
1.648 raeburn 2204: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2205:
2206: Returns a string containing a <select> element int multiple mode
2207:
2208:
2209: Args:
2210: $name - name of the <select> element
1.506 raeburn 2211: $value - scalar or array ref of values that should already be selected
1.282 albertel 2212: $size - number of rows long the select element is
1.283 albertel 2213: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2214: (shown text should already have been &mt())
1.506 raeburn 2215: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2216:
1.282 albertel 2217: =cut
2218:
2219: #-------------------------------------------
1.169 www 2220: sub multiple_select_form {
1.284 albertel 2221: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2222: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2223: my $output='';
1.191 matthew 2224: if (! defined($size)) {
2225: $size = 4;
1.283 albertel 2226: if (scalar(keys(%$hash))<4) {
2227: $size = scalar(keys(%$hash));
1.191 matthew 2228: }
2229: }
1.734 bisitz 2230: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2231: my @order;
1.506 raeburn 2232: if (ref($order) eq 'ARRAY') {
2233: @order = @{$order};
2234: } else {
2235: @order = sort(keys(%$hash));
1.501 banghart 2236: }
2237: if (exists($$hash{'select_form_order'})) {
2238: @order = @{$$hash{'select_form_order'}};
2239: }
2240:
1.284 albertel 2241: foreach my $key (@order) {
1.356 albertel 2242: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2243: $output.='selected="selected" ' if ($selected{$key});
2244: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2245: }
2246: $output.="</select>\n";
2247: return $output;
2248: }
2249:
1.88 www 2250: #-------------------------------------------
2251:
2252: =pod
2253:
1.970 raeburn 2254: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2255:
2256: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2257: allow a user to select options from a ref to a hash containing:
2258: option_name => displayed text. An optional $onchange can include
2259: a javascript onchange item, e.g., onchange="this.form.submit();"
2260:
1.88 www 2261: See lonrights.pm for an example invocation and use.
2262:
2263: =cut
2264:
2265: #-------------------------------------------
2266: sub select_form {
1.970 raeburn 2267: my ($def,$name,$hashref,$onchange) = @_;
2268: return unless (ref($hashref) eq 'HASH');
2269: if ($onchange) {
2270: $onchange = ' onchange="'.$onchange.'"';
2271: }
2272: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2273: my @keys;
1.970 raeburn 2274: if (exists($hashref->{'select_form_order'})) {
2275: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2276: } else {
1.970 raeburn 2277: @keys=sort(keys(%{$hashref}));
1.128 albertel 2278: }
1.356 albertel 2279: foreach my $key (@keys) {
2280: $selectform.=
2281: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2282: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2283: ">".$hashref->{$key}."</option>\n";
1.88 www 2284: }
2285: $selectform.="</select>";
2286: return $selectform;
2287: }
2288:
1.475 www 2289: # For display filters
2290:
2291: sub display_filter {
1.1074 raeburn 2292: my ($context) = @_;
1.475 www 2293: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2294: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2295: my $phraseinput = 'hidden';
2296: my $includeinput = 'hidden';
2297: my ($checked,$includetypestext);
2298: if ($env{'form.displayfilter'} eq 'containing') {
2299: $phraseinput = 'text';
2300: if ($context eq 'parmslog') {
2301: $includeinput = 'checkbox';
2302: if ($env{'form.includetypes'}) {
2303: $checked = ' checked="checked"';
2304: }
2305: $includetypestext = &mt('Include parameter types');
2306: }
2307: } else {
2308: $includetypestext = ' ';
2309: }
2310: my ($additional,$secondid,$thirdid);
2311: if ($context eq 'parmslog') {
2312: $additional =
2313: '<label><input type="'.$includeinput.'" name="includetypes"'.
2314: $checked.' name="includetypes" value="1" id="includetypes" />'.
2315: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2316: '</label>';
2317: $secondid = 'includetypes';
2318: $thirdid = 'includetypestext';
2319: }
2320: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2321: '$secondid','$thirdid')";
2322: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2323: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2324: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2325: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2326: &mt('Filter: [_1]',
1.477 www 2327: &select_form($env{'form.displayfilter'},
2328: 'displayfilter',
1.970 raeburn 2329: {'currentfolder' => 'Current folder/page',
1.477 www 2330: 'containing' => 'Containing phrase',
1.1074 raeburn 2331: 'none' => 'None'},$onchange)).' '.
2332: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2333: &HTML::Entities::encode($env{'form.containingphrase'}).
2334: '" />'.$additional;
2335: }
2336:
2337: sub display_filter_js {
2338: my $includetext = &mt('Include parameter types');
2339: return <<"ENDJS";
2340:
2341: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2342: var firstType = 'hidden';
2343: if (setter.options[setter.selectedIndex].value == 'containing') {
2344: firstType = 'text';
2345: }
2346: firstObject = document.getElementById(firstid);
2347: if (typeof(firstObject) == 'object') {
2348: if (firstObject.type != firstType) {
2349: changeInputType(firstObject,firstType);
2350: }
2351: }
2352: if (context == 'parmslog') {
2353: var secondType = 'hidden';
2354: if (firstType == 'text') {
2355: secondType = 'checkbox';
2356: }
2357: secondObject = document.getElementById(secondid);
2358: if (typeof(secondObject) == 'object') {
2359: if (secondObject.type != secondType) {
2360: changeInputType(secondObject,secondType);
2361: }
2362: }
2363: var textItem = document.getElementById(thirdid);
2364: var currtext = textItem.innerHTML;
2365: var newtext;
2366: if (firstType == 'text') {
2367: newtext = '$includetext';
2368: } else {
2369: newtext = ' ';
2370: }
2371: if (currtext != newtext) {
2372: textItem.innerHTML = newtext;
2373: }
2374: }
2375: return;
2376: }
2377:
2378: function changeInputType(oldObject,newType) {
2379: var newObject = document.createElement('input');
2380: newObject.type = newType;
2381: if (oldObject.size) {
2382: newObject.size = oldObject.size;
2383: }
2384: if (oldObject.value) {
2385: newObject.value = oldObject.value;
2386: }
2387: if (oldObject.name) {
2388: newObject.name = oldObject.name;
2389: }
2390: if (oldObject.id) {
2391: newObject.id = oldObject.id;
2392: }
2393: oldObject.parentNode.replaceChild(newObject,oldObject);
2394: return;
2395: }
2396:
2397: ENDJS
1.475 www 2398: }
2399:
1.167 www 2400: sub gradeleveldescription {
2401: my $gradelevel=shift;
2402: my %gradelevels=(0 => 'Not specified',
2403: 1 => 'Grade 1',
2404: 2 => 'Grade 2',
2405: 3 => 'Grade 3',
2406: 4 => 'Grade 4',
2407: 5 => 'Grade 5',
2408: 6 => 'Grade 6',
2409: 7 => 'Grade 7',
2410: 8 => 'Grade 8',
2411: 9 => 'Grade 9',
2412: 10 => 'Grade 10',
2413: 11 => 'Grade 11',
2414: 12 => 'Grade 12',
2415: 13 => 'Grade 13',
2416: 14 => '100 Level',
2417: 15 => '200 Level',
2418: 16 => '300 Level',
2419: 17 => '400 Level',
2420: 18 => 'Graduate Level');
2421: return &mt($gradelevels{$gradelevel});
2422: }
2423:
1.163 www 2424: sub select_level_form {
2425: my ($deflevel,$name)=@_;
2426: unless ($deflevel) { $deflevel=0; }
1.167 www 2427: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2428: for (my $i=0; $i<=18; $i++) {
2429: $selectform.="<option value=\"$i\" ".
1.253 albertel 2430: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2431: ">".&gradeleveldescription($i)."</option>\n";
2432: }
2433: $selectform.="</select>";
2434: return $selectform;
1.163 www 2435: }
1.167 www 2436:
1.35 matthew 2437: #-------------------------------------------
2438:
1.45 matthew 2439: =pod
2440:
1.1121 raeburn 2441: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2442:
2443: Returns a string containing a <select name='$name' size='1'> form to
2444: allow a user to select the domain to preform an operation in.
2445: See loncreateuser.pm for an example invocation and use.
2446:
1.90 www 2447: If the $includeempty flag is set, it also includes an empty choice ("no domain
2448: selected");
2449:
1.743 raeburn 2450: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2451:
1.910 raeburn 2452: 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.
2453:
1.1121 raeburn 2454: The optional $incdoms is a reference to an array of domains which will be the only available options.
2455:
2456: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2457:
1.35 matthew 2458: =cut
2459:
2460: #-------------------------------------------
1.34 matthew 2461: sub select_dom_form {
1.1121 raeburn 2462: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2463: if ($onchange) {
1.874 raeburn 2464: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2465: }
1.1121 raeburn 2466: my (@domains,%exclude);
1.910 raeburn 2467: if (ref($incdoms) eq 'ARRAY') {
2468: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2469: } else {
2470: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2471: }
1.90 www 2472: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2473: if (ref($excdoms) eq 'ARRAY') {
2474: map { $exclude{$_} = 1; } @{$excdoms};
2475: }
1.743 raeburn 2476: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2477: foreach my $dom (@domains) {
1.1121 raeburn 2478: next if ($exclude{$dom});
1.356 albertel 2479: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2480: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2481: if ($showdomdesc) {
2482: if ($dom ne '') {
2483: my $domdesc = &Apache::lonnet::domain($dom,'description');
2484: if ($domdesc ne '') {
2485: $selectdomain .= ' ('.$domdesc.')';
2486: }
2487: }
2488: }
2489: $selectdomain .= "</option>\n";
1.34 matthew 2490: }
2491: $selectdomain.="</select>";
2492: return $selectdomain;
2493: }
2494:
1.35 matthew 2495: #-------------------------------------------
2496:
1.45 matthew 2497: =pod
2498:
1.648 raeburn 2499: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2500:
1.586 raeburn 2501: input: 4 arguments (two required, two optional) -
2502: $domain - domain of new user
2503: $name - name of form element
2504: $default - Value of 'default' causes a default item to be first
2505: option, and selected by default.
2506: $hide - Value of 'hide' causes hiding of the name of the server,
2507: if 1 server found, or default, if 0 found.
1.594 raeburn 2508: output: returns 2 items:
1.586 raeburn 2509: (a) form element which contains either:
2510: (i) <select name="$name">
2511: <option value="$hostid1">$hostid $servers{$hostid}</option>
2512: <option value="$hostid2">$hostid $servers{$hostid}</option>
2513: </select>
2514: form item if there are multiple library servers in $domain, or
2515: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2516: if there is only one library server in $domain.
2517:
2518: (b) number of library servers found.
2519:
2520: See loncreateuser.pm for example of use.
1.35 matthew 2521:
2522: =cut
2523:
2524: #-------------------------------------------
1.586 raeburn 2525: sub home_server_form_item {
2526: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2527: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2528: my $result;
2529: my $numlib = keys(%servers);
2530: if ($numlib > 1) {
2531: $result .= '<select name="'.$name.'" />'."\n";
2532: if ($default) {
1.804 bisitz 2533: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2534: '</option>'."\n";
2535: }
2536: foreach my $hostid (sort(keys(%servers))) {
2537: $result.= '<option value="'.$hostid.'">'.
2538: $hostid.' '.$servers{$hostid}."</option>\n";
2539: }
2540: $result .= '</select>'."\n";
2541: } elsif ($numlib == 1) {
2542: my $hostid;
2543: foreach my $item (keys(%servers)) {
2544: $hostid = $item;
2545: }
2546: $result .= '<input type="hidden" name="'.$name.'" value="'.
2547: $hostid.'" />';
2548: if (!$hide) {
2549: $result .= $hostid.' '.$servers{$hostid};
2550: }
2551: $result .= "\n";
2552: } elsif ($default) {
2553: $result .= '<input type="hidden" name="'.$name.
2554: '" value="default" />';
2555: if (!$hide) {
2556: $result .= &mt('default');
2557: }
2558: $result .= "\n";
1.33 matthew 2559: }
1.586 raeburn 2560: return ($result,$numlib);
1.33 matthew 2561: }
1.112 bowersj2 2562:
2563: =pod
2564:
1.534 albertel 2565: =back
2566:
1.112 bowersj2 2567: =cut
1.87 matthew 2568:
2569: ###############################################################
1.112 bowersj2 2570: ## Decoding User Agent ##
1.87 matthew 2571: ###############################################################
2572:
2573: =pod
2574:
1.112 bowersj2 2575: =head1 Decoding the User Agent
2576:
2577: =over 4
2578:
2579: =item * &decode_user_agent()
1.87 matthew 2580:
2581: Inputs: $r
2582:
2583: Outputs:
2584:
2585: =over 4
2586:
1.112 bowersj2 2587: =item * $httpbrowser
1.87 matthew 2588:
1.112 bowersj2 2589: =item * $clientbrowser
1.87 matthew 2590:
1.112 bowersj2 2591: =item * $clientversion
1.87 matthew 2592:
1.112 bowersj2 2593: =item * $clientmathml
1.87 matthew 2594:
1.112 bowersj2 2595: =item * $clientunicode
1.87 matthew 2596:
1.112 bowersj2 2597: =item * $clientos
1.87 matthew 2598:
1.1137 raeburn 2599: =item * $clientmobile
2600:
1.1141 raeburn 2601: =item * $clientinfo
2602:
1.1194 raeburn 2603: =item * $clientosversion
2604:
1.87 matthew 2605: =back
2606:
1.157 matthew 2607: =back
2608:
1.87 matthew 2609: =cut
2610:
2611: ###############################################################
2612: ###############################################################
2613: sub decode_user_agent {
1.247 albertel 2614: my ($r)=@_;
1.87 matthew 2615: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2616: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2617: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2618: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2619: my $clientbrowser='unknown';
2620: my $clientversion='0';
2621: my $clientmathml='';
2622: my $clientunicode='0';
1.1137 raeburn 2623: my $clientmobile=0;
1.1194 raeburn 2624: my $clientosversion='';
1.87 matthew 2625: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2626: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2627: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2628: $clientbrowser=$bname;
2629: $httpbrowser=~/$vreg/i;
2630: $clientversion=$1;
2631: $clientmathml=($clientversion>=$minv);
2632: $clientunicode=($clientversion>=$univ);
2633: }
2634: }
2635: my $clientos='unknown';
1.1141 raeburn 2636: my $clientinfo;
1.87 matthew 2637: if (($httpbrowser=~/linux/i) ||
2638: ($httpbrowser=~/unix/i) ||
2639: ($httpbrowser=~/ux/i) ||
2640: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2641: if (($httpbrowser=~/vax/i) ||
2642: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2643: if ($httpbrowser=~/next/i) { $clientos='next'; }
2644: if (($httpbrowser=~/mac/i) ||
2645: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2646: if ($httpbrowser=~/win/i) {
2647: $clientos='win';
2648: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2649: $clientosversion = $1;
2650: }
2651: }
1.87 matthew 2652: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2653: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2654: $clientmobile=lc($1);
2655: }
1.1141 raeburn 2656: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2657: $clientinfo = 'firefox-'.$1;
2658: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2659: $clientinfo = 'chromeframe-'.$1;
2660: }
1.87 matthew 2661: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2662: $clientunicode,$clientos,$clientmobile,$clientinfo,
2663: $clientosversion);
1.87 matthew 2664: }
2665:
1.32 matthew 2666: ###############################################################
2667: ## Authentication changing form generation subroutines ##
2668: ###############################################################
2669: ##
2670: ## All of the authform_xxxxxxx subroutines take their inputs in a
2671: ## hash, and have reasonable default values.
2672: ##
2673: ## formname = the name given in the <form> tag.
1.35 matthew 2674: #-------------------------------------------
2675:
1.45 matthew 2676: =pod
2677:
1.112 bowersj2 2678: =head1 Authentication Routines
2679:
2680: =over 4
2681:
1.648 raeburn 2682: =item * &authform_xxxxxx()
1.35 matthew 2683:
2684: The authform_xxxxxx subroutines provide javascript and html forms which
2685: handle some of the conveniences required for authentication forms.
2686: This is not an optimal method, but it works.
2687:
2688: =over 4
2689:
1.112 bowersj2 2690: =item * authform_header
1.35 matthew 2691:
1.112 bowersj2 2692: =item * authform_authorwarning
1.35 matthew 2693:
1.112 bowersj2 2694: =item * authform_nochange
1.35 matthew 2695:
1.112 bowersj2 2696: =item * authform_kerberos
1.35 matthew 2697:
1.112 bowersj2 2698: =item * authform_internal
1.35 matthew 2699:
1.112 bowersj2 2700: =item * authform_filesystem
1.35 matthew 2701:
2702: =back
2703:
1.648 raeburn 2704: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2705:
1.35 matthew 2706: =cut
2707:
2708: #-------------------------------------------
1.32 matthew 2709: sub authform_header{
2710: my %in = (
2711: formname => 'cu',
1.80 albertel 2712: kerb_def_dom => '',
1.32 matthew 2713: @_,
2714: );
2715: $in{'formname'} = 'document.' . $in{'formname'};
2716: my $result='';
1.80 albertel 2717:
2718: #---------------------------------------------- Code for upper case translation
2719: my $Javascript_toUpperCase;
2720: unless ($in{kerb_def_dom}) {
2721: $Javascript_toUpperCase =<<"END";
2722: switch (choice) {
2723: case 'krb': currentform.elements[choicearg].value =
2724: currentform.elements[choicearg].value.toUpperCase();
2725: break;
2726: default:
2727: }
2728: END
2729: } else {
2730: $Javascript_toUpperCase = "";
2731: }
2732:
1.165 raeburn 2733: my $radioval = "'nochange'";
1.591 raeburn 2734: if (defined($in{'curr_authtype'})) {
2735: if ($in{'curr_authtype'} ne '') {
2736: $radioval = "'".$in{'curr_authtype'}."arg'";
2737: }
1.174 matthew 2738: }
1.165 raeburn 2739: my $argfield = 'null';
1.591 raeburn 2740: if (defined($in{'mode'})) {
1.165 raeburn 2741: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2742: if (defined($in{'curr_autharg'})) {
2743: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2744: $argfield = "'$in{'curr_autharg'}'";
2745: }
2746: }
2747: }
2748: }
2749:
1.32 matthew 2750: $result.=<<"END";
2751: var current = new Object();
1.165 raeburn 2752: current.radiovalue = $radioval;
2753: current.argfield = $argfield;
1.32 matthew 2754:
2755: function changed_radio(choice,currentform) {
2756: var choicearg = choice + 'arg';
2757: // If a radio button in changed, we need to change the argfield
2758: if (current.radiovalue != choice) {
2759: current.radiovalue = choice;
2760: if (current.argfield != null) {
2761: currentform.elements[current.argfield].value = '';
2762: }
2763: if (choice == 'nochange') {
2764: current.argfield = null;
2765: } else {
2766: current.argfield = choicearg;
2767: switch(choice) {
2768: case 'krb':
2769: currentform.elements[current.argfield].value =
2770: "$in{'kerb_def_dom'}";
2771: break;
2772: default:
2773: break;
2774: }
2775: }
2776: }
2777: return;
2778: }
1.22 www 2779:
1.32 matthew 2780: function changed_text(choice,currentform) {
2781: var choicearg = choice + 'arg';
2782: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2783: $Javascript_toUpperCase
1.32 matthew 2784: // clear old field
2785: if ((current.argfield != choicearg) && (current.argfield != null)) {
2786: currentform.elements[current.argfield].value = '';
2787: }
2788: current.argfield = choicearg;
2789: }
2790: set_auth_radio_buttons(choice,currentform);
2791: return;
1.20 www 2792: }
1.32 matthew 2793:
2794: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2795: var numauthchoices = currentform.login.length;
2796: if (typeof numauthchoices == "undefined") {
2797: return;
2798: }
1.32 matthew 2799: var i=0;
1.986 raeburn 2800: while (i < numauthchoices) {
1.32 matthew 2801: if (currentform.login[i].value == newvalue) { break; }
2802: i++;
2803: }
1.986 raeburn 2804: if (i == numauthchoices) {
1.32 matthew 2805: return;
2806: }
2807: current.radiovalue = newvalue;
2808: currentform.login[i].checked = true;
2809: return;
2810: }
2811: END
2812: return $result;
2813: }
2814:
1.1106 raeburn 2815: sub authform_authorwarning {
1.32 matthew 2816: my $result='';
1.144 matthew 2817: $result='<i>'.
2818: &mt('As a general rule, only authors or co-authors should be '.
2819: 'filesystem authenticated '.
2820: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2821: return $result;
2822: }
2823:
1.1106 raeburn 2824: sub authform_nochange {
1.32 matthew 2825: my %in = (
2826: formname => 'document.cu',
2827: kerb_def_dom => 'MSU.EDU',
2828: @_,
2829: );
1.1106 raeburn 2830: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2831: my $result;
1.1104 raeburn 2832: if (!$authnum) {
1.1105 raeburn 2833: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2834: } else {
2835: $result = '<label>'.&mt('[_1] Do not change login data',
2836: '<input type="radio" name="login" value="nochange" '.
2837: 'checked="checked" onclick="'.
1.281 albertel 2838: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2839: '</label>';
1.586 raeburn 2840: }
1.32 matthew 2841: return $result;
2842: }
2843:
1.591 raeburn 2844: sub authform_kerberos {
1.32 matthew 2845: my %in = (
2846: formname => 'document.cu',
2847: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2848: kerb_def_auth => 'krb4',
1.32 matthew 2849: @_,
2850: );
1.586 raeburn 2851: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2852: $autharg,$jscall);
1.1106 raeburn 2853: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2854: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2855: $check5 = ' checked="checked"';
1.80 albertel 2856: } else {
1.772 bisitz 2857: $check4 = ' checked="checked"';
1.80 albertel 2858: }
1.165 raeburn 2859: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2860: if (defined($in{'curr_authtype'})) {
2861: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2862: $krbcheck = ' checked="checked"';
1.623 raeburn 2863: if (defined($in{'mode'})) {
2864: if ($in{'mode'} eq 'modifyuser') {
2865: $krbcheck = '';
2866: }
2867: }
1.591 raeburn 2868: if (defined($in{'curr_kerb_ver'})) {
2869: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2870: $check5 = ' checked="checked"';
1.591 raeburn 2871: $check4 = '';
2872: } else {
1.772 bisitz 2873: $check4 = ' checked="checked"';
1.591 raeburn 2874: $check5 = '';
2875: }
1.586 raeburn 2876: }
1.591 raeburn 2877: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2878: $krbarg = $in{'curr_autharg'};
2879: }
1.586 raeburn 2880: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2881: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2882: $result =
2883: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2884: $in{'curr_autharg'},$krbver);
2885: } else {
2886: $result =
2887: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2888: }
2889: return $result;
2890: }
2891: }
2892: } else {
2893: if ($authnum == 1) {
1.784 bisitz 2894: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2895: }
2896: }
1.586 raeburn 2897: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2898: return;
1.587 raeburn 2899: } elsif ($authtype eq '') {
1.591 raeburn 2900: if (defined($in{'mode'})) {
1.587 raeburn 2901: if ($in{'mode'} eq 'modifycourse') {
2902: if ($authnum == 1) {
1.1104 raeburn 2903: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2904: }
2905: }
2906: }
1.586 raeburn 2907: }
2908: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2909: if ($authtype eq '') {
2910: $authtype = '<input type="radio" name="login" value="krb" '.
2911: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2912: $krbcheck.' />';
2913: }
2914: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2915: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2916: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2917: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2918: $in{'curr_authtype'} eq 'krb4')) {
2919: $result .= &mt
1.144 matthew 2920: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2921: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2922: '<label>'.$authtype,
1.281 albertel 2923: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2924: 'value="'.$krbarg.'" '.
1.144 matthew 2925: 'onchange="'.$jscall.'" />',
1.281 albertel 2926: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2927: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2928: '</label>');
1.586 raeburn 2929: } elsif ($can_assign{'krb4'}) {
2930: $result .= &mt
2931: ('[_1] Kerberos authenticated with domain [_2] '.
2932: '[_3] Version 4 [_4]',
2933: '<label>'.$authtype,
2934: '</label><input type="text" size="10" name="krbarg" '.
2935: 'value="'.$krbarg.'" '.
2936: 'onchange="'.$jscall.'" />',
2937: '<label><input type="hidden" name="krbver" value="4" />',
2938: '</label>');
2939: } elsif ($can_assign{'krb5'}) {
2940: $result .= &mt
2941: ('[_1] Kerberos authenticated with domain [_2] '.
2942: '[_3] Version 5 [_4]',
2943: '<label>'.$authtype,
2944: '</label><input type="text" size="10" name="krbarg" '.
2945: 'value="'.$krbarg.'" '.
2946: 'onchange="'.$jscall.'" />',
2947: '<label><input type="hidden" name="krbver" value="5" />',
2948: '</label>');
2949: }
1.32 matthew 2950: return $result;
2951: }
2952:
1.1106 raeburn 2953: sub authform_internal {
1.586 raeburn 2954: my %in = (
1.32 matthew 2955: formname => 'document.cu',
2956: kerb_def_dom => 'MSU.EDU',
2957: @_,
2958: );
1.586 raeburn 2959: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2960: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2961: if (defined($in{'curr_authtype'})) {
2962: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2963: if ($can_assign{'int'}) {
1.772 bisitz 2964: $intcheck = 'checked="checked" ';
1.623 raeburn 2965: if (defined($in{'mode'})) {
2966: if ($in{'mode'} eq 'modifyuser') {
2967: $intcheck = '';
2968: }
2969: }
1.591 raeburn 2970: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2971: $intarg = $in{'curr_autharg'};
2972: }
2973: } else {
2974: $result = &mt('Currently internally authenticated.');
2975: return $result;
1.165 raeburn 2976: }
2977: }
1.586 raeburn 2978: } else {
2979: if ($authnum == 1) {
1.784 bisitz 2980: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2981: }
2982: }
2983: if (!$can_assign{'int'}) {
2984: return;
1.587 raeburn 2985: } elsif ($authtype eq '') {
1.591 raeburn 2986: if (defined($in{'mode'})) {
1.587 raeburn 2987: if ($in{'mode'} eq 'modifycourse') {
2988: if ($authnum == 1) {
1.1104 raeburn 2989: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2990: }
2991: }
2992: }
1.165 raeburn 2993: }
1.586 raeburn 2994: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2995: if ($authtype eq '') {
2996: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2997: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2998: }
1.605 bisitz 2999: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3000: $intarg.'" onchange="'.$jscall.'" />';
3001: $result = &mt
1.144 matthew 3002: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3003: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3004: $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 3005: return $result;
3006: }
3007:
1.1104 raeburn 3008: sub authform_local {
1.32 matthew 3009: my %in = (
3010: formname => 'document.cu',
3011: kerb_def_dom => 'MSU.EDU',
3012: @_,
3013: );
1.586 raeburn 3014: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3015: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3016: if (defined($in{'curr_authtype'})) {
3017: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3018: if ($can_assign{'loc'}) {
1.772 bisitz 3019: $loccheck = 'checked="checked" ';
1.623 raeburn 3020: if (defined($in{'mode'})) {
3021: if ($in{'mode'} eq 'modifyuser') {
3022: $loccheck = '';
3023: }
3024: }
1.591 raeburn 3025: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3026: $locarg = $in{'curr_autharg'};
3027: }
3028: } else {
3029: $result = &mt('Currently using local (institutional) authentication.');
3030: return $result;
1.165 raeburn 3031: }
3032: }
1.586 raeburn 3033: } else {
3034: if ($authnum == 1) {
1.784 bisitz 3035: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3036: }
3037: }
3038: if (!$can_assign{'loc'}) {
3039: return;
1.587 raeburn 3040: } elsif ($authtype eq '') {
1.591 raeburn 3041: if (defined($in{'mode'})) {
1.587 raeburn 3042: if ($in{'mode'} eq 'modifycourse') {
3043: if ($authnum == 1) {
1.1104 raeburn 3044: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3045: }
3046: }
3047: }
1.165 raeburn 3048: }
1.586 raeburn 3049: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3050: if ($authtype eq '') {
3051: $authtype = '<input type="radio" name="login" value="loc" '.
3052: $loccheck.' onchange="'.$jscall.'" onclick="'.
3053: $jscall.'" />';
3054: }
3055: $autharg = '<input type="text" size="10" name="locarg" value="'.
3056: $locarg.'" onchange="'.$jscall.'" />';
3057: $result = &mt('[_1] Local Authentication with argument [_2]',
3058: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3059: return $result;
3060: }
3061:
1.1106 raeburn 3062: sub authform_filesystem {
1.32 matthew 3063: my %in = (
3064: formname => 'document.cu',
3065: kerb_def_dom => 'MSU.EDU',
3066: @_,
3067: );
1.586 raeburn 3068: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3069: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3070: if (defined($in{'curr_authtype'})) {
3071: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3072: if ($can_assign{'fsys'}) {
1.772 bisitz 3073: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3074: if (defined($in{'mode'})) {
3075: if ($in{'mode'} eq 'modifyuser') {
3076: $fsyscheck = '';
3077: }
3078: }
1.586 raeburn 3079: } else {
3080: $result = &mt('Currently Filesystem Authenticated.');
3081: return $result;
3082: }
3083: }
3084: } else {
3085: if ($authnum == 1) {
1.784 bisitz 3086: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3087: }
3088: }
3089: if (!$can_assign{'fsys'}) {
3090: return;
1.587 raeburn 3091: } elsif ($authtype eq '') {
1.591 raeburn 3092: if (defined($in{'mode'})) {
1.587 raeburn 3093: if ($in{'mode'} eq 'modifycourse') {
3094: if ($authnum == 1) {
1.1104 raeburn 3095: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3096: }
3097: }
3098: }
1.586 raeburn 3099: }
3100: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3101: if ($authtype eq '') {
3102: $authtype = '<input type="radio" name="login" value="fsys" '.
3103: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3104: $jscall.'" />';
3105: }
3106: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3107: ' onchange="'.$jscall.'" />';
3108: $result = &mt
1.144 matthew 3109: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3110: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3111: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3112: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3113: 'onchange="'.$jscall.'" />');
1.32 matthew 3114: return $result;
3115: }
3116:
1.586 raeburn 3117: sub get_assignable_auth {
3118: my ($dom) = @_;
3119: if ($dom eq '') {
3120: $dom = $env{'request.role.domain'};
3121: }
3122: my %can_assign = (
3123: krb4 => 1,
3124: krb5 => 1,
3125: int => 1,
3126: loc => 1,
3127: );
3128: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3129: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3130: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3131: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3132: my $context;
3133: if ($env{'request.role'} =~ /^au/) {
3134: $context = 'author';
3135: } elsif ($env{'request.role'} =~ /^dc/) {
3136: $context = 'domain';
3137: } elsif ($env{'request.course.id'}) {
3138: $context = 'course';
3139: }
3140: if ($context) {
3141: if (ref($authhash->{$context}) eq 'HASH') {
3142: %can_assign = %{$authhash->{$context}};
3143: }
3144: }
3145: }
3146: }
3147: my $authnum = 0;
3148: foreach my $key (keys(%can_assign)) {
3149: if ($can_assign{$key}) {
3150: $authnum ++;
3151: }
3152: }
3153: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3154: $authnum --;
3155: }
3156: return ($authnum,%can_assign);
3157: }
3158:
1.80 albertel 3159: ###############################################################
3160: ## Get Kerberos Defaults for Domain ##
3161: ###############################################################
3162: ##
3163: ## Returns default kerberos version and an associated argument
3164: ## as listed in file domain.tab. If not listed, provides
3165: ## appropriate default domain and kerberos version.
3166: ##
3167: #-------------------------------------------
3168:
3169: =pod
3170:
1.648 raeburn 3171: =item * &get_kerberos_defaults()
1.80 albertel 3172:
3173: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3174: version and domain. If not found, it defaults to version 4 and the
3175: domain of the server.
1.80 albertel 3176:
1.648 raeburn 3177: =over 4
3178:
1.80 albertel 3179: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3180:
1.648 raeburn 3181: =back
3182:
3183: =back
3184:
1.80 albertel 3185: =cut
3186:
3187: #-------------------------------------------
3188: sub get_kerberos_defaults {
3189: my $domain=shift;
1.641 raeburn 3190: my ($krbdef,$krbdefdom);
3191: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3192: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3193: $krbdef = $domdefaults{'auth_def'};
3194: $krbdefdom = $domdefaults{'auth_arg_def'};
3195: } else {
1.80 albertel 3196: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3197: my $krbdefdom=$1;
3198: $krbdefdom=~tr/a-z/A-Z/;
3199: $krbdef = "krb4";
3200: }
3201: return ($krbdef,$krbdefdom);
3202: }
1.112 bowersj2 3203:
1.32 matthew 3204:
1.46 matthew 3205: ###############################################################
3206: ## Thesaurus Functions ##
3207: ###############################################################
1.20 www 3208:
1.46 matthew 3209: =pod
1.20 www 3210:
1.112 bowersj2 3211: =head1 Thesaurus Functions
3212:
3213: =over 4
3214:
1.648 raeburn 3215: =item * &initialize_keywords()
1.46 matthew 3216:
3217: Initializes the package variable %Keywords if it is empty. Uses the
3218: package variable $thesaurus_db_file.
3219:
3220: =cut
3221:
3222: ###################################################
3223:
3224: sub initialize_keywords {
3225: return 1 if (scalar keys(%Keywords));
3226: # If we are here, %Keywords is empty, so fill it up
3227: # Make sure the file we need exists...
3228: if (! -e $thesaurus_db_file) {
3229: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3230: " failed because it does not exist");
3231: return 0;
3232: }
3233: # Set up the hash as a database
3234: my %thesaurus_db;
3235: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3236: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3237: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3238: $thesaurus_db_file);
3239: return 0;
3240: }
3241: # Get the average number of appearances of a word.
3242: my $avecount = $thesaurus_db{'average.count'};
3243: # Put keywords (those that appear > average) into %Keywords
3244: while (my ($word,$data)=each (%thesaurus_db)) {
3245: my ($count,undef) = split /:/,$data;
3246: $Keywords{$word}++ if ($count > $avecount);
3247: }
3248: untie %thesaurus_db;
3249: # Remove special values from %Keywords.
1.356 albertel 3250: foreach my $value ('total.count','average.count') {
3251: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3252: }
1.46 matthew 3253: return 1;
3254: }
3255:
3256: ###################################################
3257:
3258: =pod
3259:
1.648 raeburn 3260: =item * &keyword($word)
1.46 matthew 3261:
3262: Returns true if $word is a keyword. A keyword is a word that appears more
3263: than the average number of times in the thesaurus database. Calls
3264: &initialize_keywords
3265:
3266: =cut
3267:
3268: ###################################################
1.20 www 3269:
3270: sub keyword {
1.46 matthew 3271: return if (!&initialize_keywords());
3272: my $word=lc(shift());
3273: $word=~s/\W//g;
3274: return exists($Keywords{$word});
1.20 www 3275: }
1.46 matthew 3276:
3277: ###############################################################
3278:
3279: =pod
1.20 www 3280:
1.648 raeburn 3281: =item * &get_related_words()
1.46 matthew 3282:
1.160 matthew 3283: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3284: an array of words. If the keyword is not in the thesaurus, an empty array
3285: will be returned. The order of the words returned is determined by the
3286: database which holds them.
3287:
3288: Uses global $thesaurus_db_file.
3289:
1.1057 foxr 3290:
1.46 matthew 3291: =cut
3292:
3293: ###############################################################
3294: sub get_related_words {
3295: my $keyword = shift;
3296: my %thesaurus_db;
3297: if (! -e $thesaurus_db_file) {
3298: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3299: "failed because the file does not exist");
3300: return ();
3301: }
3302: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3303: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3304: return ();
3305: }
3306: my @Words=();
1.429 www 3307: my $count=0;
1.46 matthew 3308: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3309: # The first element is the number of times
3310: # the word appears. We do not need it now.
1.429 www 3311: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3312: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3313: my $threshold=$mostfrequentcount/10;
3314: foreach my $possibleword (@RelatedWords) {
3315: my ($word,$wordcount)=split(/\,/,$possibleword);
3316: if ($wordcount>$threshold) {
3317: push(@Words,$word);
3318: $count++;
3319: if ($count>10) { last; }
3320: }
1.20 www 3321: }
3322: }
1.46 matthew 3323: untie %thesaurus_db;
3324: return @Words;
1.14 harris41 3325: }
1.1090 foxr 3326: ###############################################################
3327: #
3328: # Spell checking
3329: #
3330:
3331: =pod
3332:
1.1142 raeburn 3333: =back
3334:
1.1090 foxr 3335: =head1 Spell checking
3336:
3337: =over 4
3338:
3339: =item * &check_spelling($wordlist $language)
3340:
3341: Takes a string containing words and feeds it to an external
3342: spellcheck program via a pipeline. Returns a string containing
3343: them mis-spelled words.
3344:
3345: Parameters:
3346:
3347: =over 4
3348:
3349: =item - $wordlist
3350:
3351: String that will be fed into the spellcheck program.
3352:
3353: =item - $language
3354:
3355: Language string that specifies the language for which the spell
3356: check will be performed.
3357:
3358: =back
3359:
3360: =back
3361:
3362: Note: This sub assumes that aspell is installed.
3363:
3364:
3365: =cut
3366:
1.46 matthew 3367:
1.1090 foxr 3368: sub check_spelling {
3369: my ($wordlist, $language) = @_;
1.1091 foxr 3370: my @misspellings;
3371:
3372: # Generate the speller and set the langauge.
3373: # if explicitly selected:
1.1090 foxr 3374:
1.1091 foxr 3375: my $speller = Text::Aspell->new;
1.1090 foxr 3376: if ($language) {
1.1091 foxr 3377: $speller->set_option('lang', $language);
1.1090 foxr 3378: }
3379:
1.1091 foxr 3380: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3381:
1.1091 foxr 3382: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3383:
1.1091 foxr 3384: foreach my $word (@words) {
3385: if(! $speller->check($word)) {
3386: push(@misspellings, $word);
1.1090 foxr 3387: }
3388: }
1.1091 foxr 3389: return join(' ', @misspellings);
3390:
1.1090 foxr 3391: }
3392:
1.61 www 3393: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3394: =pod
3395:
1.112 bowersj2 3396: =head1 User Name Functions
3397:
3398: =over 4
3399:
1.648 raeburn 3400: =item * &plainname($uname,$udom,$first)
1.81 albertel 3401:
1.112 bowersj2 3402: Takes a users logon name and returns it as a string in
1.226 albertel 3403: "first middle last generation" form
3404: if $first is set to 'lastname' then it returns it as
3405: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3406:
3407: =cut
1.61 www 3408:
1.295 www 3409:
1.81 albertel 3410: ###############################################################
1.61 www 3411: sub plainname {
1.226 albertel 3412: my ($uname,$udom,$first)=@_;
1.537 albertel 3413: return if (!defined($uname) || !defined($udom));
1.295 www 3414: my %names=&getnames($uname,$udom);
1.226 albertel 3415: my $name=&Apache::lonnet::format_name($names{'firstname'},
3416: $names{'middlename'},
3417: $names{'lastname'},
3418: $names{'generation'},$first);
3419: $name=~s/^\s+//;
1.62 www 3420: $name=~s/\s+$//;
3421: $name=~s/\s+/ /g;
1.353 albertel 3422: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3423: return $name;
1.61 www 3424: }
1.66 www 3425:
3426: # -------------------------------------------------------------------- Nickname
1.81 albertel 3427: =pod
3428:
1.648 raeburn 3429: =item * &nickname($uname,$udom)
1.81 albertel 3430:
3431: Gets a users name and returns it as a string as
3432:
3433: ""nickname""
1.66 www 3434:
1.81 albertel 3435: if the user has a nickname or
3436:
3437: "first middle last generation"
3438:
3439: if the user does not
3440:
3441: =cut
1.66 www 3442:
3443: sub nickname {
3444: my ($uname,$udom)=@_;
1.537 albertel 3445: return if (!defined($uname) || !defined($udom));
1.295 www 3446: my %names=&getnames($uname,$udom);
1.68 albertel 3447: my $name=$names{'nickname'};
1.66 www 3448: if ($name) {
3449: $name='"'.$name.'"';
3450: } else {
3451: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3452: $names{'lastname'}.' '.$names{'generation'};
3453: $name=~s/\s+$//;
3454: $name=~s/\s+/ /g;
3455: }
3456: return $name;
3457: }
3458:
1.295 www 3459: sub getnames {
3460: my ($uname,$udom)=@_;
1.537 albertel 3461: return if (!defined($uname) || !defined($udom));
1.433 albertel 3462: if ($udom eq 'public' && $uname eq 'public') {
3463: return ('lastname' => &mt('Public'));
3464: }
1.295 www 3465: my $id=$uname.':'.$udom;
3466: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3467: if ($cached) {
3468: return %{$names};
3469: } else {
3470: my %loadnames=&Apache::lonnet::get('environment',
3471: ['firstname','middlename','lastname','generation','nickname'],
3472: $udom,$uname);
3473: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3474: return %loadnames;
3475: }
3476: }
1.61 www 3477:
1.542 raeburn 3478: # -------------------------------------------------------------------- getemails
1.648 raeburn 3479:
1.542 raeburn 3480: =pod
3481:
1.648 raeburn 3482: =item * &getemails($uname,$udom)
1.542 raeburn 3483:
3484: Gets a user's email information and returns it as a hash with keys:
3485: notification, critnotification, permanentemail
3486:
3487: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3488: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3489:
1.648 raeburn 3490:
1.542 raeburn 3491: =cut
3492:
1.648 raeburn 3493:
1.466 albertel 3494: sub getemails {
3495: my ($uname,$udom)=@_;
3496: if ($udom eq 'public' && $uname eq 'public') {
3497: return;
3498: }
1.467 www 3499: if (!$udom) { $udom=$env{'user.domain'}; }
3500: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3501: my $id=$uname.':'.$udom;
3502: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3503: if ($cached) {
3504: return %{$names};
3505: } else {
3506: my %loadnames=&Apache::lonnet::get('environment',
3507: ['notification','critnotification',
3508: 'permanentemail'],
3509: $udom,$uname);
3510: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3511: return %loadnames;
3512: }
3513: }
3514:
1.551 albertel 3515: sub flush_email_cache {
3516: my ($uname,$udom)=@_;
3517: if (!$udom) { $udom =$env{'user.domain'}; }
3518: if (!$uname) { $uname=$env{'user.name'}; }
3519: return if ($udom eq 'public' && $uname eq 'public');
3520: my $id=$uname.':'.$udom;
3521: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3522: }
3523:
1.728 raeburn 3524: # -------------------------------------------------------------------- getlangs
3525:
3526: =pod
3527:
3528: =item * &getlangs($uname,$udom)
3529:
3530: Gets a user's language preference and returns it as a hash with key:
3531: language.
3532:
3533: =cut
3534:
3535:
3536: sub getlangs {
3537: my ($uname,$udom) = @_;
3538: if (!$udom) { $udom =$env{'user.domain'}; }
3539: if (!$uname) { $uname=$env{'user.name'}; }
3540: my $id=$uname.':'.$udom;
3541: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3542: if ($cached) {
3543: return %{$langs};
3544: } else {
3545: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3546: $udom,$uname);
3547: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3548: return %loadlangs;
3549: }
3550: }
3551:
3552: sub flush_langs_cache {
3553: my ($uname,$udom)=@_;
3554: if (!$udom) { $udom =$env{'user.domain'}; }
3555: if (!$uname) { $uname=$env{'user.name'}; }
3556: return if ($udom eq 'public' && $uname eq 'public');
3557: my $id=$uname.':'.$udom;
3558: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3559: }
3560:
1.61 www 3561: # ------------------------------------------------------------------ Screenname
1.81 albertel 3562:
3563: =pod
3564:
1.648 raeburn 3565: =item * &screenname($uname,$udom)
1.81 albertel 3566:
3567: Gets a users screenname and returns it as a string
3568:
3569: =cut
1.61 www 3570:
3571: sub screenname {
3572: my ($uname,$udom)=@_;
1.258 albertel 3573: if ($uname eq $env{'user.name'} &&
3574: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3575: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3576: return $names{'screenname'};
1.62 www 3577: }
3578:
1.212 albertel 3579:
1.802 bisitz 3580: # ------------------------------------------------------------- Confirm Wrapper
3581: =pod
3582:
1.1142 raeburn 3583: =item * &confirmwrapper($message)
1.802 bisitz 3584:
3585: Wrap messages about completion of operation in box
3586:
3587: =cut
3588:
3589: sub confirmwrapper {
3590: my ($message)=@_;
3591: if ($message) {
3592: return "\n".'<div class="LC_confirm_box">'."\n"
3593: .$message."\n"
3594: .'</div>'."\n";
3595: } else {
3596: return $message;
3597: }
3598: }
3599:
1.62 www 3600: # ------------------------------------------------------------- Message Wrapper
3601:
3602: sub messagewrapper {
1.369 www 3603: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3604: return
1.441 albertel 3605: '<a href="/adm/email?compose=individual&'.
3606: 'recname='.$username.'&recdom='.$domain.
3607: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3608: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3609: }
1.802 bisitz 3610:
1.74 www 3611: # --------------------------------------------------------------- Notes Wrapper
3612:
3613: sub noteswrapper {
3614: my ($link,$un,$do)=@_;
3615: return
1.896 amueller 3616: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3617: }
1.802 bisitz 3618:
1.62 www 3619: # ------------------------------------------------------------- Aboutme Wrapper
3620:
3621: sub aboutmewrapper {
1.1070 raeburn 3622: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3623: if (!defined($username) && !defined($domain)) {
3624: return;
3625: }
1.1096 raeburn 3626: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3627: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3628: }
3629:
3630: # ------------------------------------------------------------ Syllabus Wrapper
3631:
3632: sub syllabuswrapper {
1.707 bisitz 3633: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3634: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3635: }
1.14 harris41 3636:
1.802 bisitz 3637: # -----------------------------------------------------------------------------
3638:
1.208 matthew 3639: sub track_student_link {
1.887 raeburn 3640: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3641: my $link ="/adm/trackstudent?";
1.208 matthew 3642: my $title = 'View recent activity';
3643: if (defined($sname) && $sname !~ /^\s*$/ &&
3644: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3645: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3646: $title .= ' of this student';
1.268 albertel 3647: }
1.208 matthew 3648: if (defined($target) && $target !~ /^\s*$/) {
3649: $target = qq{target="$target"};
3650: } else {
3651: $target = '';
3652: }
1.268 albertel 3653: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3654: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3655: $title = &mt($title);
3656: $linktext = &mt($linktext);
1.448 albertel 3657: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3658: &help_open_topic('View_recent_activity');
1.208 matthew 3659: }
3660:
1.781 raeburn 3661: sub slot_reservations_link {
3662: my ($linktext,$sname,$sdom,$target) = @_;
3663: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3664: my $title = 'View slot reservation history';
3665: if (defined($sname) && $sname !~ /^\s*$/ &&
3666: defined($sdom) && $sdom !~ /^\s*$/) {
3667: $link .= "&uname=$sname&udom=$sdom";
3668: $title .= ' of this student';
3669: }
3670: if (defined($target) && $target !~ /^\s*$/) {
3671: $target = qq{target="$target"};
3672: } else {
3673: $target = '';
3674: }
3675: $title = &mt($title);
3676: $linktext = &mt($linktext);
3677: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3678: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3679:
3680: }
3681:
1.508 www 3682: # ===================================================== Display a student photo
3683:
3684:
1.509 albertel 3685: sub student_image_tag {
1.508 www 3686: my ($domain,$user)=@_;
3687: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3688: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3689: return '<img src="'.$imgsrc.'" align="right" />';
3690: } else {
3691: return '';
3692: }
3693: }
3694:
1.112 bowersj2 3695: =pod
3696:
3697: =back
3698:
3699: =head1 Access .tab File Data
3700:
3701: =over 4
3702:
1.648 raeburn 3703: =item * &languageids()
1.112 bowersj2 3704:
3705: returns list of all language ids
3706:
3707: =cut
3708:
1.14 harris41 3709: sub languageids {
1.16 harris41 3710: return sort(keys(%language));
1.14 harris41 3711: }
3712:
1.112 bowersj2 3713: =pod
3714:
1.648 raeburn 3715: =item * &languagedescription()
1.112 bowersj2 3716:
3717: returns description of a specified language id
3718:
3719: =cut
3720:
1.14 harris41 3721: sub languagedescription {
1.125 www 3722: my $code=shift;
3723: return ($supported_language{$code}?'* ':'').
3724: $language{$code}.
1.126 www 3725: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3726: }
3727:
1.1048 foxr 3728: =pod
3729:
3730: =item * &plainlanguagedescription
3731:
3732: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3733: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3734:
3735: =cut
3736:
1.145 www 3737: sub plainlanguagedescription {
3738: my $code=shift;
3739: return $language{$code};
3740: }
3741:
1.1048 foxr 3742: =pod
3743:
3744: =item * &supportedlanguagecode
3745:
3746: Returns the supported language code (e.g. sptutf maps to pt) given a language
3747: code.
3748:
3749: =cut
3750:
1.145 www 3751: sub supportedlanguagecode {
3752: my $code=shift;
3753: return $supported_language{$code};
1.97 www 3754: }
3755:
1.112 bowersj2 3756: =pod
3757:
1.1048 foxr 3758: =item * &latexlanguage()
3759:
3760: Given a language key code returns the correspondnig language to use
3761: to select the correct hyphenation on LaTeX printouts. This is undef if there
3762: is no supported hyphenation for the language code.
3763:
3764: =cut
3765:
3766: sub latexlanguage {
3767: my $code = shift;
3768: return $latex_language{$code};
3769: }
3770:
3771: =pod
3772:
3773: =item * &latexhyphenation()
3774:
3775: Same as above but what's supplied is the language as it might be stored
3776: in the metadata.
3777:
3778: =cut
3779:
3780: sub latexhyphenation {
3781: my $key = shift;
3782: return $latex_language_bykey{$key};
3783: }
3784:
3785: =pod
3786:
1.648 raeburn 3787: =item * ©rightids()
1.112 bowersj2 3788:
3789: returns list of all copyrights
3790:
3791: =cut
3792:
3793: sub copyrightids {
3794: return sort(keys(%cprtag));
3795: }
3796:
3797: =pod
3798:
1.648 raeburn 3799: =item * ©rightdescription()
1.112 bowersj2 3800:
3801: returns description of a specified copyright id
3802:
3803: =cut
3804:
3805: sub copyrightdescription {
1.166 www 3806: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3807: }
1.197 matthew 3808:
3809: =pod
3810:
1.648 raeburn 3811: =item * &source_copyrightids()
1.192 taceyjo1 3812:
3813: returns list of all source copyrights
3814:
3815: =cut
3816:
3817: sub source_copyrightids {
3818: return sort(keys(%scprtag));
3819: }
3820:
3821: =pod
3822:
1.648 raeburn 3823: =item * &source_copyrightdescription()
1.192 taceyjo1 3824:
3825: returns description of a specified source copyright id
3826:
3827: =cut
3828:
3829: sub source_copyrightdescription {
3830: return &mt($scprtag{shift(@_)});
3831: }
1.112 bowersj2 3832:
3833: =pod
3834:
1.648 raeburn 3835: =item * &filecategories()
1.112 bowersj2 3836:
3837: returns list of all file categories
3838:
3839: =cut
3840:
3841: sub filecategories {
3842: return sort(keys(%category_extensions));
3843: }
3844:
3845: =pod
3846:
1.648 raeburn 3847: =item * &filecategorytypes()
1.112 bowersj2 3848:
3849: returns list of file types belonging to a given file
3850: category
3851:
3852: =cut
3853:
3854: sub filecategorytypes {
1.356 albertel 3855: my ($cat) = @_;
3856: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3857: }
3858:
3859: =pod
3860:
1.648 raeburn 3861: =item * &fileembstyle()
1.112 bowersj2 3862:
3863: returns embedding style for a specified file type
3864:
3865: =cut
3866:
3867: sub fileembstyle {
3868: return $fe{lc(shift(@_))};
1.169 www 3869: }
3870:
1.351 www 3871: sub filemimetype {
3872: return $fm{lc(shift(@_))};
3873: }
3874:
1.169 www 3875:
3876: sub filecategoryselect {
3877: my ($name,$value)=@_;
1.189 matthew 3878: return &select_form($value,$name,
1.970 raeburn 3879: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3880: }
3881:
3882: =pod
3883:
1.648 raeburn 3884: =item * &filedescription()
1.112 bowersj2 3885:
3886: returns description for a specified file type
3887:
3888: =cut
3889:
3890: sub filedescription {
1.188 matthew 3891: my $file_description = $fd{lc(shift())};
3892: $file_description =~ s:([\[\]]):~$1:g;
3893: return &mt($file_description);
1.112 bowersj2 3894: }
3895:
3896: =pod
3897:
1.648 raeburn 3898: =item * &filedescriptionex()
1.112 bowersj2 3899:
3900: returns description for a specified file type with
3901: extra formatting
3902:
3903: =cut
3904:
3905: sub filedescriptionex {
3906: my $ex=shift;
1.188 matthew 3907: my $file_description = $fd{lc($ex)};
3908: $file_description =~ s:([\[\]]):~$1:g;
3909: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3910: }
3911:
3912: # End of .tab access
3913: =pod
3914:
3915: =back
3916:
3917: =cut
3918:
3919: # ------------------------------------------------------------------ File Types
3920: sub fileextensions {
3921: return sort(keys(%fe));
3922: }
3923:
1.97 www 3924: # ----------------------------------------------------------- Display Languages
3925: # returns a hash with all desired display languages
3926: #
3927:
3928: sub display_languages {
3929: my %languages=();
1.695 raeburn 3930: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3931: $languages{$lang}=1;
1.97 www 3932: }
3933: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3934: if ($env{'form.displaylanguage'}) {
1.356 albertel 3935: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3936: $languages{$lang}=1;
1.97 www 3937: }
3938: }
3939: return %languages;
1.14 harris41 3940: }
3941:
1.582 albertel 3942: sub languages {
3943: my ($possible_langs) = @_;
1.695 raeburn 3944: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3945: if (!ref($possible_langs)) {
3946: if( wantarray ) {
3947: return @preferred_langs;
3948: } else {
3949: return $preferred_langs[0];
3950: }
3951: }
3952: my %possibilities = map { $_ => 1 } (@$possible_langs);
3953: my @preferred_possibilities;
3954: foreach my $preferred_lang (@preferred_langs) {
3955: if (exists($possibilities{$preferred_lang})) {
3956: push(@preferred_possibilities, $preferred_lang);
3957: }
3958: }
3959: if( wantarray ) {
3960: return @preferred_possibilities;
3961: }
3962: return $preferred_possibilities[0];
3963: }
3964:
1.742 raeburn 3965: sub user_lang {
3966: my ($touname,$toudom,$fromcid) = @_;
3967: my @userlangs;
3968: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3969: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3970: $env{'course.'.$fromcid.'.languages'}));
3971: } else {
3972: my %langhash = &getlangs($touname,$toudom);
3973: if ($langhash{'languages'} ne '') {
3974: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3975: } else {
3976: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3977: if ($domdefs{'lang_def'} ne '') {
3978: @userlangs = ($domdefs{'lang_def'});
3979: }
3980: }
3981: }
3982: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3983: my $user_lh = Apache::localize->get_handle(@languages);
3984: return $user_lh;
3985: }
3986:
3987:
1.112 bowersj2 3988: ###############################################################
3989: ## Student Answer Attempts ##
3990: ###############################################################
3991:
3992: =pod
3993:
3994: =head1 Alternate Problem Views
3995:
3996: =over 4
3997:
1.648 raeburn 3998: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 3999: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4000:
4001: Return string with previous attempt on problem. Arguments:
4002:
4003: =over 4
4004:
4005: =item * $symb: Problem, including path
4006:
4007: =item * $username: username of the desired student
4008:
4009: =item * $domain: domain of the desired student
1.14 harris41 4010:
1.112 bowersj2 4011: =item * $course: Course ID
1.14 harris41 4012:
1.112 bowersj2 4013: =item * $getattempt: Leave blank for all attempts, otherwise put
4014: something
1.14 harris41 4015:
1.112 bowersj2 4016: =item * $regexp: if string matches this regexp, the string will be
4017: sent to $gradesub
1.14 harris41 4018:
1.112 bowersj2 4019: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4020:
1.1199 raeburn 4021: =item * $usec: section of the desired student
4022:
4023: =item * $identifier: counter for student (multiple students one problem) or
4024: problem (one student; whole sequence).
4025:
1.112 bowersj2 4026: =back
1.14 harris41 4027:
1.112 bowersj2 4028: The output string is a table containing all desired attempts, if any.
1.16 harris41 4029:
1.112 bowersj2 4030: =cut
1.1 albertel 4031:
4032: sub get_previous_attempt {
1.1199 raeburn 4033: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4034: my $prevattempts='';
1.43 ng 4035: no strict 'refs';
1.1 albertel 4036: if ($symb) {
1.3 albertel 4037: my (%returnhash)=
4038: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4039: if ($returnhash{'version'}) {
4040: my %lasthash=();
4041: my $version;
4042: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4043: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4044: if ($key =~ /\.rawrndseed$/) {
4045: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4046: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4047: } else {
4048: $lasthash{$key}=$returnhash{$version.':'.$key};
4049: }
1.19 harris41 4050: }
1.1 albertel 4051: }
1.596 albertel 4052: $prevattempts=&start_data_table().&start_data_table_header_row();
4053: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4054: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4055: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4056: foreach my $key (sort(keys(%lasthash))) {
4057: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4058: if ($#parts > 0) {
1.31 albertel 4059: my $data=$parts[-1];
1.989 raeburn 4060: next if ($data eq 'foilorder');
1.31 albertel 4061: pop(@parts);
1.1010 www 4062: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4063: if ($data eq 'type') {
4064: unless ($showsurv) {
4065: my $id = join(',',@parts);
4066: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4067: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4068: $lasthidden{$ign.'.'.$id} = 1;
4069: }
1.945 raeburn 4070: }
1.1199 raeburn 4071: if ($identifier ne '') {
4072: my $id = join(',',@parts);
4073: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4074: $domain,$username,$usec,undef,$course) =~ /^no/) {
4075: $hidestatus{$ign.'.'.$id} = 1;
4076: }
4077: }
4078: } elsif ($data eq 'regrader') {
4079: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4080: my $id = join(',',@parts);
4081: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4082: }
1.1010 www 4083: }
1.31 albertel 4084: } else {
1.41 ng 4085: if ($#parts == 0) {
4086: $prevattempts.='<th>'.$parts[0].'</th>';
4087: } else {
4088: $prevattempts.='<th>'.$ign.'</th>';
4089: }
1.31 albertel 4090: }
1.16 harris41 4091: }
1.596 albertel 4092: $prevattempts.=&end_data_table_header_row();
1.40 ng 4093: if ($getattempt eq '') {
1.1199 raeburn 4094: my (%solved,%resets,%probstatus);
1.1200 raeburn 4095: if (($identifier ne '') && (keys(%regraded) > 0)) {
4096: for ($version=1;$version<=$returnhash{'version'};$version++) {
4097: foreach my $id (keys(%regraded)) {
4098: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4099: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4100: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4101: push(@{$resets{$id}},$version);
1.1199 raeburn 4102: }
4103: }
4104: }
1.1200 raeburn 4105: }
4106: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4107: my (@hidden,@unsolved);
1.945 raeburn 4108: if (%typeparts) {
4109: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4110: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4111: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4112: push(@hidden,$id);
1.1199 raeburn 4113: } elsif ($identifier ne '') {
4114: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4115: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4116: ($hidestatus{$id})) {
1.1200 raeburn 4117: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4118: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4119: push(@{$solved{$id}},$version);
4120: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4121: (ref($solved{$id}) eq 'ARRAY')) {
4122: my $skip;
4123: if (ref($resets{$id}) eq 'ARRAY') {
4124: foreach my $reset (@{$resets{$id}}) {
4125: if ($reset > $solved{$id}[-1]) {
4126: $skip=1;
4127: last;
4128: }
4129: }
4130: }
4131: unless ($skip) {
4132: my ($ign,$partslist) = split(/\./,$id,2);
4133: push(@unsolved,$partslist);
4134: }
4135: }
4136: }
1.945 raeburn 4137: }
4138: }
4139: }
4140: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4141: '<td>'.&mt('Transaction [_1]',$version);
4142: if (@unsolved) {
4143: $prevattempts .= '<span class="LC_nobreak"><label>'.
4144: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4145: &mt('Hide').'</label></span>';
4146: }
4147: $prevattempts .= '</td>';
1.945 raeburn 4148: if (@hidden) {
4149: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4150: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4151: my $hide;
4152: foreach my $id (@hidden) {
4153: if ($key =~ /^\Q$id\E/) {
4154: $hide = 1;
4155: last;
4156: }
4157: }
4158: if ($hide) {
4159: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4160: if (($data eq 'award') || ($data eq 'awarddetail')) {
4161: my $value = &format_previous_attempt_value($key,
4162: $returnhash{$version.':'.$key});
1.1173 kruse 4163: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4164: } else {
4165: $prevattempts.='<td> </td>';
4166: }
4167: } else {
4168: if ($key =~ /\./) {
1.1212 raeburn 4169: my $value = $returnhash{$version.':'.$key};
4170: if ($key =~ /\.rndseed$/) {
4171: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4172: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4173: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4174: }
4175: }
4176: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4177: ' </td>';
1.945 raeburn 4178: } else {
4179: $prevattempts.='<td> </td>';
4180: }
4181: }
4182: }
4183: } else {
4184: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4185: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4186: my $value = $returnhash{$version.':'.$key};
4187: if ($key =~ /\.rndseed$/) {
4188: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4189: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4190: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4191: }
4192: }
4193: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4194: ' </td>';
1.945 raeburn 4195: }
4196: }
4197: $prevattempts.=&end_data_table_row();
1.40 ng 4198: }
1.1 albertel 4199: }
1.945 raeburn 4200: my @currhidden = keys(%lasthidden);
1.596 albertel 4201: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4202: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4203: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4204: if (%typeparts) {
4205: my $hidden;
4206: foreach my $id (@currhidden) {
4207: if ($key =~ /^\Q$id\E/) {
4208: $hidden = 1;
4209: last;
4210: }
4211: }
4212: if ($hidden) {
4213: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4214: if (($data eq 'award') || ($data eq 'awarddetail')) {
4215: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4216: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4217: $value = &$gradesub($value);
4218: }
1.1173 kruse 4219: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4220: } else {
4221: $prevattempts.='<td> </td>';
4222: }
4223: } else {
4224: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4225: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4226: $value = &$gradesub($value);
4227: }
1.1173 kruse 4228: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4229: }
4230: } else {
4231: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4232: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4233: $value = &$gradesub($value);
4234: }
1.1173 kruse 4235: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4236: }
1.16 harris41 4237: }
1.596 albertel 4238: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4239: } else {
1.596 albertel 4240: $prevattempts=
4241: &start_data_table().&start_data_table_row().
4242: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4243: &end_data_table_row().&end_data_table();
1.1 albertel 4244: }
4245: } else {
1.596 albertel 4246: $prevattempts=
4247: &start_data_table().&start_data_table_row().
4248: '<td>'.&mt('No data.').'</td>'.
4249: &end_data_table_row().&end_data_table();
1.1 albertel 4250: }
1.10 albertel 4251: }
4252:
1.581 albertel 4253: sub format_previous_attempt_value {
4254: my ($key,$value) = @_;
1.1011 www 4255: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4256: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4257: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4258: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4259: } elsif ($key =~ /answerstring$/) {
4260: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4261: my @answer = %answers;
4262: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4263: my @anskeys = sort(keys(%answers));
4264: if (@anskeys == 1) {
4265: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4266: if ($answer =~ m{\0}) {
4267: $answer =~ s{\0}{,}g;
1.988 raeburn 4268: }
4269: my $tag_internal_answer_name = 'INTERNAL';
4270: if ($anskeys[0] eq $tag_internal_answer_name) {
4271: $value = $answer;
4272: } else {
4273: $value = $anskeys[0].'='.$answer;
4274: }
4275: } else {
4276: foreach my $ans (@anskeys) {
4277: my $answer = $answers{$ans};
1.1001 raeburn 4278: if ($answer =~ m{\0}) {
4279: $answer =~ s{\0}{,}g;
1.988 raeburn 4280: }
4281: $value .= $ans.'='.$answer.'<br />';;
4282: }
4283: }
1.581 albertel 4284: } else {
1.1173 kruse 4285: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4286: }
4287: return $value;
4288: }
4289:
4290:
1.107 albertel 4291: sub relative_to_absolute {
4292: my ($url,$output)=@_;
4293: my $parser=HTML::TokeParser->new(\$output);
4294: my $token;
4295: my $thisdir=$url;
4296: my @rlinks=();
4297: while ($token=$parser->get_token) {
4298: if ($token->[0] eq 'S') {
4299: if ($token->[1] eq 'a') {
4300: if ($token->[2]->{'href'}) {
4301: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4302: }
4303: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4304: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4305: } elsif ($token->[1] eq 'base') {
4306: $thisdir=$token->[2]->{'href'};
4307: }
4308: }
4309: }
4310: $thisdir=~s-/[^/]*$--;
1.356 albertel 4311: foreach my $link (@rlinks) {
1.726 raeburn 4312: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4313: ($link=~/^\//) ||
4314: ($link=~/^javascript:/i) ||
4315: ($link=~/^mailto:/i) ||
4316: ($link=~/^\#/)) {
4317: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4318: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4319: }
4320: }
4321: # -------------------------------------------------- Deal with Applet codebases
4322: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4323: return $output;
4324: }
4325:
1.112 bowersj2 4326: =pod
4327:
1.648 raeburn 4328: =item * &get_student_view()
1.112 bowersj2 4329:
4330: show a snapshot of what student was looking at
4331:
4332: =cut
4333:
1.10 albertel 4334: sub get_student_view {
1.186 albertel 4335: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4336: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4337: my (%form);
1.10 albertel 4338: my @elements=('symb','courseid','domain','username');
4339: foreach my $element (@elements) {
1.186 albertel 4340: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4341: }
1.186 albertel 4342: if (defined($moreenv)) {
4343: %form=(%form,%{$moreenv});
4344: }
1.236 albertel 4345: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4346: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4347: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4348: $userview=~s/\<body[^\>]*\>//gi;
4349: $userview=~s/\<\/body\>//gi;
4350: $userview=~s/\<html\>//gi;
4351: $userview=~s/\<\/html\>//gi;
4352: $userview=~s/\<head\>//gi;
4353: $userview=~s/\<\/head\>//gi;
4354: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4355: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4356: if (wantarray) {
4357: return ($userview,$response);
4358: } else {
4359: return $userview;
4360: }
4361: }
4362:
4363: sub get_student_view_with_retries {
4364: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4365:
4366: my $ok = 0; # True if we got a good response.
4367: my $content;
4368: my $response;
4369:
4370: # Try to get the student_view done. within the retries count:
4371:
4372: do {
4373: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4374: $ok = $response->is_success;
4375: if (!$ok) {
4376: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4377: }
4378: $retries--;
4379: } while (!$ok && ($retries > 0));
4380:
4381: if (!$ok) {
4382: $content = ''; # On error return an empty content.
4383: }
1.651 www 4384: if (wantarray) {
4385: return ($content, $response);
4386: } else {
4387: return $content;
4388: }
1.11 albertel 4389: }
4390:
1.112 bowersj2 4391: =pod
4392:
1.648 raeburn 4393: =item * &get_student_answers()
1.112 bowersj2 4394:
4395: show a snapshot of how student was answering problem
4396:
4397: =cut
4398:
1.11 albertel 4399: sub get_student_answers {
1.100 sakharuk 4400: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4401: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4402: my (%moreenv);
1.11 albertel 4403: my @elements=('symb','courseid','domain','username');
4404: foreach my $element (@elements) {
1.186 albertel 4405: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4406: }
1.186 albertel 4407: $moreenv{'grade_target'}='answer';
4408: %moreenv=(%form,%moreenv);
1.497 raeburn 4409: $feedurl = &Apache::lonnet::clutter($feedurl);
4410: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4411: return $userview;
1.1 albertel 4412: }
1.116 albertel 4413:
4414: =pod
4415:
4416: =item * &submlink()
4417:
1.242 albertel 4418: Inputs: $text $uname $udom $symb $target
1.116 albertel 4419:
4420: Returns: A link to grades.pm such as to see the SUBM view of a student
4421:
4422: =cut
4423:
4424: ###############################################
4425: sub submlink {
1.242 albertel 4426: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4427: if (!($uname && $udom)) {
4428: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4429: &Apache::lonnet::whichuser($symb);
1.116 albertel 4430: if (!$symb) { $symb=$cursymb; }
4431: }
1.254 matthew 4432: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4433: $symb=&escape($symb);
1.960 bisitz 4434: if ($target) { $target=" target=\"$target\""; }
4435: return
4436: '<a href="/adm/grades?command=submission'.
4437: '&symb='.$symb.
4438: '&student='.$uname.
4439: '&userdom='.$udom.'"'.
4440: $target.'>'.$text.'</a>';
1.242 albertel 4441: }
4442: ##############################################
4443:
4444: =pod
4445:
4446: =item * &pgrdlink()
4447:
4448: Inputs: $text $uname $udom $symb $target
4449:
4450: Returns: A link to grades.pm such as to see the PGRD view of a student
4451:
4452: =cut
4453:
4454: ###############################################
4455: sub pgrdlink {
4456: my $link=&submlink(@_);
4457: $link=~s/(&command=submission)/$1&showgrading=yes/;
4458: return $link;
4459: }
4460: ##############################################
4461:
4462: =pod
4463:
4464: =item * &pprmlink()
4465:
4466: Inputs: $text $uname $udom $symb $target
4467:
4468: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4469: student and a specific resource
1.242 albertel 4470:
4471: =cut
4472:
4473: ###############################################
4474: sub pprmlink {
4475: my ($text,$uname,$udom,$symb,$target)=@_;
4476: if (!($uname && $udom)) {
4477: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4478: &Apache::lonnet::whichuser($symb);
1.242 albertel 4479: if (!$symb) { $symb=$cursymb; }
4480: }
1.254 matthew 4481: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4482: $symb=&escape($symb);
1.242 albertel 4483: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4484: return '<a href="/adm/parmset?command=set&'.
4485: 'symb='.$symb.'&uname='.$uname.
4486: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4487: }
4488: ##############################################
1.37 matthew 4489:
1.112 bowersj2 4490: =pod
4491:
4492: =back
4493:
4494: =cut
4495:
1.37 matthew 4496: ###############################################
1.51 www 4497:
4498:
4499: sub timehash {
1.687 raeburn 4500: my ($thistime) = @_;
4501: my $timezone = &Apache::lonlocal::gettimezone();
4502: my $dt = DateTime->from_epoch(epoch => $thistime)
4503: ->set_time_zone($timezone);
4504: my $wday = $dt->day_of_week();
4505: if ($wday == 7) { $wday = 0; }
4506: return ( 'second' => $dt->second(),
4507: 'minute' => $dt->minute(),
4508: 'hour' => $dt->hour(),
4509: 'day' => $dt->day_of_month(),
4510: 'month' => $dt->month(),
4511: 'year' => $dt->year(),
4512: 'weekday' => $wday,
4513: 'dayyear' => $dt->day_of_year(),
4514: 'dlsav' => $dt->is_dst() );
1.51 www 4515: }
4516:
1.370 www 4517: sub utc_string {
4518: my ($date)=@_;
1.371 www 4519: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4520: }
4521:
1.51 www 4522: sub maketime {
4523: my %th=@_;
1.687 raeburn 4524: my ($epoch_time,$timezone,$dt);
4525: $timezone = &Apache::lonlocal::gettimezone();
4526: eval {
4527: $dt = DateTime->new( year => $th{'year'},
4528: month => $th{'month'},
4529: day => $th{'day'},
4530: hour => $th{'hour'},
4531: minute => $th{'minute'},
4532: second => $th{'second'},
4533: time_zone => $timezone,
4534: );
4535: };
4536: if (!$@) {
4537: $epoch_time = $dt->epoch;
4538: if ($epoch_time) {
4539: return $epoch_time;
4540: }
4541: }
1.51 www 4542: return POSIX::mktime(
4543: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4544: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4545: }
4546:
4547: #########################################
1.51 www 4548:
4549: sub findallcourses {
1.482 raeburn 4550: my ($roles,$uname,$udom) = @_;
1.355 albertel 4551: my %roles;
4552: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4553: my %courses;
1.51 www 4554: my $now=time;
1.482 raeburn 4555: if (!defined($uname)) {
4556: $uname = $env{'user.name'};
4557: }
4558: if (!defined($udom)) {
4559: $udom = $env{'user.domain'};
4560: }
4561: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4562: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4563: if (!%roles) {
4564: %roles = (
4565: cc => 1,
1.907 raeburn 4566: co => 1,
1.482 raeburn 4567: in => 1,
4568: ep => 1,
4569: ta => 1,
4570: cr => 1,
4571: st => 1,
4572: );
4573: }
4574: foreach my $entry (keys(%roleshash)) {
4575: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4576: if ($trole =~ /^cr/) {
4577: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4578: } else {
4579: next if (!exists($roles{$trole}));
4580: }
4581: if ($tend) {
4582: next if ($tend < $now);
4583: }
4584: if ($tstart) {
4585: next if ($tstart > $now);
4586: }
1.1058 raeburn 4587: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4588: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4589: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4590: if ($secpart eq '') {
4591: ($cnum,$role) = split(/_/,$cnumpart);
4592: $sec = 'none';
1.1058 raeburn 4593: $value .= $cnum.'/';
1.482 raeburn 4594: } else {
4595: $cnum = $cnumpart;
4596: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4597: $value .= $cnum.'/'.$sec;
4598: }
4599: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4600: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4601: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4602: }
4603: } else {
4604: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4605: }
1.482 raeburn 4606: }
4607: } else {
4608: foreach my $key (keys(%env)) {
1.483 albertel 4609: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4610: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4611: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4612: next if ($role eq 'ca' || $role eq 'aa');
4613: next if (%roles && !exists($roles{$role}));
4614: my ($starttime,$endtime)=split(/\./,$env{$key});
4615: my $active=1;
4616: if ($starttime) {
4617: if ($now<$starttime) { $active=0; }
4618: }
4619: if ($endtime) {
4620: if ($now>$endtime) { $active=0; }
4621: }
4622: if ($active) {
1.1058 raeburn 4623: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4624: if ($sec eq '') {
4625: $sec = 'none';
1.1058 raeburn 4626: } else {
4627: $value .= $sec;
4628: }
4629: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4630: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4631: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4632: }
4633: } else {
4634: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4635: }
1.474 raeburn 4636: }
4637: }
1.51 www 4638: }
4639: }
1.474 raeburn 4640: return %courses;
1.51 www 4641: }
1.37 matthew 4642:
1.54 www 4643: ###############################################
1.474 raeburn 4644:
4645: sub blockcheck {
1.1189 raeburn 4646: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4647:
1.1189 raeburn 4648: if (defined($udom) && defined($uname)) {
4649: # If uname and udom are for a course, check for blocks in the course.
4650: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4651: my ($startblock,$endblock,$triggerblock) =
4652: &get_blocks($setters,$activity,$udom,$uname,$url);
4653: return ($startblock,$endblock,$triggerblock);
4654: }
4655: } else {
1.490 raeburn 4656: $udom = $env{'user.domain'};
4657: $uname = $env{'user.name'};
4658: }
4659:
1.502 raeburn 4660: my $startblock = 0;
4661: my $endblock = 0;
1.1062 raeburn 4662: my $triggerblock = '';
1.482 raeburn 4663: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4664:
1.490 raeburn 4665: # If uname is for a user, and activity is course-specific, i.e.,
4666: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4667:
1.490 raeburn 4668: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4669: $activity eq 'groups' || $activity eq 'printout') &&
4670: ($env{'request.course.id'})) {
1.490 raeburn 4671: foreach my $key (keys(%live_courses)) {
4672: if ($key ne $env{'request.course.id'}) {
4673: delete($live_courses{$key});
4674: }
4675: }
4676: }
4677:
4678: my $otheruser = 0;
4679: my %own_courses;
4680: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4681: # Resource belongs to user other than current user.
4682: $otheruser = 1;
4683: # Gather courses for current user
4684: %own_courses =
4685: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4686: }
4687:
4688: # Gather active course roles - course coordinator, instructor,
4689: # exam proctor, ta, student, or custom role.
1.474 raeburn 4690:
4691: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4692: my ($cdom,$cnum);
4693: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4694: $cdom = $env{'course.'.$course.'.domain'};
4695: $cnum = $env{'course.'.$course.'.num'};
4696: } else {
1.490 raeburn 4697: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4698: }
4699: my $no_ownblock = 0;
4700: my $no_userblock = 0;
1.533 raeburn 4701: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4702: # Check if current user has 'evb' priv for this
4703: if (defined($own_courses{$course})) {
4704: foreach my $sec (keys(%{$own_courses{$course}})) {
4705: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4706: if ($sec ne 'none') {
4707: $checkrole .= '/'.$sec;
4708: }
4709: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4710: $no_ownblock = 1;
4711: last;
4712: }
4713: }
4714: }
4715: # if they have 'evb' priv and are currently not playing student
4716: next if (($no_ownblock) &&
4717: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4718: }
1.474 raeburn 4719: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4720: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4721: if ($sec ne 'none') {
1.482 raeburn 4722: $checkrole .= '/'.$sec;
1.474 raeburn 4723: }
1.490 raeburn 4724: if ($otheruser) {
4725: # Resource belongs to user other than current user.
4726: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4727: my (%allroles,%userroles);
4728: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4729: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4730: my ($trole,$tdom,$tnum,$tsec);
4731: if ($entry =~ /^cr/) {
4732: ($trole,$tdom,$tnum,$tsec) =
4733: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4734: } else {
4735: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4736: }
4737: my ($spec,$area,$trest);
4738: $area = '/'.$tdom.'/'.$tnum;
4739: $trest = $tnum;
4740: if ($tsec ne '') {
4741: $area .= '/'.$tsec;
4742: $trest .= '/'.$tsec;
4743: }
4744: $spec = $trole.'.'.$area;
4745: if ($trole =~ /^cr/) {
4746: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4747: $tdom,$spec,$trest,$area);
4748: } else {
4749: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4750: $tdom,$spec,$trest,$area);
4751: }
4752: }
4753: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4754: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4755: if ($1) {
4756: $no_userblock = 1;
4757: last;
4758: }
1.486 raeburn 4759: }
4760: }
1.490 raeburn 4761: } else {
4762: # Resource belongs to current user
4763: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4764: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4765: $no_ownblock = 1;
4766: last;
4767: }
1.474 raeburn 4768: }
4769: }
4770: # if they have the evb priv and are currently not playing student
1.482 raeburn 4771: next if (($no_ownblock) &&
1.491 albertel 4772: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4773: next if ($no_userblock);
1.474 raeburn 4774:
1.866 kalberla 4775: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4776: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4777:
1.1062 raeburn 4778: my ($start,$end,$trigger) =
4779: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4780: if (($start != 0) &&
4781: (($startblock == 0) || ($startblock > $start))) {
4782: $startblock = $start;
1.1062 raeburn 4783: if ($trigger ne '') {
4784: $triggerblock = $trigger;
4785: }
1.502 raeburn 4786: }
4787: if (($end != 0) &&
4788: (($endblock == 0) || ($endblock < $end))) {
4789: $endblock = $end;
1.1062 raeburn 4790: if ($trigger ne '') {
4791: $triggerblock = $trigger;
4792: }
1.502 raeburn 4793: }
1.490 raeburn 4794: }
1.1062 raeburn 4795: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4796: }
4797:
4798: sub get_blocks {
1.1062 raeburn 4799: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4800: my $startblock = 0;
4801: my $endblock = 0;
1.1062 raeburn 4802: my $triggerblock = '';
1.490 raeburn 4803: my $course = $cdom.'_'.$cnum;
4804: $setters->{$course} = {};
4805: $setters->{$course}{'staff'} = [];
4806: $setters->{$course}{'times'} = [];
1.1062 raeburn 4807: $setters->{$course}{'triggers'} = [];
4808: my (@blockers,%triggered);
4809: my $now = time;
4810: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4811: if ($activity eq 'docs') {
4812: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4813: foreach my $block (@blockers) {
4814: if ($block =~ /^firstaccess____(.+)$/) {
4815: my $item = $1;
4816: my $type = 'map';
4817: my $timersymb = $item;
4818: if ($item eq 'course') {
4819: $type = 'course';
4820: } elsif ($item =~ /___\d+___/) {
4821: $type = 'resource';
4822: } else {
4823: $timersymb = &Apache::lonnet::symbread($item);
4824: }
4825: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4826: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4827: $triggered{$block} = {
4828: start => $start,
4829: end => $end,
4830: type => $type,
4831: };
4832: }
4833: }
4834: } else {
4835: foreach my $block (keys(%commblocks)) {
4836: if ($block =~ m/^(\d+)____(\d+)$/) {
4837: my ($start,$end) = ($1,$2);
4838: if ($start <= time && $end >= time) {
4839: if (ref($commblocks{$block}) eq 'HASH') {
4840: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4841: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4842: unless(grep(/^\Q$block\E$/,@blockers)) {
4843: push(@blockers,$block);
4844: }
4845: }
4846: }
4847: }
4848: }
4849: } elsif ($block =~ /^firstaccess____(.+)$/) {
4850: my $item = $1;
4851: my $timersymb = $item;
4852: my $type = 'map';
4853: if ($item eq 'course') {
4854: $type = 'course';
4855: } elsif ($item =~ /___\d+___/) {
4856: $type = 'resource';
4857: } else {
4858: $timersymb = &Apache::lonnet::symbread($item);
4859: }
4860: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4861: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4862: if ($start && $end) {
4863: if (($start <= time) && ($end >= time)) {
4864: unless (grep(/^\Q$block\E$/,@blockers)) {
4865: push(@blockers,$block);
4866: $triggered{$block} = {
4867: start => $start,
4868: end => $end,
4869: type => $type,
4870: };
4871: }
4872: }
1.490 raeburn 4873: }
1.1062 raeburn 4874: }
4875: }
4876: }
4877: foreach my $blocker (@blockers) {
4878: my ($staff_name,$staff_dom,$title,$blocks) =
4879: &parse_block_record($commblocks{$blocker});
4880: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4881: my ($start,$end,$triggertype);
4882: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4883: ($start,$end) = ($1,$2);
4884: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4885: $start = $triggered{$blocker}{'start'};
4886: $end = $triggered{$blocker}{'end'};
4887: $triggertype = $triggered{$blocker}{'type'};
4888: }
4889: if ($start) {
4890: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4891: if ($triggertype) {
4892: push(@{$$setters{$course}{'triggers'}},$triggertype);
4893: } else {
4894: push(@{$$setters{$course}{'triggers'}},0);
4895: }
4896: if ( ($startblock == 0) || ($startblock > $start) ) {
4897: $startblock = $start;
4898: if ($triggertype) {
4899: $triggerblock = $blocker;
1.474 raeburn 4900: }
4901: }
1.1062 raeburn 4902: if ( ($endblock == 0) || ($endblock < $end) ) {
4903: $endblock = $end;
4904: if ($triggertype) {
4905: $triggerblock = $blocker;
4906: }
4907: }
1.474 raeburn 4908: }
4909: }
1.1062 raeburn 4910: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4911: }
4912:
4913: sub parse_block_record {
4914: my ($record) = @_;
4915: my ($setuname,$setudom,$title,$blocks);
4916: if (ref($record) eq 'HASH') {
4917: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4918: $title = &unescape($record->{'event'});
4919: $blocks = $record->{'blocks'};
4920: } else {
4921: my @data = split(/:/,$record,3);
4922: if (scalar(@data) eq 2) {
4923: $title = $data[1];
4924: ($setuname,$setudom) = split(/@/,$data[0]);
4925: } else {
4926: ($setuname,$setudom,$title) = @data;
4927: }
4928: $blocks = { 'com' => 'on' };
4929: }
4930: return ($setuname,$setudom,$title,$blocks);
4931: }
4932:
1.854 kalberla 4933: sub blocking_status {
1.1189 raeburn 4934: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4935: my %setters;
1.890 droeschl 4936:
1.1061 raeburn 4937: # check for active blocking
1.1062 raeburn 4938: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4939: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4940: my $blocked = 0;
4941: if ($startblock && $endblock) {
4942: $blocked = 1;
4943: }
1.890 droeschl 4944:
1.1061 raeburn 4945: # caller just wants to know whether a block is active
4946: if (!wantarray) { return $blocked; }
4947:
4948: # build a link to a popup window containing the details
4949: my $querystring = "?activity=$activity";
4950: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4951: if ($activity eq 'port') {
4952: $querystring .= "&udom=$udom" if $udom;
4953: $querystring .= "&uname=$uname" if $uname;
4954: } elsif ($activity eq 'docs') {
4955: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4956: }
1.1061 raeburn 4957:
4958: my $output .= <<'END_MYBLOCK';
4959: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4960: var options = "width=" + w + ",height=" + h + ",";
4961: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4962: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4963: var newWin = window.open(url, wdwName, options);
4964: newWin.focus();
4965: }
1.890 droeschl 4966: END_MYBLOCK
1.854 kalberla 4967:
1.1061 raeburn 4968: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4969:
1.1061 raeburn 4970: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4971: my $text = &mt('Communication Blocked');
1.1217 raeburn 4972: my $class = 'LC_comblock';
1.1062 raeburn 4973: if ($activity eq 'docs') {
4974: $text = &mt('Content Access Blocked');
1.1217 raeburn 4975: $class = '';
1.1063 raeburn 4976: } elsif ($activity eq 'printout') {
4977: $text = &mt('Printing Blocked');
1.1062 raeburn 4978: }
1.1061 raeburn 4979: $output .= <<"END_BLOCK";
1.1217 raeburn 4980: <div class='$class'>
1.869 kalberla 4981: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4982: title='$text'>
4983: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4984: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4985: title='$text'>$text</a>
1.867 kalberla 4986: </div>
4987:
4988: END_BLOCK
1.474 raeburn 4989:
1.1061 raeburn 4990: return ($blocked, $output);
1.854 kalberla 4991: }
1.490 raeburn 4992:
1.60 matthew 4993: ###############################################
4994:
1.682 raeburn 4995: sub check_ip_acc {
1.1201 raeburn 4996: my ($acc,$clientip)=@_;
1.682 raeburn 4997: &Apache::lonxml::debug("acc is $acc");
4998: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4999: return 1;
5000: }
1.1219 ! raeburn 5001: my $allowed;
1.1201 raeburn 5002: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682 raeburn 5003:
5004: my $name;
1.1219 ! raeburn 5005: my %access = (
! 5006: allowfrom => 1,
! 5007: denyfrom => 0,
! 5008: );
! 5009: my @allows;
! 5010: my @denies;
! 5011: foreach my $item (split(',',$acc)) {
! 5012: $item =~ s/^\s*//;
! 5013: $item =~ s/\s*$//;
! 5014: my $pattern;
! 5015: if ($item =~ /^\!(.+)$/) {
! 5016: push(@denies,$1);
! 5017: } else {
! 5018: push(@allows,$item);
! 5019: }
! 5020: }
! 5021: my $numdenies = scalar(@denies);
! 5022: my $numallows = scalar(@allows);
! 5023: my $count = 0;
! 5024: foreach my $pattern (@denies,@allows) {
! 5025: $count ++;
! 5026: my $acctype = 'allowfrom';
! 5027: if ($count <= $numdenies) {
! 5028: $acctype = 'denyfrom';
! 5029: }
1.682 raeburn 5030: if ($pattern =~ /\*$/) {
5031: #35.8.*
5032: $pattern=~s/\*//;
1.1219 ! raeburn 5033: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5034: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5035: #35.8.3.[34-56]
5036: my $low=$2;
5037: my $high=$3;
5038: $pattern=$1;
5039: if ($ip =~ /^\Q$pattern\E/) {
5040: my $last=(split(/\./,$ip))[3];
1.1219 ! raeburn 5041: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5042: }
5043: } elsif ($pattern =~ /^\*/) {
5044: #*.msu.edu
5045: $pattern=~s/\*//;
5046: if (!defined($name)) {
5047: use Socket;
5048: my $netaddr=inet_aton($ip);
5049: ($name)=gethostbyaddr($netaddr,AF_INET);
5050: }
1.1219 ! raeburn 5051: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5052: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5053: #127.0.0.1
1.1219 ! raeburn 5054: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5055: } else {
5056: #some.name.com
5057: if (!defined($name)) {
5058: use Socket;
5059: my $netaddr=inet_aton($ip);
5060: ($name)=gethostbyaddr($netaddr,AF_INET);
5061: }
1.1219 ! raeburn 5062: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
! 5063: }
! 5064: if ($allowed =~ /^(0|1)$/) { last; }
! 5065: }
! 5066: if ($allowed eq '') {
! 5067: if ($numdenies && !$numallows) {
! 5068: $allowed = 1;
! 5069: } else {
! 5070: $allowed = 0;
1.682 raeburn 5071: }
5072: }
5073: return $allowed;
5074: }
5075:
5076: ###############################################
5077:
1.60 matthew 5078: =pod
5079:
1.112 bowersj2 5080: =head1 Domain Template Functions
5081:
5082: =over 4
5083:
5084: =item * &determinedomain()
1.60 matthew 5085:
5086: Inputs: $domain (usually will be undef)
5087:
1.63 www 5088: Returns: Determines which domain should be used for designs
1.60 matthew 5089:
5090: =cut
1.54 www 5091:
1.60 matthew 5092: ###############################################
1.63 www 5093: sub determinedomain {
5094: my $domain=shift;
1.531 albertel 5095: if (! $domain) {
1.60 matthew 5096: # Determine domain if we have not been given one
1.893 raeburn 5097: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5098: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5099: if ($env{'request.role.domain'}) {
5100: $domain=$env{'request.role.domain'};
1.60 matthew 5101: }
5102: }
1.63 www 5103: return $domain;
5104: }
5105: ###############################################
1.517 raeburn 5106:
1.518 albertel 5107: sub devalidate_domconfig_cache {
5108: my ($udom)=@_;
5109: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5110: }
5111:
5112: # ---------------------- Get domain configuration for a domain
5113: sub get_domainconf {
5114: my ($udom) = @_;
5115: my $cachetime=1800;
5116: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5117: if (defined($cached)) { return %{$result}; }
5118:
5119: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5120: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5121: my (%designhash,%legacy);
1.518 albertel 5122: if (keys(%domconfig) > 0) {
5123: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5124: if (keys(%{$domconfig{'login'}})) {
5125: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5126: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5127: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5128: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5129: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5130: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5131: if ($key eq 'loginvia') {
5132: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5133: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5134: $designhash{$udom.'.login.loginvia'} = $server;
5135: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5136:
5137: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5138: } else {
5139: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5140: }
1.948 raeburn 5141: }
1.1208 raeburn 5142: } elsif ($key eq 'headtag') {
5143: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5144: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5145: }
1.946 raeburn 5146: }
1.1208 raeburn 5147: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5148: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5149: }
1.946 raeburn 5150: }
5151: }
5152: }
5153: } else {
5154: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5155: $designhash{$udom.'.login.'.$key.'_'.$img} =
5156: $domconfig{'login'}{$key}{$img};
5157: }
1.699 raeburn 5158: }
5159: } else {
5160: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5161: }
1.632 raeburn 5162: }
5163: } else {
5164: $legacy{'login'} = 1;
1.518 albertel 5165: }
1.632 raeburn 5166: } else {
5167: $legacy{'login'} = 1;
1.518 albertel 5168: }
5169: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5170: if (keys(%{$domconfig{'rolecolors'}})) {
5171: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5172: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5173: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5174: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5175: }
1.518 albertel 5176: }
5177: }
1.632 raeburn 5178: } else {
5179: $legacy{'rolecolors'} = 1;
1.518 albertel 5180: }
1.632 raeburn 5181: } else {
5182: $legacy{'rolecolors'} = 1;
1.518 albertel 5183: }
1.948 raeburn 5184: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5185: if ($domconfig{'autoenroll'}{'co-owners'}) {
5186: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5187: }
5188: }
1.632 raeburn 5189: if (keys(%legacy) > 0) {
5190: my %legacyhash = &get_legacy_domconf($udom);
5191: foreach my $item (keys(%legacyhash)) {
5192: if ($item =~ /^\Q$udom\E\.login/) {
5193: if ($legacy{'login'}) {
5194: $designhash{$item} = $legacyhash{$item};
5195: }
5196: } else {
5197: if ($legacy{'rolecolors'}) {
5198: $designhash{$item} = $legacyhash{$item};
5199: }
1.518 albertel 5200: }
5201: }
5202: }
1.632 raeburn 5203: } else {
5204: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5205: }
5206: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5207: $cachetime);
5208: return %designhash;
5209: }
5210:
1.632 raeburn 5211: sub get_legacy_domconf {
5212: my ($udom) = @_;
5213: my %legacyhash;
5214: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5215: my $designfile = $designdir.'/'.$udom.'.tab';
5216: if (-e $designfile) {
5217: if ( open (my $fh,"<$designfile") ) {
5218: while (my $line = <$fh>) {
5219: next if ($line =~ /^\#/);
5220: chomp($line);
5221: my ($key,$val)=(split(/\=/,$line));
5222: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5223: }
5224: close($fh);
5225: }
5226: }
1.1026 raeburn 5227: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5228: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5229: }
5230: return %legacyhash;
5231: }
5232:
1.63 www 5233: =pod
5234:
1.112 bowersj2 5235: =item * &domainlogo()
1.63 www 5236:
5237: Inputs: $domain (usually will be undef)
5238:
5239: Returns: A link to a domain logo, if the domain logo exists.
5240: If the domain logo does not exist, a description of the domain.
5241:
5242: =cut
1.112 bowersj2 5243:
1.63 www 5244: ###############################################
5245: sub domainlogo {
1.517 raeburn 5246: my $domain = &determinedomain(shift);
1.518 albertel 5247: my %designhash = &get_domainconf($domain);
1.517 raeburn 5248: # See if there is a logo
5249: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5250: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5251: if ($imgsrc =~ m{^/(adm|res)/}) {
5252: if ($imgsrc =~ m{^/res/}) {
5253: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5254: &Apache::lonnet::repcopy($local_name);
5255: }
5256: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5257: }
5258: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5259: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5260: return &Apache::lonnet::domain($domain,'description');
1.59 www 5261: } else {
1.60 matthew 5262: return '';
1.59 www 5263: }
5264: }
1.63 www 5265: ##############################################
5266:
5267: =pod
5268:
1.112 bowersj2 5269: =item * &designparm()
1.63 www 5270:
5271: Inputs: $which parameter; $domain (usually will be undef)
5272:
5273: Returns: value of designparamter $which
5274:
5275: =cut
1.112 bowersj2 5276:
1.397 albertel 5277:
1.400 albertel 5278: ##############################################
1.397 albertel 5279: sub designparm {
5280: my ($which,$domain)=@_;
5281: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5282: return $env{'environment.color.'.$which};
1.96 www 5283: }
1.63 www 5284: $domain=&determinedomain($domain);
1.1016 raeburn 5285: my %domdesign;
5286: unless ($domain eq 'public') {
5287: %domdesign = &get_domainconf($domain);
5288: }
1.520 raeburn 5289: my $output;
1.517 raeburn 5290: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5291: $output = $domdesign{$domain.'.'.$which};
1.63 www 5292: } else {
1.520 raeburn 5293: $output = $defaultdesign{$which};
5294: }
5295: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5296: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5297: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5298: if ($output =~ m{^/res/}) {
5299: my $local_name = &Apache::lonnet::filelocation('',$output);
5300: &Apache::lonnet::repcopy($local_name);
5301: }
1.520 raeburn 5302: $output = &lonhttpdurl($output);
5303: }
1.63 www 5304: }
1.520 raeburn 5305: return $output;
1.63 www 5306: }
1.59 www 5307:
1.822 bisitz 5308: ##############################################
5309: =pod
5310:
1.832 bisitz 5311: =item * &authorspace()
5312:
1.1028 raeburn 5313: Inputs: $url (usually will be undef).
1.832 bisitz 5314:
1.1132 raeburn 5315: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5316: directory being viewed (or for which action is being taken).
5317: If $url is provided, and begins /priv/<domain>/<uname>
5318: the path will be that portion of the $context argument.
5319: Otherwise the path will be for the author space of the current
5320: user when the current role is author, or for that of the
5321: co-author/assistant co-author space when the current role
5322: is co-author or assistant co-author.
1.832 bisitz 5323:
5324: =cut
5325:
5326: sub authorspace {
1.1028 raeburn 5327: my ($url) = @_;
5328: if ($url ne '') {
5329: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5330: return $1;
5331: }
5332: }
1.832 bisitz 5333: my $caname = '';
1.1024 www 5334: my $cadom = '';
1.1028 raeburn 5335: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5336: ($cadom,$caname) =
1.832 bisitz 5337: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5338: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5339: $caname = $env{'user.name'};
1.1024 www 5340: $cadom = $env{'user.domain'};
1.832 bisitz 5341: }
1.1028 raeburn 5342: if (($caname ne '') && ($cadom ne '')) {
5343: return "/priv/$cadom/$caname/";
5344: }
5345: return;
1.832 bisitz 5346: }
5347:
5348: ##############################################
5349: =pod
5350:
1.822 bisitz 5351: =item * &head_subbox()
5352:
5353: Inputs: $content (contains HTML code with page functions, etc.)
5354:
5355: Returns: HTML div with $content
5356: To be included in page header
5357:
5358: =cut
5359:
5360: sub head_subbox {
5361: my ($content)=@_;
5362: my $output =
1.993 raeburn 5363: '<div class="LC_head_subbox">'
1.822 bisitz 5364: .$content
5365: .'</div>'
5366: }
5367:
5368: ##############################################
5369: =pod
5370:
5371: =item * &CSTR_pageheader()
5372:
1.1026 raeburn 5373: Input: (optional) filename from which breadcrumb trail is built.
5374: In most cases no input as needed, as $env{'request.filename'}
5375: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5376:
5377: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5378: To be included on Authoring Space pages
1.822 bisitz 5379:
5380: =cut
5381:
5382: sub CSTR_pageheader {
1.1026 raeburn 5383: my ($trailfile) = @_;
5384: if ($trailfile eq '') {
5385: $trailfile = $env{'request.filename'};
5386: }
5387:
5388: # this is for resources; directories have customtitle, and crumbs
5389: # and select recent are created in lonpubdir.pm
5390:
5391: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5392: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5393: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5394: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5395: $formaction =~ s{/+}{/}g;
1.822 bisitz 5396:
5397: my $parentpath = '';
5398: my $lastitem = '';
5399: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5400: $parentpath = $1;
5401: $lastitem = $2;
5402: } else {
5403: $lastitem = $thisdisfn;
5404: }
1.921 bisitz 5405:
5406: my $output =
1.822 bisitz 5407: '<div>'
5408: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5409: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5410: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5411: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5412: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5413:
5414: if ($lastitem) {
5415: $output .=
5416: '<span class="LC_filename">'
5417: .$lastitem
5418: .'</span>';
5419: }
5420: $output .=
5421: '<br />'
1.822 bisitz 5422: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5423: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5424: .'</form>'
5425: .&Apache::lonmenu::constspaceform()
5426: .'</div>';
1.921 bisitz 5427:
5428: return $output;
1.822 bisitz 5429: }
5430:
1.60 matthew 5431: ###############################################
5432: ###############################################
5433:
5434: =pod
5435:
1.112 bowersj2 5436: =back
5437:
1.549 albertel 5438: =head1 HTML Helpers
1.112 bowersj2 5439:
5440: =over 4
5441:
5442: =item * &bodytag()
1.60 matthew 5443:
5444: Returns a uniform header for LON-CAPA web pages.
5445:
5446: Inputs:
5447:
1.112 bowersj2 5448: =over 4
5449:
5450: =item * $title, A title to be displayed on the page.
5451:
5452: =item * $function, the current role (can be undef).
5453:
5454: =item * $addentries, extra parameters for the <body> tag.
5455:
5456: =item * $bodyonly, if defined, only return the <body> tag.
5457:
5458: =item * $domain, if defined, force a given domain.
5459:
5460: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5461: text interface only)
1.60 matthew 5462:
1.814 bisitz 5463: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5464: navigational links
1.317 albertel 5465:
1.338 albertel 5466: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5467:
1.460 albertel 5468: =item * $args, optional argument valid values are
5469: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5470: inherit_jsmath -> when creating popup window in a page,
5471: should it have jsmath forced on by the
5472: current page
1.460 albertel 5473:
1.1096 raeburn 5474: =item * $advtoolsref, optional argument, ref to an array containing
5475: inlineremote items to be added in "Functions" menu below
5476: breadcrumbs.
5477:
1.112 bowersj2 5478: =back
5479:
1.60 matthew 5480: Returns: A uniform header for LON-CAPA web pages.
5481: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5482: If $bodyonly is undef or zero, an html string containing a <body> tag and
5483: other decorations will be returned.
5484:
5485: =cut
5486:
1.54 www 5487: sub bodytag {
1.831 bisitz 5488: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5489: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5490:
1.954 raeburn 5491: my $public;
5492: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5493: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5494: $public = 1;
5495: }
1.460 albertel 5496: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5497: my $httphost = $args->{'use_absolute'};
1.339 albertel 5498:
1.183 matthew 5499: $function = &get_users_function() if (!$function);
1.339 albertel 5500: my $img = &designparm($function.'.img',$domain);
5501: my $font = &designparm($function.'.font',$domain);
5502: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5503:
1.803 bisitz 5504: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5505: 'bgcolor' => $pgbg,
1.339 albertel 5506: 'text' => $font,
5507: 'alink' => &designparm($function.'.alink',$domain),
5508: 'vlink' => &designparm($function.'.vlink',$domain),
5509: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5510: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5511:
1.63 www 5512: # role and realm
1.1178 raeburn 5513: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5514: if ($realm) {
5515: $realm = '/'.$realm;
5516: }
1.378 raeburn 5517: if ($role eq 'ca') {
1.479 albertel 5518: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5519: $realm = &plainname($rname,$rdom);
1.378 raeburn 5520: }
1.55 www 5521: # realm
1.258 albertel 5522: if ($env{'request.course.id'}) {
1.378 raeburn 5523: if ($env{'request.role'} !~ /^cr/) {
5524: $role = &Apache::lonnet::plaintext($role,&course_type());
5525: }
1.898 raeburn 5526: if ($env{'request.course.sec'}) {
5527: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5528: }
1.359 albertel 5529: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5530: } else {
5531: $role = &Apache::lonnet::plaintext($role);
1.54 www 5532: }
1.433 albertel 5533:
1.359 albertel 5534: if (!$realm) { $realm=' '; }
1.330 albertel 5535:
1.438 albertel 5536: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5537:
1.101 www 5538: # construct main body tag
1.359 albertel 5539: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5540: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5541:
1.1131 raeburn 5542: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5543:
1.1130 raeburn 5544: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5545: return $bodytag;
1.1130 raeburn 5546: }
1.359 albertel 5547:
1.954 raeburn 5548: if ($public) {
1.433 albertel 5549: undef($role);
5550: }
1.359 albertel 5551:
1.762 bisitz 5552: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5553: #
5554: # Extra info if you are the DC
5555: my $dc_info = '';
5556: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5557: $env{'course.'.$env{'request.course.id'}.
5558: '.domain'}.'/'})) {
5559: my $cid = $env{'request.course.id'};
1.917 raeburn 5560: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5561: $dc_info =~ s/\s+$//;
1.359 albertel 5562: }
5563:
1.898 raeburn 5564: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5565:
1.903 droeschl 5566: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5567:
5568: # if ($env{'request.state'} eq 'construct') {
5569: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5570: # }
5571:
1.1130 raeburn 5572: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5573: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5574:
1.1130 raeburn 5575: my ($left,$right) = Apache::lonmenu::primary_menu();
1.359 albertel 5576:
1.916 droeschl 5577: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5578: if ($dc_info) {
5579: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5580: }
1.1130 raeburn 5581: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5582: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5583: return $bodytag;
5584: }
1.894 droeschl 5585:
1.927 raeburn 5586: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5587: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5588: }
1.916 droeschl 5589:
1.1130 raeburn 5590: $bodytag .= $right;
1.852 droeschl 5591:
1.917 raeburn 5592: if ($dc_info) {
5593: $dc_info = &dc_courseid_toggle($dc_info);
5594: }
5595: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5596:
1.1169 raeburn 5597: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5598: if ($args->{'no_secondary_menu'}) {
5599: return $bodytag;
5600: }
1.1169 raeburn 5601: #don't show menus for public users
1.954 raeburn 5602: if (!$public){
1.1154 raeburn 5603: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5604: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5605: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5606: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5607: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5608: $args->{'bread_crumbs'});
1.1096 raeburn 5609: } elsif ($forcereg) {
5610: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5611: $args->{'group'});
5612: } else {
5613: $bodytag .=
5614: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5615: $forcereg,$args->{'group'},
5616: $args->{'bread_crumbs'},
5617: $advtoolsref);
1.920 raeburn 5618: }
1.903 droeschl 5619: }else{
5620: # this is to seperate menu from content when there's no secondary
5621: # menu. Especially needed for public accessible ressources.
5622: $bodytag .= '<hr style="clear:both" />';
5623: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5624: }
1.903 droeschl 5625:
1.235 raeburn 5626: return $bodytag;
1.182 matthew 5627: }
5628:
1.917 raeburn 5629: sub dc_courseid_toggle {
5630: my ($dc_info) = @_;
1.980 raeburn 5631: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5632: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5633: &mt('(More ...)').'</a></span>'.
5634: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5635: }
5636:
1.330 albertel 5637: sub make_attr_string {
5638: my ($register,$attr_ref) = @_;
5639:
5640: if ($attr_ref && !ref($attr_ref)) {
5641: die("addentries Must be a hash ref ".
5642: join(':',caller(1))." ".
5643: join(':',caller(0))." ");
5644: }
5645:
5646: if ($register) {
1.339 albertel 5647: my ($on_load,$on_unload);
5648: foreach my $key (keys(%{$attr_ref})) {
5649: if (lc($key) eq 'onload') {
5650: $on_load.=$attr_ref->{$key}.';';
5651: delete($attr_ref->{$key});
5652:
5653: } elsif (lc($key) eq 'onunload') {
5654: $on_unload.=$attr_ref->{$key}.';';
5655: delete($attr_ref->{$key});
5656: }
5657: }
1.953 droeschl 5658: $attr_ref->{'onload'} = $on_load;
5659: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5660: }
1.339 albertel 5661:
1.330 albertel 5662: my $attr_string;
1.1159 raeburn 5663: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5664: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5665: }
5666: return $attr_string;
5667: }
5668:
5669:
1.182 matthew 5670: ###############################################
1.251 albertel 5671: ###############################################
5672:
5673: =pod
5674:
5675: =item * &endbodytag()
5676:
5677: Returns a uniform footer for LON-CAPA web pages.
5678:
1.635 raeburn 5679: Inputs: 1 - optional reference to an args hash
5680: If in the hash, key for noredirectlink has a value which evaluates to true,
5681: a 'Continue' link is not displayed if the page contains an
5682: internal redirect in the <head></head> section,
5683: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5684:
5685: =cut
5686:
5687: sub endbodytag {
1.635 raeburn 5688: my ($args) = @_;
1.1080 raeburn 5689: my $endbodytag;
5690: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5691: $endbodytag='</body>';
5692: }
1.269 albertel 5693: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5694: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5695: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5696: $endbodytag=
5697: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5698: &mt('Continue').'</a>'.
5699: $endbodytag;
5700: }
1.315 albertel 5701: }
1.251 albertel 5702: return $endbodytag;
5703: }
5704:
1.352 albertel 5705: =pod
5706:
5707: =item * &standard_css()
5708:
5709: Returns a style sheet
5710:
5711: Inputs: (all optional)
5712: domain -> force to color decorate a page for a specific
5713: domain
5714: function -> force usage of a specific rolish color scheme
5715: bgcolor -> override the default page bgcolor
5716:
5717: =cut
5718:
1.343 albertel 5719: sub standard_css {
1.345 albertel 5720: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5721: $function = &get_users_function() if (!$function);
5722: my $img = &designparm($function.'.img', $domain);
5723: my $tabbg = &designparm($function.'.tabbg', $domain);
5724: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5725: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5726: #second colour for later usage
1.345 albertel 5727: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5728: my $pgbg_or_bgcolor =
5729: $bgcolor ||
1.352 albertel 5730: &designparm($function.'.pgbg', $domain);
1.382 albertel 5731: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5732: my $alink = &designparm($function.'.alink', $domain);
5733: my $vlink = &designparm($function.'.vlink', $domain);
5734: my $link = &designparm($function.'.link', $domain);
5735:
1.602 albertel 5736: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5737: my $mono = 'monospace';
1.850 bisitz 5738: my $data_table_head = $sidebg;
5739: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5740: my $data_table_dark = '#E0E0E0';
1.470 banghart 5741: my $data_table_darker = '#CCCCCC';
1.349 albertel 5742: my $data_table_highlight = '#FFFF00';
1.352 albertel 5743: my $mail_new = '#FFBB77';
5744: my $mail_new_hover = '#DD9955';
5745: my $mail_read = '#BBBB77';
5746: my $mail_read_hover = '#999944';
5747: my $mail_replied = '#AAAA88';
5748: my $mail_replied_hover = '#888855';
5749: my $mail_other = '#99BBBB';
5750: my $mail_other_hover = '#669999';
1.391 albertel 5751: my $table_header = '#DDDDDD';
1.489 raeburn 5752: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5753: my $lg_border_color = '#C8C8C8';
1.952 onken 5754: my $button_hover = '#BF2317';
1.392 albertel 5755:
1.608 albertel 5756: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5757: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5758: : '0 3px 0 4px';
1.448 albertel 5759:
1.523 albertel 5760:
1.343 albertel 5761: return <<END;
1.947 droeschl 5762:
5763: /* needed for iframe to allow 100% height in FF */
5764: body, html {
5765: margin: 0;
5766: padding: 0 0.5%;
5767: height: 99%; /* to avoid scrollbars */
5768: }
5769:
1.795 www 5770: body {
1.911 bisitz 5771: font-family: $sans;
5772: line-height:130%;
5773: font-size:0.83em;
5774: color:$font;
1.795 www 5775: }
5776:
1.959 onken 5777: a:focus,
5778: a:focus img {
1.795 www 5779: color: red;
5780: }
1.698 harmsja 5781:
1.911 bisitz 5782: form, .inline {
5783: display: inline;
1.795 www 5784: }
1.721 harmsja 5785:
1.795 www 5786: .LC_right {
1.911 bisitz 5787: text-align:right;
1.795 www 5788: }
5789:
5790: .LC_middle {
1.911 bisitz 5791: vertical-align:middle;
1.795 www 5792: }
1.721 harmsja 5793:
1.1130 raeburn 5794: .LC_floatleft {
5795: float: left;
5796: }
5797:
5798: .LC_floatright {
5799: float: right;
5800: }
5801:
1.911 bisitz 5802: .LC_400Box {
5803: width:400px;
5804: }
1.721 harmsja 5805:
1.947 droeschl 5806: .LC_iframecontainer {
5807: width: 98%;
5808: margin: 0;
5809: position: fixed;
5810: top: 8.5em;
5811: bottom: 0;
5812: }
5813:
5814: .LC_iframecontainer iframe{
5815: border: none;
5816: width: 100%;
5817: height: 100%;
5818: }
5819:
1.778 bisitz 5820: .LC_filename {
5821: font-family: $mono;
5822: white-space:pre;
1.921 bisitz 5823: font-size: 120%;
1.778 bisitz 5824: }
5825:
5826: .LC_fileicon {
5827: border: none;
5828: height: 1.3em;
5829: vertical-align: text-bottom;
5830: margin-right: 0.3em;
5831: text-decoration:none;
5832: }
5833:
1.1008 www 5834: .LC_setting {
5835: text-decoration:underline;
5836: }
5837:
1.350 albertel 5838: .LC_error {
5839: color: red;
5840: }
1.795 www 5841:
1.1097 bisitz 5842: .LC_warning {
5843: color: darkorange;
5844: }
5845:
1.457 albertel 5846: .LC_diff_removed {
1.733 bisitz 5847: color: red;
1.394 albertel 5848: }
1.532 albertel 5849:
5850: .LC_info,
1.457 albertel 5851: .LC_success,
5852: .LC_diff_added {
1.350 albertel 5853: color: green;
5854: }
1.795 www 5855:
1.802 bisitz 5856: div.LC_confirm_box {
5857: background-color: #FAFAFA;
5858: border: 1px solid $lg_border_color;
5859: margin-right: 0;
5860: padding: 5px;
5861: }
5862:
5863: div.LC_confirm_box .LC_error img,
5864: div.LC_confirm_box .LC_success img {
5865: vertical-align: middle;
5866: }
5867:
1.440 albertel 5868: .LC_icon {
1.771 droeschl 5869: border: none;
1.790 droeschl 5870: vertical-align: middle;
1.771 droeschl 5871: }
5872:
1.543 albertel 5873: .LC_docs_spacer {
5874: width: 25px;
5875: height: 1px;
1.771 droeschl 5876: border: none;
1.543 albertel 5877: }
1.346 albertel 5878:
1.532 albertel 5879: .LC_internal_info {
1.735 bisitz 5880: color: #999999;
1.532 albertel 5881: }
5882:
1.794 www 5883: .LC_discussion {
1.1050 www 5884: background: $data_table_dark;
1.911 bisitz 5885: border: 1px solid black;
5886: margin: 2px;
1.794 www 5887: }
5888:
5889: .LC_disc_action_left {
1.1050 www 5890: background: $sidebg;
1.911 bisitz 5891: text-align: left;
1.1050 www 5892: padding: 4px;
5893: margin: 2px;
1.794 www 5894: }
5895:
5896: .LC_disc_action_right {
1.1050 www 5897: background: $sidebg;
1.911 bisitz 5898: text-align: right;
1.1050 www 5899: padding: 4px;
5900: margin: 2px;
1.794 www 5901: }
5902:
5903: .LC_disc_new_item {
1.911 bisitz 5904: background: white;
5905: border: 2px solid red;
1.1050 www 5906: margin: 4px;
5907: padding: 4px;
1.794 www 5908: }
5909:
5910: .LC_disc_old_item {
1.911 bisitz 5911: background: white;
1.1050 www 5912: margin: 4px;
5913: padding: 4px;
1.794 www 5914: }
5915:
1.458 albertel 5916: table.LC_pastsubmission {
5917: border: 1px solid black;
5918: margin: 2px;
5919: }
5920:
1.924 bisitz 5921: table#LC_menubuttons {
1.345 albertel 5922: width: 100%;
5923: background: $pgbg;
1.392 albertel 5924: border: 2px;
1.402 albertel 5925: border-collapse: separate;
1.803 bisitz 5926: padding: 0;
1.345 albertel 5927: }
1.392 albertel 5928:
1.801 tempelho 5929: table#LC_title_bar a {
5930: color: $fontmenu;
5931: }
1.836 bisitz 5932:
1.807 droeschl 5933: table#LC_title_bar {
1.819 tempelho 5934: clear: both;
1.836 bisitz 5935: display: none;
1.807 droeschl 5936: }
5937:
1.795 www 5938: table#LC_title_bar,
1.933 droeschl 5939: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5940: table#LC_title_bar.LC_with_remote {
1.359 albertel 5941: width: 100%;
1.392 albertel 5942: border-color: $pgbg;
5943: border-style: solid;
5944: border-width: $border;
1.379 albertel 5945: background: $pgbg;
1.801 tempelho 5946: color: $fontmenu;
1.392 albertel 5947: border-collapse: collapse;
1.803 bisitz 5948: padding: 0;
1.819 tempelho 5949: margin: 0;
1.359 albertel 5950: }
1.795 www 5951:
1.933 droeschl 5952: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5953: margin: 0;
5954: padding: 0;
1.933 droeschl 5955: position: relative;
5956: list-style: none;
1.913 droeschl 5957: }
1.933 droeschl 5958: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5959: display: inline;
5960: }
1.933 droeschl 5961:
5962: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5963: padding: 0;
1.933 droeschl 5964: margin: 0;
5965: float: left;
1.913 droeschl 5966: }
1.933 droeschl 5967: .LC_breadcrumb_tools_tools {
5968: padding: 0;
5969: margin: 0;
1.913 droeschl 5970: float: right;
5971: }
5972:
1.359 albertel 5973: table#LC_title_bar td {
5974: background: $tabbg;
5975: }
1.795 www 5976:
1.911 bisitz 5977: table#LC_menubuttons img {
1.803 bisitz 5978: border: none;
1.346 albertel 5979: }
1.795 www 5980:
1.842 droeschl 5981: .LC_breadcrumbs_component {
1.911 bisitz 5982: float: right;
5983: margin: 0 1em;
1.357 albertel 5984: }
1.842 droeschl 5985: .LC_breadcrumbs_component img {
1.911 bisitz 5986: vertical-align: middle;
1.777 tempelho 5987: }
1.795 www 5988:
1.383 albertel 5989: td.LC_table_cell_checkbox {
5990: text-align: center;
5991: }
1.795 www 5992:
5993: .LC_fontsize_small {
1.911 bisitz 5994: font-size: 70%;
1.705 tempelho 5995: }
5996:
1.844 bisitz 5997: #LC_breadcrumbs {
1.911 bisitz 5998: clear:both;
5999: background: $sidebg;
6000: border-bottom: 1px solid $lg_border_color;
6001: line-height: 2.5em;
1.933 droeschl 6002: overflow: hidden;
1.911 bisitz 6003: margin: 0;
6004: padding: 0;
1.995 raeburn 6005: text-align: left;
1.819 tempelho 6006: }
1.862 bisitz 6007:
1.1098 bisitz 6008: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6009: clear:both;
6010: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6011: border: 1px solid $sidebg;
1.1098 bisitz 6012: margin: 0 0 10px 0;
1.966 bisitz 6013: padding: 3px;
1.995 raeburn 6014: text-align: left;
1.822 bisitz 6015: }
6016:
1.795 www 6017: .LC_fontsize_medium {
1.911 bisitz 6018: font-size: 85%;
1.705 tempelho 6019: }
6020:
1.795 www 6021: .LC_fontsize_large {
1.911 bisitz 6022: font-size: 120%;
1.705 tempelho 6023: }
6024:
1.346 albertel 6025: .LC_menubuttons_inline_text {
6026: color: $font;
1.698 harmsja 6027: font-size: 90%;
1.701 harmsja 6028: padding-left:3px;
1.346 albertel 6029: }
6030:
1.934 droeschl 6031: .LC_menubuttons_inline_text img{
6032: vertical-align: middle;
6033: }
6034:
1.1051 www 6035: li.LC_menubuttons_inline_text img {
1.951 onken 6036: cursor:pointer;
1.1002 droeschl 6037: text-decoration: none;
1.951 onken 6038: }
6039:
1.526 www 6040: .LC_menubuttons_link {
6041: text-decoration: none;
6042: }
1.795 www 6043:
1.522 albertel 6044: .LC_menubuttons_category {
1.521 www 6045: color: $font;
1.526 www 6046: background: $pgbg;
1.521 www 6047: font-size: larger;
6048: font-weight: bold;
6049: }
6050:
1.346 albertel 6051: td.LC_menubuttons_text {
1.911 bisitz 6052: color: $font;
1.346 albertel 6053: }
1.706 harmsja 6054:
1.346 albertel 6055: .LC_current_location {
6056: background: $tabbg;
6057: }
1.795 www 6058:
1.938 bisitz 6059: table.LC_data_table {
1.347 albertel 6060: border: 1px solid #000000;
1.402 albertel 6061: border-collapse: separate;
1.426 albertel 6062: border-spacing: 1px;
1.610 albertel 6063: background: $pgbg;
1.347 albertel 6064: }
1.795 www 6065:
1.422 albertel 6066: .LC_data_table_dense {
6067: font-size: small;
6068: }
1.795 www 6069:
1.507 raeburn 6070: table.LC_nested_outer {
6071: border: 1px solid #000000;
1.589 raeburn 6072: border-collapse: collapse;
1.803 bisitz 6073: border-spacing: 0;
1.507 raeburn 6074: width: 100%;
6075: }
1.795 www 6076:
1.879 raeburn 6077: table.LC_innerpickbox,
1.507 raeburn 6078: table.LC_nested {
1.803 bisitz 6079: border: none;
1.589 raeburn 6080: border-collapse: collapse;
1.803 bisitz 6081: border-spacing: 0;
1.507 raeburn 6082: width: 100%;
6083: }
1.795 www 6084:
1.911 bisitz 6085: table.LC_data_table tr th,
6086: table.LC_calendar tr th,
1.879 raeburn 6087: table.LC_prior_tries tr th,
6088: table.LC_innerpickbox tr th {
1.349 albertel 6089: font-weight: bold;
6090: background-color: $data_table_head;
1.801 tempelho 6091: color:$fontmenu;
1.701 harmsja 6092: font-size:90%;
1.347 albertel 6093: }
1.795 www 6094:
1.879 raeburn 6095: table.LC_innerpickbox tr th,
6096: table.LC_innerpickbox tr td {
6097: vertical-align: top;
6098: }
6099:
1.711 raeburn 6100: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6101: background-color: #CCCCCC;
1.711 raeburn 6102: font-weight: bold;
6103: text-align: left;
6104: }
1.795 www 6105:
1.912 bisitz 6106: table.LC_data_table tr.LC_odd_row > td {
6107: background-color: $data_table_light;
6108: padding: 2px;
6109: vertical-align: top;
6110: }
6111:
1.809 bisitz 6112: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6113: background-color: $data_table_light;
1.912 bisitz 6114: vertical-align: top;
6115: }
6116:
6117: table.LC_data_table tr.LC_even_row > td {
6118: background-color: $data_table_dark;
1.425 albertel 6119: padding: 2px;
1.900 bisitz 6120: vertical-align: top;
1.347 albertel 6121: }
1.795 www 6122:
1.809 bisitz 6123: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6124: background-color: $data_table_dark;
1.900 bisitz 6125: vertical-align: top;
1.347 albertel 6126: }
1.795 www 6127:
1.425 albertel 6128: table.LC_data_table tr.LC_data_table_highlight td {
6129: background-color: $data_table_darker;
6130: }
1.795 www 6131:
1.639 raeburn 6132: table.LC_data_table tr td.LC_leftcol_header {
6133: background-color: $data_table_head;
6134: font-weight: bold;
6135: }
1.795 www 6136:
1.451 albertel 6137: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6138: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6139: font-weight: bold;
6140: font-style: italic;
6141: text-align: center;
6142: padding: 8px;
1.347 albertel 6143: }
1.795 www 6144:
1.1114 raeburn 6145: table.LC_data_table tr.LC_empty_row td,
6146: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6147: background-color: $sidebg;
6148: }
6149:
6150: table.LC_nested tr.LC_empty_row td {
6151: background-color: #FFFFFF;
6152: }
6153:
1.890 droeschl 6154: table.LC_caption {
6155: }
6156:
1.507 raeburn 6157: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6158: padding: 4ex
6159: }
1.795 www 6160:
1.507 raeburn 6161: table.LC_nested_outer tr th {
6162: font-weight: bold;
1.801 tempelho 6163: color:$fontmenu;
1.507 raeburn 6164: background-color: $data_table_head;
1.701 harmsja 6165: font-size: small;
1.507 raeburn 6166: border-bottom: 1px solid #000000;
6167: }
1.795 www 6168:
1.507 raeburn 6169: table.LC_nested_outer tr td.LC_subheader {
6170: background-color: $data_table_head;
6171: font-weight: bold;
6172: font-size: small;
6173: border-bottom: 1px solid #000000;
6174: text-align: right;
1.451 albertel 6175: }
1.795 www 6176:
1.507 raeburn 6177: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6178: background-color: #CCCCCC;
1.451 albertel 6179: font-weight: bold;
6180: font-size: small;
1.507 raeburn 6181: text-align: center;
6182: }
1.795 www 6183:
1.589 raeburn 6184: table.LC_nested tr.LC_info_row td.LC_left_item,
6185: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6186: text-align: left;
1.451 albertel 6187: }
1.795 www 6188:
1.507 raeburn 6189: table.LC_nested td {
1.735 bisitz 6190: background-color: #FFFFFF;
1.451 albertel 6191: font-size: small;
1.507 raeburn 6192: }
1.795 www 6193:
1.507 raeburn 6194: table.LC_nested_outer tr th.LC_right_item,
6195: table.LC_nested tr.LC_info_row td.LC_right_item,
6196: table.LC_nested tr.LC_odd_row td.LC_right_item,
6197: table.LC_nested tr td.LC_right_item {
1.451 albertel 6198: text-align: right;
6199: }
6200:
1.507 raeburn 6201: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6202: background-color: #EEEEEE;
1.451 albertel 6203: }
6204:
1.473 raeburn 6205: table.LC_createuser {
6206: }
6207:
6208: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6209: font-size: small;
1.473 raeburn 6210: }
6211:
6212: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6213: background-color: #CCCCCC;
1.473 raeburn 6214: font-weight: bold;
6215: text-align: center;
6216: }
6217:
1.349 albertel 6218: table.LC_calendar {
6219: border: 1px solid #000000;
6220: border-collapse: collapse;
1.917 raeburn 6221: width: 98%;
1.349 albertel 6222: }
1.795 www 6223:
1.349 albertel 6224: table.LC_calendar_pickdate {
6225: font-size: xx-small;
6226: }
1.795 www 6227:
1.349 albertel 6228: table.LC_calendar tr td {
6229: border: 1px solid #000000;
6230: vertical-align: top;
1.917 raeburn 6231: width: 14%;
1.349 albertel 6232: }
1.795 www 6233:
1.349 albertel 6234: table.LC_calendar tr td.LC_calendar_day_empty {
6235: background-color: $data_table_dark;
6236: }
1.795 www 6237:
1.779 bisitz 6238: table.LC_calendar tr td.LC_calendar_day_current {
6239: background-color: $data_table_highlight;
1.777 tempelho 6240: }
1.795 www 6241:
1.938 bisitz 6242: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6243: background-color: $mail_new;
6244: }
1.795 www 6245:
1.938 bisitz 6246: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6247: background-color: $mail_new_hover;
6248: }
1.795 www 6249:
1.938 bisitz 6250: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6251: background-color: $mail_read;
6252: }
1.795 www 6253:
1.938 bisitz 6254: /*
6255: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6256: background-color: $mail_read_hover;
6257: }
1.938 bisitz 6258: */
1.795 www 6259:
1.938 bisitz 6260: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6261: background-color: $mail_replied;
6262: }
1.795 www 6263:
1.938 bisitz 6264: /*
6265: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6266: background-color: $mail_replied_hover;
6267: }
1.938 bisitz 6268: */
1.795 www 6269:
1.938 bisitz 6270: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6271: background-color: $mail_other;
6272: }
1.795 www 6273:
1.938 bisitz 6274: /*
6275: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6276: background-color: $mail_other_hover;
6277: }
1.938 bisitz 6278: */
1.494 raeburn 6279:
1.777 tempelho 6280: table.LC_data_table tr > td.LC_browser_file,
6281: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6282: background: #AAEE77;
1.389 albertel 6283: }
1.795 www 6284:
1.777 tempelho 6285: table.LC_data_table tr > td.LC_browser_file_locked,
6286: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6287: background: #FFAA99;
1.387 albertel 6288: }
1.795 www 6289:
1.777 tempelho 6290: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6291: background: #888888;
1.779 bisitz 6292: }
1.795 www 6293:
1.777 tempelho 6294: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6295: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6296: background: #F8F866;
1.777 tempelho 6297: }
1.795 www 6298:
1.696 bisitz 6299: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6300: background: #E0E8FF;
1.387 albertel 6301: }
1.696 bisitz 6302:
1.707 bisitz 6303: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6304: /* background: #77FF77; */
1.707 bisitz 6305: }
1.795 www 6306:
1.707 bisitz 6307: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6308: border-right: 8px solid #FFFF77;
1.707 bisitz 6309: }
1.795 www 6310:
1.707 bisitz 6311: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6312: border-right: 8px solid #FFAA77;
1.707 bisitz 6313: }
1.795 www 6314:
1.707 bisitz 6315: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6316: border-right: 8px solid #FF7777;
1.707 bisitz 6317: }
1.795 www 6318:
1.707 bisitz 6319: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6320: border-right: 8px solid #AAFF77;
1.707 bisitz 6321: }
1.795 www 6322:
1.707 bisitz 6323: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6324: border-right: 8px solid #11CC55;
1.707 bisitz 6325: }
6326:
1.388 albertel 6327: span.LC_current_location {
1.701 harmsja 6328: font-size:larger;
1.388 albertel 6329: background: $pgbg;
6330: }
1.387 albertel 6331:
1.1029 www 6332: span.LC_current_nav_location {
6333: font-weight:bold;
6334: background: $sidebg;
6335: }
6336:
1.395 albertel 6337: span.LC_parm_menu_item {
6338: font-size: larger;
6339: }
1.795 www 6340:
1.395 albertel 6341: span.LC_parm_scope_all {
6342: color: red;
6343: }
1.795 www 6344:
1.395 albertel 6345: span.LC_parm_scope_folder {
6346: color: green;
6347: }
1.795 www 6348:
1.395 albertel 6349: span.LC_parm_scope_resource {
6350: color: orange;
6351: }
1.795 www 6352:
1.395 albertel 6353: span.LC_parm_part {
6354: color: blue;
6355: }
1.795 www 6356:
1.911 bisitz 6357: span.LC_parm_folder,
6358: span.LC_parm_symb {
1.395 albertel 6359: font-size: x-small;
6360: font-family: $mono;
6361: color: #AAAAAA;
6362: }
6363:
1.977 bisitz 6364: ul.LC_parm_parmlist li {
6365: display: inline-block;
6366: padding: 0.3em 0.8em;
6367: vertical-align: top;
6368: width: 150px;
6369: border-top:1px solid $lg_border_color;
6370: }
6371:
1.795 www 6372: td.LC_parm_overview_level_menu,
6373: td.LC_parm_overview_map_menu,
6374: td.LC_parm_overview_parm_selectors,
6375: td.LC_parm_overview_restrictions {
1.396 albertel 6376: border: 1px solid black;
6377: border-collapse: collapse;
6378: }
1.795 www 6379:
1.396 albertel 6380: table.LC_parm_overview_restrictions td {
6381: border-width: 1px 4px 1px 4px;
6382: border-style: solid;
6383: border-color: $pgbg;
6384: text-align: center;
6385: }
1.795 www 6386:
1.396 albertel 6387: table.LC_parm_overview_restrictions th {
6388: background: $tabbg;
6389: border-width: 1px 4px 1px 4px;
6390: border-style: solid;
6391: border-color: $pgbg;
6392: }
1.795 www 6393:
1.398 albertel 6394: table#LC_helpmenu {
1.803 bisitz 6395: border: none;
1.398 albertel 6396: height: 55px;
1.803 bisitz 6397: border-spacing: 0;
1.398 albertel 6398: }
6399:
6400: table#LC_helpmenu fieldset legend {
6401: font-size: larger;
6402: }
1.795 www 6403:
1.397 albertel 6404: table#LC_helpmenu_links {
6405: width: 100%;
6406: border: 1px solid black;
6407: background: $pgbg;
1.803 bisitz 6408: padding: 0;
1.397 albertel 6409: border-spacing: 1px;
6410: }
1.795 www 6411:
1.397 albertel 6412: table#LC_helpmenu_links tr td {
6413: padding: 1px;
6414: background: $tabbg;
1.399 albertel 6415: text-align: center;
6416: font-weight: bold;
1.397 albertel 6417: }
1.396 albertel 6418:
1.795 www 6419: table#LC_helpmenu_links a:link,
6420: table#LC_helpmenu_links a:visited,
1.397 albertel 6421: table#LC_helpmenu_links a:active {
6422: text-decoration: none;
6423: color: $font;
6424: }
1.795 www 6425:
1.397 albertel 6426: table#LC_helpmenu_links a:hover {
6427: text-decoration: underline;
6428: color: $vlink;
6429: }
1.396 albertel 6430:
1.417 albertel 6431: .LC_chrt_popup_exists {
6432: border: 1px solid #339933;
6433: margin: -1px;
6434: }
1.795 www 6435:
1.417 albertel 6436: .LC_chrt_popup_up {
6437: border: 1px solid yellow;
6438: margin: -1px;
6439: }
1.795 www 6440:
1.417 albertel 6441: .LC_chrt_popup {
6442: border: 1px solid #8888FF;
6443: background: #CCCCFF;
6444: }
1.795 www 6445:
1.421 albertel 6446: table.LC_pick_box {
6447: border-collapse: separate;
6448: background: white;
6449: border: 1px solid black;
6450: border-spacing: 1px;
6451: }
1.795 www 6452:
1.421 albertel 6453: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6454: background: $sidebg;
1.421 albertel 6455: font-weight: bold;
1.900 bisitz 6456: text-align: left;
1.740 bisitz 6457: vertical-align: top;
1.421 albertel 6458: width: 184px;
6459: padding: 8px;
6460: }
1.795 www 6461:
1.579 raeburn 6462: table.LC_pick_box td.LC_pick_box_value {
6463: text-align: left;
6464: padding: 8px;
6465: }
1.795 www 6466:
1.579 raeburn 6467: table.LC_pick_box td.LC_pick_box_select {
6468: text-align: left;
6469: padding: 8px;
6470: }
1.795 www 6471:
1.424 albertel 6472: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6473: padding: 0;
1.421 albertel 6474: height: 1px;
6475: background: black;
6476: }
1.795 www 6477:
1.421 albertel 6478: table.LC_pick_box td.LC_pick_box_submit {
6479: text-align: right;
6480: }
1.795 www 6481:
1.579 raeburn 6482: table.LC_pick_box td.LC_evenrow_value {
6483: text-align: left;
6484: padding: 8px;
6485: background-color: $data_table_light;
6486: }
1.795 www 6487:
1.579 raeburn 6488: table.LC_pick_box td.LC_oddrow_value {
6489: text-align: left;
6490: padding: 8px;
6491: background-color: $data_table_light;
6492: }
1.795 www 6493:
1.579 raeburn 6494: span.LC_helpform_receipt_cat {
6495: font-weight: bold;
6496: }
1.795 www 6497:
1.424 albertel 6498: table.LC_group_priv_box {
6499: background: white;
6500: border: 1px solid black;
6501: border-spacing: 1px;
6502: }
1.795 www 6503:
1.424 albertel 6504: table.LC_group_priv_box td.LC_pick_box_title {
6505: background: $tabbg;
6506: font-weight: bold;
6507: text-align: right;
6508: width: 184px;
6509: }
1.795 www 6510:
1.424 albertel 6511: table.LC_group_priv_box td.LC_groups_fixed {
6512: background: $data_table_light;
6513: text-align: center;
6514: }
1.795 www 6515:
1.424 albertel 6516: table.LC_group_priv_box td.LC_groups_optional {
6517: background: $data_table_dark;
6518: text-align: center;
6519: }
1.795 www 6520:
1.424 albertel 6521: table.LC_group_priv_box td.LC_groups_functionality {
6522: background: $data_table_darker;
6523: text-align: center;
6524: font-weight: bold;
6525: }
1.795 www 6526:
1.424 albertel 6527: table.LC_group_priv td {
6528: text-align: left;
1.803 bisitz 6529: padding: 0;
1.424 albertel 6530: }
6531:
6532: .LC_navbuttons {
6533: margin: 2ex 0ex 2ex 0ex;
6534: }
1.795 www 6535:
1.423 albertel 6536: .LC_topic_bar {
6537: font-weight: bold;
6538: background: $tabbg;
1.918 wenzelju 6539: margin: 1em 0em 1em 2em;
1.805 bisitz 6540: padding: 3px;
1.918 wenzelju 6541: font-size: 1.2em;
1.423 albertel 6542: }
1.795 www 6543:
1.423 albertel 6544: .LC_topic_bar span {
1.918 wenzelju 6545: left: 0.5em;
6546: position: absolute;
1.423 albertel 6547: vertical-align: middle;
1.918 wenzelju 6548: font-size: 1.2em;
1.423 albertel 6549: }
1.795 www 6550:
1.423 albertel 6551: table.LC_course_group_status {
6552: margin: 20px;
6553: }
1.795 www 6554:
1.423 albertel 6555: table.LC_status_selector td {
6556: vertical-align: top;
6557: text-align: center;
1.424 albertel 6558: padding: 4px;
6559: }
1.795 www 6560:
1.599 albertel 6561: div.LC_feedback_link {
1.616 albertel 6562: clear: both;
1.829 kalberla 6563: background: $sidebg;
1.779 bisitz 6564: width: 100%;
1.829 kalberla 6565: padding-bottom: 10px;
6566: border: 1px $tabbg solid;
1.833 kalberla 6567: height: 22px;
6568: line-height: 22px;
6569: padding-top: 5px;
6570: }
6571:
6572: div.LC_feedback_link img {
6573: height: 22px;
1.867 kalberla 6574: vertical-align:middle;
1.829 kalberla 6575: }
6576:
1.911 bisitz 6577: div.LC_feedback_link a {
1.829 kalberla 6578: text-decoration: none;
1.489 raeburn 6579: }
1.795 www 6580:
1.867 kalberla 6581: div.LC_comblock {
1.911 bisitz 6582: display:inline;
1.867 kalberla 6583: color:$font;
6584: font-size:90%;
6585: }
6586:
6587: div.LC_feedback_link div.LC_comblock {
6588: padding-left:5px;
6589: }
6590:
6591: div.LC_feedback_link div.LC_comblock a {
6592: color:$font;
6593: }
6594:
1.489 raeburn 6595: span.LC_feedback_link {
1.858 bisitz 6596: /* background: $feedback_link_bg; */
1.599 albertel 6597: font-size: larger;
6598: }
1.795 www 6599:
1.599 albertel 6600: span.LC_message_link {
1.858 bisitz 6601: /* background: $feedback_link_bg; */
1.599 albertel 6602: font-size: larger;
6603: position: absolute;
6604: right: 1em;
1.489 raeburn 6605: }
1.421 albertel 6606:
1.515 albertel 6607: table.LC_prior_tries {
1.524 albertel 6608: border: 1px solid #000000;
6609: border-collapse: separate;
6610: border-spacing: 1px;
1.515 albertel 6611: }
1.523 albertel 6612:
1.515 albertel 6613: table.LC_prior_tries td {
1.524 albertel 6614: padding: 2px;
1.515 albertel 6615: }
1.523 albertel 6616:
6617: .LC_answer_correct {
1.795 www 6618: background: lightgreen;
6619: color: darkgreen;
6620: padding: 6px;
1.523 albertel 6621: }
1.795 www 6622:
1.523 albertel 6623: .LC_answer_charged_try {
1.797 www 6624: background: #FFAAAA;
1.795 www 6625: color: darkred;
6626: padding: 6px;
1.523 albertel 6627: }
1.795 www 6628:
1.779 bisitz 6629: .LC_answer_not_charged_try,
1.523 albertel 6630: .LC_answer_no_grade,
6631: .LC_answer_late {
1.795 www 6632: background: lightyellow;
1.523 albertel 6633: color: black;
1.795 www 6634: padding: 6px;
1.523 albertel 6635: }
1.795 www 6636:
1.523 albertel 6637: .LC_answer_previous {
1.795 www 6638: background: lightblue;
6639: color: darkblue;
6640: padding: 6px;
1.523 albertel 6641: }
1.795 www 6642:
1.779 bisitz 6643: .LC_answer_no_message {
1.777 tempelho 6644: background: #FFFFFF;
6645: color: black;
1.795 www 6646: padding: 6px;
1.779 bisitz 6647: }
1.795 www 6648:
1.779 bisitz 6649: .LC_answer_unknown {
6650: background: orange;
6651: color: black;
1.795 www 6652: padding: 6px;
1.777 tempelho 6653: }
1.795 www 6654:
1.529 albertel 6655: span.LC_prior_numerical,
6656: span.LC_prior_string,
6657: span.LC_prior_custom,
6658: span.LC_prior_reaction,
6659: span.LC_prior_math {
1.925 bisitz 6660: font-family: $mono;
1.523 albertel 6661: white-space: pre;
6662: }
6663:
1.525 albertel 6664: span.LC_prior_string {
1.925 bisitz 6665: font-family: $mono;
1.525 albertel 6666: white-space: pre;
6667: }
6668:
1.523 albertel 6669: table.LC_prior_option {
6670: width: 100%;
6671: border-collapse: collapse;
6672: }
1.795 www 6673:
1.911 bisitz 6674: table.LC_prior_rank,
1.795 www 6675: table.LC_prior_match {
1.528 albertel 6676: border-collapse: collapse;
6677: }
1.795 www 6678:
1.528 albertel 6679: table.LC_prior_option tr td,
6680: table.LC_prior_rank tr td,
6681: table.LC_prior_match tr td {
1.524 albertel 6682: border: 1px solid #000000;
1.515 albertel 6683: }
6684:
1.855 bisitz 6685: .LC_nobreak {
1.544 albertel 6686: white-space: nowrap;
1.519 raeburn 6687: }
6688:
1.576 raeburn 6689: span.LC_cusr_emph {
6690: font-style: italic;
6691: }
6692:
1.633 raeburn 6693: span.LC_cusr_subheading {
6694: font-weight: normal;
6695: font-size: 85%;
6696: }
6697:
1.861 bisitz 6698: div.LC_docs_entry_move {
1.859 bisitz 6699: border: 1px solid #BBBBBB;
1.545 albertel 6700: background: #DDDDDD;
1.861 bisitz 6701: width: 22px;
1.859 bisitz 6702: padding: 1px;
6703: margin: 0;
1.545 albertel 6704: }
6705:
1.861 bisitz 6706: table.LC_data_table tr > td.LC_docs_entry_commands,
6707: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6708: font-size: x-small;
6709: }
1.795 www 6710:
1.861 bisitz 6711: .LC_docs_entry_parameter {
6712: white-space: nowrap;
6713: }
6714:
1.544 albertel 6715: .LC_docs_copy {
1.545 albertel 6716: color: #000099;
1.544 albertel 6717: }
1.795 www 6718:
1.544 albertel 6719: .LC_docs_cut {
1.545 albertel 6720: color: #550044;
1.544 albertel 6721: }
1.795 www 6722:
1.544 albertel 6723: .LC_docs_rename {
1.545 albertel 6724: color: #009900;
1.544 albertel 6725: }
1.795 www 6726:
1.544 albertel 6727: .LC_docs_remove {
1.545 albertel 6728: color: #990000;
6729: }
6730:
1.547 albertel 6731: .LC_docs_reinit_warn,
6732: .LC_docs_ext_edit {
6733: font-size: x-small;
6734: }
6735:
1.545 albertel 6736: table.LC_docs_adddocs td,
6737: table.LC_docs_adddocs th {
6738: border: 1px solid #BBBBBB;
6739: padding: 4px;
6740: background: #DDDDDD;
1.543 albertel 6741: }
6742:
1.584 albertel 6743: table.LC_sty_begin {
6744: background: #BBFFBB;
6745: }
1.795 www 6746:
1.584 albertel 6747: table.LC_sty_end {
6748: background: #FFBBBB;
6749: }
6750:
1.589 raeburn 6751: table.LC_double_column {
1.803 bisitz 6752: border-width: 0;
1.589 raeburn 6753: border-collapse: collapse;
6754: width: 100%;
6755: padding: 2px;
6756: }
6757:
6758: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6759: top: 2px;
1.589 raeburn 6760: left: 2px;
6761: width: 47%;
6762: vertical-align: top;
6763: }
6764:
6765: table.LC_double_column tr td.LC_right_col {
6766: top: 2px;
1.779 bisitz 6767: right: 2px;
1.589 raeburn 6768: width: 47%;
6769: vertical-align: top;
6770: }
6771:
1.591 raeburn 6772: div.LC_left_float {
6773: float: left;
6774: padding-right: 5%;
1.597 albertel 6775: padding-bottom: 4px;
1.591 raeburn 6776: }
6777:
6778: div.LC_clear_float_header {
1.597 albertel 6779: padding-bottom: 2px;
1.591 raeburn 6780: }
6781:
6782: div.LC_clear_float_footer {
1.597 albertel 6783: padding-top: 10px;
1.591 raeburn 6784: clear: both;
6785: }
6786:
1.597 albertel 6787: div.LC_grade_show_user {
1.941 bisitz 6788: /* border-left: 5px solid $sidebg; */
6789: border-top: 5px solid #000000;
6790: margin: 50px 0 0 0;
1.936 bisitz 6791: padding: 15px 0 5px 10px;
1.597 albertel 6792: }
1.795 www 6793:
1.936 bisitz 6794: div.LC_grade_show_user_odd_row {
1.941 bisitz 6795: /* border-left: 5px solid #000000; */
6796: }
6797:
6798: div.LC_grade_show_user div.LC_Box {
6799: margin-right: 50px;
1.597 albertel 6800: }
6801:
6802: div.LC_grade_submissions,
6803: div.LC_grade_message_center,
1.936 bisitz 6804: div.LC_grade_info_links {
1.597 albertel 6805: margin: 5px;
6806: width: 99%;
6807: background: #FFFFFF;
6808: }
1.795 www 6809:
1.597 albertel 6810: div.LC_grade_submissions_header,
1.936 bisitz 6811: div.LC_grade_message_center_header {
1.705 tempelho 6812: font-weight: bold;
6813: font-size: large;
1.597 albertel 6814: }
1.795 www 6815:
1.597 albertel 6816: div.LC_grade_submissions_body,
1.936 bisitz 6817: div.LC_grade_message_center_body {
1.597 albertel 6818: border: 1px solid black;
6819: width: 99%;
6820: background: #FFFFFF;
6821: }
1.795 www 6822:
1.613 albertel 6823: table.LC_scantron_action {
6824: width: 100%;
6825: }
1.795 www 6826:
1.613 albertel 6827: table.LC_scantron_action tr th {
1.698 harmsja 6828: font-weight:bold;
6829: font-style:normal;
1.613 albertel 6830: }
1.795 www 6831:
1.779 bisitz 6832: .LC_edit_problem_header,
1.614 albertel 6833: div.LC_edit_problem_footer {
1.705 tempelho 6834: font-weight: normal;
6835: font-size: medium;
1.602 albertel 6836: margin: 2px;
1.1060 bisitz 6837: background-color: $sidebg;
1.600 albertel 6838: }
1.795 www 6839:
1.600 albertel 6840: div.LC_edit_problem_header,
1.602 albertel 6841: div.LC_edit_problem_header div,
1.614 albertel 6842: div.LC_edit_problem_footer,
6843: div.LC_edit_problem_footer div,
1.602 albertel 6844: div.LC_edit_problem_editxml_header,
6845: div.LC_edit_problem_editxml_header div {
1.1205 golterma 6846: z-index: 100;
1.600 albertel 6847: }
1.795 www 6848:
1.600 albertel 6849: div.LC_edit_problem_header_title {
1.705 tempelho 6850: font-weight: bold;
6851: font-size: larger;
1.602 albertel 6852: background: $tabbg;
6853: padding: 3px;
1.1060 bisitz 6854: margin: 0 0 5px 0;
1.602 albertel 6855: }
1.795 www 6856:
1.602 albertel 6857: table.LC_edit_problem_header_title {
6858: width: 100%;
1.600 albertel 6859: background: $tabbg;
1.602 albertel 6860: }
6861:
1.1205 golterma 6862: div.LC_edit_actionbar {
6863: background-color: $sidebg;
1.1218 droeschl 6864: margin: 0;
6865: padding: 0;
6866: line-height: 200%;
1.602 albertel 6867: }
1.795 www 6868:
1.1218 droeschl 6869: div.LC_edit_actionbar div{
6870: padding: 0;
6871: margin: 0;
6872: display: inline-block;
1.600 albertel 6873: }
1.795 www 6874:
1.1124 bisitz 6875: .LC_edit_opt {
6876: padding-left: 1em;
6877: white-space: nowrap;
6878: }
6879:
1.1152 golterma 6880: .LC_edit_problem_latexhelper{
6881: text-align: right;
6882: }
6883:
6884: #LC_edit_problem_colorful div{
6885: margin-left: 40px;
6886: }
6887:
1.1205 golterma 6888: #LC_edit_problem_codemirror div{
6889: margin-left: 0px;
6890: }
6891:
1.911 bisitz 6892: img.stift {
1.803 bisitz 6893: border-width: 0;
6894: vertical-align: middle;
1.677 riegler 6895: }
1.680 riegler 6896:
1.923 bisitz 6897: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6898: vertical-align: top;
1.777 tempelho 6899: }
1.795 www 6900:
1.716 raeburn 6901: div.LC_createcourse {
1.911 bisitz 6902: margin: 10px 10px 10px 10px;
1.716 raeburn 6903: }
6904:
1.917 raeburn 6905: .LC_dccid {
1.1130 raeburn 6906: float: right;
1.917 raeburn 6907: margin: 0.2em 0 0 0;
6908: padding: 0;
6909: font-size: 90%;
6910: display:none;
6911: }
6912:
1.897 wenzelju 6913: ol.LC_primary_menu a:hover,
1.721 harmsja 6914: ol#LC_MenuBreadcrumbs a:hover,
6915: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6916: ul#LC_secondary_menu a:hover,
1.721 harmsja 6917: .LC_FormSectionClearButton input:hover
1.795 www 6918: ul.LC_TabContent li:hover a {
1.952 onken 6919: color:$button_hover;
1.911 bisitz 6920: text-decoration:none;
1.693 droeschl 6921: }
6922:
1.779 bisitz 6923: h1 {
1.911 bisitz 6924: padding: 0;
6925: line-height:130%;
1.693 droeschl 6926: }
1.698 harmsja 6927:
1.911 bisitz 6928: h2,
6929: h3,
6930: h4,
6931: h5,
6932: h6 {
6933: margin: 5px 0 5px 0;
6934: padding: 0;
6935: line-height:130%;
1.693 droeschl 6936: }
1.795 www 6937:
6938: .LC_hcell {
1.911 bisitz 6939: padding:3px 15px 3px 15px;
6940: margin: 0;
6941: background-color:$tabbg;
6942: color:$fontmenu;
6943: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6944: }
1.795 www 6945:
1.840 bisitz 6946: .LC_Box > .LC_hcell {
1.911 bisitz 6947: margin: 0 -10px 10px -10px;
1.835 bisitz 6948: }
6949:
1.721 harmsja 6950: .LC_noBorder {
1.911 bisitz 6951: border: 0;
1.698 harmsja 6952: }
1.693 droeschl 6953:
1.721 harmsja 6954: .LC_FormSectionClearButton input {
1.911 bisitz 6955: background-color:transparent;
6956: border: none;
6957: cursor:pointer;
6958: text-decoration:underline;
1.693 droeschl 6959: }
1.763 bisitz 6960:
6961: .LC_help_open_topic {
1.911 bisitz 6962: color: #FFFFFF;
6963: background-color: #EEEEFF;
6964: margin: 1px;
6965: padding: 4px;
6966: border: 1px solid #000033;
6967: white-space: nowrap;
6968: /* vertical-align: middle; */
1.759 neumanie 6969: }
1.693 droeschl 6970:
1.911 bisitz 6971: dl,
6972: ul,
6973: div,
6974: fieldset {
6975: margin: 10px 10px 10px 0;
6976: /* overflow: hidden; */
1.693 droeschl 6977: }
1.795 www 6978:
1.1211 raeburn 6979: article.geogebraweb div {
6980: margin: 0;
6981: }
6982:
1.838 bisitz 6983: fieldset > legend {
1.911 bisitz 6984: font-weight: bold;
6985: padding: 0 5px 0 5px;
1.838 bisitz 6986: }
6987:
1.813 bisitz 6988: #LC_nav_bar {
1.911 bisitz 6989: float: left;
1.995 raeburn 6990: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6991: margin: 0 0 2px 0;
1.807 droeschl 6992: }
6993:
1.916 droeschl 6994: #LC_realm {
6995: margin: 0.2em 0 0 0;
6996: padding: 0;
6997: font-weight: bold;
6998: text-align: center;
1.995 raeburn 6999: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7000: }
7001:
1.911 bisitz 7002: #LC_nav_bar em {
7003: font-weight: bold;
7004: font-style: normal;
1.807 droeschl 7005: }
7006:
1.897 wenzelju 7007: ol.LC_primary_menu {
1.934 droeschl 7008: margin: 0;
1.1076 raeburn 7009: padding: 0;
1.807 droeschl 7010: }
7011:
1.852 droeschl 7012: ol#LC_PathBreadcrumbs {
1.911 bisitz 7013: margin: 0;
1.693 droeschl 7014: }
7015:
1.897 wenzelju 7016: ol.LC_primary_menu li {
1.1076 raeburn 7017: color: RGB(80, 80, 80);
7018: vertical-align: middle;
7019: text-align: left;
7020: list-style: none;
1.1205 golterma 7021: position: relative;
1.1076 raeburn 7022: float: left;
1.1205 golterma 7023: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7024: line-height: 1.5em;
1.1076 raeburn 7025: }
7026:
1.1205 golterma 7027: ol.LC_primary_menu li a,
7028: ol.LC_primary_menu li p {
1.1076 raeburn 7029: display: block;
7030: margin: 0;
7031: padding: 0 5px 0 10px;
7032: text-decoration: none;
7033: }
7034:
1.1205 golterma 7035: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7036: display: inline-block;
7037: width: 95%;
7038: text-align: left;
7039: }
7040:
7041: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7042: display: inline-block;
7043: width: 5%;
7044: float: right;
7045: text-align: right;
7046: font-size: 70%;
7047: }
7048:
7049: ol.LC_primary_menu ul {
1.1076 raeburn 7050: display: none;
1.1205 golterma 7051: width: 15em;
1.1076 raeburn 7052: background-color: $data_table_light;
1.1205 golterma 7053: position: absolute;
7054: top: 100%;
1.1076 raeburn 7055: }
7056:
1.1205 golterma 7057: ol.LC_primary_menu ul ul {
7058: left: 100%;
7059: top: 0;
7060: }
7061:
7062: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7063: display: block;
7064: position: absolute;
7065: margin: 0;
7066: padding: 0;
1.1078 raeburn 7067: z-index: 2;
1.1076 raeburn 7068: }
7069:
7070: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7071: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7072: font-size: 90%;
1.911 bisitz 7073: vertical-align: top;
1.1076 raeburn 7074: float: none;
1.1079 raeburn 7075: border-left: 1px solid black;
7076: border-right: 1px solid black;
1.1205 golterma 7077: /* A dark bottom border to visualize different menu options;
7078: overwritten in the create_submenu routine for the last border-bottom of the menu */
7079: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7080: }
7081:
1.1205 golterma 7082: ol.LC_primary_menu li li p:hover {
7083: color:$button_hover;
7084: text-decoration:none;
7085: background-color:$data_table_dark;
1.1076 raeburn 7086: }
7087:
7088: ol.LC_primary_menu li li a:hover {
7089: color:$button_hover;
7090: background-color:$data_table_dark;
1.693 droeschl 7091: }
7092:
1.1205 golterma 7093: /* Font-size equal to the size of the predecessors*/
7094: ol.LC_primary_menu li:hover li li {
7095: font-size: 100%;
7096: }
7097:
1.897 wenzelju 7098: ol.LC_primary_menu li img {
1.911 bisitz 7099: vertical-align: bottom;
1.934 droeschl 7100: height: 1.1em;
1.1077 raeburn 7101: margin: 0.2em 0 0 0;
1.693 droeschl 7102: }
7103:
1.897 wenzelju 7104: ol.LC_primary_menu a {
1.911 bisitz 7105: color: RGB(80, 80, 80);
7106: text-decoration: none;
1.693 droeschl 7107: }
1.795 www 7108:
1.949 droeschl 7109: ol.LC_primary_menu a.LC_new_message {
7110: font-weight:bold;
7111: color: darkred;
7112: }
7113:
1.975 raeburn 7114: ol.LC_docs_parameters {
7115: margin-left: 0;
7116: padding: 0;
7117: list-style: none;
7118: }
7119:
7120: ol.LC_docs_parameters li {
7121: margin: 0;
7122: padding-right: 20px;
7123: display: inline;
7124: }
7125:
1.976 raeburn 7126: ol.LC_docs_parameters li:before {
7127: content: "\\002022 \\0020";
7128: }
7129:
7130: li.LC_docs_parameters_title {
7131: font-weight: bold;
7132: }
7133:
7134: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7135: content: "";
7136: }
7137:
1.897 wenzelju 7138: ul#LC_secondary_menu {
1.1107 raeburn 7139: clear: right;
1.911 bisitz 7140: color: $fontmenu;
7141: background: $tabbg;
7142: list-style: none;
7143: padding: 0;
7144: margin: 0;
7145: width: 100%;
1.995 raeburn 7146: text-align: left;
1.1107 raeburn 7147: float: left;
1.808 droeschl 7148: }
7149:
1.897 wenzelju 7150: ul#LC_secondary_menu li {
1.911 bisitz 7151: font-weight: bold;
7152: line-height: 1.8em;
1.1107 raeburn 7153: border-right: 1px solid black;
7154: float: left;
7155: }
7156:
7157: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7158: background-color: $data_table_light;
7159: }
7160:
7161: ul#LC_secondary_menu li a {
1.911 bisitz 7162: padding: 0 0.8em;
1.1107 raeburn 7163: }
7164:
7165: ul#LC_secondary_menu li ul {
7166: display: none;
7167: }
7168:
7169: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7170: display: block;
7171: position: absolute;
7172: margin: 0;
7173: padding: 0;
7174: list-style:none;
7175: float: none;
7176: background-color: $data_table_light;
7177: z-index: 2;
7178: margin-left: -1px;
7179: }
7180:
7181: ul#LC_secondary_menu li ul li {
7182: font-size: 90%;
7183: vertical-align: top;
7184: border-left: 1px solid black;
1.911 bisitz 7185: border-right: 1px solid black;
1.1119 raeburn 7186: background-color: $data_table_light;
1.1107 raeburn 7187: list-style:none;
7188: float: none;
7189: }
7190:
7191: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7192: background-color: $data_table_dark;
1.807 droeschl 7193: }
7194:
1.847 tempelho 7195: ul.LC_TabContent {
1.911 bisitz 7196: display:block;
7197: background: $sidebg;
7198: border-bottom: solid 1px $lg_border_color;
7199: list-style:none;
1.1020 raeburn 7200: margin: -1px -10px 0 -10px;
1.911 bisitz 7201: padding: 0;
1.693 droeschl 7202: }
7203:
1.795 www 7204: ul.LC_TabContent li,
7205: ul.LC_TabContentBigger li {
1.911 bisitz 7206: float:left;
1.741 harmsja 7207: }
1.795 www 7208:
1.897 wenzelju 7209: ul#LC_secondary_menu li a {
1.911 bisitz 7210: color: $fontmenu;
7211: text-decoration: none;
1.693 droeschl 7212: }
1.795 www 7213:
1.721 harmsja 7214: ul.LC_TabContent {
1.952 onken 7215: min-height:20px;
1.721 harmsja 7216: }
1.795 www 7217:
7218: ul.LC_TabContent li {
1.911 bisitz 7219: vertical-align:middle;
1.959 onken 7220: padding: 0 16px 0 10px;
1.911 bisitz 7221: background-color:$tabbg;
7222: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7223: border-left: solid 1px $font;
1.721 harmsja 7224: }
1.795 www 7225:
1.847 tempelho 7226: ul.LC_TabContent .right {
1.911 bisitz 7227: float:right;
1.847 tempelho 7228: }
7229:
1.911 bisitz 7230: ul.LC_TabContent li a,
7231: ul.LC_TabContent li {
7232: color:rgb(47,47,47);
7233: text-decoration:none;
7234: font-size:95%;
7235: font-weight:bold;
1.952 onken 7236: min-height:20px;
7237: }
7238:
1.959 onken 7239: ul.LC_TabContent li a:hover,
7240: ul.LC_TabContent li a:focus {
1.952 onken 7241: color: $button_hover;
1.959 onken 7242: background:none;
7243: outline:none;
1.952 onken 7244: }
7245:
7246: ul.LC_TabContent li:hover {
7247: color: $button_hover;
7248: cursor:pointer;
1.721 harmsja 7249: }
1.795 www 7250:
1.911 bisitz 7251: ul.LC_TabContent li.active {
1.952 onken 7252: color: $font;
1.911 bisitz 7253: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7254: border-bottom:solid 1px #FFFFFF;
7255: cursor: default;
1.744 ehlerst 7256: }
1.795 www 7257:
1.959 onken 7258: ul.LC_TabContent li.active a {
7259: color:$font;
7260: background:#FFFFFF;
7261: outline: none;
7262: }
1.1047 raeburn 7263:
7264: ul.LC_TabContent li.goback {
7265: float: left;
7266: border-left: none;
7267: }
7268:
1.870 tempelho 7269: #maincoursedoc {
1.911 bisitz 7270: clear:both;
1.870 tempelho 7271: }
7272:
7273: ul.LC_TabContentBigger {
1.911 bisitz 7274: display:block;
7275: list-style:none;
7276: padding: 0;
1.870 tempelho 7277: }
7278:
1.795 www 7279: ul.LC_TabContentBigger li {
1.911 bisitz 7280: vertical-align:bottom;
7281: height: 30px;
7282: font-size:110%;
7283: font-weight:bold;
7284: color: #737373;
1.841 tempelho 7285: }
7286:
1.957 onken 7287: ul.LC_TabContentBigger li.active {
7288: position: relative;
7289: top: 1px;
7290: }
7291:
1.870 tempelho 7292: ul.LC_TabContentBigger li a {
1.911 bisitz 7293: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7294: height: 30px;
7295: line-height: 30px;
7296: text-align: center;
7297: display: block;
7298: text-decoration: none;
1.958 onken 7299: outline: none;
1.741 harmsja 7300: }
1.795 www 7301:
1.870 tempelho 7302: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7303: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7304: color:$font;
1.744 ehlerst 7305: }
1.795 www 7306:
1.870 tempelho 7307: ul.LC_TabContentBigger li b {
1.911 bisitz 7308: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7309: display: block;
7310: float: left;
7311: padding: 0 30px;
1.957 onken 7312: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7313: }
7314:
1.956 onken 7315: ul.LC_TabContentBigger li:hover b {
7316: color:$button_hover;
7317: }
7318:
1.870 tempelho 7319: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7320: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7321: color:$font;
1.957 onken 7322: border: 0;
1.741 harmsja 7323: }
1.693 droeschl 7324:
1.870 tempelho 7325:
1.862 bisitz 7326: ul.LC_CourseBreadcrumbs {
7327: background: $sidebg;
1.1020 raeburn 7328: height: 2em;
1.862 bisitz 7329: padding-left: 10px;
1.1020 raeburn 7330: margin: 0;
1.862 bisitz 7331: list-style-position: inside;
7332: }
7333:
1.911 bisitz 7334: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7335: ol#LC_PathBreadcrumbs {
1.911 bisitz 7336: padding-left: 10px;
7337: margin: 0;
1.933 droeschl 7338: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7339: }
7340:
1.911 bisitz 7341: ol#LC_MenuBreadcrumbs li,
7342: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7343: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7344: display: inline;
1.933 droeschl 7345: white-space: normal;
1.693 droeschl 7346: }
7347:
1.823 bisitz 7348: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7349: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7350: text-decoration: none;
7351: font-size:90%;
1.693 droeschl 7352: }
1.795 www 7353:
1.969 droeschl 7354: ol#LC_MenuBreadcrumbs h1 {
7355: display: inline;
7356: font-size: 90%;
7357: line-height: 2.5em;
7358: margin: 0;
7359: padding: 0;
7360: }
7361:
1.795 www 7362: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7363: text-decoration:none;
7364: font-size:100%;
7365: font-weight:bold;
1.693 droeschl 7366: }
1.795 www 7367:
1.840 bisitz 7368: .LC_Box {
1.911 bisitz 7369: border: solid 1px $lg_border_color;
7370: padding: 0 10px 10px 10px;
1.746 neumanie 7371: }
1.795 www 7372:
1.1020 raeburn 7373: .LC_DocsBox {
7374: border: solid 1px $lg_border_color;
7375: padding: 0 0 10px 10px;
7376: }
7377:
1.795 www 7378: .LC_AboutMe_Image {
1.911 bisitz 7379: float:left;
7380: margin-right:10px;
1.747 neumanie 7381: }
1.795 www 7382:
7383: .LC_Clear_AboutMe_Image {
1.911 bisitz 7384: clear:left;
1.747 neumanie 7385: }
1.795 www 7386:
1.721 harmsja 7387: dl.LC_ListStyleClean dt {
1.911 bisitz 7388: padding-right: 5px;
7389: display: table-header-group;
1.693 droeschl 7390: }
7391:
1.721 harmsja 7392: dl.LC_ListStyleClean dd {
1.911 bisitz 7393: display: table-row;
1.693 droeschl 7394: }
7395:
1.721 harmsja 7396: .LC_ListStyleClean,
7397: .LC_ListStyleSimple,
7398: .LC_ListStyleNormal,
1.795 www 7399: .LC_ListStyleSpecial {
1.911 bisitz 7400: /* display:block; */
7401: list-style-position: inside;
7402: list-style-type: none;
7403: overflow: hidden;
7404: padding: 0;
1.693 droeschl 7405: }
7406:
1.721 harmsja 7407: .LC_ListStyleSimple li,
7408: .LC_ListStyleSimple dd,
7409: .LC_ListStyleNormal li,
7410: .LC_ListStyleNormal dd,
7411: .LC_ListStyleSpecial li,
1.795 www 7412: .LC_ListStyleSpecial dd {
1.911 bisitz 7413: margin: 0;
7414: padding: 5px 5px 5px 10px;
7415: clear: both;
1.693 droeschl 7416: }
7417:
1.721 harmsja 7418: .LC_ListStyleClean li,
7419: .LC_ListStyleClean dd {
1.911 bisitz 7420: padding-top: 0;
7421: padding-bottom: 0;
1.693 droeschl 7422: }
7423:
1.721 harmsja 7424: .LC_ListStyleSimple dd,
1.795 www 7425: .LC_ListStyleSimple li {
1.911 bisitz 7426: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7427: }
7428:
1.721 harmsja 7429: .LC_ListStyleSpecial li,
7430: .LC_ListStyleSpecial dd {
1.911 bisitz 7431: list-style-type: none;
7432: background-color: RGB(220, 220, 220);
7433: margin-bottom: 4px;
1.693 droeschl 7434: }
7435:
1.721 harmsja 7436: table.LC_SimpleTable {
1.911 bisitz 7437: margin:5px;
7438: border:solid 1px $lg_border_color;
1.795 www 7439: }
1.693 droeschl 7440:
1.721 harmsja 7441: table.LC_SimpleTable tr {
1.911 bisitz 7442: padding: 0;
7443: border:solid 1px $lg_border_color;
1.693 droeschl 7444: }
1.795 www 7445:
7446: table.LC_SimpleTable thead {
1.911 bisitz 7447: background:rgb(220,220,220);
1.693 droeschl 7448: }
7449:
1.721 harmsja 7450: div.LC_columnSection {
1.911 bisitz 7451: display: block;
7452: clear: both;
7453: overflow: hidden;
7454: margin: 0;
1.693 droeschl 7455: }
7456:
1.721 harmsja 7457: div.LC_columnSection>* {
1.911 bisitz 7458: float: left;
7459: margin: 10px 20px 10px 0;
7460: overflow:hidden;
1.693 droeschl 7461: }
1.721 harmsja 7462:
1.795 www 7463: table em {
1.911 bisitz 7464: font-weight: bold;
7465: font-style: normal;
1.748 schulted 7466: }
1.795 www 7467:
1.779 bisitz 7468: table.LC_tableBrowseRes,
1.795 www 7469: table.LC_tableOfContent {
1.911 bisitz 7470: border:none;
7471: border-spacing: 1px;
7472: padding: 3px;
7473: background-color: #FFFFFF;
7474: font-size: 90%;
1.753 droeschl 7475: }
1.789 droeschl 7476:
1.911 bisitz 7477: table.LC_tableOfContent {
7478: border-collapse: collapse;
1.789 droeschl 7479: }
7480:
1.771 droeschl 7481: table.LC_tableBrowseRes a,
1.768 schulted 7482: table.LC_tableOfContent a {
1.911 bisitz 7483: background-color: transparent;
7484: text-decoration: none;
1.753 droeschl 7485: }
7486:
1.795 www 7487: table.LC_tableOfContent img {
1.911 bisitz 7488: border: none;
7489: height: 1.3em;
7490: vertical-align: text-bottom;
7491: margin-right: 0.3em;
1.753 droeschl 7492: }
1.757 schulted 7493:
1.795 www 7494: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7495: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7496: }
7497:
1.795 www 7498: a#LC_content_toolbar_everything {
1.911 bisitz 7499: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7500: }
7501:
1.795 www 7502: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7503: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7504: }
7505:
1.795 www 7506: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7507: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7508: }
7509:
1.795 www 7510: a#LC_content_toolbar_changefolder {
1.911 bisitz 7511: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7512: }
7513:
1.795 www 7514: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7515: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7516: }
7517:
1.1043 raeburn 7518: a#LC_content_toolbar_edittoplevel {
7519: background-image:url(/res/adm/pages/edittoplevel.gif);
7520: }
7521:
1.795 www 7522: ul#LC_toolbar li a:hover {
1.911 bisitz 7523: background-position: bottom center;
1.757 schulted 7524: }
7525:
1.795 www 7526: ul#LC_toolbar {
1.911 bisitz 7527: padding: 0;
7528: margin: 2px;
7529: list-style:none;
7530: position:relative;
7531: background-color:white;
1.1082 raeburn 7532: overflow: auto;
1.757 schulted 7533: }
7534:
1.795 www 7535: ul#LC_toolbar li {
1.911 bisitz 7536: border:1px solid white;
7537: padding: 0;
7538: margin: 0;
7539: float: left;
7540: display:inline;
7541: vertical-align:middle;
1.1082 raeburn 7542: white-space: nowrap;
1.911 bisitz 7543: }
1.757 schulted 7544:
1.783 amueller 7545:
1.795 www 7546: a.LC_toolbarItem {
1.911 bisitz 7547: display:block;
7548: padding: 0;
7549: margin: 0;
7550: height: 32px;
7551: width: 32px;
7552: color:white;
7553: border: none;
7554: background-repeat:no-repeat;
7555: background-color:transparent;
1.757 schulted 7556: }
7557:
1.915 droeschl 7558: ul.LC_funclist {
7559: margin: 0;
7560: padding: 0.5em 1em 0.5em 0;
7561: }
7562:
1.933 droeschl 7563: ul.LC_funclist > li:first-child {
7564: font-weight:bold;
7565: margin-left:0.8em;
7566: }
7567:
1.915 droeschl 7568: ul.LC_funclist + ul.LC_funclist {
7569: /*
7570: left border as a seperator if we have more than
7571: one list
7572: */
7573: border-left: 1px solid $sidebg;
7574: /*
7575: this hides the left border behind the border of the
7576: outer box if element is wrapped to the next 'line'
7577: */
7578: margin-left: -1px;
7579: }
7580:
1.843 bisitz 7581: ul.LC_funclist li {
1.915 droeschl 7582: display: inline;
1.782 bisitz 7583: white-space: nowrap;
1.915 droeschl 7584: margin: 0 0 0 25px;
7585: line-height: 150%;
1.782 bisitz 7586: }
7587:
1.974 wenzelju 7588: .LC_hidden {
7589: display: none;
7590: }
7591:
1.1030 www 7592: .LCmodal-overlay {
7593: position:fixed;
7594: top:0;
7595: right:0;
7596: bottom:0;
7597: left:0;
7598: height:100%;
7599: width:100%;
7600: margin:0;
7601: padding:0;
7602: background:#999;
7603: opacity:.75;
7604: filter: alpha(opacity=75);
7605: -moz-opacity: 0.75;
7606: z-index:101;
7607: }
7608:
7609: * html .LCmodal-overlay {
7610: position: absolute;
7611: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7612: }
7613:
7614: .LCmodal-window {
7615: position:fixed;
7616: top:50%;
7617: left:50%;
7618: margin:0;
7619: padding:0;
7620: z-index:102;
7621: }
7622:
7623: * html .LCmodal-window {
7624: position:absolute;
7625: }
7626:
7627: .LCclose-window {
7628: position:absolute;
7629: width:32px;
7630: height:32px;
7631: right:8px;
7632: top:8px;
7633: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7634: text-indent:-99999px;
7635: overflow:hidden;
7636: cursor:pointer;
7637: }
7638:
1.1100 raeburn 7639: /*
7640: styles used by TTH when "Default set of options to pass to tth/m
7641: when converting TeX" in course settings has been set
7642:
7643: option passed: -t
7644:
7645: */
7646:
7647: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7648: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7649: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7650: td div.norm {line-height:normal;}
7651:
7652: /*
7653: option passed -y3
7654: */
7655:
7656: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7657: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7658: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7659:
1.343 albertel 7660: END
7661: }
7662:
1.306 albertel 7663: =pod
7664:
7665: =item * &headtag()
7666:
7667: Returns a uniform footer for LON-CAPA web pages.
7668:
1.307 albertel 7669: Inputs: $title - optional title for the head
7670: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7671: $args - optional arguments
1.319 albertel 7672: force_register - if is true call registerurl so the remote is
7673: informed
1.415 albertel 7674: redirect -> array ref of
7675: 1- seconds before redirect occurs
7676: 2- url to redirect to
7677: 3- whether the side effect should occur
1.315 albertel 7678: (side effect of setting
7679: $env{'internal.head.redirect'} to the url
7680: redirected too)
1.352 albertel 7681: domain -> force to color decorate a page for a specific
7682: domain
7683: function -> force usage of a specific rolish color scheme
7684: bgcolor -> override the default page bgcolor
1.460 albertel 7685: no_auto_mt_title
7686: -> prevent &mt()ing the title arg
1.464 albertel 7687:
1.306 albertel 7688: =cut
7689:
7690: sub headtag {
1.313 albertel 7691: my ($title,$head_extra,$args) = @_;
1.306 albertel 7692:
1.363 albertel 7693: my $function = $args->{'function'} || &get_users_function();
7694: my $domain = $args->{'domain'} || &determinedomain();
7695: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7696: my $httphost = $args->{'use_absolute'};
1.418 albertel 7697: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7698: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7699: #time(),
1.418 albertel 7700: $env{'environment.color.timestamp'},
1.363 albertel 7701: $function,$domain,$bgcolor);
7702:
1.369 www 7703: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7704:
1.308 albertel 7705: my $result =
7706: '<head>'.
1.1160 raeburn 7707: &font_settings($args);
1.319 albertel 7708:
1.1188 raeburn 7709: my $inhibitprint;
7710: if ($args->{'print_suppress'}) {
7711: $inhibitprint = &print_suppression();
7712: }
1.1064 raeburn 7713:
1.461 albertel 7714: if (!$args->{'frameset'}) {
7715: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7716: }
1.962 droeschl 7717: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7718: $result .= Apache::lonxml::display_title();
1.319 albertel 7719: }
1.436 albertel 7720: if (!$args->{'no_nav_bar'}
7721: && !$args->{'only_body'}
7722: && !$args->{'frameset'}) {
1.1154 raeburn 7723: $result .= &help_menu_js($httphost);
1.1032 www 7724: $result.=&modal_window();
1.1038 www 7725: $result.=&togglebox_script();
1.1034 www 7726: $result.=&wishlist_window();
1.1041 www 7727: $result.=&LCprogressbarUpdate_script();
1.1034 www 7728: } else {
7729: if ($args->{'add_modal'}) {
7730: $result.=&modal_window();
7731: }
7732: if ($args->{'add_wishlist'}) {
7733: $result.=&wishlist_window();
7734: }
1.1038 www 7735: if ($args->{'add_togglebox'}) {
7736: $result.=&togglebox_script();
7737: }
1.1041 www 7738: if ($args->{'add_progressbar'}) {
7739: $result.=&LCprogressbarUpdate_script();
7740: }
1.436 albertel 7741: }
1.314 albertel 7742: if (ref($args->{'redirect'})) {
1.414 albertel 7743: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7744: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7745: if (!$inhibit_continue) {
7746: $env{'internal.head.redirect'} = $url;
7747: }
1.313 albertel 7748: $result.=<<ADDMETA
7749: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7750: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7751: ADDMETA
1.1210 raeburn 7752: } else {
7753: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7754: my $requrl = $env{'request.uri'};
7755: if ($requrl eq '') {
7756: $requrl = $ENV{'REQUEST_URI'};
7757: $requrl =~ s/\?.+$//;
7758: }
7759: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7760: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7761: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7762: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7763: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7764: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7765: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7766: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7767: if ($domdefs{'offloadnow'}{$lonhost}) {
7768: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7769: if (($newserver) && ($newserver ne $lonhost)) {
7770: my $numsec = 5;
7771: my $timeout = $numsec * 1000;
7772: my ($newurl,$locknum,%locks,$msg);
7773: if ($env{'request.role.adv'}) {
7774: ($locknum,%locks) = &Apache::lonnet::get_locks();
7775: }
7776: my $disable_submit = 0;
7777: if ($requrl =~ /$LONCAPA::assess_re/) {
7778: $disable_submit = 1;
7779: }
7780: if ($locknum) {
7781: my @lockinfo = sort(values(%locks));
7782: $msg = &mt('Once the following tasks are complete: ')."\\n".
7783: join(", ",sort(values(%locks)))."\\n".
7784: &mt('your session will be transferred to a different server, after you click "Roles".');
7785: } else {
7786: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7787: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7788: }
7789: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7790: $newurl = '/adm/switchserver?otherserver='.$newserver;
7791: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7792: $newurl .= '&role='.$env{'request.role'};
7793: }
7794: if ($env{'request.symb'}) {
7795: $newurl .= '&symb='.$env{'request.symb'};
7796: } else {
7797: $newurl .= '&origurl='.$requrl;
7798: }
7799: }
7800: $result.=<<OFFLOAD
7801: <meta http-equiv="pragma" content="no-cache" />
7802: <script type="text/javascript">
1.1215 raeburn 7803: // <![CDATA[
1.1210 raeburn 7804: function LC_Offload_Now() {
7805: var dest = "$newurl";
7806: if (dest != '') {
7807: window.location.href="$newurl";
7808: }
7809: }
1.1214 raeburn 7810: \$(document).ready(function () {
7811: window.alert('$msg');
7812: if ($disable_submit) {
1.1210 raeburn 7813: \$(".LC_hwk_submit").prop("disabled", true);
7814: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 7815: }
7816: setTimeout('LC_Offload_Now()', $timeout);
7817: });
1.1215 raeburn 7818: // ]]>
1.1210 raeburn 7819: </script>
7820: OFFLOAD
7821: }
7822: }
7823: }
7824: }
7825: }
7826: }
1.313 albertel 7827: }
1.306 albertel 7828: if (!defined($title)) {
7829: $title = 'The LearningOnline Network with CAPA';
7830: }
1.460 albertel 7831: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7832: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7833: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7834: if (!$args->{'frameset'}) {
7835: $result .= ' /';
7836: }
7837: $result .= '>'
1.1064 raeburn 7838: .$inhibitprint
1.414 albertel 7839: .$head_extra;
1.1137 raeburn 7840: if ($env{'browser.mobile'}) {
7841: $result .= '
7842: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7843: <meta name="apple-mobile-web-app-capable" content="yes" />';
7844: }
1.962 droeschl 7845: return $result.'</head>';
1.306 albertel 7846: }
7847:
7848: =pod
7849:
1.340 albertel 7850: =item * &font_settings()
7851:
7852: Returns neccessary <meta> to set the proper encoding
7853:
1.1160 raeburn 7854: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7855:
7856: =cut
7857:
7858: sub font_settings {
1.1160 raeburn 7859: my ($args) = @_;
1.340 albertel 7860: my $headerstring='';
1.1160 raeburn 7861: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7862: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7863: $headerstring.=
7864: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7865: if (!$args->{'frameset'}) {
7866: $headerstring.= ' /';
7867: }
7868: $headerstring .= '>'."\n";
1.340 albertel 7869: }
7870: return $headerstring;
7871: }
7872:
1.341 albertel 7873: =pod
7874:
1.1064 raeburn 7875: =item * &print_suppression()
7876:
7877: In course context returns css which causes the body to be blank when media="print",
7878: if printout generation is unavailable for the current resource.
7879:
7880: This could be because:
7881:
7882: (a) printstartdate is in the future
7883:
7884: (b) printenddate is in the past
7885:
7886: (c) there is an active exam block with "printout"
7887: functionality blocked
7888:
7889: Users with pav, pfo or evb privileges are exempt.
7890:
7891: Inputs: none
7892:
7893: =cut
7894:
7895:
7896: sub print_suppression {
7897: my $noprint;
7898: if ($env{'request.course.id'}) {
7899: my $scope = $env{'request.course.id'};
7900: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7901: (&Apache::lonnet::allowed('pfo',$scope))) {
7902: return;
7903: }
7904: if ($env{'request.course.sec'} ne '') {
7905: $scope .= "/$env{'request.course.sec'}";
7906: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7907: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7908: return;
1.1064 raeburn 7909: }
7910: }
7911: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7912: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 7913: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7914: if ($blocked) {
7915: my $checkrole = "cm./$cdom/$cnum";
7916: if ($env{'request.course.sec'} ne '') {
7917: $checkrole .= "/$env{'request.course.sec'}";
7918: }
7919: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7920: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7921: $noprint = 1;
7922: }
7923: }
7924: unless ($noprint) {
7925: my $symb = &Apache::lonnet::symbread();
7926: if ($symb ne '') {
7927: my $navmap = Apache::lonnavmaps::navmap->new();
7928: if (ref($navmap)) {
7929: my $res = $navmap->getBySymb($symb);
7930: if (ref($res)) {
7931: if (!$res->resprintable()) {
7932: $noprint = 1;
7933: }
7934: }
7935: }
7936: }
7937: }
7938: if ($noprint) {
7939: return <<"ENDSTYLE";
7940: <style type="text/css" media="print">
7941: body { display:none }
7942: </style>
7943: ENDSTYLE
7944: }
7945: }
7946: return;
7947: }
7948:
7949: =pod
7950:
1.341 albertel 7951: =item * &xml_begin()
7952:
7953: Returns the needed doctype and <html>
7954:
7955: Inputs: none
7956:
7957: =cut
7958:
7959: sub xml_begin {
1.1168 raeburn 7960: my ($is_frameset) = @_;
1.341 albertel 7961: my $output='';
7962:
7963: if ($env{'browser.mathml'}) {
7964: $output='<?xml version="1.0"?>'
7965: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7966: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7967:
7968: # .'<!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">] >'
7969: .'<!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">'
7970: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7971: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 7972: } elsif ($is_frameset) {
7973: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7974: '<html>'."\n";
1.341 albertel 7975: } else {
1.1168 raeburn 7976: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7977: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7978: }
7979: return $output;
7980: }
1.340 albertel 7981:
7982: =pod
7983:
1.306 albertel 7984: =item * &start_page()
7985:
7986: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7987:
1.648 raeburn 7988: Inputs:
7989:
7990: =over 4
7991:
7992: $title - optional title for the page
7993:
7994: $head_extra - optional extra HTML to incude inside the <head>
7995:
7996: $args - additional optional args supported are:
7997:
7998: =over 8
7999:
8000: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8001: arg on
1.814 bisitz 8002: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8003: add_entries -> additional attributes to add to the <body>
8004: domain -> force to color decorate a page for a
1.317 albertel 8005: specific domain
1.648 raeburn 8006: function -> force usage of a specific rolish color
1.317 albertel 8007: scheme
1.648 raeburn 8008: redirect -> see &headtag()
8009: bgcolor -> override the default page bg color
8010: js_ready -> return a string ready for being used in
1.317 albertel 8011: a javascript writeln
1.648 raeburn 8012: html_encode -> return a string ready for being used in
1.320 albertel 8013: a html attribute
1.648 raeburn 8014: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8015: $forcereg arg
1.648 raeburn 8016: frameset -> if true will start with a <frameset>
1.330 albertel 8017: rather than <body>
1.648 raeburn 8018: skip_phases -> hash ref of
1.338 albertel 8019: head -> skip the <html><head> generation
8020: body -> skip all <body> generation
1.648 raeburn 8021: no_auto_mt_title -> prevent &mt()ing the title arg
8022: inherit_jsmath -> when creating popup window in a page,
8023: should it have jsmath forced on by the
8024: current page
1.867 kalberla 8025: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8026: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8027: group -> includes the current group, if page is for a
8028: specific group
1.361 albertel 8029:
1.648 raeburn 8030: =back
1.460 albertel 8031:
1.648 raeburn 8032: =back
1.562 albertel 8033:
1.306 albertel 8034: =cut
8035:
8036: sub start_page {
1.309 albertel 8037: my ($title,$head_extra,$args) = @_;
1.318 albertel 8038: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8039:
1.315 albertel 8040: $env{'internal.start_page'}++;
1.1096 raeburn 8041: my ($result,@advtools);
1.964 droeschl 8042:
1.338 albertel 8043: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8044: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8045: }
8046:
8047: if (! exists($args->{'skip_phases'}{'body'}) ) {
8048: if ($args->{'frameset'}) {
8049: my $attr_string = &make_attr_string($args->{'force_register'},
8050: $args->{'add_entries'});
8051: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8052: } else {
8053: $result .=
8054: &bodytag($title,
8055: $args->{'function'}, $args->{'add_entries'},
8056: $args->{'only_body'}, $args->{'domain'},
8057: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8058: $args->{'bgcolor'}, $args,
8059: \@advtools);
1.831 bisitz 8060: }
1.330 albertel 8061: }
1.338 albertel 8062:
1.315 albertel 8063: if ($args->{'js_ready'}) {
1.713 kaisler 8064: $result = &js_ready($result);
1.315 albertel 8065: }
1.320 albertel 8066: if ($args->{'html_encode'}) {
1.713 kaisler 8067: $result = &html_encode($result);
8068: }
8069:
1.813 bisitz 8070: # Preparation for new and consistent functionlist at top of screen
8071: # if ($args->{'functionlist'}) {
8072: # $result .= &build_functionlist();
8073: #}
8074:
1.964 droeschl 8075: # Don't add anything more if only_body wanted or in const space
8076: return $result if $args->{'only_body'}
8077: || $env{'request.state'} eq 'construct';
1.813 bisitz 8078:
8079: #Breadcrumbs
1.758 kaisler 8080: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8081: &Apache::lonhtmlcommon::clear_breadcrumbs();
8082: #if any br links exists, add them to the breadcrumbs
8083: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8084: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8085: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8086: }
8087: }
1.1096 raeburn 8088: # if @advtools array contains items add then to the breadcrumbs
8089: if (@advtools > 0) {
8090: &Apache::lonmenu::advtools_crumbs(@advtools);
8091: }
1.758 kaisler 8092:
8093: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8094: if(exists($args->{'bread_crumbs_component'})){
8095: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
8096: }else{
8097: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8098: }
1.320 albertel 8099: }
1.315 albertel 8100: return $result;
1.306 albertel 8101: }
8102:
8103: sub end_page {
1.315 albertel 8104: my ($args) = @_;
8105: $env{'internal.end_page'}++;
1.330 albertel 8106: my $result;
1.335 albertel 8107: if ($args->{'discussion'}) {
8108: my ($target,$parser);
8109: if (ref($args->{'discussion'})) {
8110: ($target,$parser) =($args->{'discussion'}{'target'},
8111: $args->{'discussion'}{'parser'});
8112: }
8113: $result .= &Apache::lonxml::xmlend($target,$parser);
8114: }
1.330 albertel 8115: if ($args->{'frameset'}) {
8116: $result .= '</frameset>';
8117: } else {
1.635 raeburn 8118: $result .= &endbodytag($args);
1.330 albertel 8119: }
1.1080 raeburn 8120: unless ($args->{'notbody'}) {
8121: $result .= "\n</html>";
8122: }
1.330 albertel 8123:
1.315 albertel 8124: if ($args->{'js_ready'}) {
1.317 albertel 8125: $result = &js_ready($result);
1.315 albertel 8126: }
1.335 albertel 8127:
1.320 albertel 8128: if ($args->{'html_encode'}) {
8129: $result = &html_encode($result);
8130: }
1.335 albertel 8131:
1.315 albertel 8132: return $result;
8133: }
8134:
1.1034 www 8135: sub wishlist_window {
8136: return(<<'ENDWISHLIST');
1.1046 raeburn 8137: <script type="text/javascript">
1.1034 www 8138: // <![CDATA[
8139: // <!-- BEGIN LON-CAPA Internal
8140: function set_wishlistlink(title, path) {
8141: if (!title) {
8142: title = document.title;
8143: title = title.replace(/^LON-CAPA /,'');
8144: }
1.1175 raeburn 8145: title = encodeURIComponent(title);
1.1203 raeburn 8146: title = title.replace("'","\\\'");
1.1034 www 8147: if (!path) {
8148: path = location.pathname;
8149: }
1.1175 raeburn 8150: path = encodeURIComponent(path);
1.1203 raeburn 8151: path = path.replace("'","\\\'");
1.1034 www 8152: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8153: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8154: }
8155: // END LON-CAPA Internal -->
8156: // ]]>
8157: </script>
8158: ENDWISHLIST
8159: }
8160:
1.1030 www 8161: sub modal_window {
8162: return(<<'ENDMODAL');
1.1046 raeburn 8163: <script type="text/javascript">
1.1030 www 8164: // <![CDATA[
8165: // <!-- BEGIN LON-CAPA Internal
8166: var modalWindow = {
8167: parent:"body",
8168: windowId:null,
8169: content:null,
8170: width:null,
8171: height:null,
8172: close:function()
8173: {
8174: $(".LCmodal-window").remove();
8175: $(".LCmodal-overlay").remove();
8176: },
8177: open:function()
8178: {
8179: var modal = "";
8180: modal += "<div class=\"LCmodal-overlay\"></div>";
8181: 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;\">";
8182: modal += this.content;
8183: modal += "</div>";
8184:
8185: $(this.parent).append(modal);
8186:
8187: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8188: $(".LCclose-window").click(function(){modalWindow.close();});
8189: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8190: }
8191: };
1.1140 raeburn 8192: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8193: {
1.1203 raeburn 8194: source = source.replace("'","'");
1.1030 www 8195: modalWindow.windowId = "myModal";
8196: modalWindow.width = width;
8197: modalWindow.height = height;
1.1196 raeburn 8198: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8199: modalWindow.open();
1.1208 raeburn 8200: };
1.1030 www 8201: // END LON-CAPA Internal -->
8202: // ]]>
8203: </script>
8204: ENDMODAL
8205: }
8206:
8207: sub modal_link {
1.1140 raeburn 8208: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8209: unless ($width) { $width=480; }
8210: unless ($height) { $height=400; }
1.1031 www 8211: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8212: unless ($transparency) { $transparency='true'; }
8213:
1.1074 raeburn 8214: my $target_attr;
8215: if (defined($target)) {
8216: $target_attr = 'target="'.$target.'"';
8217: }
8218: return <<"ENDLINK";
1.1140 raeburn 8219: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8220: $linktext</a>
8221: ENDLINK
1.1030 www 8222: }
8223:
1.1032 www 8224: sub modal_adhoc_script {
8225: my ($funcname,$width,$height,$content)=@_;
8226: return (<<ENDADHOC);
1.1046 raeburn 8227: <script type="text/javascript">
1.1032 www 8228: // <![CDATA[
8229: var $funcname = function()
8230: {
8231: modalWindow.windowId = "myModal";
8232: modalWindow.width = $width;
8233: modalWindow.height = $height;
8234: modalWindow.content = '$content';
8235: modalWindow.open();
8236: };
8237: // ]]>
8238: </script>
8239: ENDADHOC
8240: }
8241:
1.1041 www 8242: sub modal_adhoc_inner {
8243: my ($funcname,$width,$height,$content)=@_;
8244: my $innerwidth=$width-20;
8245: $content=&js_ready(
1.1140 raeburn 8246: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8247: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8248: $content.
1.1041 www 8249: &end_scrollbox().
1.1140 raeburn 8250: &end_page()
1.1041 www 8251: );
8252: return &modal_adhoc_script($funcname,$width,$height,$content);
8253: }
8254:
8255: sub modal_adhoc_window {
8256: my ($funcname,$width,$height,$content,$linktext)=@_;
8257: return &modal_adhoc_inner($funcname,$width,$height,$content).
8258: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8259: }
8260:
8261: sub modal_adhoc_launch {
8262: my ($funcname,$width,$height,$content)=@_;
8263: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8264: <script type="text/javascript">
8265: // <![CDATA[
8266: $funcname();
8267: // ]]>
8268: </script>
8269: ENDLAUNCH
8270: }
8271:
8272: sub modal_adhoc_close {
8273: return (<<ENDCLOSE);
8274: <script type="text/javascript">
8275: // <![CDATA[
8276: modalWindow.close();
8277: // ]]>
8278: </script>
8279: ENDCLOSE
8280: }
8281:
1.1038 www 8282: sub togglebox_script {
8283: return(<<ENDTOGGLE);
8284: <script type="text/javascript">
8285: // <![CDATA[
8286: function LCtoggleDisplay(id,hidetext,showtext) {
8287: link = document.getElementById(id + "link").childNodes[0];
8288: with (document.getElementById(id).style) {
8289: if (display == "none" ) {
8290: display = "inline";
8291: link.nodeValue = hidetext;
8292: } else {
8293: display = "none";
8294: link.nodeValue = showtext;
8295: }
8296: }
8297: }
8298: // ]]>
8299: </script>
8300: ENDTOGGLE
8301: }
8302:
1.1039 www 8303: sub start_togglebox {
8304: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8305: unless ($heading) { $heading=''; } else { $heading.=' '; }
8306: unless ($showtext) { $showtext=&mt('show'); }
8307: unless ($hidetext) { $hidetext=&mt('hide'); }
8308: unless ($headerbg) { $headerbg='#FFFFFF'; }
8309: return &start_data_table().
8310: &start_data_table_header_row().
8311: '<td bgcolor="'.$headerbg.'">'.$heading.
8312: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8313: $showtext.'\')">'.$showtext.'</a>]</td>'.
8314: &end_data_table_header_row().
8315: '<tr id="'.$id.'" style="display:none""><td>';
8316: }
8317:
8318: sub end_togglebox {
8319: return '</td></tr>'.&end_data_table();
8320: }
8321:
1.1041 www 8322: sub LCprogressbar_script {
1.1045 www 8323: my ($id)=@_;
1.1041 www 8324: return(<<ENDPROGRESS);
8325: <script type="text/javascript">
8326: // <![CDATA[
1.1045 www 8327: \$('#progressbar$id').progressbar({
1.1041 www 8328: value: 0,
8329: change: function(event, ui) {
8330: var newVal = \$(this).progressbar('option', 'value');
8331: \$('.pblabel', this).text(LCprogressTxt);
8332: }
8333: });
8334: // ]]>
8335: </script>
8336: ENDPROGRESS
8337: }
8338:
8339: sub LCprogressbarUpdate_script {
8340: return(<<ENDPROGRESSUPDATE);
8341: <style type="text/css">
8342: .ui-progressbar { position:relative; }
8343: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8344: </style>
8345: <script type="text/javascript">
8346: // <![CDATA[
1.1045 www 8347: var LCprogressTxt='---';
8348:
8349: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8350: LCprogressTxt=progresstext;
1.1045 www 8351: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8352: }
8353: // ]]>
8354: </script>
8355: ENDPROGRESSUPDATE
8356: }
8357:
1.1042 www 8358: my $LClastpercent;
1.1045 www 8359: my $LCidcnt;
8360: my $LCcurrentid;
1.1042 www 8361:
1.1041 www 8362: sub LCprogressbar {
1.1042 www 8363: my ($r)=(@_);
8364: $LClastpercent=0;
1.1045 www 8365: $LCidcnt++;
8366: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8367: my $starting=&mt('Starting');
8368: my $content=(<<ENDPROGBAR);
1.1045 www 8369: <div id="progressbar$LCcurrentid">
1.1041 www 8370: <span class="pblabel">$starting</span>
8371: </div>
8372: ENDPROGBAR
1.1045 www 8373: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8374: }
8375:
8376: sub LCprogressbarUpdate {
1.1042 www 8377: my ($r,$val,$text)=@_;
8378: unless ($val) {
8379: if ($LClastpercent) {
8380: $val=$LClastpercent;
8381: } else {
8382: $val=0;
8383: }
8384: }
1.1041 www 8385: if ($val<0) { $val=0; }
8386: if ($val>100) { $val=0; }
1.1042 www 8387: $LClastpercent=$val;
1.1041 www 8388: unless ($text) { $text=$val.'%'; }
8389: $text=&js_ready($text);
1.1044 www 8390: &r_print($r,<<ENDUPDATE);
1.1041 www 8391: <script type="text/javascript">
8392: // <![CDATA[
1.1045 www 8393: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8394: // ]]>
8395: </script>
8396: ENDUPDATE
1.1035 www 8397: }
8398:
1.1042 www 8399: sub LCprogressbarClose {
8400: my ($r)=@_;
8401: $LClastpercent=0;
1.1044 www 8402: &r_print($r,<<ENDCLOSE);
1.1042 www 8403: <script type="text/javascript">
8404: // <![CDATA[
1.1045 www 8405: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8406: // ]]>
8407: </script>
8408: ENDCLOSE
1.1044 www 8409: }
8410:
8411: sub r_print {
8412: my ($r,$to_print)=@_;
8413: if ($r) {
8414: $r->print($to_print);
8415: $r->rflush();
8416: } else {
8417: print($to_print);
8418: }
1.1042 www 8419: }
8420:
1.320 albertel 8421: sub html_encode {
8422: my ($result) = @_;
8423:
1.322 albertel 8424: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8425:
8426: return $result;
8427: }
1.1044 www 8428:
1.317 albertel 8429: sub js_ready {
8430: my ($result) = @_;
8431:
1.323 albertel 8432: $result =~ s/[\n\r]/ /xmsg;
8433: $result =~ s/\\/\\\\/xmsg;
8434: $result =~ s/'/\\'/xmsg;
1.372 albertel 8435: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8436:
8437: return $result;
8438: }
8439:
1.315 albertel 8440: sub validate_page {
8441: if ( exists($env{'internal.start_page'})
1.316 albertel 8442: && $env{'internal.start_page'} > 1) {
8443: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8444: $env{'internal.start_page'}.' '.
1.316 albertel 8445: $ENV{'request.filename'});
1.315 albertel 8446: }
8447: if ( exists($env{'internal.end_page'})
1.316 albertel 8448: && $env{'internal.end_page'} > 1) {
8449: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8450: $env{'internal.end_page'}.' '.
1.316 albertel 8451: $env{'request.filename'});
1.315 albertel 8452: }
8453: if ( exists($env{'internal.start_page'})
8454: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8455: &Apache::lonnet::logthis('start_page called without end_page '.
8456: $env{'request.filename'});
1.315 albertel 8457: }
8458: if ( ! exists($env{'internal.start_page'})
8459: && exists($env{'internal.end_page'})) {
1.316 albertel 8460: &Apache::lonnet::logthis('end_page called without start_page'.
8461: $env{'request.filename'});
1.315 albertel 8462: }
1.306 albertel 8463: }
1.315 albertel 8464:
1.996 www 8465:
8466: sub start_scrollbox {
1.1140 raeburn 8467: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8468: unless ($outerwidth) { $outerwidth='520px'; }
8469: unless ($width) { $width='500px'; }
8470: unless ($height) { $height='200px'; }
1.1075 raeburn 8471: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8472: if ($id ne '') {
1.1140 raeburn 8473: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8474: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8475: }
1.1075 raeburn 8476: if ($bgcolor ne '') {
8477: $tdcol = "background-color: $bgcolor;";
8478: }
1.1137 raeburn 8479: my $nicescroll_js;
8480: if ($env{'browser.mobile'}) {
1.1140 raeburn 8481: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8482: }
8483: return <<"END";
8484: $nicescroll_js
8485:
8486: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8487: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8488: END
8489: }
8490:
8491: sub end_scrollbox {
8492: return '</div></td></tr></table>';
8493: }
8494:
8495: sub nicescroll_javascript {
8496: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8497: my %options;
8498: if (ref($cursor) eq 'HASH') {
8499: %options = %{$cursor};
8500: }
8501: unless ($options{'railalign'} =~ /^left|right$/) {
8502: $options{'railalign'} = 'left';
8503: }
8504: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8505: my $function = &get_users_function();
8506: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8507: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8508: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8509: }
1.1140 raeburn 8510: }
8511: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8512: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8513: $options{'cursoropacity'}='1.0';
8514: }
1.1140 raeburn 8515: } else {
8516: $options{'cursoropacity'}='1.0';
8517: }
8518: if ($options{'cursorfixedheight'} eq 'none') {
8519: delete($options{'cursorfixedheight'});
8520: } else {
8521: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8522: }
8523: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8524: delete($options{'railoffset'});
8525: }
8526: my @niceoptions;
8527: while (my($key,$value) = each(%options)) {
8528: if ($value =~ /^\{.+\}$/) {
8529: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8530: } else {
1.1140 raeburn 8531: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8532: }
1.1140 raeburn 8533: }
8534: my $nicescroll_js = '
1.1137 raeburn 8535: $(document).ready(
1.1140 raeburn 8536: function() {
8537: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8538: }
1.1137 raeburn 8539: );
8540: ';
1.1140 raeburn 8541: if ($framecheck) {
8542: $nicescroll_js .= '
8543: function expand_div(caller) {
8544: if (top === self) {
8545: document.getElementById("'.$id.'").style.width = "auto";
8546: document.getElementById("'.$id.'").style.height = "auto";
8547: } else {
8548: try {
8549: if (parent.frames) {
8550: if (parent.frames.length > 1) {
8551: var framesrc = parent.frames[1].location.href;
8552: var currsrc = framesrc.replace(/\#.*$/,"");
8553: if ((caller == "search") || (currsrc == "'.$location.'")) {
8554: document.getElementById("'.$id.'").style.width = "auto";
8555: document.getElementById("'.$id.'").style.height = "auto";
8556: }
8557: }
8558: }
8559: } catch (e) {
8560: return;
8561: }
1.1137 raeburn 8562: }
1.1140 raeburn 8563: return;
1.996 www 8564: }
1.1140 raeburn 8565: ';
8566: }
8567: if ($needjsready) {
8568: $nicescroll_js = '
8569: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8570: } else {
8571: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8572: }
8573: return $nicescroll_js;
1.996 www 8574: }
8575:
1.318 albertel 8576: sub simple_error_page {
1.1150 bisitz 8577: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8578: if (ref($args) eq 'HASH') {
8579: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8580: } else {
8581: $msg = &mt($msg);
8582: }
1.1150 bisitz 8583:
1.318 albertel 8584: my $page =
8585: &Apache::loncommon::start_page($title).
1.1150 bisitz 8586: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8587: &Apache::loncommon::end_page();
8588: if (ref($r)) {
8589: $r->print($page);
1.327 albertel 8590: return;
1.318 albertel 8591: }
8592: return $page;
8593: }
1.347 albertel 8594:
8595: {
1.610 albertel 8596: my @row_count;
1.961 onken 8597:
8598: sub start_data_table_count {
8599: unshift(@row_count, 0);
8600: return;
8601: }
8602:
8603: sub end_data_table_count {
8604: shift(@row_count);
8605: return;
8606: }
8607:
1.347 albertel 8608: sub start_data_table {
1.1018 raeburn 8609: my ($add_class,$id) = @_;
1.422 albertel 8610: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8611: my $table_id;
8612: if (defined($id)) {
8613: $table_id = ' id="'.$id.'"';
8614: }
1.961 onken 8615: &start_data_table_count();
1.1018 raeburn 8616: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8617: }
8618:
8619: sub end_data_table {
1.961 onken 8620: &end_data_table_count();
1.389 albertel 8621: return '</table>'."\n";;
1.347 albertel 8622: }
8623:
8624: sub start_data_table_row {
1.974 wenzelju 8625: my ($add_class, $id) = @_;
1.610 albertel 8626: $row_count[0]++;
8627: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8628: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8629: $id = (' id="'.$id.'"') unless ($id eq '');
8630: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8631: }
1.471 banghart 8632:
8633: sub continue_data_table_row {
1.974 wenzelju 8634: my ($add_class, $id) = @_;
1.610 albertel 8635: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8636: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8637: $id = (' id="'.$id.'"') unless ($id eq '');
8638: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8639: }
1.347 albertel 8640:
8641: sub end_data_table_row {
1.389 albertel 8642: return '</tr>'."\n";;
1.347 albertel 8643: }
1.367 www 8644:
1.421 albertel 8645: sub start_data_table_empty_row {
1.707 bisitz 8646: # $row_count[0]++;
1.421 albertel 8647: return '<tr class="LC_empty_row" >'."\n";;
8648: }
8649:
8650: sub end_data_table_empty_row {
8651: return '</tr>'."\n";;
8652: }
8653:
1.367 www 8654: sub start_data_table_header_row {
1.389 albertel 8655: return '<tr class="LC_header_row">'."\n";;
1.367 www 8656: }
8657:
8658: sub end_data_table_header_row {
1.389 albertel 8659: return '</tr>'."\n";;
1.367 www 8660: }
1.890 droeschl 8661:
8662: sub data_table_caption {
8663: my $caption = shift;
8664: return "<caption class=\"LC_caption\">$caption</caption>";
8665: }
1.347 albertel 8666: }
8667:
1.548 albertel 8668: =pod
8669:
8670: =item * &inhibit_menu_check($arg)
8671:
8672: Checks for a inhibitmenu state and generates output to preserve it
8673:
8674: Inputs: $arg - can be any of
8675: - undef - in which case the return value is a string
8676: to add into arguments list of a uri
8677: - 'input' - in which case the return value is a HTML
8678: <form> <input> field of type hidden to
8679: preserve the value
8680: - a url - in which case the return value is the url with
8681: the neccesary cgi args added to preserve the
8682: inhibitmenu state
8683: - a ref to a url - no return value, but the string is
8684: updated to include the neccessary cgi
8685: args to preserve the inhibitmenu state
8686:
8687: =cut
8688:
8689: sub inhibit_menu_check {
8690: my ($arg) = @_;
8691: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8692: if ($arg eq 'input') {
8693: if ($env{'form.inhibitmenu'}) {
8694: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8695: } else {
8696: return
8697: }
8698: }
8699: if ($env{'form.inhibitmenu'}) {
8700: if (ref($arg)) {
8701: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8702: } elsif ($arg eq '') {
8703: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8704: } else {
8705: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8706: }
8707: }
8708: if (!ref($arg)) {
8709: return $arg;
8710: }
8711: }
8712:
1.251 albertel 8713: ###############################################
1.182 matthew 8714:
8715: =pod
8716:
1.549 albertel 8717: =back
8718:
8719: =head1 User Information Routines
8720:
8721: =over 4
8722:
1.405 albertel 8723: =item * &get_users_function()
1.182 matthew 8724:
8725: Used by &bodytag to determine the current users primary role.
8726: Returns either 'student','coordinator','admin', or 'author'.
8727:
8728: =cut
8729:
8730: ###############################################
8731: sub get_users_function {
1.815 tempelho 8732: my $function = 'norole';
1.818 tempelho 8733: if ($env{'request.role'}=~/^(st)/) {
8734: $function='student';
8735: }
1.907 raeburn 8736: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8737: $function='coordinator';
8738: }
1.258 albertel 8739: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8740: $function='admin';
8741: }
1.826 bisitz 8742: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8743: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8744: $function='author';
8745: }
8746: return $function;
1.54 www 8747: }
1.99 www 8748:
8749: ###############################################
8750:
1.233 raeburn 8751: =pod
8752:
1.821 raeburn 8753: =item * &show_course()
8754:
8755: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8756: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8757:
8758: Inputs:
8759: None
8760:
8761: Outputs:
8762: Scalar: 1 if 'Course' to be used, 0 otherwise.
8763:
8764: =cut
8765:
8766: ###############################################
8767: sub show_course {
8768: my $course = !$env{'user.adv'};
8769: if (!$env{'user.adv'}) {
8770: foreach my $env (keys(%env)) {
8771: next if ($env !~ m/^user\.priv\./);
8772: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8773: $course = 0;
8774: last;
8775: }
8776: }
8777: }
8778: return $course;
8779: }
8780:
8781: ###############################################
8782:
8783: =pod
8784:
1.542 raeburn 8785: =item * &check_user_status()
1.274 raeburn 8786:
8787: Determines current status of supplied role for a
8788: specific user. Roles can be active, previous or future.
8789:
8790: Inputs:
8791: user's domain, user's username, course's domain,
1.375 raeburn 8792: course's number, optional section ID.
1.274 raeburn 8793:
8794: Outputs:
8795: role status: active, previous or future.
8796:
8797: =cut
8798:
8799: sub check_user_status {
1.412 raeburn 8800: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8801: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 8802: my @uroles = keys(%userinfo);
1.274 raeburn 8803: my $srchstr;
8804: my $active_chk = 'none';
1.412 raeburn 8805: my $now = time;
1.274 raeburn 8806: if (@uroles > 0) {
1.908 raeburn 8807: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8808: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8809: } else {
1.412 raeburn 8810: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8811: }
8812: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8813: my $role_end = 0;
8814: my $role_start = 0;
8815: $active_chk = 'active';
1.412 raeburn 8816: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8817: $role_end = $1;
8818: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8819: $role_start = $1;
1.274 raeburn 8820: }
8821: }
8822: if ($role_start > 0) {
1.412 raeburn 8823: if ($now < $role_start) {
1.274 raeburn 8824: $active_chk = 'future';
8825: }
8826: }
8827: if ($role_end > 0) {
1.412 raeburn 8828: if ($now > $role_end) {
1.274 raeburn 8829: $active_chk = 'previous';
8830: }
8831: }
8832: }
8833: }
8834: return $active_chk;
8835: }
8836:
8837: ###############################################
8838:
8839: =pod
8840:
1.405 albertel 8841: =item * &get_sections()
1.233 raeburn 8842:
8843: Determines all the sections for a course including
8844: sections with students and sections containing other roles.
1.419 raeburn 8845: Incoming parameters:
8846:
8847: 1. domain
8848: 2. course number
8849: 3. reference to array containing roles for which sections should
8850: be gathered (optional).
8851: 4. reference to array containing status types for which sections
8852: should be gathered (optional).
8853:
8854: If the third argument is undefined, sections are gathered for any role.
8855: If the fourth argument is undefined, sections are gathered for any status.
8856: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8857:
1.374 raeburn 8858: Returns section hash (keys are section IDs, values are
8859: number of users in each section), subject to the
1.419 raeburn 8860: optional roles filter, optional status filter
1.233 raeburn 8861:
8862: =cut
8863:
8864: ###############################################
8865: sub get_sections {
1.419 raeburn 8866: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8867: if (!defined($cdom) || !defined($cnum)) {
8868: my $cid = $env{'request.course.id'};
8869:
8870: return if (!defined($cid));
8871:
8872: $cdom = $env{'course.'.$cid.'.domain'};
8873: $cnum = $env{'course.'.$cid.'.num'};
8874: }
8875:
8876: my %sectioncount;
1.419 raeburn 8877: my $now = time;
1.240 albertel 8878:
1.1118 raeburn 8879: my $check_students = 1;
8880: my $only_students = 0;
8881: if (ref($possible_roles) eq 'ARRAY') {
8882: if (grep(/^st$/,@{$possible_roles})) {
8883: if (@{$possible_roles} == 1) {
8884: $only_students = 1;
8885: }
8886: } else {
8887: $check_students = 0;
8888: }
8889: }
8890:
8891: if ($check_students) {
1.276 albertel 8892: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8893: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8894: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8895: my $start_index = &Apache::loncoursedata::CL_START();
8896: my $end_index = &Apache::loncoursedata::CL_END();
8897: my $status;
1.366 albertel 8898: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8899: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8900: $data->[$status_index],
8901: $data->[$start_index],
8902: $data->[$end_index]);
8903: if ($stu_status eq 'Active') {
8904: $status = 'active';
8905: } elsif ($end < $now) {
8906: $status = 'previous';
8907: } elsif ($start > $now) {
8908: $status = 'future';
8909: }
8910: if ($section ne '-1' && $section !~ /^\s*$/) {
8911: if ((!defined($possible_status)) || (($status ne '') &&
8912: (grep/^\Q$status\E$/,@{$possible_status}))) {
8913: $sectioncount{$section}++;
8914: }
1.240 albertel 8915: }
8916: }
8917: }
1.1118 raeburn 8918: if ($only_students) {
8919: return %sectioncount;
8920: }
1.240 albertel 8921: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8922: foreach my $user (sort(keys(%courseroles))) {
8923: if ($user !~ /^(\w{2})/) { next; }
8924: my ($role) = ($user =~ /^(\w{2})/);
8925: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8926: my ($section,$status);
1.240 albertel 8927: if ($role eq 'cr' &&
8928: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8929: $section=$1;
8930: }
8931: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8932: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8933: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8934: if ($end == -1 && $start == -1) {
8935: next; #deleted role
8936: }
8937: if (!defined($possible_status)) {
8938: $sectioncount{$section}++;
8939: } else {
8940: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8941: $status = 'active';
8942: } elsif ($end < $now) {
8943: $status = 'future';
8944: } elsif ($start > $now) {
8945: $status = 'previous';
8946: }
8947: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8948: $sectioncount{$section}++;
8949: }
8950: }
1.233 raeburn 8951: }
1.366 albertel 8952: return %sectioncount;
1.233 raeburn 8953: }
8954:
1.274 raeburn 8955: ###############################################
1.294 raeburn 8956:
8957: =pod
1.405 albertel 8958:
8959: =item * &get_course_users()
8960:
1.275 raeburn 8961: Retrieves usernames:domains for users in the specified course
8962: with specific role(s), and access status.
8963:
8964: Incoming parameters:
1.277 albertel 8965: 1. course domain
8966: 2. course number
8967: 3. access status: users must have - either active,
1.275 raeburn 8968: previous, future, or all.
1.277 albertel 8969: 4. reference to array of permissible roles
1.288 raeburn 8970: 5. reference to array of section restrictions (optional)
8971: 6. reference to results object (hash of hashes).
8972: 7. reference to optional userdata hash
1.609 raeburn 8973: 8. reference to optional statushash
1.630 raeburn 8974: 9. flag if privileged users (except those set to unhide in
8975: course settings) should be excluded
1.609 raeburn 8976: Keys of top level results hash are roles.
1.275 raeburn 8977: Keys of inner hashes are username:domain, with
8978: values set to access type.
1.288 raeburn 8979: Optional userdata hash returns an array with arguments in the
8980: same order as loncoursedata::get_classlist() for student data.
8981:
1.609 raeburn 8982: Optional statushash returns
8983:
1.288 raeburn 8984: Entries for end, start, section and status are blank because
8985: of the possibility of multiple values for non-student roles.
8986:
1.275 raeburn 8987: =cut
1.405 albertel 8988:
1.275 raeburn 8989: ###############################################
1.405 albertel 8990:
1.275 raeburn 8991: sub get_course_users {
1.630 raeburn 8992: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8993: my %idx = ();
1.419 raeburn 8994: my %seclists;
1.288 raeburn 8995:
8996: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8997: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8998: $idx{end} = &Apache::loncoursedata::CL_END();
8999: $idx{start} = &Apache::loncoursedata::CL_START();
9000: $idx{id} = &Apache::loncoursedata::CL_ID();
9001: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9002: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9003: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9004:
1.290 albertel 9005: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9006: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9007: my $now = time;
1.277 albertel 9008: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9009: my $match = 0;
1.412 raeburn 9010: my $secmatch = 0;
1.419 raeburn 9011: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9012: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9013: if ($section eq '') {
9014: $section = 'none';
9015: }
1.291 albertel 9016: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9017: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9018: $secmatch = 1;
9019: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9020: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9021: $secmatch = 1;
9022: }
9023: } else {
1.419 raeburn 9024: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9025: $secmatch = 1;
9026: }
1.290 albertel 9027: }
1.412 raeburn 9028: if (!$secmatch) {
9029: next;
9030: }
1.419 raeburn 9031: }
1.275 raeburn 9032: if (defined($$types{'active'})) {
1.288 raeburn 9033: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9034: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9035: $match = 1;
1.275 raeburn 9036: }
9037: }
9038: if (defined($$types{'previous'})) {
1.609 raeburn 9039: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9040: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9041: $match = 1;
1.275 raeburn 9042: }
9043: }
9044: if (defined($$types{'future'})) {
1.609 raeburn 9045: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9046: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9047: $match = 1;
1.275 raeburn 9048: }
9049: }
1.609 raeburn 9050: if ($match) {
9051: push(@{$seclists{$student}},$section);
9052: if (ref($userdata) eq 'HASH') {
9053: $$userdata{$student} = $$classlist{$student};
9054: }
9055: if (ref($statushash) eq 'HASH') {
9056: $statushash->{$student}{'st'}{$section} = $status;
9057: }
1.288 raeburn 9058: }
1.275 raeburn 9059: }
9060: }
1.412 raeburn 9061: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9062: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9063: my $now = time;
1.609 raeburn 9064: my %displaystatus = ( previous => 'Expired',
9065: active => 'Active',
9066: future => 'Future',
9067: );
1.1121 raeburn 9068: my (%nothide,@possdoms);
1.630 raeburn 9069: if ($hidepriv) {
9070: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9071: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9072: if ($user !~ /:/) {
9073: $nothide{join(':',split(/[\@]/,$user))}=1;
9074: } else {
9075: $nothide{$user} = 1;
9076: }
9077: }
1.1121 raeburn 9078: my @possdoms = ($cdom);
9079: if ($coursehash{'checkforpriv'}) {
9080: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9081: }
1.630 raeburn 9082: }
1.439 raeburn 9083: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9084: my $match = 0;
1.412 raeburn 9085: my $secmatch = 0;
1.439 raeburn 9086: my $status;
1.412 raeburn 9087: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9088: $user =~ s/:$//;
1.439 raeburn 9089: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9090: if ($end == -1 || $start == -1) {
9091: next;
9092: }
9093: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9094: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9095: my ($uname,$udom) = split(/:/,$user);
9096: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9097: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9098: $secmatch = 1;
9099: } elsif ($usec eq '') {
1.420 albertel 9100: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9101: $secmatch = 1;
9102: }
9103: } else {
9104: if (grep(/^\Q$usec\E$/,@{$sections})) {
9105: $secmatch = 1;
9106: }
9107: }
9108: if (!$secmatch) {
9109: next;
9110: }
1.288 raeburn 9111: }
1.419 raeburn 9112: if ($usec eq '') {
9113: $usec = 'none';
9114: }
1.275 raeburn 9115: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9116: if ($hidepriv) {
1.1121 raeburn 9117: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9118: (!$nothide{$uname.':'.$udom})) {
9119: next;
9120: }
9121: }
1.503 raeburn 9122: if ($end > 0 && $end < $now) {
1.439 raeburn 9123: $status = 'previous';
9124: } elsif ($start > $now) {
9125: $status = 'future';
9126: } else {
9127: $status = 'active';
9128: }
1.277 albertel 9129: foreach my $type (keys(%{$types})) {
1.275 raeburn 9130: if ($status eq $type) {
1.420 albertel 9131: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9132: push(@{$$users{$role}{$user}},$type);
9133: }
1.288 raeburn 9134: $match = 1;
9135: }
9136: }
1.419 raeburn 9137: if (($match) && (ref($userdata) eq 'HASH')) {
9138: if (!exists($$userdata{$uname.':'.$udom})) {
9139: &get_user_info($udom,$uname,\%idx,$userdata);
9140: }
1.420 albertel 9141: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9142: push(@{$seclists{$uname.':'.$udom}},$usec);
9143: }
1.609 raeburn 9144: if (ref($statushash) eq 'HASH') {
9145: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9146: }
1.275 raeburn 9147: }
9148: }
9149: }
9150: }
1.290 albertel 9151: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9152: if ((defined($cdom)) && (defined($cnum))) {
9153: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9154: if ( defined($csettings{'internal.courseowner'}) ) {
9155: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9156: next if ($owner eq '');
9157: my ($ownername,$ownerdom);
9158: if ($owner =~ /^([^:]+):([^:]+)$/) {
9159: $ownername = $1;
9160: $ownerdom = $2;
9161: } else {
9162: $ownername = $owner;
9163: $ownerdom = $cdom;
9164: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9165: }
9166: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9167: if (defined($userdata) &&
1.609 raeburn 9168: !exists($$userdata{$owner})) {
9169: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9170: if (!grep(/^none$/,@{$seclists{$owner}})) {
9171: push(@{$seclists{$owner}},'none');
9172: }
9173: if (ref($statushash) eq 'HASH') {
9174: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9175: }
1.290 albertel 9176: }
1.279 raeburn 9177: }
9178: }
9179: }
1.419 raeburn 9180: foreach my $user (keys(%seclists)) {
9181: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9182: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9183: }
1.275 raeburn 9184: }
9185: return;
9186: }
9187:
1.288 raeburn 9188: sub get_user_info {
9189: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9190: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9191: &plainname($uname,$udom,'lastname');
1.291 albertel 9192: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9193: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9194: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9195: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9196: return;
9197: }
1.275 raeburn 9198:
1.472 raeburn 9199: ###############################################
9200:
9201: =pod
9202:
9203: =item * &get_user_quota()
9204:
1.1134 raeburn 9205: Retrieves quota assigned for storage of user files.
9206: Default is to report quota for portfolio files.
1.472 raeburn 9207:
9208: Incoming parameters:
9209: 1. user's username
9210: 2. user's domain
1.1134 raeburn 9211: 3. quota name - portfolio, author, or course
1.1136 raeburn 9212: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 9213: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 9214: course
1.472 raeburn 9215:
9216: Returns:
1.1163 raeburn 9217: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9218: 2. (Optional) Type of setting: custom or default
9219: (individually assigned or default for user's
9220: institutional status).
9221: 3. (Optional) - User's institutional status (e.g., faculty, staff
9222: or student - types as defined in localenroll::inst_usertypes
9223: for user's domain, which determines default quota for user.
9224: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9225:
9226: If a value has been stored in the user's environment,
1.536 raeburn 9227: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9228: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9229:
9230: =cut
9231:
9232: ###############################################
9233:
9234:
9235: sub get_user_quota {
1.1136 raeburn 9236: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9237: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9238: if (!defined($udom)) {
9239: $udom = $env{'user.domain'};
9240: }
9241: if (!defined($uname)) {
9242: $uname = $env{'user.name'};
9243: }
9244: if (($udom eq '' || $uname eq '') ||
9245: ($udom eq 'public') && ($uname eq 'public')) {
9246: $quota = 0;
1.536 raeburn 9247: $quotatype = 'default';
9248: $defquota = 0;
1.472 raeburn 9249: } else {
1.536 raeburn 9250: my $inststatus;
1.1134 raeburn 9251: if ($quotaname eq 'course') {
9252: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9253: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9254: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9255: } else {
9256: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9257: $quota = $cenv{'internal.uploadquota'};
9258: }
1.536 raeburn 9259: } else {
1.1134 raeburn 9260: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9261: if ($quotaname eq 'author') {
9262: $quota = $env{'environment.authorquota'};
9263: } else {
9264: $quota = $env{'environment.portfolioquota'};
9265: }
9266: $inststatus = $env{'environment.inststatus'};
9267: } else {
9268: my %userenv =
9269: &Apache::lonnet::get('environment',['portfolioquota',
9270: 'authorquota','inststatus'],$udom,$uname);
9271: my ($tmp) = keys(%userenv);
9272: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9273: if ($quotaname eq 'author') {
9274: $quota = $userenv{'authorquota'};
9275: } else {
9276: $quota = $userenv{'portfolioquota'};
9277: }
9278: $inststatus = $userenv{'inststatus'};
9279: } else {
9280: undef(%userenv);
9281: }
9282: }
9283: }
9284: if ($quota eq '' || wantarray) {
9285: if ($quotaname eq 'course') {
9286: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9287: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
9288: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 9289: $defquota = $domdefs{$crstype.'quota'};
9290: }
9291: if ($defquota eq '') {
9292: $defquota = 500;
9293: }
1.1134 raeburn 9294: } else {
9295: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9296: }
9297: if ($quota eq '') {
9298: $quota = $defquota;
9299: $quotatype = 'default';
9300: } else {
9301: $quotatype = 'custom';
9302: }
1.472 raeburn 9303: }
9304: }
1.536 raeburn 9305: if (wantarray) {
9306: return ($quota,$quotatype,$settingstatus,$defquota);
9307: } else {
9308: return $quota;
9309: }
1.472 raeburn 9310: }
9311:
9312: ###############################################
9313:
9314: =pod
9315:
9316: =item * &default_quota()
9317:
1.536 raeburn 9318: Retrieves default quota assigned for storage of user portfolio files,
9319: given an (optional) user's institutional status.
1.472 raeburn 9320:
9321: Incoming parameters:
1.1142 raeburn 9322:
1.472 raeburn 9323: 1. domain
1.536 raeburn 9324: 2. (Optional) institutional status(es). This is a : separated list of
9325: status types (e.g., faculty, staff, student etc.)
9326: which apply to the user for whom the default is being retrieved.
9327: If the institutional status string in undefined, the domain
1.1134 raeburn 9328: default quota will be returned.
9329: 3. quota name - portfolio, author, or course
9330: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9331:
9332: Returns:
1.1142 raeburn 9333:
1.1163 raeburn 9334: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9335: 2. (Optional) institutional type which determined the value of the
9336: default quota.
1.472 raeburn 9337:
9338: If a value has been stored in the domain's configuration db,
9339: it will return that, otherwise it returns 20 (for backwards
9340: compatibility with domains which have not set up a configuration
1.1163 raeburn 9341: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9342:
1.536 raeburn 9343: If the user's status includes multiple types (e.g., staff and student),
9344: the largest default quota which applies to the user determines the
9345: default quota returned.
9346:
1.472 raeburn 9347: =cut
9348:
9349: ###############################################
9350:
9351:
9352: sub default_quota {
1.1134 raeburn 9353: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9354: my ($defquota,$settingstatus);
9355: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9356: ['quotas'],$udom);
1.1134 raeburn 9357: my $key = 'defaultquota';
9358: if ($quotaname eq 'author') {
9359: $key = 'authorquota';
9360: }
1.622 raeburn 9361: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9362: if ($inststatus ne '') {
1.765 raeburn 9363: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9364: foreach my $item (@statuses) {
1.1134 raeburn 9365: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9366: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9367: if ($defquota eq '') {
1.1134 raeburn 9368: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9369: $settingstatus = $item;
1.1134 raeburn 9370: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9371: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9372: $settingstatus = $item;
9373: }
9374: }
1.1134 raeburn 9375: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9376: if ($quotahash{'quotas'}{$item} ne '') {
9377: if ($defquota eq '') {
9378: $defquota = $quotahash{'quotas'}{$item};
9379: $settingstatus = $item;
9380: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9381: $defquota = $quotahash{'quotas'}{$item};
9382: $settingstatus = $item;
9383: }
1.536 raeburn 9384: }
9385: }
9386: }
9387: }
9388: if ($defquota eq '') {
1.1134 raeburn 9389: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9390: $defquota = $quotahash{'quotas'}{$key}{'default'};
9391: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9392: $defquota = $quotahash{'quotas'}{'default'};
9393: }
1.536 raeburn 9394: $settingstatus = 'default';
1.1139 raeburn 9395: if ($defquota eq '') {
9396: if ($quotaname eq 'author') {
9397: $defquota = 500;
9398: }
9399: }
1.536 raeburn 9400: }
9401: } else {
9402: $settingstatus = 'default';
1.1134 raeburn 9403: if ($quotaname eq 'author') {
9404: $defquota = 500;
9405: } else {
9406: $defquota = 20;
9407: }
1.536 raeburn 9408: }
9409: if (wantarray) {
9410: return ($defquota,$settingstatus);
1.472 raeburn 9411: } else {
1.536 raeburn 9412: return $defquota;
1.472 raeburn 9413: }
9414: }
9415:
1.1135 raeburn 9416: ###############################################
9417:
9418: =pod
9419:
1.1136 raeburn 9420: =item * &excess_filesize_warning()
1.1135 raeburn 9421:
9422: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9423: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9424: space to be exceeded.
1.1136 raeburn 9425:
9426: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9427: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9428:
1.1165 raeburn 9429: Inputs: 7
1.1136 raeburn 9430: 1. username or coursenum
1.1135 raeburn 9431: 2. domain
1.1136 raeburn 9432: 3. context ('author' or 'course')
1.1135 raeburn 9433: 4. filename of file for which action is being requested
9434: 5. filesize (kB) of file
9435: 6. action being taken: copy or upload.
1.1165 raeburn 9436: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 9437:
9438: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9439: otherwise return null.
9440:
9441: =back
1.1135 raeburn 9442:
9443: =cut
9444:
1.1136 raeburn 9445: sub excess_filesize_warning {
1.1165 raeburn 9446: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9447: my $current_disk_usage = 0;
1.1165 raeburn 9448: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9449: if ($context eq 'author') {
9450: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9451: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9452: } else {
9453: foreach my $subdir ('docs','supplemental') {
9454: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9455: }
9456: }
1.1135 raeburn 9457: $disk_quota = int($disk_quota * 1000);
9458: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9459: return '<p class="LC_warning">'.
1.1135 raeburn 9460: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9461: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9462: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9463: $disk_quota,$current_disk_usage).
9464: '</p>';
9465: }
9466: return;
9467: }
9468:
9469: ###############################################
9470:
9471:
1.1136 raeburn 9472:
9473:
1.384 raeburn 9474: sub get_secgrprole_info {
9475: my ($cdom,$cnum,$needroles,$type) = @_;
9476: my %sections_count = &get_sections($cdom,$cnum);
9477: my @sections = (sort {$a <=> $b} keys(%sections_count));
9478: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9479: my @groups = sort(keys(%curr_groups));
9480: my $allroles = [];
9481: my $rolehash;
9482: my $accesshash = {
9483: active => 'Currently has access',
9484: future => 'Will have future access',
9485: previous => 'Previously had access',
9486: };
9487: if ($needroles) {
9488: $rolehash = {'all' => 'all'};
1.385 albertel 9489: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9490: if (&Apache::lonnet::error(%user_roles)) {
9491: undef(%user_roles);
9492: }
9493: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9494: my ($role)=split(/\:/,$item,2);
9495: if ($role eq 'cr') { next; }
9496: if ($role =~ /^cr/) {
9497: $$rolehash{$role} = (split('/',$role))[3];
9498: } else {
9499: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9500: }
9501: }
9502: foreach my $key (sort(keys(%{$rolehash}))) {
9503: push(@{$allroles},$key);
9504: }
9505: push (@{$allroles},'st');
9506: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9507: }
9508: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9509: }
9510:
1.555 raeburn 9511: sub user_picker {
1.994 raeburn 9512: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9513: my $currdom = $dom;
9514: my %curr_selected = (
9515: srchin => 'dom',
1.580 raeburn 9516: srchby => 'lastname',
1.555 raeburn 9517: );
9518: my $srchterm;
1.625 raeburn 9519: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9520: if ($srch->{'srchby'} ne '') {
9521: $curr_selected{'srchby'} = $srch->{'srchby'};
9522: }
9523: if ($srch->{'srchin'} ne '') {
9524: $curr_selected{'srchin'} = $srch->{'srchin'};
9525: }
9526: if ($srch->{'srchtype'} ne '') {
9527: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9528: }
9529: if ($srch->{'srchdomain'} ne '') {
9530: $currdom = $srch->{'srchdomain'};
9531: }
9532: $srchterm = $srch->{'srchterm'};
9533: }
9534: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9535: 'usr' => 'Search criteria',
1.563 raeburn 9536: 'doma' => 'Domain/institution to search',
1.558 albertel 9537: 'uname' => 'username',
9538: 'lastname' => 'last name',
1.555 raeburn 9539: 'lastfirst' => 'last name, first name',
1.558 albertel 9540: 'crs' => 'in this course',
1.576 raeburn 9541: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9542: 'alc' => 'all LON-CAPA',
1.573 raeburn 9543: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9544: 'exact' => 'is',
9545: 'contains' => 'contains',
1.569 raeburn 9546: 'begins' => 'begins with',
1.571 raeburn 9547: 'youm' => "You must include some text to search for.",
9548: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9549: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9550: 'yomc' => "You must choose a domain when using an institutional directory search.",
9551: 'ymcd' => "You must choose a domain when using a domain search.",
9552: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9553: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9554: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9555: );
1.563 raeburn 9556: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9557: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9558:
9559: my @srchins = ('crs','dom','alc','instd');
9560:
9561: foreach my $option (@srchins) {
9562: # FIXME 'alc' option unavailable until
9563: # loncreateuser::print_user_query_page()
9564: # has been completed.
9565: next if ($option eq 'alc');
1.880 raeburn 9566: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9567: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9568: if ($curr_selected{'srchin'} eq $option) {
9569: $srchinsel .= '
9570: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9571: } else {
9572: $srchinsel .= '
9573: <option value="'.$option.'">'.$lt{$option}.'</option>';
9574: }
1.555 raeburn 9575: }
1.563 raeburn 9576: $srchinsel .= "\n </select>\n";
1.555 raeburn 9577:
9578: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9579: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9580: if ($curr_selected{'srchby'} eq $option) {
9581: $srchbysel .= '
9582: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9583: } else {
9584: $srchbysel .= '
9585: <option value="'.$option.'">'.$lt{$option}.'</option>';
9586: }
9587: }
9588: $srchbysel .= "\n </select>\n";
9589:
9590: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9591: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9592: if ($curr_selected{'srchtype'} eq $option) {
9593: $srchtypesel .= '
9594: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9595: } else {
9596: $srchtypesel .= '
9597: <option value="'.$option.'">'.$lt{$option}.'</option>';
9598: }
9599: }
9600: $srchtypesel .= "\n </select>\n";
9601:
1.558 albertel 9602: my ($newuserscript,$new_user_create);
1.994 raeburn 9603: my $context_dom = $env{'request.role.domain'};
9604: if ($context eq 'requestcrs') {
9605: if ($env{'form.coursedom'} ne '') {
9606: $context_dom = $env{'form.coursedom'};
9607: }
9608: }
1.556 raeburn 9609: if ($forcenewuser) {
1.576 raeburn 9610: if (ref($srch) eq 'HASH') {
1.994 raeburn 9611: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9612: if ($cancreate) {
9613: $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>';
9614: } else {
1.799 bisitz 9615: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9616: my %usertypetext = (
9617: official => 'institutional',
9618: unofficial => 'non-institutional',
9619: );
1.799 bisitz 9620: $new_user_create = '<p class="LC_warning">'
9621: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9622: .' '
9623: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9624: ,'<a href="'.$helplink.'">','</a>')
9625: .'</p><br />';
1.627 raeburn 9626: }
1.576 raeburn 9627: }
9628: }
9629:
1.556 raeburn 9630: $newuserscript = <<"ENDSCRIPT";
9631:
1.570 raeburn 9632: function setSearch(createnew,callingForm) {
1.556 raeburn 9633: if (createnew == 1) {
1.570 raeburn 9634: for (var i=0; i<callingForm.srchby.length; i++) {
9635: if (callingForm.srchby.options[i].value == 'uname') {
9636: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9637: }
9638: }
1.570 raeburn 9639: for (var i=0; i<callingForm.srchin.length; i++) {
9640: if ( callingForm.srchin.options[i].value == 'dom') {
9641: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9642: }
9643: }
1.570 raeburn 9644: for (var i=0; i<callingForm.srchtype.length; i++) {
9645: if (callingForm.srchtype.options[i].value == 'exact') {
9646: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9647: }
9648: }
1.570 raeburn 9649: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9650: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9651: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9652: }
9653: }
9654: }
9655: }
9656: ENDSCRIPT
1.558 albertel 9657:
1.556 raeburn 9658: }
9659:
1.555 raeburn 9660: my $output = <<"END_BLOCK";
1.556 raeburn 9661: <script type="text/javascript">
1.824 bisitz 9662: // <![CDATA[
1.570 raeburn 9663: function validateEntry(callingForm) {
1.558 albertel 9664:
1.556 raeburn 9665: var checkok = 1;
1.558 albertel 9666: var srchin;
1.570 raeburn 9667: for (var i=0; i<callingForm.srchin.length; i++) {
9668: if ( callingForm.srchin[i].checked ) {
9669: srchin = callingForm.srchin[i].value;
1.558 albertel 9670: }
9671: }
9672:
1.570 raeburn 9673: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9674: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9675: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9676: var srchterm = callingForm.srchterm.value;
9677: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9678: var msg = "";
9679:
9680: if (srchterm == "") {
9681: checkok = 0;
1.571 raeburn 9682: msg += "$lt{'youm'}\\n";
1.556 raeburn 9683: }
9684:
1.569 raeburn 9685: if (srchtype== 'begins') {
9686: if (srchterm.length < 2) {
9687: checkok = 0;
1.571 raeburn 9688: msg += "$lt{'thte'}\\n";
1.569 raeburn 9689: }
9690: }
9691:
1.556 raeburn 9692: if (srchtype== 'contains') {
9693: if (srchterm.length < 3) {
9694: checkok = 0;
1.571 raeburn 9695: msg += "$lt{'thet'}\\n";
1.556 raeburn 9696: }
9697: }
9698: if (srchin == 'instd') {
9699: if (srchdomain == '') {
9700: checkok = 0;
1.571 raeburn 9701: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9702: }
9703: }
9704: if (srchin == 'dom') {
9705: if (srchdomain == '') {
9706: checkok = 0;
1.571 raeburn 9707: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9708: }
9709: }
9710: if (srchby == 'lastfirst') {
9711: if (srchterm.indexOf(",") == -1) {
9712: checkok = 0;
1.571 raeburn 9713: msg += "$lt{'whus'}\\n";
1.556 raeburn 9714: }
9715: if (srchterm.indexOf(",") == srchterm.length -1) {
9716: checkok = 0;
1.571 raeburn 9717: msg += "$lt{'whse'}\\n";
1.556 raeburn 9718: }
9719: }
9720: if (checkok == 0) {
1.571 raeburn 9721: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9722: return;
9723: }
9724: if (checkok == 1) {
1.570 raeburn 9725: callingForm.submit();
1.556 raeburn 9726: }
9727: }
9728:
9729: $newuserscript
9730:
1.824 bisitz 9731: // ]]>
1.556 raeburn 9732: </script>
1.558 albertel 9733:
9734: $new_user_create
9735:
1.555 raeburn 9736: END_BLOCK
1.558 albertel 9737:
1.876 raeburn 9738: $output .= &Apache::lonhtmlcommon::start_pick_box().
9739: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9740: $domform.
9741: &Apache::lonhtmlcommon::row_closure().
9742: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9743: $srchbysel.
9744: $srchtypesel.
9745: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9746: $srchinsel.
9747: &Apache::lonhtmlcommon::row_closure(1).
9748: &Apache::lonhtmlcommon::end_pick_box().
9749: '<br />';
1.555 raeburn 9750: return $output;
9751: }
9752:
1.612 raeburn 9753: sub user_rule_check {
1.615 raeburn 9754: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9755: my $response;
9756: if (ref($usershash) eq 'HASH') {
9757: foreach my $user (keys(%{$usershash})) {
9758: my ($uname,$udom) = split(/:/,$user);
9759: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9760: my ($id,$newuser);
1.612 raeburn 9761: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9762: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9763: $id = $usershash->{$user}->{'id'};
9764: }
9765: my $inst_response;
9766: if (ref($checks) eq 'HASH') {
9767: if (defined($checks->{'username'})) {
1.615 raeburn 9768: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9769: &Apache::lonnet::get_instuser($udom,$uname);
9770: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9771: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9772: &Apache::lonnet::get_instuser($udom,undef,$id);
9773: }
1.615 raeburn 9774: } else {
9775: ($inst_response,%{$inst_results->{$user}}) =
9776: &Apache::lonnet::get_instuser($udom,$uname);
9777: return;
1.612 raeburn 9778: }
1.615 raeburn 9779: if (!$got_rules->{$udom}) {
1.612 raeburn 9780: my %domconfig = &Apache::lonnet::get_dom('configuration',
9781: ['usercreation'],$udom);
9782: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9783: foreach my $item ('username','id') {
1.612 raeburn 9784: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9785: $$curr_rules{$udom}{$item} =
9786: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9787: }
9788: }
9789: }
1.615 raeburn 9790: $got_rules->{$udom} = 1;
1.585 raeburn 9791: }
1.612 raeburn 9792: foreach my $item (keys(%{$checks})) {
9793: if (ref($$curr_rules{$udom}) eq 'HASH') {
9794: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9795: if (@{$$curr_rules{$udom}{$item}} > 0) {
9796: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9797: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9798: if ($rule_check{$rule}) {
9799: $$rulematch{$user}{$item} = $rule;
9800: if ($inst_response eq 'ok') {
1.615 raeburn 9801: if (ref($inst_results) eq 'HASH') {
9802: if (ref($inst_results->{$user}) eq 'HASH') {
9803: if (keys(%{$inst_results->{$user}}) == 0) {
9804: $$alerts{$item}{$udom}{$uname} = 1;
9805: }
1.612 raeburn 9806: }
9807: }
1.615 raeburn 9808: }
9809: last;
1.585 raeburn 9810: }
9811: }
9812: }
9813: }
9814: }
9815: }
9816: }
9817: }
1.612 raeburn 9818: return;
9819: }
9820:
9821: sub user_rule_formats {
9822: my ($domain,$domdesc,$curr_rules,$check) = @_;
9823: my %text = (
9824: 'username' => 'Usernames',
9825: 'id' => 'IDs',
9826: );
9827: my $output;
9828: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9829: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9830: if (@{$ruleorder} > 0) {
1.1102 raeburn 9831: $output = '<br />'.
9832: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9833: '<span class="LC_cusr_emph">','</span>',$domdesc).
9834: ' <ul>';
1.612 raeburn 9835: foreach my $rule (@{$ruleorder}) {
9836: if (ref($curr_rules) eq 'ARRAY') {
9837: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9838: if (ref($rules->{$rule}) eq 'HASH') {
9839: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9840: $rules->{$rule}{'desc'}.'</li>';
9841: }
9842: }
9843: }
9844: }
9845: $output .= '</ul>';
9846: }
9847: }
9848: return $output;
9849: }
9850:
9851: sub instrule_disallow_msg {
1.615 raeburn 9852: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9853: my $response;
9854: my %text = (
9855: item => 'username',
9856: items => 'usernames',
9857: match => 'matches',
9858: do => 'does',
9859: action => 'a username',
9860: one => 'one',
9861: );
9862: if ($count > 1) {
9863: $text{'item'} = 'usernames';
9864: $text{'match'} ='match';
9865: $text{'do'} = 'do';
9866: $text{'action'} = 'usernames',
9867: $text{'one'} = 'ones';
9868: }
9869: if ($checkitem eq 'id') {
9870: $text{'items'} = 'IDs';
9871: $text{'item'} = 'ID';
9872: $text{'action'} = 'an ID';
1.615 raeburn 9873: if ($count > 1) {
9874: $text{'item'} = 'IDs';
9875: $text{'action'} = 'IDs';
9876: }
1.612 raeburn 9877: }
1.674 bisitz 9878: $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 9879: if ($mode eq 'upload') {
9880: if ($checkitem eq 'username') {
9881: $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'}.");
9882: } elsif ($checkitem eq 'id') {
1.674 bisitz 9883: $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 9884: }
1.669 raeburn 9885: } elsif ($mode eq 'selfcreate') {
9886: if ($checkitem eq 'id') {
9887: $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.");
9888: }
1.615 raeburn 9889: } else {
9890: if ($checkitem eq 'username') {
9891: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9892: } elsif ($checkitem eq 'id') {
9893: $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.");
9894: }
1.612 raeburn 9895: }
9896: return $response;
1.585 raeburn 9897: }
9898:
1.624 raeburn 9899: sub personal_data_fieldtitles {
9900: my %fieldtitles = &Apache::lonlocal::texthash (
9901: id => 'Student/Employee ID',
9902: permanentemail => 'E-mail address',
9903: lastname => 'Last Name',
9904: firstname => 'First Name',
9905: middlename => 'Middle Name',
9906: generation => 'Generation',
9907: gen => 'Generation',
1.765 raeburn 9908: inststatus => 'Affiliation',
1.624 raeburn 9909: );
9910: return %fieldtitles;
9911: }
9912:
1.642 raeburn 9913: sub sorted_inst_types {
9914: my ($dom) = @_;
1.1185 raeburn 9915: my ($usertypes,$order);
9916: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9917: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9918: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9919: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9920: } else {
9921: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9922: }
1.642 raeburn 9923: my $othertitle = &mt('All users');
9924: if ($env{'request.course.id'}) {
1.668 raeburn 9925: $othertitle = &mt('Any users');
1.642 raeburn 9926: }
9927: my @types;
9928: if (ref($order) eq 'ARRAY') {
9929: @types = @{$order};
9930: }
9931: if (@types == 0) {
9932: if (ref($usertypes) eq 'HASH') {
9933: @types = sort(keys(%{$usertypes}));
9934: }
9935: }
9936: if (keys(%{$usertypes}) > 0) {
9937: $othertitle = &mt('Other users');
9938: }
9939: return ($othertitle,$usertypes,\@types);
9940: }
9941:
1.645 raeburn 9942: sub get_institutional_codes {
9943: my ($settings,$allcourses,$LC_code) = @_;
9944: # Get complete list of course sections to update
9945: my @currsections = ();
9946: my @currxlists = ();
9947: my $coursecode = $$settings{'internal.coursecode'};
9948:
9949: if ($$settings{'internal.sectionnums'} ne '') {
9950: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9951: }
9952:
9953: if ($$settings{'internal.crosslistings'} ne '') {
9954: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9955: }
9956:
9957: if (@currxlists > 0) {
9958: foreach (@currxlists) {
9959: if (m/^([^:]+):(\w*)$/) {
9960: unless (grep/^$1$/,@{$allcourses}) {
9961: push @{$allcourses},$1;
9962: $$LC_code{$1} = $2;
9963: }
9964: }
9965: }
9966: }
9967:
9968: if (@currsections > 0) {
9969: foreach (@currsections) {
9970: if (m/^(\w+):(\w*)$/) {
9971: my $sec = $coursecode.$1;
9972: my $lc_sec = $2;
9973: unless (grep/^$sec$/,@{$allcourses}) {
9974: push @{$allcourses},$sec;
9975: $$LC_code{$sec} = $lc_sec;
9976: }
9977: }
9978: }
9979: }
9980: return;
9981: }
9982:
1.971 raeburn 9983: sub get_standard_codeitems {
9984: return ('Year','Semester','Department','Number','Section');
9985: }
9986:
1.112 bowersj2 9987: =pod
9988:
1.780 raeburn 9989: =head1 Slot Helpers
9990:
9991: =over 4
9992:
9993: =item * sorted_slots()
9994:
1.1040 raeburn 9995: Sorts an array of slot names in order of an optional sort key,
9996: default sort is by slot start time (earliest first).
1.780 raeburn 9997:
9998: Inputs:
9999:
10000: =over 4
10001:
10002: slotsarr - Reference to array of unsorted slot names.
10003:
10004: slots - Reference to hash of hash, where outer hash keys are slot names.
10005:
1.1040 raeburn 10006: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10007:
1.549 albertel 10008: =back
10009:
1.780 raeburn 10010: Returns:
10011:
10012: =over 4
10013:
1.1040 raeburn 10014: sorted - An array of slot names sorted by a specified sort key
10015: (default sort key is start time of the slot).
1.780 raeburn 10016:
10017: =back
10018:
10019: =cut
10020:
10021:
10022: sub sorted_slots {
1.1040 raeburn 10023: my ($slotsarr,$slots,$sortkey) = @_;
10024: if ($sortkey eq '') {
10025: $sortkey = 'starttime';
10026: }
1.780 raeburn 10027: my @sorted;
10028: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10029: @sorted =
10030: sort {
10031: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10032: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10033: }
10034: if (ref($slots->{$a})) { return -1;}
10035: if (ref($slots->{$b})) { return 1;}
10036: return 0;
10037: } @{$slotsarr};
10038: }
10039: return @sorted;
10040: }
10041:
1.1040 raeburn 10042: =pod
10043:
10044: =item * get_future_slots()
10045:
10046: Inputs:
10047:
10048: =over 4
10049:
10050: cnum - course number
10051:
10052: cdom - course domain
10053:
10054: now - current UNIX time
10055:
10056: symb - optional symb
10057:
10058: =back
10059:
10060: Returns:
10061:
10062: =over 4
10063:
10064: sorted_reservable - ref to array of student_schedulable slots currently
10065: reservable, ordered by end date of reservation period.
10066:
10067: reservable_now - ref to hash of student_schedulable slots currently
10068: reservable.
10069:
10070: Keys in inner hash are:
10071: (a) symb: either blank or symb to which slot use is restricted.
10072: (b) endreserve: end date of reservation period.
10073:
10074: sorted_future - ref to array of student_schedulable slots reservable in
10075: the future, ordered by start date of reservation period.
10076:
10077: future_reservable - ref to hash of student_schedulable slots reservable
10078: in the future.
10079:
10080: Keys in inner hash are:
10081: (a) symb: either blank or symb to which slot use is restricted.
10082: (b) startreserve: start date of reservation period.
10083:
10084: =back
10085:
10086: =cut
10087:
10088: sub get_future_slots {
10089: my ($cnum,$cdom,$now,$symb) = @_;
10090: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10091: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10092: foreach my $slot (keys(%slots)) {
10093: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10094: if ($symb) {
10095: next if (($slots{$slot}->{'symb'} ne '') &&
10096: ($slots{$slot}->{'symb'} ne $symb));
10097: }
10098: if (($slots{$slot}->{'starttime'} > $now) &&
10099: ($slots{$slot}->{'endtime'} > $now)) {
10100: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10101: my $userallowed = 0;
10102: if ($slots{$slot}->{'allowedsections'}) {
10103: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10104: if (!defined($env{'request.role.sec'})
10105: && grep(/^No section assigned$/,@allowed_sec)) {
10106: $userallowed=1;
10107: } else {
10108: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10109: $userallowed=1;
10110: }
10111: }
10112: unless ($userallowed) {
10113: if (defined($env{'request.course.groups'})) {
10114: my @groups = split(/:/,$env{'request.course.groups'});
10115: foreach my $group (@groups) {
10116: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10117: $userallowed=1;
10118: last;
10119: }
10120: }
10121: }
10122: }
10123: }
10124: if ($slots{$slot}->{'allowedusers'}) {
10125: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10126: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10127: if (grep(/^\Q$user\E$/,@allowed_users)) {
10128: $userallowed = 1;
10129: }
10130: }
10131: next unless($userallowed);
10132: }
10133: my $startreserve = $slots{$slot}->{'startreserve'};
10134: my $endreserve = $slots{$slot}->{'endreserve'};
10135: my $symb = $slots{$slot}->{'symb'};
10136: if (($startreserve < $now) &&
10137: (!$endreserve || $endreserve > $now)) {
10138: my $lastres = $endreserve;
10139: if (!$lastres) {
10140: $lastres = $slots{$slot}->{'starttime'};
10141: }
10142: $reservable_now{$slot} = {
10143: symb => $symb,
10144: endreserve => $lastres
10145: };
10146: } elsif (($startreserve > $now) &&
10147: (!$endreserve || $endreserve > $startreserve)) {
10148: $future_reservable{$slot} = {
10149: symb => $symb,
10150: startreserve => $startreserve
10151: };
10152: }
10153: }
10154: }
10155: my @unsorted_reservable = keys(%reservable_now);
10156: if (@unsorted_reservable > 0) {
10157: @sorted_reservable =
10158: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10159: }
10160: my @unsorted_future = keys(%future_reservable);
10161: if (@unsorted_future > 0) {
10162: @sorted_future =
10163: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10164: }
10165: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10166: }
1.780 raeburn 10167:
10168: =pod
10169:
1.1057 foxr 10170: =back
10171:
1.549 albertel 10172: =head1 HTTP Helpers
10173:
10174: =over 4
10175:
1.648 raeburn 10176: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10177:
1.258 albertel 10178: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10179: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10180: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10181:
10182: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10183: $possible_names is an ref to an array of form element names. As an example:
10184: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10185: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10186:
10187: =cut
1.1 albertel 10188:
1.6 albertel 10189: sub get_unprocessed_cgi {
1.25 albertel 10190: my ($query,$possible_names)= @_;
1.26 matthew 10191: # $Apache::lonxml::debug=1;
1.356 albertel 10192: foreach my $pair (split(/&/,$query)) {
10193: my ($name, $value) = split(/=/,$pair);
1.369 www 10194: $name = &unescape($name);
1.25 albertel 10195: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10196: $value =~ tr/+/ /;
10197: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10198: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10199: }
1.16 harris41 10200: }
1.6 albertel 10201: }
10202:
1.112 bowersj2 10203: =pod
10204:
1.648 raeburn 10205: =item * &cacheheader()
1.112 bowersj2 10206:
10207: returns cache-controlling header code
10208:
10209: =cut
10210:
1.7 albertel 10211: sub cacheheader {
1.258 albertel 10212: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10213: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10214: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10215: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10216: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10217: return $output;
1.7 albertel 10218: }
10219:
1.112 bowersj2 10220: =pod
10221:
1.648 raeburn 10222: =item * &no_cache($r)
1.112 bowersj2 10223:
10224: specifies header code to not have cache
10225:
10226: =cut
10227:
1.9 albertel 10228: sub no_cache {
1.216 albertel 10229: my ($r) = @_;
10230: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10231: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10232: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10233: $r->no_cache(1);
10234: $r->header_out("Expires" => $date);
10235: $r->header_out("Pragma" => "no-cache");
1.123 www 10236: }
10237:
10238: sub content_type {
1.181 albertel 10239: my ($r,$type,$charset) = @_;
1.299 foxr 10240: if ($r) {
10241: # Note that printout.pl calls this with undef for $r.
10242: &no_cache($r);
10243: }
1.258 albertel 10244: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10245: unless ($charset) {
10246: $charset=&Apache::lonlocal::current_encoding;
10247: }
10248: if ($charset) { $type.='; charset='.$charset; }
10249: if ($r) {
10250: $r->content_type($type);
10251: } else {
10252: print("Content-type: $type\n\n");
10253: }
1.9 albertel 10254: }
1.25 albertel 10255:
1.112 bowersj2 10256: =pod
10257:
1.648 raeburn 10258: =item * &add_to_env($name,$value)
1.112 bowersj2 10259:
1.258 albertel 10260: adds $name to the %env hash with value
1.112 bowersj2 10261: $value, if $name already exists, the entry is converted to an array
10262: reference and $value is added to the array.
10263:
10264: =cut
10265:
1.25 albertel 10266: sub add_to_env {
10267: my ($name,$value)=@_;
1.258 albertel 10268: if (defined($env{$name})) {
10269: if (ref($env{$name})) {
1.25 albertel 10270: #already have multiple values
1.258 albertel 10271: push(@{ $env{$name} },$value);
1.25 albertel 10272: } else {
10273: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10274: my $first=$env{$name};
10275: undef($env{$name});
10276: push(@{ $env{$name} },$first,$value);
1.25 albertel 10277: }
10278: } else {
1.258 albertel 10279: $env{$name}=$value;
1.25 albertel 10280: }
1.31 albertel 10281: }
1.149 albertel 10282:
10283: =pod
10284:
1.648 raeburn 10285: =item * &get_env_multiple($name)
1.149 albertel 10286:
1.258 albertel 10287: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10288: values may be defined and end up as an array ref.
10289:
10290: returns an array of values
10291:
10292: =cut
10293:
10294: sub get_env_multiple {
10295: my ($name) = @_;
10296: my @values;
1.258 albertel 10297: if (defined($env{$name})) {
1.149 albertel 10298: # exists is it an array
1.258 albertel 10299: if (ref($env{$name})) {
10300: @values=@{ $env{$name} };
1.149 albertel 10301: } else {
1.258 albertel 10302: $values[0]=$env{$name};
1.149 albertel 10303: }
10304: }
10305: return(@values);
10306: }
10307:
1.660 raeburn 10308: sub ask_for_embedded_content {
10309: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10310: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10311: %currsubfile,%unused,$rem);
1.1071 raeburn 10312: my $counter = 0;
10313: my $numnew = 0;
1.987 raeburn 10314: my $numremref = 0;
10315: my $numinvalid = 0;
10316: my $numpathchg = 0;
10317: my $numexisting = 0;
1.1071 raeburn 10318: my $numunused = 0;
10319: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10320: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10321: my $heading = &mt('Upload embedded files');
10322: my $buttontext = &mt('Upload');
10323:
1.1085 raeburn 10324: if ($env{'request.course.id'}) {
1.1123 raeburn 10325: if ($actionurl eq '/adm/dependencies') {
10326: $navmap = Apache::lonnavmaps::navmap->new();
10327: }
10328: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10329: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10330: }
1.1123 raeburn 10331: if (($actionurl eq '/adm/portfolio') ||
10332: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10333: my $current_path='/';
10334: if ($env{'form.currentpath'}) {
10335: $current_path = $env{'form.currentpath'};
10336: }
10337: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10338: $udom = $cdom;
10339: $uname = $cnum;
1.984 raeburn 10340: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10341: } else {
10342: $udom = $env{'user.domain'};
10343: $uname = $env{'user.name'};
10344: $url = '/userfiles/portfolio';
10345: }
1.987 raeburn 10346: $toplevel = $url.'/';
1.984 raeburn 10347: $url .= $current_path;
10348: $getpropath = 1;
1.987 raeburn 10349: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10350: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10351: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10352: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10353: $toplevel = $url;
1.984 raeburn 10354: if ($rest ne '') {
1.987 raeburn 10355: $url .= $rest;
10356: }
10357: } elsif ($actionurl eq '/adm/coursedocs') {
10358: if (ref($args) eq 'HASH') {
1.1071 raeburn 10359: $url = $args->{'docs_url'};
10360: $toplevel = $url;
1.1084 raeburn 10361: if ($args->{'context'} eq 'paste') {
10362: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10363: ($path) =
10364: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10365: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10366: $fileloc =~ s{^/}{};
10367: }
1.1071 raeburn 10368: }
1.1084 raeburn 10369: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 10370: if ($env{'request.course.id'} ne '') {
10371: if (ref($args) eq 'HASH') {
10372: $url = $args->{'docs_url'};
10373: $title = $args->{'docs_title'};
1.1126 raeburn 10374: $toplevel = $url;
10375: unless ($toplevel =~ m{^/}) {
10376: $toplevel = "/$url";
10377: }
1.1085 raeburn 10378: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 10379: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10380: $path = $1;
10381: } else {
10382: ($path) =
10383: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10384: }
1.1195 raeburn 10385: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10386: $fileloc = $toplevel;
10387: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10388: my ($udom,$uname,$fname) =
10389: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10390: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10391: } else {
10392: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10393: }
1.1071 raeburn 10394: $fileloc =~ s{^/}{};
10395: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10396: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10397: }
1.987 raeburn 10398: }
1.1123 raeburn 10399: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10400: $udom = $cdom;
10401: $uname = $cnum;
10402: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10403: $toplevel = $url;
10404: $path = $url;
10405: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10406: $fileloc =~ s{^/}{};
1.987 raeburn 10407: }
1.1126 raeburn 10408: foreach my $file (keys(%{$allfiles})) {
10409: my $embed_file;
10410: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10411: $embed_file = $1;
10412: } else {
10413: $embed_file = $file;
10414: }
1.1158 raeburn 10415: my ($absolutepath,$cleaned_file);
10416: if ($embed_file =~ m{^\w+://}) {
10417: $cleaned_file = $embed_file;
1.1147 raeburn 10418: $newfiles{$cleaned_file} = 1;
10419: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10420: } else {
1.1158 raeburn 10421: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10422: if ($embed_file =~ m{^/}) {
10423: $absolutepath = $embed_file;
10424: }
1.1147 raeburn 10425: if ($cleaned_file =~ m{/}) {
10426: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10427: $path = &check_for_traversal($path,$url,$toplevel);
10428: my $item = $fname;
10429: if ($path ne '') {
10430: $item = $path.'/'.$fname;
10431: $subdependencies{$path}{$fname} = 1;
10432: } else {
10433: $dependencies{$item} = 1;
10434: }
10435: if ($absolutepath) {
10436: $mapping{$item} = $absolutepath;
10437: } else {
10438: $mapping{$item} = $embed_file;
10439: }
10440: } else {
10441: $dependencies{$embed_file} = 1;
10442: if ($absolutepath) {
1.1147 raeburn 10443: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10444: } else {
1.1147 raeburn 10445: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10446: }
10447: }
1.984 raeburn 10448: }
10449: }
1.1071 raeburn 10450: my $dirptr = 16384;
1.984 raeburn 10451: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10452: $currsubfile{$path} = {};
1.1123 raeburn 10453: if (($actionurl eq '/adm/portfolio') ||
10454: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10455: my ($sublistref,$listerror) =
10456: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10457: if (ref($sublistref) eq 'ARRAY') {
10458: foreach my $line (@{$sublistref}) {
10459: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10460: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10461: }
1.984 raeburn 10462: }
1.987 raeburn 10463: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10464: if (opendir(my $dir,$url.'/'.$path)) {
10465: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10466: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10467: }
1.1084 raeburn 10468: } elsif (($actionurl eq '/adm/dependencies') ||
10469: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10470: ($args->{'context'} eq 'paste')) ||
10471: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10472: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10473: my $dir;
10474: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10475: $dir = $fileloc;
10476: } else {
10477: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10478: }
1.1071 raeburn 10479: if ($dir ne '') {
10480: my ($sublistref,$listerror) =
10481: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10482: if (ref($sublistref) eq 'ARRAY') {
10483: foreach my $line (@{$sublistref}) {
10484: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10485: undef,$mtime)=split(/\&/,$line,12);
10486: unless (($testdir&$dirptr) ||
10487: ($file_name =~ /^\.\.?$/)) {
10488: $currsubfile{$path}{$file_name} = [$size,$mtime];
10489: }
10490: }
10491: }
10492: }
1.984 raeburn 10493: }
10494: }
10495: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10496: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10497: my $item = $path.'/'.$file;
10498: unless ($mapping{$item} eq $item) {
10499: $pathchanges{$item} = 1;
10500: }
10501: $existing{$item} = 1;
10502: $numexisting ++;
10503: } else {
10504: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10505: }
10506: }
1.1071 raeburn 10507: if ($actionurl eq '/adm/dependencies') {
10508: foreach my $path (keys(%currsubfile)) {
10509: if (ref($currsubfile{$path}) eq 'HASH') {
10510: foreach my $file (keys(%{$currsubfile{$path}})) {
10511: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10512: next if (($rem ne '') &&
10513: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10514: (ref($navmap) &&
10515: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10516: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10517: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10518: $unused{$path.'/'.$file} = 1;
10519: }
10520: }
10521: }
10522: }
10523: }
1.984 raeburn 10524: }
1.987 raeburn 10525: my %currfile;
1.1123 raeburn 10526: if (($actionurl eq '/adm/portfolio') ||
10527: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10528: my ($dirlistref,$listerror) =
10529: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10530: if (ref($dirlistref) eq 'ARRAY') {
10531: foreach my $line (@{$dirlistref}) {
10532: my ($file_name,$rest) = split(/\&/,$line,2);
10533: $currfile{$file_name} = 1;
10534: }
1.984 raeburn 10535: }
1.987 raeburn 10536: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10537: if (opendir(my $dir,$url)) {
1.987 raeburn 10538: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10539: map {$currfile{$_} = 1;} @dir_list;
10540: }
1.1084 raeburn 10541: } elsif (($actionurl eq '/adm/dependencies') ||
10542: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10543: ($args->{'context'} eq 'paste')) ||
10544: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10545: if ($env{'request.course.id'} ne '') {
10546: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10547: if ($dir ne '') {
10548: my ($dirlistref,$listerror) =
10549: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10550: if (ref($dirlistref) eq 'ARRAY') {
10551: foreach my $line (@{$dirlistref}) {
10552: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10553: $size,undef,$mtime)=split(/\&/,$line,12);
10554: unless (($testdir&$dirptr) ||
10555: ($file_name =~ /^\.\.?$/)) {
10556: $currfile{$file_name} = [$size,$mtime];
10557: }
10558: }
10559: }
10560: }
10561: }
1.984 raeburn 10562: }
10563: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10564: if (exists($currfile{$file})) {
1.987 raeburn 10565: unless ($mapping{$file} eq $file) {
10566: $pathchanges{$file} = 1;
10567: }
10568: $existing{$file} = 1;
10569: $numexisting ++;
10570: } else {
1.984 raeburn 10571: $newfiles{$file} = 1;
10572: }
10573: }
1.1071 raeburn 10574: foreach my $file (keys(%currfile)) {
10575: unless (($file eq $filename) ||
10576: ($file eq $filename.'.bak') ||
10577: ($dependencies{$file})) {
1.1085 raeburn 10578: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10579: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10580: next if (($rem ne '') &&
10581: (($env{"httpref.$rem".$file} ne '') ||
10582: (ref($navmap) &&
10583: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10584: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10585: ($navmap->getResourceByUrl($rem.$1)))))));
10586: }
1.1085 raeburn 10587: }
1.1071 raeburn 10588: $unused{$file} = 1;
10589: }
10590: }
1.1084 raeburn 10591: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10592: ($args->{'context'} eq 'paste')) {
10593: $counter = scalar(keys(%existing));
10594: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10595: return ($output,$counter,$numpathchg,\%existing);
10596: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10597: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10598: $counter = scalar(keys(%existing));
10599: $numpathchg = scalar(keys(%pathchanges));
10600: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10601: }
1.984 raeburn 10602: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10603: if ($actionurl eq '/adm/dependencies') {
10604: next if ($embed_file =~ m{^\w+://});
10605: }
1.660 raeburn 10606: $upload_output .= &start_data_table_row().
1.1123 raeburn 10607: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10608: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10609: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10610: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10611: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10612: }
1.1123 raeburn 10613: $upload_output .= '</td>';
1.1071 raeburn 10614: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10615: $upload_output.='<td align="right">'.
10616: '<span class="LC_info LC_fontsize_medium">'.
10617: &mt("URL points to web address").'</span>';
1.987 raeburn 10618: $numremref++;
1.660 raeburn 10619: } elsif ($args->{'error_on_invalid_names'}
10620: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10621: $upload_output.='<td align="right"><span class="LC_warning">'.
10622: &mt('Invalid characters').'</span>';
1.987 raeburn 10623: $numinvalid++;
1.660 raeburn 10624: } else {
1.1123 raeburn 10625: $upload_output .= '<td>'.
10626: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10627: $embed_file,\%mapping,
1.1071 raeburn 10628: $allfiles,$codebase,'upload');
10629: $counter ++;
10630: $numnew ++;
1.987 raeburn 10631: }
10632: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10633: }
10634: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10635: if ($actionurl eq '/adm/dependencies') {
10636: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10637: $modify_output .= &start_data_table_row().
10638: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10639: '<img src="'.&icon($embed_file).'" border="0" />'.
10640: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10641: '<td>'.$size.'</td>'.
10642: '<td>'.$mtime.'</td>'.
10643: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10644: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10645: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10646: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10647: &embedded_file_element('upload_embedded',$counter,
10648: $embed_file,\%mapping,
10649: $allfiles,$codebase,'modify').
10650: '</div></td>'.
10651: &end_data_table_row()."\n";
10652: $counter ++;
10653: } else {
10654: $upload_output .= &start_data_table_row().
1.1123 raeburn 10655: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10656: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10657: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10658: &Apache::loncommon::end_data_table_row()."\n";
10659: }
10660: }
10661: my $delidx = $counter;
10662: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10663: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10664: $delete_output .= &start_data_table_row().
10665: '<td><img src="'.&icon($oldfile).'" />'.
10666: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10667: '<td>'.$size.'</td>'.
10668: '<td>'.$mtime.'</td>'.
10669: '<td><label><input type="checkbox" name="del_upload_dep" '.
10670: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10671: &embedded_file_element('upload_embedded',$delidx,
10672: $oldfile,\%mapping,$allfiles,
10673: $codebase,'delete').'</td>'.
10674: &end_data_table_row()."\n";
10675: $numunused ++;
10676: $delidx ++;
1.987 raeburn 10677: }
10678: if ($upload_output) {
10679: $upload_output = &start_data_table().
10680: $upload_output.
10681: &end_data_table()."\n";
10682: }
1.1071 raeburn 10683: if ($modify_output) {
10684: $modify_output = &start_data_table().
10685: &start_data_table_header_row().
10686: '<th>'.&mt('File').'</th>'.
10687: '<th>'.&mt('Size (KB)').'</th>'.
10688: '<th>'.&mt('Modified').'</th>'.
10689: '<th>'.&mt('Upload replacement?').'</th>'.
10690: &end_data_table_header_row().
10691: $modify_output.
10692: &end_data_table()."\n";
10693: }
10694: if ($delete_output) {
10695: $delete_output = &start_data_table().
10696: &start_data_table_header_row().
10697: '<th>'.&mt('File').'</th>'.
10698: '<th>'.&mt('Size (KB)').'</th>'.
10699: '<th>'.&mt('Modified').'</th>'.
10700: '<th>'.&mt('Delete?').'</th>'.
10701: &end_data_table_header_row().
10702: $delete_output.
10703: &end_data_table()."\n";
10704: }
1.987 raeburn 10705: my $applies = 0;
10706: if ($numremref) {
10707: $applies ++;
10708: }
10709: if ($numinvalid) {
10710: $applies ++;
10711: }
10712: if ($numexisting) {
10713: $applies ++;
10714: }
1.1071 raeburn 10715: if ($counter || $numunused) {
1.987 raeburn 10716: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10717: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10718: $state.'<h3>'.$heading.'</h3>';
10719: if ($actionurl eq '/adm/dependencies') {
10720: if ($numnew) {
10721: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10722: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10723: $upload_output.'<br />'."\n";
10724: }
10725: if ($numexisting) {
10726: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10727: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10728: $modify_output.'<br />'."\n";
10729: $buttontext = &mt('Save changes');
10730: }
10731: if ($numunused) {
10732: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10733: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10734: $delete_output.'<br />'."\n";
10735: $buttontext = &mt('Save changes');
10736: }
10737: } else {
10738: $output .= $upload_output.'<br />'."\n";
10739: }
10740: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10741: $counter.'" />'."\n";
10742: if ($actionurl eq '/adm/dependencies') {
10743: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10744: $numnew.'" />'."\n";
10745: } elsif ($actionurl eq '') {
1.987 raeburn 10746: $output .= '<input type="hidden" name="phase" value="three" />';
10747: }
10748: } elsif ($applies) {
10749: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10750: if ($applies > 1) {
10751: $output .=
1.1123 raeburn 10752: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10753: if ($numremref) {
10754: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10755: }
10756: if ($numinvalid) {
10757: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10758: }
10759: if ($numexisting) {
10760: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10761: }
10762: $output .= '</ul><br />';
10763: } elsif ($numremref) {
10764: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10765: } elsif ($numinvalid) {
10766: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10767: } elsif ($numexisting) {
10768: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10769: }
10770: $output .= $upload_output.'<br />';
10771: }
10772: my ($pathchange_output,$chgcount);
1.1071 raeburn 10773: $chgcount = $counter;
1.987 raeburn 10774: if (keys(%pathchanges) > 0) {
10775: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10776: if ($counter) {
1.987 raeburn 10777: $output .= &embedded_file_element('pathchange',$chgcount,
10778: $embed_file,\%mapping,
1.1071 raeburn 10779: $allfiles,$codebase,'change');
1.987 raeburn 10780: } else {
10781: $pathchange_output .=
10782: &start_data_table_row().
10783: '<td><input type ="checkbox" name="namechange" value="'.
10784: $chgcount.'" checked="checked" /></td>'.
10785: '<td>'.$mapping{$embed_file}.'</td>'.
10786: '<td>'.$embed_file.
10787: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10788: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10789: '</td>'.&end_data_table_row();
1.660 raeburn 10790: }
1.987 raeburn 10791: $numpathchg ++;
10792: $chgcount ++;
1.660 raeburn 10793: }
10794: }
1.1127 raeburn 10795: if (($counter) || ($numunused)) {
1.987 raeburn 10796: if ($numpathchg) {
10797: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10798: $numpathchg.'" />'."\n";
10799: }
10800: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10801: ($actionurl eq '/adm/imsimport')) {
10802: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10803: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10804: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10805: } elsif ($actionurl eq '/adm/dependencies') {
10806: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10807: }
1.1123 raeburn 10808: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10809: } elsif ($numpathchg) {
10810: my %pathchange = ();
10811: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10812: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10813: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10814: }
1.987 raeburn 10815: }
1.1071 raeburn 10816: return ($output,$counter,$numpathchg);
1.987 raeburn 10817: }
10818:
1.1147 raeburn 10819: =pod
10820:
10821: =item * clean_path($name)
10822:
10823: Performs clean-up of directories, subdirectories and filename in an
10824: embedded object, referenced in an HTML file which is being uploaded
10825: to a course or portfolio, where
10826: "Upload embedded images/multimedia files if HTML file" checkbox was
10827: checked.
10828:
10829: Clean-up is similar to replacements in lonnet::clean_filename()
10830: except each / between sub-directory and next level is preserved.
10831:
10832: =cut
10833:
10834: sub clean_path {
10835: my ($embed_file) = @_;
10836: $embed_file =~s{^/+}{};
10837: my @contents;
10838: if ($embed_file =~ m{/}) {
10839: @contents = split(/\//,$embed_file);
10840: } else {
10841: @contents = ($embed_file);
10842: }
10843: my $lastidx = scalar(@contents)-1;
10844: for (my $i=0; $i<=$lastidx; $i++) {
10845: $contents[$i]=~s{\\}{/}g;
10846: $contents[$i]=~s/\s+/\_/g;
10847: $contents[$i]=~s{[^/\w\.\-]}{}g;
10848: if ($i == $lastidx) {
10849: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10850: }
10851: }
10852: if ($lastidx > 0) {
10853: return join('/',@contents);
10854: } else {
10855: return $contents[0];
10856: }
10857: }
10858:
1.987 raeburn 10859: sub embedded_file_element {
1.1071 raeburn 10860: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10861: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10862: (ref($codebase) eq 'HASH'));
10863: my $output;
1.1071 raeburn 10864: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10865: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10866: }
10867: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10868: &escape($embed_file).'" />';
10869: unless (($context eq 'upload_embedded') &&
10870: ($mapping->{$embed_file} eq $embed_file)) {
10871: $output .='
10872: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10873: }
10874: my $attrib;
10875: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10876: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10877: }
10878: $output .=
10879: "\n\t\t".
10880: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10881: $attrib.'" />';
10882: if (exists($codebase->{$mapping->{$embed_file}})) {
10883: $output .=
10884: "\n\t\t".
10885: '<input name="codebase_'.$num.'" type="hidden" value="'.
10886: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10887: }
1.987 raeburn 10888: return $output;
1.660 raeburn 10889: }
10890:
1.1071 raeburn 10891: sub get_dependency_details {
10892: my ($currfile,$currsubfile,$embed_file) = @_;
10893: my ($size,$mtime,$showsize,$showmtime);
10894: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10895: if ($embed_file =~ m{/}) {
10896: my ($path,$fname) = split(/\//,$embed_file);
10897: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10898: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10899: }
10900: } else {
10901: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10902: ($size,$mtime) = @{$currfile->{$embed_file}};
10903: }
10904: }
10905: $showsize = $size/1024.0;
10906: $showsize = sprintf("%.1f",$showsize);
10907: if ($mtime > 0) {
10908: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10909: }
10910: }
10911: return ($showsize,$showmtime);
10912: }
10913:
10914: sub ask_embedded_js {
10915: return <<"END";
10916: <script type="text/javascript"">
10917: // <![CDATA[
10918: function toggleBrowse(counter) {
10919: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10920: var fileid = document.getElementById('embedded_item_'+counter);
10921: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10922: if (chkboxid.checked == true) {
10923: uploaddivid.style.display='block';
10924: } else {
10925: uploaddivid.style.display='none';
10926: fileid.value = '';
10927: }
10928: }
10929: // ]]>
10930: </script>
10931:
10932: END
10933: }
10934:
1.661 raeburn 10935: sub upload_embedded {
10936: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10937: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10938: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10939: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10940: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10941: my $orig_uploaded_filename =
10942: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10943: foreach my $type ('orig','ref','attrib','codebase') {
10944: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10945: $env{'form.embedded_'.$type.'_'.$i} =
10946: &unescape($env{'form.embedded_'.$type.'_'.$i});
10947: }
10948: }
1.661 raeburn 10949: my ($path,$fname) =
10950: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10951: # no path, whole string is fname
10952: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10953: $fname = &Apache::lonnet::clean_filename($fname);
10954: # See if there is anything left
10955: next if ($fname eq '');
10956:
10957: # Check if file already exists as a file or directory.
10958: my ($state,$msg);
10959: if ($context eq 'portfolio') {
10960: my $port_path = $dirpath;
10961: if ($group ne '') {
10962: $port_path = "groups/$group/$port_path";
10963: }
1.987 raeburn 10964: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10965: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10966: $dir_root,$port_path,$disk_quota,
10967: $current_disk_usage,$uname,$udom);
10968: if ($state eq 'will_exceed_quota'
1.984 raeburn 10969: || $state eq 'file_locked') {
1.661 raeburn 10970: $output .= $msg;
10971: next;
10972: }
10973: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10974: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10975: if ($state eq 'exists') {
10976: $output .= $msg;
10977: next;
10978: }
10979: }
10980: # Check if extension is valid
10981: if (($fname =~ /\.(\w+)$/) &&
10982: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10983: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10984: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10985: next;
10986: } elsif (($fname =~ /\.(\w+)$/) &&
10987: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10988: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10989: next;
10990: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10991: $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 10992: next;
10993: }
10994: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10995: my $subdir = $path;
10996: $subdir =~ s{/+$}{};
1.661 raeburn 10997: if ($context eq 'portfolio') {
1.984 raeburn 10998: my $result;
10999: if ($state eq 'existingfile') {
11000: $result=
11001: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11002: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11003: } else {
1.984 raeburn 11004: $result=
11005: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11006: $dirpath.
1.1123 raeburn 11007: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11008: if ($result !~ m|^/uploaded/|) {
11009: $output .= '<span class="LC_error">'
11010: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11011: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11012: .'</span><br />';
11013: next;
11014: } else {
1.987 raeburn 11015: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11016: $path.$fname.'</span>').'<br />';
1.984 raeburn 11017: }
1.661 raeburn 11018: }
1.1123 raeburn 11019: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11020: my $extendedsubdir = $dirpath.'/'.$subdir;
11021: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11022: my $result =
1.1126 raeburn 11023: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11024: if ($result !~ m|^/uploaded/|) {
11025: $output .= '<span class="LC_error">'
11026: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11027: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11028: .'</span><br />';
11029: next;
11030: } else {
11031: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11032: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11033: if ($context eq 'syllabus') {
11034: &Apache::lonnet::make_public_indefinitely($result);
11035: }
1.987 raeburn 11036: }
1.661 raeburn 11037: } else {
11038: # Save the file
11039: my $target = $env{'form.embedded_item_'.$i};
11040: my $fullpath = $dir_root.$dirpath.'/'.$path;
11041: my $dest = $fullpath.$fname;
11042: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11043: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11044: my $count;
11045: my $filepath = $dir_root;
1.1027 raeburn 11046: foreach my $subdir (@parts) {
11047: $filepath .= "/$subdir";
11048: if (!-e $filepath) {
1.661 raeburn 11049: mkdir($filepath,0770);
11050: }
11051: }
11052: my $fh;
11053: if (!open($fh,'>'.$dest)) {
11054: &Apache::lonnet::logthis('Failed to create '.$dest);
11055: $output .= '<span class="LC_error">'.
1.1071 raeburn 11056: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11057: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11058: '</span><br />';
11059: } else {
11060: if (!print $fh $env{'form.embedded_item_'.$i}) {
11061: &Apache::lonnet::logthis('Failed to write to '.$dest);
11062: $output .= '<span class="LC_error">'.
1.1071 raeburn 11063: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11064: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11065: '</span><br />';
11066: } else {
1.987 raeburn 11067: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11068: $url.'</span>').'<br />';
11069: unless ($context eq 'testbank') {
11070: $footer .= &mt('View embedded file: [_1]',
11071: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11072: }
11073: }
11074: close($fh);
11075: }
11076: }
11077: if ($env{'form.embedded_ref_'.$i}) {
11078: $pathchange{$i} = 1;
11079: }
11080: }
11081: if ($output) {
11082: $output = '<p>'.$output.'</p>';
11083: }
11084: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11085: $returnflag = 'ok';
1.1071 raeburn 11086: my $numpathchgs = scalar(keys(%pathchange));
11087: if ($numpathchgs > 0) {
1.987 raeburn 11088: if ($context eq 'portfolio') {
11089: $output .= '<p>'.&mt('or').'</p>';
11090: } elsif ($context eq 'testbank') {
1.1071 raeburn 11091: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11092: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11093: $returnflag = 'modify_orightml';
11094: }
11095: }
1.1071 raeburn 11096: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11097: }
11098:
11099: sub modify_html_form {
11100: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11101: my $end = 0;
11102: my $modifyform;
11103: if ($context eq 'upload_embedded') {
11104: return unless (ref($pathchange) eq 'HASH');
11105: if ($env{'form.number_embedded_items'}) {
11106: $end += $env{'form.number_embedded_items'};
11107: }
11108: if ($env{'form.number_pathchange_items'}) {
11109: $end += $env{'form.number_pathchange_items'};
11110: }
11111: if ($end) {
11112: for (my $i=0; $i<$end; $i++) {
11113: if ($i < $env{'form.number_embedded_items'}) {
11114: next unless($pathchange->{$i});
11115: }
11116: $modifyform .=
11117: &start_data_table_row().
11118: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11119: 'checked="checked" /></td>'.
11120: '<td>'.$env{'form.embedded_ref_'.$i}.
11121: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11122: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11123: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11124: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11125: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11126: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11127: '<td>'.$env{'form.embedded_orig_'.$i}.
11128: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11129: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11130: &end_data_table_row();
1.1071 raeburn 11131: }
1.987 raeburn 11132: }
11133: } else {
11134: $modifyform = $pathchgtable;
11135: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11136: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11137: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11138: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11139: }
11140: }
11141: if ($modifyform) {
1.1071 raeburn 11142: if ($actionurl eq '/adm/dependencies') {
11143: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11144: }
1.987 raeburn 11145: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11146: '<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".
11147: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11148: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11149: '</ol></p>'."\n".'<p>'.
11150: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11151: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11152: &start_data_table()."\n".
11153: &start_data_table_header_row().
11154: '<th>'.&mt('Change?').'</th>'.
11155: '<th>'.&mt('Current reference').'</th>'.
11156: '<th>'.&mt('Required reference').'</th>'.
11157: &end_data_table_header_row()."\n".
11158: $modifyform.
11159: &end_data_table().'<br />'."\n".$hiddenstate.
11160: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11161: '</form>'."\n";
11162: }
11163: return;
11164: }
11165:
11166: sub modify_html_refs {
1.1123 raeburn 11167: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11168: my $container;
11169: if ($context eq 'portfolio') {
11170: $container = $env{'form.container'};
11171: } elsif ($context eq 'coursedoc') {
11172: $container = $env{'form.primaryurl'};
1.1071 raeburn 11173: } elsif ($context eq 'manage_dependencies') {
11174: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11175: $container = "/$container";
1.1123 raeburn 11176: } elsif ($context eq 'syllabus') {
11177: $container = $url;
1.987 raeburn 11178: } else {
1.1027 raeburn 11179: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11180: }
11181: my (%allfiles,%codebase,$output,$content);
11182: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11183: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11184: if (wantarray) {
11185: return ('',0,0);
11186: } else {
11187: return;
11188: }
11189: }
11190: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11191: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11192: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11193: if (wantarray) {
11194: return ('',0,0);
11195: } else {
11196: return;
11197: }
11198: }
1.987 raeburn 11199: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11200: if ($content eq '-1') {
11201: if (wantarray) {
11202: return ('',0,0);
11203: } else {
11204: return;
11205: }
11206: }
1.987 raeburn 11207: } else {
1.1071 raeburn 11208: unless ($container =~ /^\Q$dir_root\E/) {
11209: if (wantarray) {
11210: return ('',0,0);
11211: } else {
11212: return;
11213: }
11214: }
1.987 raeburn 11215: if (open(my $fh,"<$container")) {
11216: $content = join('', <$fh>);
11217: close($fh);
11218: } else {
1.1071 raeburn 11219: if (wantarray) {
11220: return ('',0,0);
11221: } else {
11222: return;
11223: }
1.987 raeburn 11224: }
11225: }
11226: my ($count,$codebasecount) = (0,0);
11227: my $mm = new File::MMagic;
11228: my $mime_type = $mm->checktype_contents($content);
11229: if ($mime_type eq 'text/html') {
11230: my $parse_result =
11231: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11232: \%codebase,\$content);
11233: if ($parse_result eq 'ok') {
11234: foreach my $i (@changes) {
11235: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11236: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11237: if ($allfiles{$ref}) {
11238: my $newname = $orig;
11239: my ($attrib_regexp,$codebase);
1.1006 raeburn 11240: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11241: if ($attrib_regexp =~ /:/) {
11242: $attrib_regexp =~ s/\:/|/g;
11243: }
11244: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11245: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11246: $count += $numchg;
1.1123 raeburn 11247: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11248: delete($allfiles{$ref});
1.987 raeburn 11249: }
11250: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11251: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11252: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11253: $codebasecount ++;
11254: }
11255: }
11256: }
1.1123 raeburn 11257: my $skiprewrites;
1.987 raeburn 11258: if ($count || $codebasecount) {
11259: my $saveresult;
1.1071 raeburn 11260: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11261: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11262: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11263: if ($url eq $container) {
11264: my ($fname) = ($container =~ m{/([^/]+)$});
11265: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11266: $count,'<span class="LC_filename">'.
1.1071 raeburn 11267: $fname.'</span>').'</p>';
1.987 raeburn 11268: } else {
11269: $output = '<p class="LC_error">'.
11270: &mt('Error: update failed for: [_1].',
11271: '<span class="LC_filename">'.
11272: $container.'</span>').'</p>';
11273: }
1.1123 raeburn 11274: if ($context eq 'syllabus') {
11275: unless ($saveresult eq 'ok') {
11276: $skiprewrites = 1;
11277: }
11278: }
1.987 raeburn 11279: } else {
11280: if (open(my $fh,">$container")) {
11281: print $fh $content;
11282: close($fh);
11283: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11284: $count,'<span class="LC_filename">'.
11285: $container.'</span>').'</p>';
1.661 raeburn 11286: } else {
1.987 raeburn 11287: $output = '<p class="LC_error">'.
11288: &mt('Error: could not update [_1].',
11289: '<span class="LC_filename">'.
11290: $container.'</span>').'</p>';
1.661 raeburn 11291: }
11292: }
11293: }
1.1123 raeburn 11294: if (($context eq 'syllabus') && (!$skiprewrites)) {
11295: my ($actionurl,$state);
11296: $actionurl = "/public/$udom/$uname/syllabus";
11297: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11298: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11299: \%codebase,
11300: {'context' => 'rewrites',
11301: 'ignore_remote_references' => 1,});
11302: if (ref($mapping) eq 'HASH') {
11303: my $rewrites = 0;
11304: foreach my $key (keys(%{$mapping})) {
11305: next if ($key =~ m{^https?://});
11306: my $ref = $mapping->{$key};
11307: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11308: my $attrib;
11309: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11310: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11311: }
11312: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11313: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11314: $rewrites += $numchg;
11315: }
11316: }
11317: if ($rewrites) {
11318: my $saveresult;
11319: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11320: if ($url eq $container) {
11321: my ($fname) = ($container =~ m{/([^/]+)$});
11322: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11323: $count,'<span class="LC_filename">'.
11324: $fname.'</span>').'</p>';
11325: } else {
11326: $output .= '<p class="LC_error">'.
11327: &mt('Error: could not update links in [_1].',
11328: '<span class="LC_filename">'.
11329: $container.'</span>').'</p>';
11330:
11331: }
11332: }
11333: }
11334: }
1.987 raeburn 11335: } else {
11336: &logthis('Failed to parse '.$container.
11337: ' to modify references: '.$parse_result);
1.661 raeburn 11338: }
11339: }
1.1071 raeburn 11340: if (wantarray) {
11341: return ($output,$count,$codebasecount);
11342: } else {
11343: return $output;
11344: }
1.661 raeburn 11345: }
11346:
11347: sub check_for_existing {
11348: my ($path,$fname,$element) = @_;
11349: my ($state,$msg);
11350: if (-d $path.'/'.$fname) {
11351: $state = 'exists';
11352: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11353: } elsif (-e $path.'/'.$fname) {
11354: $state = 'exists';
11355: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11356: }
11357: if ($state eq 'exists') {
11358: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11359: }
11360: return ($state,$msg);
11361: }
11362:
11363: sub check_for_upload {
11364: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11365: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11366: my $filesize = length($env{'form.'.$element});
11367: if (!$filesize) {
11368: my $msg = '<span class="LC_error">'.
11369: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11370: '<span class="LC_filename">'.$fname.'</span>',
11371: $filesize).'<br />'.
1.1007 raeburn 11372: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11373: '</span>';
11374: return ('zero_bytes',$msg);
11375: }
11376: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11377: my $getpropath = 1;
1.1021 raeburn 11378: my ($dirlistref,$listerror) =
11379: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11380: my $found_file = 0;
11381: my $locked_file = 0;
1.991 raeburn 11382: my @lockers;
11383: my $navmap;
11384: if ($env{'request.course.id'}) {
11385: $navmap = Apache::lonnavmaps::navmap->new();
11386: }
1.1021 raeburn 11387: if (ref($dirlistref) eq 'ARRAY') {
11388: foreach my $line (@{$dirlistref}) {
11389: my ($file_name,$rest)=split(/\&/,$line,2);
11390: if ($file_name eq $fname){
11391: $file_name = $path.$file_name;
11392: if ($group ne '') {
11393: $file_name = $group.$file_name;
11394: }
11395: $found_file = 1;
11396: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11397: foreach my $lock (@lockers) {
11398: if (ref($lock) eq 'ARRAY') {
11399: my ($symb,$crsid) = @{$lock};
11400: if ($crsid eq $env{'request.course.id'}) {
11401: if (ref($navmap)) {
11402: my $res = $navmap->getBySymb($symb);
11403: foreach my $part (@{$res->parts()}) {
11404: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11405: unless (($slot_status == $res->RESERVED) ||
11406: ($slot_status == $res->RESERVED_LOCATION)) {
11407: $locked_file = 1;
11408: }
1.991 raeburn 11409: }
1.1021 raeburn 11410: } else {
11411: $locked_file = 1;
1.991 raeburn 11412: }
11413: } else {
11414: $locked_file = 1;
11415: }
11416: }
1.1021 raeburn 11417: }
11418: } else {
11419: my @info = split(/\&/,$rest);
11420: my $currsize = $info[6]/1000;
11421: if ($currsize < $filesize) {
11422: my $extra = $filesize - $currsize;
11423: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11424: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11425: &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 11426: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11427: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11428: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11429: return ('will_exceed_quota',$msg);
11430: }
1.984 raeburn 11431: }
11432: }
1.661 raeburn 11433: }
11434: }
11435: }
11436: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11437: my $msg = '<p class="LC_warning">'.
11438: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11439: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11440: return ('will_exceed_quota',$msg);
11441: } elsif ($found_file) {
11442: if ($locked_file) {
1.1179 bisitz 11443: my $msg = '<p class="LC_warning">';
1.661 raeburn 11444: $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 11445: $msg .= '</p>';
1.661 raeburn 11446: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11447: return ('file_locked',$msg);
11448: } else {
1.1179 bisitz 11449: my $msg = '<p class="LC_error">';
1.984 raeburn 11450: $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 11451: $msg .= '</p>';
1.984 raeburn 11452: return ('existingfile',$msg);
1.661 raeburn 11453: }
11454: }
11455: }
11456:
1.987 raeburn 11457: sub check_for_traversal {
11458: my ($path,$url,$toplevel) = @_;
11459: my @parts=split(/\//,$path);
11460: my $cleanpath;
11461: my $fullpath = $url;
11462: for (my $i=0;$i<@parts;$i++) {
11463: next if ($parts[$i] eq '.');
11464: if ($parts[$i] eq '..') {
11465: $fullpath =~ s{([^/]+/)$}{};
11466: } else {
11467: $fullpath .= $parts[$i].'/';
11468: }
11469: }
11470: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11471: $cleanpath = $1;
11472: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11473: my $curr_toprel = $1;
11474: my @parts = split(/\//,$curr_toprel);
11475: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11476: my @urlparts = split(/\//,$url_toprel);
11477: my $doubledots;
11478: my $startdiff = -1;
11479: for (my $i=0; $i<@urlparts; $i++) {
11480: if ($startdiff == -1) {
11481: unless ($urlparts[$i] eq $parts[$i]) {
11482: $startdiff = $i;
11483: $doubledots .= '../';
11484: }
11485: } else {
11486: $doubledots .= '../';
11487: }
11488: }
11489: if ($startdiff > -1) {
11490: $cleanpath = $doubledots;
11491: for (my $i=$startdiff; $i<@parts; $i++) {
11492: $cleanpath .= $parts[$i].'/';
11493: }
11494: }
11495: }
11496: $cleanpath =~ s{(/)$}{};
11497: return $cleanpath;
11498: }
1.31 albertel 11499:
1.1053 raeburn 11500: sub is_archive_file {
11501: my ($mimetype) = @_;
11502: if (($mimetype eq 'application/octet-stream') ||
11503: ($mimetype eq 'application/x-stuffit') ||
11504: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11505: return 1;
11506: }
11507: return;
11508: }
11509:
11510: sub decompress_form {
1.1065 raeburn 11511: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11512: my %lt = &Apache::lonlocal::texthash (
11513: this => 'This file is an archive file.',
1.1067 raeburn 11514: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11515: itsc => 'Its contents are as follows:',
1.1053 raeburn 11516: youm => 'You may wish to extract its contents.',
11517: extr => 'Extract contents',
1.1067 raeburn 11518: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11519: proa => 'Process automatically?',
1.1053 raeburn 11520: yes => 'Yes',
11521: no => 'No',
1.1067 raeburn 11522: fold => 'Title for folder containing movie',
11523: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11524: );
1.1065 raeburn 11525: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11526: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11527: my $info = &list_archive_contents($fileloc,\@paths);
11528: if (@paths) {
11529: foreach my $path (@paths) {
11530: $path =~ s{^/}{};
1.1067 raeburn 11531: if ($path =~ m{^([^/]+)/$}) {
11532: $topdir = $1;
11533: }
1.1065 raeburn 11534: if ($path =~ m{^([^/]+)/}) {
11535: $toplevel{$1} = $path;
11536: } else {
11537: $toplevel{$path} = $path;
11538: }
11539: }
11540: }
1.1067 raeburn 11541: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11542: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11543: "$topdir/media/",
11544: "$topdir/media/$topdir.mp4",
11545: "$topdir/media/FirstFrame.png",
11546: "$topdir/media/player.swf",
11547: "$topdir/media/swfobject.js",
11548: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11549: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11550: "$topdir/$topdir.mp4",
11551: "$topdir/$topdir\_config.xml",
11552: "$topdir/$topdir\_controller.swf",
11553: "$topdir/$topdir\_embed.css",
11554: "$topdir/$topdir\_First_Frame.png",
11555: "$topdir/$topdir\_player.html",
11556: "$topdir/$topdir\_Thumbnails.png",
11557: "$topdir/playerProductInstall.swf",
11558: "$topdir/scripts/",
11559: "$topdir/scripts/config_xml.js",
11560: "$topdir/scripts/handlebars.js",
11561: "$topdir/scripts/jquery-1.7.1.min.js",
11562: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11563: "$topdir/scripts/modernizr.js",
11564: "$topdir/scripts/player-min.js",
11565: "$topdir/scripts/swfobject.js",
11566: "$topdir/skins/",
11567: "$topdir/skins/configuration_express.xml",
11568: "$topdir/skins/express_show/",
11569: "$topdir/skins/express_show/player-min.css",
11570: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11571: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11572: "$topdir/$topdir.mp4",
11573: "$topdir/$topdir\_config.xml",
11574: "$topdir/$topdir\_controller.swf",
11575: "$topdir/$topdir\_embed.css",
11576: "$topdir/$topdir\_First_Frame.png",
11577: "$topdir/$topdir\_player.html",
11578: "$topdir/$topdir\_Thumbnails.png",
11579: "$topdir/playerProductInstall.swf",
11580: "$topdir/scripts/",
11581: "$topdir/scripts/config_xml.js",
11582: "$topdir/scripts/techsmith-smart-player.min.js",
11583: "$topdir/skins/",
11584: "$topdir/skins/configuration_express.xml",
11585: "$topdir/skins/express_show/",
11586: "$topdir/skins/express_show/spritesheet.min.css",
11587: "$topdir/skins/express_show/spritesheet.png",
11588: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11589: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11590: if (@diffs == 0) {
1.1164 raeburn 11591: $is_camtasia = 6;
11592: } else {
1.1197 raeburn 11593: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11594: if (@diffs == 0) {
11595: $is_camtasia = 8;
1.1197 raeburn 11596: } else {
11597: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11598: if (@diffs == 0) {
11599: $is_camtasia = 8;
11600: }
1.1164 raeburn 11601: }
1.1067 raeburn 11602: }
11603: }
11604: my $output;
11605: if ($is_camtasia) {
11606: $output = <<"ENDCAM";
11607: <script type="text/javascript" language="Javascript">
11608: // <![CDATA[
11609:
11610: function camtasiaToggle() {
11611: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11612: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11613: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11614: document.getElementById('camtasia_titles').style.display='block';
11615: } else {
11616: document.getElementById('camtasia_titles').style.display='none';
11617: }
11618: }
11619: }
11620: return;
11621: }
11622:
11623: // ]]>
11624: </script>
11625: <p>$lt{'camt'}</p>
11626: ENDCAM
1.1065 raeburn 11627: } else {
1.1067 raeburn 11628: $output = '<p>'.$lt{'this'};
11629: if ($info eq '') {
11630: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11631: } else {
11632: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11633: '<div><pre>'.$info.'</pre></div>';
11634: }
1.1065 raeburn 11635: }
1.1067 raeburn 11636: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11637: my $duplicates;
11638: my $num = 0;
11639: if (ref($dirlist) eq 'ARRAY') {
11640: foreach my $item (@{$dirlist}) {
11641: if (ref($item) eq 'ARRAY') {
11642: if (exists($toplevel{$item->[0]})) {
11643: $duplicates .=
11644: &start_data_table_row().
11645: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11646: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11647: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11648: 'value="1" />'.&mt('Yes').'</label>'.
11649: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11650: '<td>'.$item->[0].'</td>';
11651: if ($item->[2]) {
11652: $duplicates .= '<td>'.&mt('Directory').'</td>';
11653: } else {
11654: $duplicates .= '<td>'.&mt('File').'</td>';
11655: }
11656: $duplicates .= '<td>'.$item->[3].'</td>'.
11657: '<td>'.
11658: &Apache::lonlocal::locallocaltime($item->[4]).
11659: '</td>'.
11660: &end_data_table_row();
11661: $num ++;
11662: }
11663: }
11664: }
11665: }
11666: my $itemcount;
11667: if (@paths > 0) {
11668: $itemcount = scalar(@paths);
11669: } else {
11670: $itemcount = 1;
11671: }
1.1067 raeburn 11672: if ($is_camtasia) {
11673: $output .= $lt{'auto'}.'<br />'.
11674: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11675: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11676: $lt{'yes'}.'</label> <label>'.
11677: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11678: $lt{'no'}.'</label></span><br />'.
11679: '<div id="camtasia_titles" style="display:block">'.
11680: &Apache::lonhtmlcommon::start_pick_box().
11681: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11682: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11683: &Apache::lonhtmlcommon::row_closure().
11684: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11685: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11686: &Apache::lonhtmlcommon::row_closure(1).
11687: &Apache::lonhtmlcommon::end_pick_box().
11688: '</div>';
11689: }
1.1065 raeburn 11690: $output .=
11691: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11692: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11693: "\n";
1.1065 raeburn 11694: if ($duplicates ne '') {
11695: $output .= '<p><span class="LC_warning">'.
11696: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11697: &start_data_table().
11698: &start_data_table_header_row().
11699: '<th>'.&mt('Overwrite?').'</th>'.
11700: '<th>'.&mt('Name').'</th>'.
11701: '<th>'.&mt('Type').'</th>'.
11702: '<th>'.&mt('Size').'</th>'.
11703: '<th>'.&mt('Last modified').'</th>'.
11704: &end_data_table_header_row().
11705: $duplicates.
11706: &end_data_table().
11707: '</p>';
11708: }
1.1067 raeburn 11709: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11710: if (ref($hiddenelements) eq 'HASH') {
11711: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11712: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11713: }
11714: }
11715: $output .= <<"END";
1.1067 raeburn 11716: <br />
1.1053 raeburn 11717: <input type="submit" name="decompress" value="$lt{'extr'}" />
11718: </form>
11719: $noextract
11720: END
11721: return $output;
11722: }
11723:
1.1065 raeburn 11724: sub decompression_utility {
11725: my ($program) = @_;
11726: my @utilities = ('tar','gunzip','bunzip2','unzip');
11727: my $location;
11728: if (grep(/^\Q$program\E$/,@utilities)) {
11729: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11730: '/usr/sbin/') {
11731: if (-x $dir.$program) {
11732: $location = $dir.$program;
11733: last;
11734: }
11735: }
11736: }
11737: return $location;
11738: }
11739:
11740: sub list_archive_contents {
11741: my ($file,$pathsref) = @_;
11742: my (@cmd,$output);
11743: my $needsregexp;
11744: if ($file =~ /\.zip$/) {
11745: @cmd = (&decompression_utility('unzip'),"-l");
11746: $needsregexp = 1;
11747: } elsif (($file =~ m/\.tar\.gz$/) ||
11748: ($file =~ /\.tgz$/)) {
11749: @cmd = (&decompression_utility('tar'),"-ztf");
11750: } elsif ($file =~ /\.tar\.bz2$/) {
11751: @cmd = (&decompression_utility('tar'),"-jtf");
11752: } elsif ($file =~ m|\.tar$|) {
11753: @cmd = (&decompression_utility('tar'),"-tf");
11754: }
11755: if (@cmd) {
11756: undef($!);
11757: undef($@);
11758: if (open(my $fh,"-|", @cmd, $file)) {
11759: while (my $line = <$fh>) {
11760: $output .= $line;
11761: chomp($line);
11762: my $item;
11763: if ($needsregexp) {
11764: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11765: } else {
11766: $item = $line;
11767: }
11768: if ($item ne '') {
11769: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11770: push(@{$pathsref},$item);
11771: }
11772: }
11773: }
11774: close($fh);
11775: }
11776: }
11777: return $output;
11778: }
11779:
1.1053 raeburn 11780: sub decompress_uploaded_file {
11781: my ($file,$dir) = @_;
11782: &Apache::lonnet::appenv({'cgi.file' => $file});
11783: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11784: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11785: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11786: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11787: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11788: my $decompressed = $env{'cgi.decompressed'};
11789: &Apache::lonnet::delenv('cgi.file');
11790: &Apache::lonnet::delenv('cgi.dir');
11791: &Apache::lonnet::delenv('cgi.decompressed');
11792: return ($decompressed,$result);
11793: }
11794:
1.1055 raeburn 11795: sub process_decompression {
11796: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11797: my ($dir,$error,$warning,$output);
1.1180 raeburn 11798: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11799: $error = &mt('Filename not a supported archive file type.').
11800: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11801: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11802: } else {
11803: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11804: if ($docuhome eq 'no_host') {
11805: $error = &mt('Could not determine home server for course.');
11806: } else {
11807: my @ids=&Apache::lonnet::current_machine_ids();
11808: my $currdir = "$dir_root/$destination";
11809: if (grep(/^\Q$docuhome\E$/,@ids)) {
11810: $dir = &LONCAPA::propath($docudom,$docuname).
11811: "$dir_root/$destination";
11812: } else {
11813: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11814: "$dir_root/$docudom/$docuname/$destination";
11815: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11816: $error = &mt('Archive file not found.');
11817: }
11818: }
1.1065 raeburn 11819: my (@to_overwrite,@to_skip);
11820: if ($env{'form.archive_overwrite_total'} > 0) {
11821: my $total = $env{'form.archive_overwrite_total'};
11822: for (my $i=0; $i<$total; $i++) {
11823: if ($env{'form.archive_overwrite_'.$i} == 1) {
11824: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11825: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11826: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11827: }
11828: }
11829: }
11830: my $numskip = scalar(@to_skip);
11831: if (($numskip > 0) &&
11832: ($numskip == $env{'form.archive_itemcount'})) {
11833: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11834: } elsif ($dir eq '') {
1.1055 raeburn 11835: $error = &mt('Directory containing archive file unavailable.');
11836: } elsif (!$error) {
1.1065 raeburn 11837: my ($decompressed,$display);
11838: if ($numskip > 0) {
11839: my $tempdir = time.'_'.$$.int(rand(10000));
11840: mkdir("$dir/$tempdir",0755);
11841: system("mv $dir/$file $dir/$tempdir/$file");
11842: ($decompressed,$display) =
11843: &decompress_uploaded_file($file,"$dir/$tempdir");
11844: foreach my $item (@to_skip) {
11845: if (($item ne '') && ($item !~ /\.\./)) {
11846: if (-f "$dir/$tempdir/$item") {
11847: unlink("$dir/$tempdir/$item");
11848: } elsif (-d "$dir/$tempdir/$item") {
11849: system("rm -rf $dir/$tempdir/$item");
11850: }
11851: }
11852: }
11853: system("mv $dir/$tempdir/* $dir");
11854: rmdir("$dir/$tempdir");
11855: } else {
11856: ($decompressed,$display) =
11857: &decompress_uploaded_file($file,$dir);
11858: }
1.1055 raeburn 11859: if ($decompressed eq 'ok') {
1.1065 raeburn 11860: $output = '<p class="LC_info">'.
11861: &mt('Files extracted successfully from archive.').
11862: '</p>'."\n";
1.1055 raeburn 11863: my ($warning,$result,@contents);
11864: my ($newdirlistref,$newlisterror) =
11865: &Apache::lonnet::dirlist($currdir,$docudom,
11866: $docuname,1);
11867: my (%is_dir,%changes,@newitems);
11868: my $dirptr = 16384;
1.1065 raeburn 11869: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11870: foreach my $dir_line (@{$newdirlistref}) {
11871: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11872: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11873: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11874: push(@newitems,$item);
11875: if ($dirptr&$testdir) {
11876: $is_dir{$item} = 1;
11877: }
11878: $changes{$item} = 1;
11879: }
11880: }
11881: }
11882: if (keys(%changes) > 0) {
11883: foreach my $item (sort(@newitems)) {
11884: if ($changes{$item}) {
11885: push(@contents,$item);
11886: }
11887: }
11888: }
11889: if (@contents > 0) {
1.1067 raeburn 11890: my $wantform;
11891: unless ($env{'form.autoextract_camtasia'}) {
11892: $wantform = 1;
11893: }
1.1056 raeburn 11894: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11895: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11896: $currdir,\%is_dir,
11897: \%children,\%parent,
1.1056 raeburn 11898: \@contents,\%dirorder,
11899: \%titles,$wantform);
1.1055 raeburn 11900: if ($datatable ne '') {
11901: $output .= &archive_options_form('decompressed',$datatable,
11902: $count,$hiddenelem);
1.1065 raeburn 11903: my $startcount = 6;
1.1055 raeburn 11904: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11905: \%titles,\%children);
1.1055 raeburn 11906: }
1.1067 raeburn 11907: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11908: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11909: my %displayed;
11910: my $total = 1;
11911: $env{'form.archive_directory'} = [];
11912: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11913: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11914: $path =~ s{/$}{};
11915: my $item;
11916: if ($path ne '') {
11917: $item = "$path/$titles{$i}";
11918: } else {
11919: $item = $titles{$i};
11920: }
11921: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11922: if ($item eq $contents[0]) {
11923: push(@{$env{'form.archive_directory'}},$i);
11924: $env{'form.archive_'.$i} = 'display';
11925: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11926: $displayed{'folder'} = $i;
1.1164 raeburn 11927: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11928: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11929: $env{'form.archive_'.$i} = 'display';
11930: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11931: $displayed{'web'} = $i;
11932: } else {
1.1164 raeburn 11933: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11934: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11935: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11936: push(@{$env{'form.archive_directory'}},$i);
11937: }
11938: $env{'form.archive_'.$i} = 'dependency';
11939: }
11940: $total ++;
11941: }
11942: for (my $i=1; $i<$total; $i++) {
11943: next if ($i == $displayed{'web'});
11944: next if ($i == $displayed{'folder'});
11945: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11946: }
11947: $env{'form.phase'} = 'decompress_cleanup';
11948: $env{'form.archivedelete'} = 1;
11949: $env{'form.archive_count'} = $total-1;
11950: $output .=
11951: &process_extracted_files('coursedocs',$docudom,
11952: $docuname,$destination,
11953: $dir_root,$hiddenelem);
11954: }
1.1055 raeburn 11955: } else {
11956: $warning = &mt('No new items extracted from archive file.');
11957: }
11958: } else {
11959: $output = $display;
11960: $error = &mt('An error occurred during extraction from the archive file.');
11961: }
11962: }
11963: }
11964: }
11965: if ($error) {
11966: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11967: $error.'</p>'."\n";
11968: }
11969: if ($warning) {
11970: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11971: }
11972: return $output;
11973: }
11974:
11975: sub get_extracted {
1.1056 raeburn 11976: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11977: $titles,$wantform) = @_;
1.1055 raeburn 11978: my $count = 0;
11979: my $depth = 0;
11980: my $datatable;
1.1056 raeburn 11981: my @hierarchy;
1.1055 raeburn 11982: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11983: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11984: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11985: foreach my $item (@{$contents}) {
11986: $count ++;
1.1056 raeburn 11987: @{$dirorder->{$count}} = @hierarchy;
11988: $titles->{$count} = $item;
1.1055 raeburn 11989: &archive_hierarchy($depth,$count,$parent,$children);
11990: if ($wantform) {
11991: $datatable .= &archive_row($is_dir->{$item},$item,
11992: $currdir,$depth,$count);
11993: }
11994: if ($is_dir->{$item}) {
11995: $depth ++;
1.1056 raeburn 11996: push(@hierarchy,$count);
11997: $parent->{$depth} = $count;
1.1055 raeburn 11998: $datatable .=
11999: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12000: \$depth,\$count,\@hierarchy,$dirorder,
12001: $children,$parent,$titles,$wantform);
1.1055 raeburn 12002: $depth --;
1.1056 raeburn 12003: pop(@hierarchy);
1.1055 raeburn 12004: }
12005: }
12006: return ($count,$datatable);
12007: }
12008:
12009: sub recurse_extracted_archive {
1.1056 raeburn 12010: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12011: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12012: my $result='';
1.1056 raeburn 12013: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12014: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12015: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12016: return $result;
12017: }
12018: my $dirptr = 16384;
12019: my ($newdirlistref,$newlisterror) =
12020: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12021: if (ref($newdirlistref) eq 'ARRAY') {
12022: foreach my $dir_line (@{$newdirlistref}) {
12023: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12024: unless ($item =~ /^\.+$/) {
12025: $$count ++;
1.1056 raeburn 12026: @{$dirorder->{$$count}} = @{$hierarchy};
12027: $titles->{$$count} = $item;
1.1055 raeburn 12028: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12029:
1.1055 raeburn 12030: my $is_dir;
12031: if ($dirptr&$testdir) {
12032: $is_dir = 1;
12033: }
12034: if ($wantform) {
12035: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12036: }
12037: if ($is_dir) {
12038: $$depth ++;
1.1056 raeburn 12039: push(@{$hierarchy},$$count);
12040: $parent->{$$depth} = $$count;
1.1055 raeburn 12041: $result .=
12042: &recurse_extracted_archive("$currdir/$item",$docudom,
12043: $docuname,$depth,$count,
1.1056 raeburn 12044: $hierarchy,$dirorder,$children,
12045: $parent,$titles,$wantform);
1.1055 raeburn 12046: $$depth --;
1.1056 raeburn 12047: pop(@{$hierarchy});
1.1055 raeburn 12048: }
12049: }
12050: }
12051: }
12052: return $result;
12053: }
12054:
12055: sub archive_hierarchy {
12056: my ($depth,$count,$parent,$children) =@_;
12057: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12058: if (exists($parent->{$depth})) {
12059: $children->{$parent->{$depth}} .= $count.':';
12060: }
12061: }
12062: return;
12063: }
12064:
12065: sub archive_row {
12066: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12067: my ($name) = ($item =~ m{([^/]+)$});
12068: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12069: 'display' => 'Add as file',
1.1055 raeburn 12070: 'dependency' => 'Include as dependency',
12071: 'discard' => 'Discard',
12072: );
12073: if ($is_dir) {
1.1059 raeburn 12074: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12075: }
1.1056 raeburn 12076: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12077: my $offset = 0;
1.1055 raeburn 12078: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12079: $offset ++;
1.1065 raeburn 12080: if ($action ne 'display') {
12081: $offset ++;
12082: }
1.1055 raeburn 12083: $output .= '<td><span class="LC_nobreak">'.
12084: '<label><input type="radio" name="archive_'.$count.
12085: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12086: my $text = $choices{$action};
12087: if ($is_dir) {
12088: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12089: if ($action eq 'display') {
1.1059 raeburn 12090: $text = &mt('Add as folder');
1.1055 raeburn 12091: }
1.1056 raeburn 12092: } else {
12093: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12094:
12095: }
12096: $output .= ' /> '.$choices{$action}.'</label></span>';
12097: if ($action eq 'dependency') {
12098: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12099: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12100: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12101: '<option value=""></option>'."\n".
12102: '</select>'."\n".
12103: '</div>';
1.1059 raeburn 12104: } elsif ($action eq 'display') {
12105: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12106: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12107: '</div>';
1.1055 raeburn 12108: }
1.1056 raeburn 12109: $output .= '</td>';
1.1055 raeburn 12110: }
12111: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12112: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12113: for (my $i=0; $i<$depth; $i++) {
12114: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12115: }
12116: if ($is_dir) {
12117: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12118: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12119: } else {
12120: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12121: }
12122: $output .= ' '.$name.'</td>'."\n".
12123: &end_data_table_row();
12124: return $output;
12125: }
12126:
12127: sub archive_options_form {
1.1065 raeburn 12128: my ($form,$display,$count,$hiddenelem) = @_;
12129: my %lt = &Apache::lonlocal::texthash(
12130: perm => 'Permanently remove archive file?',
12131: hows => 'How should each extracted item be incorporated in the course?',
12132: cont => 'Content actions for all',
12133: addf => 'Add as folder/file',
12134: incd => 'Include as dependency for a displayed file',
12135: disc => 'Discard',
12136: no => 'No',
12137: yes => 'Yes',
12138: save => 'Save',
12139: );
12140: my $output = <<"END";
12141: <form name="$form" method="post" action="">
12142: <p><span class="LC_nobreak">$lt{'perm'}
12143: <label>
12144: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12145: </label>
12146:
12147: <label>
12148: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12149: </span>
12150: </p>
12151: <input type="hidden" name="phase" value="decompress_cleanup" />
12152: <br />$lt{'hows'}
12153: <div class="LC_columnSection">
12154: <fieldset>
12155: <legend>$lt{'cont'}</legend>
12156: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12157: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12158: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12159: </fieldset>
12160: </div>
12161: END
12162: return $output.
1.1055 raeburn 12163: &start_data_table()."\n".
1.1065 raeburn 12164: $display."\n".
1.1055 raeburn 12165: &end_data_table()."\n".
12166: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12167: $hiddenelem.
1.1065 raeburn 12168: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12169: '</form>';
12170: }
12171:
12172: sub archive_javascript {
1.1056 raeburn 12173: my ($startcount,$numitems,$titles,$children) = @_;
12174: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12175: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12176: my $scripttag = <<START;
12177: <script type="text/javascript">
12178: // <![CDATA[
12179:
12180: function checkAll(form,prefix) {
12181: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12182: for (var i=0; i < form.elements.length; i++) {
12183: var id = form.elements[i].id;
12184: if ((id != '') && (id != undefined)) {
12185: if (idstr.test(id)) {
12186: if (form.elements[i].type == 'radio') {
12187: form.elements[i].checked = true;
1.1056 raeburn 12188: var nostart = i-$startcount;
1.1059 raeburn 12189: var offset = nostart%7;
12190: var count = (nostart-offset)/7;
1.1056 raeburn 12191: dependencyCheck(form,count,offset);
1.1055 raeburn 12192: }
12193: }
12194: }
12195: }
12196: }
12197:
12198: function propagateCheck(form,count) {
12199: if (count > 0) {
1.1059 raeburn 12200: var startelement = $startcount + ((count-1) * 7);
12201: for (var j=1; j<6; j++) {
12202: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12203: var item = startelement + j;
12204: if (form.elements[item].type == 'radio') {
12205: if (form.elements[item].checked) {
12206: containerCheck(form,count,j);
12207: break;
12208: }
1.1055 raeburn 12209: }
12210: }
12211: }
12212: }
12213: }
12214:
12215: numitems = $numitems
1.1056 raeburn 12216: var titles = new Array(numitems);
12217: var parents = new Array(numitems);
1.1055 raeburn 12218: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12219: parents[i] = new Array;
1.1055 raeburn 12220: }
1.1059 raeburn 12221: var maintitle = '$maintitle';
1.1055 raeburn 12222:
12223: START
12224:
1.1056 raeburn 12225: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12226: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12227: for (my $i=0; $i<@contents; $i ++) {
12228: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12229: }
12230: }
12231:
1.1056 raeburn 12232: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12233: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12234: }
12235:
1.1055 raeburn 12236: $scripttag .= <<END;
12237:
12238: function containerCheck(form,count,offset) {
12239: if (count > 0) {
1.1056 raeburn 12240: dependencyCheck(form,count,offset);
1.1059 raeburn 12241: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12242: form.elements[item].checked = true;
12243: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12244: if (parents[count].length > 0) {
12245: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12246: containerCheck(form,parents[count][j],offset);
12247: }
12248: }
12249: }
12250: }
12251: }
12252:
12253: function dependencyCheck(form,count,offset) {
12254: if (count > 0) {
1.1059 raeburn 12255: var chosen = (offset+$startcount)+7*(count-1);
12256: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12257: var currtype = form.elements[depitem].type;
12258: if (form.elements[chosen].value == 'dependency') {
12259: document.getElementById('arc_depon_'+count).style.display='block';
12260: form.elements[depitem].options.length = 0;
12261: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12262: for (var i=1; i<=numitems; i++) {
12263: if (i == count) {
12264: continue;
12265: }
1.1059 raeburn 12266: var startelement = $startcount + (i-1) * 7;
12267: for (var j=1; j<6; j++) {
12268: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12269: var item = startelement + j;
12270: if (form.elements[item].type == 'radio') {
12271: if (form.elements[item].checked) {
12272: if (form.elements[item].value == 'display') {
12273: var n = form.elements[depitem].options.length;
12274: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12275: }
12276: }
12277: }
12278: }
12279: }
12280: }
12281: } else {
12282: document.getElementById('arc_depon_'+count).style.display='none';
12283: form.elements[depitem].options.length = 0;
12284: form.elements[depitem].options[0] = new Option('Select','',true,true);
12285: }
1.1059 raeburn 12286: titleCheck(form,count,offset);
1.1056 raeburn 12287: }
12288: }
12289:
12290: function propagateSelect(form,count,offset) {
12291: if (count > 0) {
1.1065 raeburn 12292: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12293: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12294: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12295: if (parents[count].length > 0) {
12296: for (var j=0; j<parents[count].length; j++) {
12297: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12298: }
12299: }
12300: }
12301: }
12302: }
1.1056 raeburn 12303:
12304: function containerSelect(form,count,offset,picked) {
12305: if (count > 0) {
1.1065 raeburn 12306: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12307: if (form.elements[item].type == 'radio') {
12308: if (form.elements[item].value == 'dependency') {
12309: if (form.elements[item+1].type == 'select-one') {
12310: for (var i=0; i<form.elements[item+1].options.length; i++) {
12311: if (form.elements[item+1].options[i].value == picked) {
12312: form.elements[item+1].selectedIndex = i;
12313: break;
12314: }
12315: }
12316: }
12317: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12318: if (parents[count].length > 0) {
12319: for (var j=0; j<parents[count].length; j++) {
12320: containerSelect(form,parents[count][j],offset,picked);
12321: }
12322: }
12323: }
12324: }
12325: }
12326: }
12327: }
12328:
1.1059 raeburn 12329: function titleCheck(form,count,offset) {
12330: if (count > 0) {
12331: var chosen = (offset+$startcount)+7*(count-1);
12332: var depitem = $startcount + ((count-1) * 7) + 2;
12333: var currtype = form.elements[depitem].type;
12334: if (form.elements[chosen].value == 'display') {
12335: document.getElementById('arc_title_'+count).style.display='block';
12336: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12337: document.getElementById('archive_title_'+count).value=maintitle;
12338: }
12339: } else {
12340: document.getElementById('arc_title_'+count).style.display='none';
12341: if (currtype == 'text') {
12342: document.getElementById('archive_title_'+count).value='';
12343: }
12344: }
12345: }
12346: return;
12347: }
12348:
1.1055 raeburn 12349: // ]]>
12350: </script>
12351: END
12352: return $scripttag;
12353: }
12354:
12355: sub process_extracted_files {
1.1067 raeburn 12356: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12357: my $numitems = $env{'form.archive_count'};
12358: return unless ($numitems);
12359: my @ids=&Apache::lonnet::current_machine_ids();
12360: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12361: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12362: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12363: if (grep(/^\Q$docuhome\E$/,@ids)) {
12364: $prefix = &LONCAPA::propath($docudom,$docuname);
12365: $pathtocheck = "$dir_root/$destination";
12366: $dir = $dir_root;
12367: $ishome = 1;
12368: } else {
12369: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12370: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12371: $dir = "$dir_root/$docudom/$docuname";
12372: }
12373: my $currdir = "$dir_root/$destination";
12374: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12375: if ($env{'form.folderpath'}) {
12376: my @items = split('&',$env{'form.folderpath'});
12377: $folders{'0'} = $items[-2];
1.1099 raeburn 12378: if ($env{'form.folderpath'} =~ /\:1$/) {
12379: $containers{'0'}='page';
12380: } else {
12381: $containers{'0'}='sequence';
12382: }
1.1055 raeburn 12383: }
12384: my @archdirs = &get_env_multiple('form.archive_directory');
12385: if ($numitems) {
12386: for (my $i=1; $i<=$numitems; $i++) {
12387: my $path = $env{'form.archive_content_'.$i};
12388: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12389: my $item = $1;
12390: $toplevelitems{$item} = $i;
12391: if (grep(/^\Q$i\E$/,@archdirs)) {
12392: $is_dir{$item} = 1;
12393: }
12394: }
12395: }
12396: }
1.1067 raeburn 12397: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12398: if (keys(%toplevelitems) > 0) {
12399: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12400: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12401: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12402: }
1.1066 raeburn 12403: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12404: if ($numitems) {
12405: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 12406: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12407: my $path = $env{'form.archive_content_'.$i};
12408: if ($path =~ /^\Q$pathtocheck\E/) {
12409: if ($env{'form.archive_'.$i} eq 'discard') {
12410: if ($prefix ne '' && $path ne '') {
12411: if (-e $prefix.$path) {
1.1066 raeburn 12412: if ((@archdirs > 0) &&
12413: (grep(/^\Q$i\E$/,@archdirs))) {
12414: $todeletedir{$prefix.$path} = 1;
12415: } else {
12416: $todelete{$prefix.$path} = 1;
12417: }
1.1055 raeburn 12418: }
12419: }
12420: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12421: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12422: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12423: $docstitle = $env{'form.archive_title_'.$i};
12424: if ($docstitle eq '') {
12425: $docstitle = $title;
12426: }
1.1055 raeburn 12427: $outer = 0;
1.1056 raeburn 12428: if (ref($dirorder{$i}) eq 'ARRAY') {
12429: if (@{$dirorder{$i}} > 0) {
12430: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12431: if ($env{'form.archive_'.$item} eq 'display') {
12432: $outer = $item;
12433: last;
12434: }
12435: }
12436: }
12437: }
12438: my ($errtext,$fatal) =
12439: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12440: '/'.$folders{$outer}.'.'.
12441: $containers{$outer});
12442: next if ($fatal);
12443: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12444: if ($context eq 'coursedocs') {
1.1056 raeburn 12445: $mapinner{$i} = time;
1.1055 raeburn 12446: $folders{$i} = 'default_'.$mapinner{$i};
12447: $containers{$i} = 'sequence';
12448: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12449: $folders{$i}.'.'.$containers{$i};
12450: my $newidx = &LONCAPA::map::getresidx();
12451: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12452: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12453: push(@LONCAPA::map::order,$newidx);
12454: my ($outtext,$errtext) =
12455: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12456: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12457: '.'.$containers{$outer},1,1);
1.1056 raeburn 12458: $newseqid{$i} = $newidx;
1.1067 raeburn 12459: unless ($errtext) {
12460: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12461: }
1.1055 raeburn 12462: }
12463: } else {
12464: if ($context eq 'coursedocs') {
12465: my $newidx=&LONCAPA::map::getresidx();
12466: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12467: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12468: $title;
12469: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12470: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12471: }
12472: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12473: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12474: }
12475: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12476: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12477: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12478: unless ($ishome) {
12479: my $fetch = "$newdest{$i}/$title";
12480: $fetch =~ s/^\Q$prefix$dir\E//;
12481: $prompttofetch{$fetch} = 1;
12482: }
1.1055 raeburn 12483: }
12484: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12485: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12486: push(@LONCAPA::map::order, $newidx);
12487: my ($outtext,$errtext)=
12488: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12489: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12490: '.'.$containers{$outer},1,1);
1.1067 raeburn 12491: unless ($errtext) {
12492: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12493: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12494: }
12495: }
1.1055 raeburn 12496: }
12497: }
1.1086 raeburn 12498: }
12499: } else {
12500: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12501: }
12502: }
12503: for (my $i=1; $i<=$numitems; $i++) {
12504: next unless ($env{'form.archive_'.$i} eq 'dependency');
12505: my $path = $env{'form.archive_content_'.$i};
12506: if ($path =~ /^\Q$pathtocheck\E/) {
12507: my ($title) = ($path =~ m{/([^/]+)$});
12508: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12509: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12510: if (ref($dirorder{$i}) eq 'ARRAY') {
12511: my ($itemidx,$fullpath,$relpath);
12512: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12513: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12514: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12515: if ($dirorder{$i}->[$j] eq $container) {
12516: $itemidx = $j;
1.1056 raeburn 12517: }
12518: }
1.1086 raeburn 12519: }
12520: if ($itemidx eq '') {
12521: $itemidx = 0;
12522: }
12523: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12524: if ($mapinner{$referrer{$i}}) {
12525: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12526: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12527: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12528: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12529: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12530: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12531: if (!-e $fullpath) {
12532: mkdir($fullpath,0755);
1.1056 raeburn 12533: }
12534: }
1.1086 raeburn 12535: } else {
12536: last;
1.1056 raeburn 12537: }
1.1086 raeburn 12538: }
12539: }
12540: } elsif ($newdest{$referrer{$i}}) {
12541: $fullpath = $newdest{$referrer{$i}};
12542: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12543: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12544: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12545: last;
12546: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12547: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12548: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12549: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12550: if (!-e $fullpath) {
12551: mkdir($fullpath,0755);
1.1056 raeburn 12552: }
12553: }
1.1086 raeburn 12554: } else {
12555: last;
1.1056 raeburn 12556: }
1.1055 raeburn 12557: }
12558: }
1.1086 raeburn 12559: if ($fullpath ne '') {
12560: if (-e "$prefix$path") {
12561: system("mv $prefix$path $fullpath/$title");
12562: }
12563: if (-e "$fullpath/$title") {
12564: my $showpath;
12565: if ($relpath ne '') {
12566: $showpath = "$relpath/$title";
12567: } else {
12568: $showpath = "/$title";
12569: }
12570: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12571: }
12572: unless ($ishome) {
12573: my $fetch = "$fullpath/$title";
12574: $fetch =~ s/^\Q$prefix$dir\E//;
12575: $prompttofetch{$fetch} = 1;
12576: }
12577: }
1.1055 raeburn 12578: }
1.1086 raeburn 12579: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12580: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12581: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12582: }
12583: } else {
12584: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12585: }
12586: }
12587: if (keys(%todelete)) {
12588: foreach my $key (keys(%todelete)) {
12589: unlink($key);
1.1066 raeburn 12590: }
12591: }
12592: if (keys(%todeletedir)) {
12593: foreach my $key (keys(%todeletedir)) {
12594: rmdir($key);
12595: }
12596: }
12597: foreach my $dir (sort(keys(%is_dir))) {
12598: if (($pathtocheck ne '') && ($dir ne '')) {
12599: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12600: }
12601: }
1.1067 raeburn 12602: if ($result ne '') {
12603: $output .= '<ul>'."\n".
12604: $result."\n".
12605: '</ul>';
12606: }
12607: unless ($ishome) {
12608: my $replicationfail;
12609: foreach my $item (keys(%prompttofetch)) {
12610: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12611: unless ($fetchresult eq 'ok') {
12612: $replicationfail .= '<li>'.$item.'</li>'."\n";
12613: }
12614: }
12615: if ($replicationfail) {
12616: $output .= '<p class="LC_error">'.
12617: &mt('Course home server failed to retrieve:').'<ul>'.
12618: $replicationfail.
12619: '</ul></p>';
12620: }
12621: }
1.1055 raeburn 12622: } else {
12623: $warning = &mt('No items found in archive.');
12624: }
12625: if ($error) {
12626: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12627: $error.'</p>'."\n";
12628: }
12629: if ($warning) {
12630: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12631: }
12632: return $output;
12633: }
12634:
1.1066 raeburn 12635: sub cleanup_empty_dirs {
12636: my ($path) = @_;
12637: if (($path ne '') && (-d $path)) {
12638: if (opendir(my $dirh,$path)) {
12639: my @dircontents = grep(!/^\./,readdir($dirh));
12640: my $numitems = 0;
12641: foreach my $item (@dircontents) {
12642: if (-d "$path/$item") {
1.1111 raeburn 12643: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12644: if (-e "$path/$item") {
12645: $numitems ++;
12646: }
12647: } else {
12648: $numitems ++;
12649: }
12650: }
12651: if ($numitems == 0) {
12652: rmdir($path);
12653: }
12654: closedir($dirh);
12655: }
12656: }
12657: return;
12658: }
12659:
1.41 ng 12660: =pod
1.45 matthew 12661:
1.1162 raeburn 12662: =item * &get_folder_hierarchy()
1.1068 raeburn 12663:
12664: Provides hierarchy of names of folders/sub-folders containing the current
12665: item,
12666:
12667: Inputs: 3
12668: - $navmap - navmaps object
12669:
12670: - $map - url for map (either the trigger itself, or map containing
12671: the resource, which is the trigger).
12672:
12673: - $showitem - 1 => show title for map itself; 0 => do not show.
12674:
12675: Outputs: 1 @pathitems - array of folder/subfolder names.
12676:
12677: =cut
12678:
12679: sub get_folder_hierarchy {
12680: my ($navmap,$map,$showitem) = @_;
12681: my @pathitems;
12682: if (ref($navmap)) {
12683: my $mapres = $navmap->getResourceByUrl($map);
12684: if (ref($mapres)) {
12685: my $pcslist = $mapres->map_hierarchy();
12686: if ($pcslist ne '') {
12687: my @pcs = split(/,/,$pcslist);
12688: foreach my $pc (@pcs) {
12689: if ($pc == 1) {
1.1129 raeburn 12690: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12691: } else {
12692: my $res = $navmap->getByMapPc($pc);
12693: if (ref($res)) {
12694: my $title = $res->compTitle();
12695: $title =~ s/\W+/_/g;
12696: if ($title ne '') {
12697: push(@pathitems,$title);
12698: }
12699: }
12700: }
12701: }
12702: }
1.1071 raeburn 12703: if ($showitem) {
12704: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12705: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12706: } else {
12707: my $maptitle = $mapres->compTitle();
12708: $maptitle =~ s/\W+/_/g;
12709: if ($maptitle ne '') {
12710: push(@pathitems,$maptitle);
12711: }
1.1068 raeburn 12712: }
12713: }
12714: }
12715: }
12716: return @pathitems;
12717: }
12718:
12719: =pod
12720:
1.1015 raeburn 12721: =item * &get_turnedin_filepath()
12722:
12723: Determines path in a user's portfolio file for storage of files uploaded
12724: to a specific essayresponse or dropbox item.
12725:
12726: Inputs: 3 required + 1 optional.
12727: $symb is symb for resource, $uname and $udom are for current user (required).
12728: $caller is optional (can be "submission", if routine is called when storing
12729: an upoaded file when "Submit Answer" button was pressed).
12730:
12731: Returns array containing $path and $multiresp.
12732: $path is path in portfolio. $multiresp is 1 if this resource contains more
12733: than one file upload item. Callers of routine should append partid as a
12734: subdirectory to $path in cases where $multiresp is 1.
12735:
12736: Called by: homework/essayresponse.pm and homework/structuretags.pm
12737:
12738: =cut
12739:
12740: sub get_turnedin_filepath {
12741: my ($symb,$uname,$udom,$caller) = @_;
12742: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12743: my $turnindir;
12744: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12745: $turnindir = $userhash{'turnindir'};
12746: my ($path,$multiresp);
12747: if ($turnindir eq '') {
12748: if ($caller eq 'submission') {
12749: $turnindir = &mt('turned in');
12750: $turnindir =~ s/\W+/_/g;
12751: my %newhash = (
12752: 'turnindir' => $turnindir,
12753: );
12754: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12755: }
12756: }
12757: if ($turnindir ne '') {
12758: $path = '/'.$turnindir.'/';
12759: my ($multipart,$turnin,@pathitems);
12760: my $navmap = Apache::lonnavmaps::navmap->new();
12761: if (defined($navmap)) {
12762: my $mapres = $navmap->getResourceByUrl($map);
12763: if (ref($mapres)) {
12764: my $pcslist = $mapres->map_hierarchy();
12765: if ($pcslist ne '') {
12766: foreach my $pc (split(/,/,$pcslist)) {
12767: my $res = $navmap->getByMapPc($pc);
12768: if (ref($res)) {
12769: my $title = $res->compTitle();
12770: $title =~ s/\W+/_/g;
12771: if ($title ne '') {
1.1149 raeburn 12772: if (($pc > 1) && (length($title) > 12)) {
12773: $title = substr($title,0,12);
12774: }
1.1015 raeburn 12775: push(@pathitems,$title);
12776: }
12777: }
12778: }
12779: }
12780: my $maptitle = $mapres->compTitle();
12781: $maptitle =~ s/\W+/_/g;
12782: if ($maptitle ne '') {
1.1149 raeburn 12783: if (length($maptitle) > 12) {
12784: $maptitle = substr($maptitle,0,12);
12785: }
1.1015 raeburn 12786: push(@pathitems,$maptitle);
12787: }
12788: unless ($env{'request.state'} eq 'construct') {
12789: my $res = $navmap->getBySymb($symb);
12790: if (ref($res)) {
12791: my $partlist = $res->parts();
12792: my $totaluploads = 0;
12793: if (ref($partlist) eq 'ARRAY') {
12794: foreach my $part (@{$partlist}) {
12795: my @types = $res->responseType($part);
12796: my @ids = $res->responseIds($part);
12797: for (my $i=0; $i < scalar(@ids); $i++) {
12798: if ($types[$i] eq 'essay') {
12799: my $partid = $part.'_'.$ids[$i];
12800: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12801: $totaluploads ++;
12802: }
12803: }
12804: }
12805: }
12806: if ($totaluploads > 1) {
12807: $multiresp = 1;
12808: }
12809: }
12810: }
12811: }
12812: } else {
12813: return;
12814: }
12815: } else {
12816: return;
12817: }
12818: my $restitle=&Apache::lonnet::gettitle($symb);
12819: $restitle =~ s/\W+/_/g;
12820: if ($restitle eq '') {
12821: $restitle = ($resurl =~ m{/[^/]+$});
12822: if ($restitle eq '') {
12823: $restitle = time;
12824: }
12825: }
1.1149 raeburn 12826: if (length($restitle) > 12) {
12827: $restitle = substr($restitle,0,12);
12828: }
1.1015 raeburn 12829: push(@pathitems,$restitle);
12830: $path .= join('/',@pathitems);
12831: }
12832: return ($path,$multiresp);
12833: }
12834:
12835: =pod
12836:
1.464 albertel 12837: =back
1.41 ng 12838:
1.112 bowersj2 12839: =head1 CSV Upload/Handling functions
1.38 albertel 12840:
1.41 ng 12841: =over 4
12842:
1.648 raeburn 12843: =item * &upfile_store($r)
1.41 ng 12844:
12845: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12846: needs $env{'form.upfile'}
1.41 ng 12847: returns $datatoken to be put into hidden field
12848:
12849: =cut
1.31 albertel 12850:
12851: sub upfile_store {
12852: my $r=shift;
1.258 albertel 12853: $env{'form.upfile'}=~s/\r/\n/gs;
12854: $env{'form.upfile'}=~s/\f/\n/gs;
12855: $env{'form.upfile'}=~s/\n+/\n/gs;
12856: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12857:
1.258 albertel 12858: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12859: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12860: {
1.158 raeburn 12861: my $datafile = $r->dir_config('lonDaemons').
12862: '/tmp/'.$datatoken.'.tmp';
12863: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12864: print $fh $env{'form.upfile'};
1.158 raeburn 12865: close($fh);
12866: }
1.31 albertel 12867: }
12868: return $datatoken;
12869: }
12870:
1.56 matthew 12871: =pod
12872:
1.648 raeburn 12873: =item * &load_tmp_file($r)
1.41 ng 12874:
12875: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12876: needs $env{'form.datatoken'},
12877: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12878:
12879: =cut
1.31 albertel 12880:
12881: sub load_tmp_file {
12882: my $r=shift;
12883: my @studentdata=();
12884: {
1.158 raeburn 12885: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12886: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12887: if ( open(my $fh,"<$studentfile") ) {
12888: @studentdata=<$fh>;
12889: close($fh);
12890: }
1.31 albertel 12891: }
1.258 albertel 12892: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12893: }
12894:
1.56 matthew 12895: =pod
12896:
1.648 raeburn 12897: =item * &upfile_record_sep()
1.41 ng 12898:
12899: Separate uploaded file into records
12900: returns array of records,
1.258 albertel 12901: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12902:
12903: =cut
1.31 albertel 12904:
12905: sub upfile_record_sep {
1.258 albertel 12906: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12907: } else {
1.248 albertel 12908: my @records;
1.258 albertel 12909: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12910: if ($line=~/^\s*$/) { next; }
12911: push(@records,$line);
12912: }
12913: return @records;
1.31 albertel 12914: }
12915: }
12916:
1.56 matthew 12917: =pod
12918:
1.648 raeburn 12919: =item * &record_sep($record)
1.41 ng 12920:
1.258 albertel 12921: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12922:
12923: =cut
12924:
1.263 www 12925: sub takeleft {
12926: my $index=shift;
12927: return substr('0000'.$index,-4,4);
12928: }
12929:
1.31 albertel 12930: sub record_sep {
12931: my $record=shift;
12932: my %components=();
1.258 albertel 12933: if ($env{'form.upfiletype'} eq 'xml') {
12934: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12935: my $i=0;
1.356 albertel 12936: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12937: $field=~s/^(\"|\')//;
12938: $field=~s/(\"|\')$//;
1.263 www 12939: $components{&takeleft($i)}=$field;
1.31 albertel 12940: $i++;
12941: }
1.258 albertel 12942: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12943: my $i=0;
1.356 albertel 12944: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12945: $field=~s/^(\"|\')//;
12946: $field=~s/(\"|\')$//;
1.263 www 12947: $components{&takeleft($i)}=$field;
1.31 albertel 12948: $i++;
12949: }
12950: } else {
1.561 www 12951: my $separator=',';
1.480 banghart 12952: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12953: $separator=';';
1.480 banghart 12954: }
1.31 albertel 12955: my $i=0;
1.561 www 12956: # the character we are looking for to indicate the end of a quote or a record
12957: my $looking_for=$separator;
12958: # do not add the characters to the fields
12959: my $ignore=0;
12960: # we just encountered a separator (or the beginning of the record)
12961: my $just_found_separator=1;
12962: # store the field we are working on here
12963: my $field='';
12964: # work our way through all characters in record
12965: foreach my $character ($record=~/(.)/g) {
12966: if ($character eq $looking_for) {
12967: if ($character ne $separator) {
12968: # Found the end of a quote, again looking for separator
12969: $looking_for=$separator;
12970: $ignore=1;
12971: } else {
12972: # Found a separator, store away what we got
12973: $components{&takeleft($i)}=$field;
12974: $i++;
12975: $just_found_separator=1;
12976: $ignore=0;
12977: $field='';
12978: }
12979: next;
12980: }
12981: # single or double quotation marks after a separator indicate beginning of a quote
12982: # we are now looking for the end of the quote and need to ignore separators
12983: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12984: $looking_for=$character;
12985: next;
12986: }
12987: # ignore would be true after we reached the end of a quote
12988: if ($ignore) { next; }
12989: if (($just_found_separator) && ($character=~/\s/)) { next; }
12990: $field.=$character;
12991: $just_found_separator=0;
1.31 albertel 12992: }
1.561 www 12993: # catch the very last entry, since we never encountered the separator
12994: $components{&takeleft($i)}=$field;
1.31 albertel 12995: }
12996: return %components;
12997: }
12998:
1.144 matthew 12999: ######################################################
13000: ######################################################
13001:
1.56 matthew 13002: =pod
13003:
1.648 raeburn 13004: =item * &upfile_select_html()
1.41 ng 13005:
1.144 matthew 13006: Return HTML code to select a file from the users machine and specify
13007: the file type.
1.41 ng 13008:
13009: =cut
13010:
1.144 matthew 13011: ######################################################
13012: ######################################################
1.31 albertel 13013: sub upfile_select_html {
1.144 matthew 13014: my %Types = (
13015: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13016: semisv => &mt('Semicolon separated values'),
1.144 matthew 13017: space => &mt('Space separated'),
13018: tab => &mt('Tabulator separated'),
13019: # xml => &mt('HTML/XML'),
13020: );
13021: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13022: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13023: foreach my $type (sort(keys(%Types))) {
13024: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13025: }
13026: $Str .= "</select>\n";
13027: return $Str;
1.31 albertel 13028: }
13029:
1.301 albertel 13030: sub get_samples {
13031: my ($records,$toget) = @_;
13032: my @samples=({});
13033: my $got=0;
13034: foreach my $rec (@$records) {
13035: my %temp = &record_sep($rec);
13036: if (! grep(/\S/, values(%temp))) { next; }
13037: if (%temp) {
13038: $samples[$got]=\%temp;
13039: $got++;
13040: if ($got == $toget) { last; }
13041: }
13042: }
13043: return \@samples;
13044: }
13045:
1.144 matthew 13046: ######################################################
13047: ######################################################
13048:
1.56 matthew 13049: =pod
13050:
1.648 raeburn 13051: =item * &csv_print_samples($r,$records)
1.41 ng 13052:
13053: Prints a table of sample values from each column uploaded $r is an
13054: Apache Request ref, $records is an arrayref from
13055: &Apache::loncommon::upfile_record_sep
13056:
13057: =cut
13058:
1.144 matthew 13059: ######################################################
13060: ######################################################
1.31 albertel 13061: sub csv_print_samples {
13062: my ($r,$records) = @_;
1.662 bisitz 13063: my $samples = &get_samples($records,5);
1.301 albertel 13064:
1.594 raeburn 13065: $r->print(&mt('Samples').'<br />'.&start_data_table().
13066: &start_data_table_header_row());
1.356 albertel 13067: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13068: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13069: $r->print(&end_data_table_header_row());
1.301 albertel 13070: foreach my $hash (@$samples) {
1.594 raeburn 13071: $r->print(&start_data_table_row());
1.356 albertel 13072: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13073: $r->print('<td>');
1.356 albertel 13074: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13075: $r->print('</td>');
13076: }
1.594 raeburn 13077: $r->print(&end_data_table_row());
1.31 albertel 13078: }
1.594 raeburn 13079: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13080: }
13081:
1.144 matthew 13082: ######################################################
13083: ######################################################
13084:
1.56 matthew 13085: =pod
13086:
1.648 raeburn 13087: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13088:
13089: Prints a table to create associations between values and table columns.
1.144 matthew 13090:
1.41 ng 13091: $r is an Apache Request ref,
13092: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13093: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13094:
13095: =cut
13096:
1.144 matthew 13097: ######################################################
13098: ######################################################
1.31 albertel 13099: sub csv_print_select_table {
13100: my ($r,$records,$d) = @_;
1.301 albertel 13101: my $i=0;
13102: my $samples = &get_samples($records,1);
1.144 matthew 13103: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13104: &start_data_table().&start_data_table_header_row().
1.144 matthew 13105: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13106: '<th>'.&mt('Column').'</th>'.
13107: &end_data_table_header_row()."\n");
1.356 albertel 13108: foreach my $array_ref (@$d) {
13109: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13110: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13111:
1.875 bisitz 13112: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13113: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13114: $r->print('<option value="none"></option>');
1.356 albertel 13115: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13116: $r->print('<option value="'.$sample.'"'.
13117: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13118: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13119: }
1.594 raeburn 13120: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13121: $i++;
13122: }
1.594 raeburn 13123: $r->print(&end_data_table());
1.31 albertel 13124: $i--;
13125: return $i;
13126: }
1.56 matthew 13127:
1.144 matthew 13128: ######################################################
13129: ######################################################
13130:
1.56 matthew 13131: =pod
1.31 albertel 13132:
1.648 raeburn 13133: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13134:
13135: Prints a table of sample values from the upload and can make associate samples to internal names.
13136:
13137: $r is an Apache Request ref,
13138: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13139: $d is an array of 2 element arrays (internal name, displayed name)
13140:
13141: =cut
13142:
1.144 matthew 13143: ######################################################
13144: ######################################################
1.31 albertel 13145: sub csv_samples_select_table {
13146: my ($r,$records,$d) = @_;
13147: my $i=0;
1.144 matthew 13148: #
1.662 bisitz 13149: my $max_samples = 5;
13150: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13151: $r->print(&start_data_table().
13152: &start_data_table_header_row().'<th>'.
13153: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13154: &end_data_table_header_row());
1.301 albertel 13155:
13156: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13157: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13158: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13159: foreach my $option (@$d) {
13160: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13161: $r->print('<option value="'.$value.'"'.
1.253 albertel 13162: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13163: $display.'</option>');
1.31 albertel 13164: }
13165: $r->print('</select></td><td>');
1.662 bisitz 13166: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13167: if (defined($samples->[$line]{$key})) {
13168: $r->print($samples->[$line]{$key}."<br />\n");
13169: }
13170: }
1.594 raeburn 13171: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13172: $i++;
13173: }
1.594 raeburn 13174: $r->print(&end_data_table());
1.31 albertel 13175: $i--;
13176: return($i);
1.115 matthew 13177: }
13178:
1.144 matthew 13179: ######################################################
13180: ######################################################
13181:
1.115 matthew 13182: =pod
13183:
1.648 raeburn 13184: =item * &clean_excel_name($name)
1.115 matthew 13185:
13186: Returns a replacement for $name which does not contain any illegal characters.
13187:
13188: =cut
13189:
1.144 matthew 13190: ######################################################
13191: ######################################################
1.115 matthew 13192: sub clean_excel_name {
13193: my ($name) = @_;
13194: $name =~ s/[:\*\?\/\\]//g;
13195: if (length($name) > 31) {
13196: $name = substr($name,0,31);
13197: }
13198: return $name;
1.25 albertel 13199: }
1.84 albertel 13200:
1.85 albertel 13201: =pod
13202:
1.648 raeburn 13203: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13204:
13205: Returns either 1 or undef
13206:
13207: 1 if the part is to be hidden, undef if it is to be shown
13208:
13209: Arguments are:
13210:
13211: $id the id of the part to be checked
13212: $symb, optional the symb of the resource to check
13213: $udom, optional the domain of the user to check for
13214: $uname, optional the username of the user to check for
13215:
13216: =cut
1.84 albertel 13217:
13218: sub check_if_partid_hidden {
13219: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13220: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13221: $symb,$udom,$uname);
1.141 albertel 13222: my $truth=1;
13223: #if the string starts with !, then the list is the list to show not hide
13224: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13225: my @hiddenlist=split(/,/,$hiddenparts);
13226: foreach my $checkid (@hiddenlist) {
1.141 albertel 13227: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13228: }
1.141 albertel 13229: return !$truth;
1.84 albertel 13230: }
1.127 matthew 13231:
1.138 matthew 13232:
13233: ############################################################
13234: ############################################################
13235:
13236: =pod
13237:
1.157 matthew 13238: =back
13239:
1.138 matthew 13240: =head1 cgi-bin script and graphing routines
13241:
1.157 matthew 13242: =over 4
13243:
1.648 raeburn 13244: =item * &get_cgi_id()
1.138 matthew 13245:
13246: Inputs: none
13247:
13248: Returns an id which can be used to pass environment variables
13249: to various cgi-bin scripts. These environment variables will
13250: be removed from the users environment after a given time by
13251: the routine &Apache::lonnet::transfer_profile_to_env.
13252:
13253: =cut
13254:
13255: ############################################################
13256: ############################################################
1.152 albertel 13257: my $uniq=0;
1.136 matthew 13258: sub get_cgi_id {
1.154 albertel 13259: $uniq=($uniq+1)%100000;
1.280 albertel 13260: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13261: }
13262:
1.127 matthew 13263: ############################################################
13264: ############################################################
13265:
13266: =pod
13267:
1.648 raeburn 13268: =item * &DrawBarGraph()
1.127 matthew 13269:
1.138 matthew 13270: Facilitates the plotting of data in a (stacked) bar graph.
13271: Puts plot definition data into the users environment in order for
13272: graph.png to plot it. Returns an <img> tag for the plot.
13273: The bars on the plot are labeled '1','2',...,'n'.
13274:
13275: Inputs:
13276:
13277: =over 4
13278:
13279: =item $Title: string, the title of the plot
13280:
13281: =item $xlabel: string, text describing the X-axis of the plot
13282:
13283: =item $ylabel: string, text describing the Y-axis of the plot
13284:
13285: =item $Max: scalar, the maximum Y value to use in the plot
13286: If $Max is < any data point, the graph will not be rendered.
13287:
1.140 matthew 13288: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13289: they are plotted. If undefined, default values will be used.
13290:
1.178 matthew 13291: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13292:
1.138 matthew 13293: =item @Values: An array of array references. Each array reference holds data
13294: to be plotted in a stacked bar chart.
13295:
1.239 matthew 13296: =item If the final element of @Values is a hash reference the key/value
13297: pairs will be added to the graph definition.
13298:
1.138 matthew 13299: =back
13300:
13301: Returns:
13302:
13303: An <img> tag which references graph.png and the appropriate identifying
13304: information for the plot.
13305:
1.127 matthew 13306: =cut
13307:
13308: ############################################################
13309: ############################################################
1.134 matthew 13310: sub DrawBarGraph {
1.178 matthew 13311: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13312: #
13313: if (! defined($colors)) {
13314: $colors = ['#33ff00',
13315: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13316: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13317: ];
13318: }
1.228 matthew 13319: my $extra_settings = {};
13320: if (ref($Values[-1]) eq 'HASH') {
13321: $extra_settings = pop(@Values);
13322: }
1.127 matthew 13323: #
1.136 matthew 13324: my $identifier = &get_cgi_id();
13325: my $id = 'cgi.'.$identifier;
1.129 matthew 13326: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13327: return '';
13328: }
1.225 matthew 13329: #
13330: my @Labels;
13331: if (defined($labels)) {
13332: @Labels = @$labels;
13333: } else {
13334: for (my $i=0;$i<@{$Values[0]};$i++) {
13335: push (@Labels,$i+1);
13336: }
13337: }
13338: #
1.129 matthew 13339: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13340: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13341: my %ValuesHash;
13342: my $NumSets=1;
13343: foreach my $array (@Values) {
13344: next if (! ref($array));
1.136 matthew 13345: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13346: join(',',@$array);
1.129 matthew 13347: }
1.127 matthew 13348: #
1.136 matthew 13349: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13350: if ($NumBars < 3) {
13351: $width = 120+$NumBars*32;
1.220 matthew 13352: $xskip = 1;
1.225 matthew 13353: $bar_width = 30;
13354: } elsif ($NumBars < 5) {
13355: $width = 120+$NumBars*20;
13356: $xskip = 1;
13357: $bar_width = 20;
1.220 matthew 13358: } elsif ($NumBars < 10) {
1.136 matthew 13359: $width = 120+$NumBars*15;
13360: $xskip = 1;
13361: $bar_width = 15;
13362: } elsif ($NumBars <= 25) {
13363: $width = 120+$NumBars*11;
13364: $xskip = 5;
13365: $bar_width = 8;
13366: } elsif ($NumBars <= 50) {
13367: $width = 120+$NumBars*8;
13368: $xskip = 5;
13369: $bar_width = 4;
13370: } else {
13371: $width = 120+$NumBars*8;
13372: $xskip = 5;
13373: $bar_width = 4;
13374: }
13375: #
1.137 matthew 13376: $Max = 1 if ($Max < 1);
13377: if ( int($Max) < $Max ) {
13378: $Max++;
13379: $Max = int($Max);
13380: }
1.127 matthew 13381: $Title = '' if (! defined($Title));
13382: $xlabel = '' if (! defined($xlabel));
13383: $ylabel = '' if (! defined($ylabel));
1.369 www 13384: $ValuesHash{$id.'.title'} = &escape($Title);
13385: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13386: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13387: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13388: $ValuesHash{$id.'.NumBars'} = $NumBars;
13389: $ValuesHash{$id.'.NumSets'} = $NumSets;
13390: $ValuesHash{$id.'.PlotType'} = 'bar';
13391: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13392: $ValuesHash{$id.'.height'} = $height;
13393: $ValuesHash{$id.'.width'} = $width;
13394: $ValuesHash{$id.'.xskip'} = $xskip;
13395: $ValuesHash{$id.'.bar_width'} = $bar_width;
13396: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13397: #
1.228 matthew 13398: # Deal with other parameters
13399: while (my ($key,$value) = each(%$extra_settings)) {
13400: $ValuesHash{$id.'.'.$key} = $value;
13401: }
13402: #
1.646 raeburn 13403: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13404: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13405: }
13406:
13407: ############################################################
13408: ############################################################
13409:
13410: =pod
13411:
1.648 raeburn 13412: =item * &DrawXYGraph()
1.137 matthew 13413:
1.138 matthew 13414: Facilitates the plotting of data in an XY graph.
13415: Puts plot definition data into the users environment in order for
13416: graph.png to plot it. Returns an <img> tag for the plot.
13417:
13418: Inputs:
13419:
13420: =over 4
13421:
13422: =item $Title: string, the title of the plot
13423:
13424: =item $xlabel: string, text describing the X-axis of the plot
13425:
13426: =item $ylabel: string, text describing the Y-axis of the plot
13427:
13428: =item $Max: scalar, the maximum Y value to use in the plot
13429: If $Max is < any data point, the graph will not be rendered.
13430:
13431: =item $colors: Array ref containing the hex color codes for the data to be
13432: plotted in. If undefined, default values will be used.
13433:
13434: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13435:
13436: =item $Ydata: Array ref containing Array refs.
1.185 www 13437: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13438:
13439: =item %Values: hash indicating or overriding any default values which are
13440: passed to graph.png.
13441: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13442:
13443: =back
13444:
13445: Returns:
13446:
13447: An <img> tag which references graph.png and the appropriate identifying
13448: information for the plot.
13449:
1.137 matthew 13450: =cut
13451:
13452: ############################################################
13453: ############################################################
13454: sub DrawXYGraph {
13455: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13456: #
13457: # Create the identifier for the graph
13458: my $identifier = &get_cgi_id();
13459: my $id = 'cgi.'.$identifier;
13460: #
13461: $Title = '' if (! defined($Title));
13462: $xlabel = '' if (! defined($xlabel));
13463: $ylabel = '' if (! defined($ylabel));
13464: my %ValuesHash =
13465: (
1.369 www 13466: $id.'.title' => &escape($Title),
13467: $id.'.xlabel' => &escape($xlabel),
13468: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13469: $id.'.y_max_value'=> $Max,
13470: $id.'.labels' => join(',',@$Xlabels),
13471: $id.'.PlotType' => 'XY',
13472: );
13473: #
13474: if (defined($colors) && ref($colors) eq 'ARRAY') {
13475: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13476: }
13477: #
13478: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13479: return '';
13480: }
13481: my $NumSets=1;
1.138 matthew 13482: foreach my $array (@{$Ydata}){
1.137 matthew 13483: next if (! ref($array));
13484: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13485: }
1.138 matthew 13486: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13487: #
13488: # Deal with other parameters
13489: while (my ($key,$value) = each(%Values)) {
13490: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13491: }
13492: #
1.646 raeburn 13493: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13494: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13495: }
13496:
13497: ############################################################
13498: ############################################################
13499:
13500: =pod
13501:
1.648 raeburn 13502: =item * &DrawXYYGraph()
1.138 matthew 13503:
13504: Facilitates the plotting of data in an XY graph with two Y axes.
13505: Puts plot definition data into the users environment in order for
13506: graph.png to plot it. Returns an <img> tag for the plot.
13507:
13508: Inputs:
13509:
13510: =over 4
13511:
13512: =item $Title: string, the title of the plot
13513:
13514: =item $xlabel: string, text describing the X-axis of the plot
13515:
13516: =item $ylabel: string, text describing the Y-axis of the plot
13517:
13518: =item $colors: Array ref containing the hex color codes for the data to be
13519: plotted in. If undefined, default values will be used.
13520:
13521: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13522:
13523: =item $Ydata1: The first data set
13524:
13525: =item $Min1: The minimum value of the left Y-axis
13526:
13527: =item $Max1: The maximum value of the left Y-axis
13528:
13529: =item $Ydata2: The second data set
13530:
13531: =item $Min2: The minimum value of the right Y-axis
13532:
13533: =item $Max2: The maximum value of the left Y-axis
13534:
13535: =item %Values: hash indicating or overriding any default values which are
13536: passed to graph.png.
13537: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13538:
13539: =back
13540:
13541: Returns:
13542:
13543: An <img> tag which references graph.png and the appropriate identifying
13544: information for the plot.
1.136 matthew 13545:
13546: =cut
13547:
13548: ############################################################
13549: ############################################################
1.137 matthew 13550: sub DrawXYYGraph {
13551: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13552: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13553: #
13554: # Create the identifier for the graph
13555: my $identifier = &get_cgi_id();
13556: my $id = 'cgi.'.$identifier;
13557: #
13558: $Title = '' if (! defined($Title));
13559: $xlabel = '' if (! defined($xlabel));
13560: $ylabel = '' if (! defined($ylabel));
13561: my %ValuesHash =
13562: (
1.369 www 13563: $id.'.title' => &escape($Title),
13564: $id.'.xlabel' => &escape($xlabel),
13565: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13566: $id.'.labels' => join(',',@$Xlabels),
13567: $id.'.PlotType' => 'XY',
13568: $id.'.NumSets' => 2,
1.137 matthew 13569: $id.'.two_axes' => 1,
13570: $id.'.y1_max_value' => $Max1,
13571: $id.'.y1_min_value' => $Min1,
13572: $id.'.y2_max_value' => $Max2,
13573: $id.'.y2_min_value' => $Min2,
1.136 matthew 13574: );
13575: #
1.137 matthew 13576: if (defined($colors) && ref($colors) eq 'ARRAY') {
13577: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13578: }
13579: #
13580: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13581: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13582: return '';
13583: }
13584: my $NumSets=1;
1.137 matthew 13585: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13586: next if (! ref($array));
13587: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13588: }
13589: #
13590: # Deal with other parameters
13591: while (my ($key,$value) = each(%Values)) {
13592: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13593: }
13594: #
1.646 raeburn 13595: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13596: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13597: }
13598:
13599: ############################################################
13600: ############################################################
13601:
13602: =pod
13603:
1.157 matthew 13604: =back
13605:
1.139 matthew 13606: =head1 Statistics helper routines?
13607:
13608: Bad place for them but what the hell.
13609:
1.157 matthew 13610: =over 4
13611:
1.648 raeburn 13612: =item * &chartlink()
1.139 matthew 13613:
13614: Returns a link to the chart for a specific student.
13615:
13616: Inputs:
13617:
13618: =over 4
13619:
13620: =item $linktext: The text of the link
13621:
13622: =item $sname: The students username
13623:
13624: =item $sdomain: The students domain
13625:
13626: =back
13627:
1.157 matthew 13628: =back
13629:
1.139 matthew 13630: =cut
13631:
13632: ############################################################
13633: ############################################################
13634: sub chartlink {
13635: my ($linktext, $sname, $sdomain) = @_;
13636: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13637: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13638: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13639: '">'.$linktext.'</a>';
1.153 matthew 13640: }
13641:
13642: #######################################################
13643: #######################################################
13644:
13645: =pod
13646:
13647: =head1 Course Environment Routines
1.157 matthew 13648:
13649: =over 4
1.153 matthew 13650:
1.648 raeburn 13651: =item * &restore_course_settings()
1.153 matthew 13652:
1.648 raeburn 13653: =item * &store_course_settings()
1.153 matthew 13654:
13655: Restores/Store indicated form parameters from the course environment.
13656: Will not overwrite existing values of the form parameters.
13657:
13658: Inputs:
13659: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13660:
13661: a hash ref describing the data to be stored. For example:
13662:
13663: %Save_Parameters = ('Status' => 'scalar',
13664: 'chartoutputmode' => 'scalar',
13665: 'chartoutputdata' => 'scalar',
13666: 'Section' => 'array',
1.373 raeburn 13667: 'Group' => 'array',
1.153 matthew 13668: 'StudentData' => 'array',
13669: 'Maps' => 'array');
13670:
13671: Returns: both routines return nothing
13672:
1.631 raeburn 13673: =back
13674:
1.153 matthew 13675: =cut
13676:
13677: #######################################################
13678: #######################################################
13679: sub store_course_settings {
1.496 albertel 13680: return &store_settings($env{'request.course.id'},@_);
13681: }
13682:
13683: sub store_settings {
1.153 matthew 13684: # save to the environment
13685: # appenv the same items, just to be safe
1.300 albertel 13686: my $udom = $env{'user.domain'};
13687: my $uname = $env{'user.name'};
1.496 albertel 13688: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13689: my %SaveHash;
13690: my %AppHash;
13691: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13692: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13693: my $envname = 'environment.'.$basename;
1.258 albertel 13694: if (exists($env{'form.'.$setting})) {
1.153 matthew 13695: # Save this value away
13696: if ($type eq 'scalar' &&
1.258 albertel 13697: (! exists($env{$envname}) ||
13698: $env{$envname} ne $env{'form.'.$setting})) {
13699: $SaveHash{$basename} = $env{'form.'.$setting};
13700: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13701: } elsif ($type eq 'array') {
13702: my $stored_form;
1.258 albertel 13703: if (ref($env{'form.'.$setting})) {
1.153 matthew 13704: $stored_form = join(',',
13705: map {
1.369 www 13706: &escape($_);
1.258 albertel 13707: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13708: } else {
13709: $stored_form =
1.369 www 13710: &escape($env{'form.'.$setting});
1.153 matthew 13711: }
13712: # Determine if the array contents are the same.
1.258 albertel 13713: if ($stored_form ne $env{$envname}) {
1.153 matthew 13714: $SaveHash{$basename} = $stored_form;
13715: $AppHash{$envname} = $stored_form;
13716: }
13717: }
13718: }
13719: }
13720: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13721: $udom,$uname);
1.153 matthew 13722: if ($put_result !~ /^(ok|delayed)/) {
13723: &Apache::lonnet::logthis('unable to save form parameters, '.
13724: 'got error:'.$put_result);
13725: }
13726: # Make sure these settings stick around in this session, too
1.646 raeburn 13727: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13728: return;
13729: }
13730:
13731: sub restore_course_settings {
1.499 albertel 13732: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13733: }
13734:
13735: sub restore_settings {
13736: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13737: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13738: next if (exists($env{'form.'.$setting}));
1.496 albertel 13739: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13740: '.'.$setting;
1.258 albertel 13741: if (exists($env{$envname})) {
1.153 matthew 13742: if ($type eq 'scalar') {
1.258 albertel 13743: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13744: } elsif ($type eq 'array') {
1.258 albertel 13745: $env{'form.'.$setting} = [
1.153 matthew 13746: map {
1.369 www 13747: &unescape($_);
1.258 albertel 13748: } split(',',$env{$envname})
1.153 matthew 13749: ];
13750: }
13751: }
13752: }
1.127 matthew 13753: }
13754:
1.618 raeburn 13755: #######################################################
13756: #######################################################
13757:
13758: =pod
13759:
13760: =head1 Domain E-mail Routines
13761:
13762: =over 4
13763:
1.648 raeburn 13764: =item * &build_recipient_list()
1.618 raeburn 13765:
1.1144 raeburn 13766: Build recipient lists for following types of e-mail:
1.766 raeburn 13767: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13768: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13769: module change checking, student/employee ID conflict checks, as
13770: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13771: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13772:
13773: Inputs:
1.619 raeburn 13774: defmail (scalar - email address of default recipient),
1.1144 raeburn 13775: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13776: requestsmail, updatesmail, or idconflictsmail).
13777:
1.619 raeburn 13778: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13779:
1.619 raeburn 13780: origmail (scalar - email address of recipient from loncapa.conf,
13781: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13782:
1.655 raeburn 13783: Returns: comma separated list of addresses to which to send e-mail.
13784:
13785: =back
1.618 raeburn 13786:
13787: =cut
13788:
13789: ############################################################
13790: ############################################################
13791: sub build_recipient_list {
1.619 raeburn 13792: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13793: my @recipients;
13794: my $otheremails;
13795: my %domconfig =
13796: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13797: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13798: if (exists($domconfig{'contacts'}{$mailing})) {
13799: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13800: my @contacts = ('adminemail','supportemail');
13801: foreach my $item (@contacts) {
13802: if ($domconfig{'contacts'}{$mailing}{$item}) {
13803: my $addr = $domconfig{'contacts'}{$item};
13804: if (!grep(/^\Q$addr\E$/,@recipients)) {
13805: push(@recipients,$addr);
13806: }
1.619 raeburn 13807: }
1.766 raeburn 13808: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13809: }
13810: }
1.766 raeburn 13811: } elsif ($origmail ne '') {
13812: push(@recipients,$origmail);
1.618 raeburn 13813: }
1.619 raeburn 13814: } elsif ($origmail ne '') {
13815: push(@recipients,$origmail);
1.618 raeburn 13816: }
1.688 raeburn 13817: if (defined($defmail)) {
13818: if ($defmail ne '') {
13819: push(@recipients,$defmail);
13820: }
1.618 raeburn 13821: }
13822: if ($otheremails) {
1.619 raeburn 13823: my @others;
13824: if ($otheremails =~ /,/) {
13825: @others = split(/,/,$otheremails);
1.618 raeburn 13826: } else {
1.619 raeburn 13827: push(@others,$otheremails);
13828: }
13829: foreach my $addr (@others) {
13830: if (!grep(/^\Q$addr\E$/,@recipients)) {
13831: push(@recipients,$addr);
13832: }
1.618 raeburn 13833: }
13834: }
1.619 raeburn 13835: my $recipientlist = join(',',@recipients);
1.618 raeburn 13836: return $recipientlist;
13837: }
13838:
1.127 matthew 13839: ############################################################
13840: ############################################################
1.154 albertel 13841:
1.655 raeburn 13842: =pod
13843:
13844: =head1 Course Catalog Routines
13845:
13846: =over 4
13847:
13848: =item * &gather_categories()
13849:
13850: Converts category definitions - keys of categories hash stored in
13851: coursecategories in configuration.db on the primary library server in a
13852: domain - to an array. Also generates javascript and idx hash used to
13853: generate Domain Coordinator interface for editing Course Categories.
13854:
13855: Inputs:
1.663 raeburn 13856:
1.655 raeburn 13857: categories (reference to hash of category definitions).
1.663 raeburn 13858:
1.655 raeburn 13859: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13860: categories and subcategories).
1.663 raeburn 13861:
1.655 raeburn 13862: idx (reference to hash of counters used in Domain Coordinator interface for
13863: editing Course Categories).
1.663 raeburn 13864:
1.655 raeburn 13865: jsarray (reference to array of categories used to create Javascript arrays for
13866: Domain Coordinator interface for editing Course Categories).
13867:
13868: Returns: nothing
13869:
13870: Side effects: populates cats, idx and jsarray.
13871:
13872: =cut
13873:
13874: sub gather_categories {
13875: my ($categories,$cats,$idx,$jsarray) = @_;
13876: my %counters;
13877: my $num = 0;
13878: foreach my $item (keys(%{$categories})) {
13879: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13880: if ($container eq '' && $depth == 0) {
13881: $cats->[$depth][$categories->{$item}] = $cat;
13882: } else {
13883: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13884: }
13885: my ($escitem,$tail) = split(/:/,$item,2);
13886: if ($counters{$tail} eq '') {
13887: $counters{$tail} = $num;
13888: $num ++;
13889: }
13890: if (ref($idx) eq 'HASH') {
13891: $idx->{$item} = $counters{$tail};
13892: }
13893: if (ref($jsarray) eq 'ARRAY') {
13894: push(@{$jsarray->[$counters{$tail}]},$item);
13895: }
13896: }
13897: return;
13898: }
13899:
13900: =pod
13901:
13902: =item * &extract_categories()
13903:
13904: Used to generate breadcrumb trails for course categories.
13905:
13906: Inputs:
1.663 raeburn 13907:
1.655 raeburn 13908: categories (reference to hash of category definitions).
1.663 raeburn 13909:
1.655 raeburn 13910: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13911: categories and subcategories).
1.663 raeburn 13912:
1.655 raeburn 13913: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13914:
1.655 raeburn 13915: allitems (reference to hash - key is category key
13916: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13917:
1.655 raeburn 13918: idx (reference to hash of counters used in Domain Coordinator interface for
13919: editing Course Categories).
1.663 raeburn 13920:
1.655 raeburn 13921: jsarray (reference to array of categories used to create Javascript arrays for
13922: Domain Coordinator interface for editing Course Categories).
13923:
1.665 raeburn 13924: subcats (reference to hash of arrays containing all subcategories within each
13925: category, -recursive)
13926:
1.655 raeburn 13927: Returns: nothing
13928:
13929: Side effects: populates trails and allitems hash references.
13930:
13931: =cut
13932:
13933: sub extract_categories {
1.665 raeburn 13934: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13935: if (ref($categories) eq 'HASH') {
13936: &gather_categories($categories,$cats,$idx,$jsarray);
13937: if (ref($cats->[0]) eq 'ARRAY') {
13938: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13939: my $name = $cats->[0][$i];
13940: my $item = &escape($name).'::0';
13941: my $trailstr;
13942: if ($name eq 'instcode') {
13943: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13944: } elsif ($name eq 'communities') {
13945: $trailstr = &mt('Communities');
1.655 raeburn 13946: } else {
13947: $trailstr = $name;
13948: }
13949: if ($allitems->{$item} eq '') {
13950: push(@{$trails},$trailstr);
13951: $allitems->{$item} = scalar(@{$trails})-1;
13952: }
13953: my @parents = ($name);
13954: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13955: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13956: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13957: if (ref($subcats) eq 'HASH') {
13958: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13959: }
13960: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13961: }
13962: } else {
13963: if (ref($subcats) eq 'HASH') {
13964: $subcats->{$item} = [];
1.655 raeburn 13965: }
13966: }
13967: }
13968: }
13969: }
13970: return;
13971: }
13972:
13973: =pod
13974:
1.1162 raeburn 13975: =item * &recurse_categories()
1.655 raeburn 13976:
13977: Recursively used to generate breadcrumb trails for course categories.
13978:
13979: Inputs:
1.663 raeburn 13980:
1.655 raeburn 13981: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13982: categories and subcategories).
1.663 raeburn 13983:
1.655 raeburn 13984: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13985:
13986: category (current course category, for which breadcrumb trail is being generated).
13987:
13988: trails (reference to array of breadcrumb trails for each category).
13989:
1.655 raeburn 13990: allitems (reference to hash - key is category key
13991: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13992:
1.655 raeburn 13993: parents (array containing containers directories for current category,
13994: back to top level).
13995:
13996: Returns: nothing
13997:
13998: Side effects: populates trails and allitems hash references
13999:
14000: =cut
14001:
14002: sub recurse_categories {
1.665 raeburn 14003: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14004: my $shallower = $depth - 1;
14005: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14006: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14007: my $name = $cats->[$depth]{$category}[$k];
14008: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14009: my $trailstr = join(' -> ',(@{$parents},$category));
14010: if ($allitems->{$item} eq '') {
14011: push(@{$trails},$trailstr);
14012: $allitems->{$item} = scalar(@{$trails})-1;
14013: }
14014: my $deeper = $depth+1;
14015: push(@{$parents},$category);
1.665 raeburn 14016: if (ref($subcats) eq 'HASH') {
14017: my $subcat = &escape($name).':'.$category.':'.$depth;
14018: for (my $j=@{$parents}; $j>=0; $j--) {
14019: my $higher;
14020: if ($j > 0) {
14021: $higher = &escape($parents->[$j]).':'.
14022: &escape($parents->[$j-1]).':'.$j;
14023: } else {
14024: $higher = &escape($parents->[$j]).'::'.$j;
14025: }
14026: push(@{$subcats->{$higher}},$subcat);
14027: }
14028: }
14029: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14030: $subcats);
1.655 raeburn 14031: pop(@{$parents});
14032: }
14033: } else {
14034: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14035: my $trailstr = join(' -> ',(@{$parents},$category));
14036: if ($allitems->{$item} eq '') {
14037: push(@{$trails},$trailstr);
14038: $allitems->{$item} = scalar(@{$trails})-1;
14039: }
14040: }
14041: return;
14042: }
14043:
1.663 raeburn 14044: =pod
14045:
1.1162 raeburn 14046: =item * &assign_categories_table()
1.663 raeburn 14047:
14048: Create a datatable for display of hierarchical categories in a domain,
14049: with checkboxes to allow a course to be categorized.
14050:
14051: Inputs:
14052:
14053: cathash - reference to hash of categories defined for the domain (from
14054: configuration.db)
14055:
14056: currcat - scalar with an & separated list of categories assigned to a course.
14057:
1.919 raeburn 14058: type - scalar contains course type (Course or Community).
14059:
1.663 raeburn 14060: Returns: $output (markup to be displayed)
14061:
14062: =cut
14063:
14064: sub assign_categories_table {
1.919 raeburn 14065: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14066: my $output;
14067: if (ref($cathash) eq 'HASH') {
14068: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14069: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14070: $maxdepth = scalar(@cats);
14071: if (@cats > 0) {
14072: my $itemcount = 0;
14073: if (ref($cats[0]) eq 'ARRAY') {
14074: my @currcategories;
14075: if ($currcat ne '') {
14076: @currcategories = split('&',$currcat);
14077: }
1.919 raeburn 14078: my $table;
1.663 raeburn 14079: for (my $i=0; $i<@{$cats[0]}; $i++) {
14080: my $parent = $cats[0][$i];
1.919 raeburn 14081: next if ($parent eq 'instcode');
14082: if ($type eq 'Community') {
14083: next unless ($parent eq 'communities');
14084: } else {
14085: next if ($parent eq 'communities');
14086: }
1.663 raeburn 14087: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14088: my $item = &escape($parent).'::0';
14089: my $checked = '';
14090: if (@currcategories > 0) {
14091: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14092: $checked = ' checked="checked"';
1.663 raeburn 14093: }
14094: }
1.919 raeburn 14095: my $parent_title = $parent;
14096: if ($parent eq 'communities') {
14097: $parent_title = &mt('Communities');
14098: }
14099: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14100: '<input type="checkbox" name="usecategory" value="'.
14101: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14102: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14103: my $depth = 1;
14104: push(@path,$parent);
1.919 raeburn 14105: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14106: pop(@path);
1.919 raeburn 14107: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14108: $itemcount ++;
14109: }
1.919 raeburn 14110: if ($itemcount) {
14111: $output = &Apache::loncommon::start_data_table().
14112: $table.
14113: &Apache::loncommon::end_data_table();
14114: }
1.663 raeburn 14115: }
14116: }
14117: }
14118: return $output;
14119: }
14120:
14121: =pod
14122:
1.1162 raeburn 14123: =item * &assign_category_rows()
1.663 raeburn 14124:
14125: Create a datatable row for display of nested categories in a domain,
14126: with checkboxes to allow a course to be categorized,called recursively.
14127:
14128: Inputs:
14129:
14130: itemcount - track row number for alternating colors
14131:
14132: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14133: categories and subcategories.
14134:
14135: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14136:
14137: parent - parent of current category item
14138:
14139: path - Array containing all categories back up through the hierarchy from the
14140: current category to the top level.
14141:
14142: currcategories - reference to array of current categories assigned to the course
14143:
14144: Returns: $output (markup to be displayed).
14145:
14146: =cut
14147:
14148: sub assign_category_rows {
14149: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14150: my ($text,$name,$item,$chgstr);
14151: if (ref($cats) eq 'ARRAY') {
14152: my $maxdepth = scalar(@{$cats});
14153: if (ref($cats->[$depth]) eq 'HASH') {
14154: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14155: my $numchildren = @{$cats->[$depth]{$parent}};
14156: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14157: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14158: for (my $j=0; $j<$numchildren; $j++) {
14159: $name = $cats->[$depth]{$parent}[$j];
14160: $item = &escape($name).':'.&escape($parent).':'.$depth;
14161: my $deeper = $depth+1;
14162: my $checked = '';
14163: if (ref($currcategories) eq 'ARRAY') {
14164: if (@{$currcategories} > 0) {
14165: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14166: $checked = ' checked="checked"';
1.663 raeburn 14167: }
14168: }
14169: }
1.664 raeburn 14170: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14171: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14172: $item.'"'.$checked.' />'.$name.'</label></span>'.
14173: '<input type="hidden" name="catname" value="'.$name.'" />'.
14174: '</td><td>';
1.663 raeburn 14175: if (ref($path) eq 'ARRAY') {
14176: push(@{$path},$name);
14177: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14178: pop(@{$path});
14179: }
14180: $text .= '</td></tr>';
14181: }
14182: $text .= '</table></td>';
14183: }
14184: }
14185: }
14186: return $text;
14187: }
14188:
1.1181 raeburn 14189: =pod
14190:
14191: =back
14192:
14193: =cut
14194:
1.655 raeburn 14195: ############################################################
14196: ############################################################
14197:
14198:
1.443 albertel 14199: sub commit_customrole {
1.664 raeburn 14200: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14201: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14202: ($start?', '.&mt('starting').' '.localtime($start):'').
14203: ($end?', ending '.localtime($end):'').': <b>'.
14204: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14205: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14206: '</b><br />';
14207: return $output;
14208: }
14209:
14210: sub commit_standardrole {
1.1116 raeburn 14211: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14212: my ($output,$logmsg,$linefeed);
14213: if ($context eq 'auto') {
14214: $linefeed = "\n";
14215: } else {
14216: $linefeed = "<br />\n";
14217: }
1.443 albertel 14218: if ($three eq 'st') {
1.541 raeburn 14219: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14220: $one,$two,$sec,$context,$credits);
1.541 raeburn 14221: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14222: ($result eq 'unknown_course') || ($result eq 'refused')) {
14223: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14224: } else {
1.541 raeburn 14225: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14226: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14227: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14228: if ($context eq 'auto') {
14229: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14230: } else {
14231: $output .= '<b>'.$result.'</b>'.$linefeed.
14232: &mt('Add to classlist').': <b>ok</b>';
14233: }
14234: $output .= $linefeed;
1.443 albertel 14235: }
14236: } else {
14237: $output = &mt('Assigning').' '.$three.' in '.$url.
14238: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14239: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14240: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14241: if ($context eq 'auto') {
14242: $output .= $result.$linefeed;
14243: } else {
14244: $output .= '<b>'.$result.'</b>'.$linefeed;
14245: }
1.443 albertel 14246: }
14247: return $output;
14248: }
14249:
14250: sub commit_studentrole {
1.1116 raeburn 14251: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14252: $credits) = @_;
1.626 raeburn 14253: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14254: if ($context eq 'auto') {
14255: $linefeed = "\n";
14256: } else {
14257: $linefeed = '<br />'."\n";
14258: }
1.443 albertel 14259: if (defined($one) && defined($two)) {
14260: my $cid=$one.'_'.$two;
14261: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14262: my $secchange = 0;
14263: my $expire_role_result;
14264: my $modify_section_result;
1.628 raeburn 14265: if ($oldsec ne '-1') {
14266: if ($oldsec ne $sec) {
1.443 albertel 14267: $secchange = 1;
1.628 raeburn 14268: my $now = time;
1.443 albertel 14269: my $uurl='/'.$cid;
14270: $uurl=~s/\_/\//g;
14271: if ($oldsec) {
14272: $uurl.='/'.$oldsec;
14273: }
1.626 raeburn 14274: $oldsecurl = $uurl;
1.628 raeburn 14275: $expire_role_result =
1.652 raeburn 14276: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14277: if ($env{'request.course.sec'} ne '') {
14278: if ($expire_role_result eq 'refused') {
14279: my @roles = ('st');
14280: my @statuses = ('previous');
14281: my @roledoms = ($one);
14282: my $withsec = 1;
14283: my %roleshash =
14284: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14285: \@statuses,\@roles,\@roledoms,$withsec);
14286: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14287: my ($oldstart,$oldend) =
14288: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14289: if ($oldend > 0 && $oldend <= $now) {
14290: $expire_role_result = 'ok';
14291: }
14292: }
14293: }
14294: }
1.443 albertel 14295: $result = $expire_role_result;
14296: }
14297: }
14298: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 14299: $modify_section_result =
14300: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14301: undef,undef,undef,$sec,
14302: $end,$start,'','',$cid,
14303: '',$context,$credits);
1.443 albertel 14304: if ($modify_section_result =~ /^ok/) {
14305: if ($secchange == 1) {
1.628 raeburn 14306: if ($sec eq '') {
14307: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14308: } else {
14309: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14310: }
1.443 albertel 14311: } elsif ($oldsec eq '-1') {
1.628 raeburn 14312: if ($sec eq '') {
14313: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14314: } else {
14315: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14316: }
1.443 albertel 14317: } else {
1.628 raeburn 14318: if ($sec eq '') {
14319: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14320: } else {
14321: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14322: }
1.443 albertel 14323: }
14324: } else {
1.1115 raeburn 14325: if ($secchange) {
1.628 raeburn 14326: $$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;
14327: } else {
14328: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14329: }
1.443 albertel 14330: }
14331: $result = $modify_section_result;
14332: } elsif ($secchange == 1) {
1.628 raeburn 14333: if ($oldsec eq '') {
1.1103 raeburn 14334: $$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 14335: } else {
14336: $$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;
14337: }
1.626 raeburn 14338: if ($expire_role_result eq 'refused') {
14339: my $newsecurl = '/'.$cid;
14340: $newsecurl =~ s/\_/\//g;
14341: if ($sec ne '') {
14342: $newsecurl.='/'.$sec;
14343: }
14344: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14345: if ($sec eq '') {
14346: $$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;
14347: } else {
14348: $$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;
14349: }
14350: }
14351: }
1.443 albertel 14352: }
14353: } else {
1.626 raeburn 14354: $$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 14355: $result = "error: incomplete course id\n";
14356: }
14357: return $result;
14358: }
14359:
1.1108 raeburn 14360: sub show_role_extent {
14361: my ($scope,$context,$role) = @_;
14362: $scope =~ s{^/}{};
14363: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14364: push(@courseroles,'co');
14365: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14366: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14367: $scope =~ s{/}{_};
14368: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14369: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14370: my ($audom,$auname) = split(/\//,$scope);
14371: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14372: &Apache::loncommon::plainname($auname,$audom).'</span>');
14373: } else {
14374: $scope =~ s{/$}{};
14375: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14376: &Apache::lonnet::domain($scope,'description').'</span>');
14377: }
14378: }
14379:
1.443 albertel 14380: ############################################################
14381: ############################################################
14382:
1.566 albertel 14383: sub check_clone {
1.578 raeburn 14384: my ($args,$linefeed) = @_;
1.566 albertel 14385: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14386: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14387: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14388: my $clonemsg;
14389: my $can_clone = 0;
1.944 raeburn 14390: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14391: if ($lctype ne 'community') {
14392: $lctype = 'course';
14393: }
1.566 albertel 14394: if ($clonehome eq 'no_host') {
1.944 raeburn 14395: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14396: $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'});
14397: } else {
14398: $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'});
14399: }
1.566 albertel 14400: } else {
14401: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14402: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14403: if ($clonedesc{'type'} ne 'Community') {
14404: $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'});
14405: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14406: }
14407: }
1.882 raeburn 14408: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14409: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14410: $can_clone = 1;
14411: } else {
14412: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14413: $args->{'clonedomain'},$args->{'clonecourse'});
14414: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14415: if (grep(/^\*$/,@cloners)) {
14416: $can_clone = 1;
14417: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14418: $can_clone = 1;
14419: } else {
1.908 raeburn 14420: my $ccrole = 'cc';
1.944 raeburn 14421: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14422: $ccrole = 'co';
14423: }
1.578 raeburn 14424: my %roleshash =
14425: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14426: $args->{'ccdomain'},
1.908 raeburn 14427: 'userroles',['active'],[$ccrole],
1.578 raeburn 14428: [$args->{'clonedomain'}]);
1.908 raeburn 14429: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14430: $can_clone = 1;
14431: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14432: $can_clone = 1;
14433: } else {
1.944 raeburn 14434: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14435: $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'});
14436: } else {
14437: $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'});
14438: }
1.578 raeburn 14439: }
1.566 albertel 14440: }
1.578 raeburn 14441: }
1.566 albertel 14442: }
14443: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14444: }
14445:
1.444 albertel 14446: sub construct_course {
1.1166 raeburn 14447: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14448: my $outcome;
1.541 raeburn 14449: my $linefeed = '<br />'."\n";
14450: if ($context eq 'auto') {
14451: $linefeed = "\n";
14452: }
1.566 albertel 14453:
14454: #
14455: # Are we cloning?
14456: #
14457: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14458: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14459: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14460: if ($context ne 'auto') {
1.578 raeburn 14461: if ($clonemsg ne '') {
14462: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14463: }
1.566 albertel 14464: }
14465: $outcome .= $clonemsg.$linefeed;
14466:
14467: if (!$can_clone) {
14468: return (0,$outcome);
14469: }
14470: }
14471:
1.444 albertel 14472: #
14473: # Open course
14474: #
14475: my $crstype = lc($args->{'crstype'});
14476: my %cenv=();
14477: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14478: $args->{'cdescr'},
14479: $args->{'curl'},
14480: $args->{'course_home'},
14481: $args->{'nonstandard'},
14482: $args->{'crscode'},
14483: $args->{'ccuname'}.':'.
14484: $args->{'ccdomain'},
1.882 raeburn 14485: $args->{'crstype'},
1.885 raeburn 14486: $cnum,$context,$category);
1.444 albertel 14487:
14488: # Note: The testing routines depend on this being output; see
14489: # Utils::Course. This needs to at least be output as a comment
14490: # if anyone ever decides to not show this, and Utils::Course::new
14491: # will need to be suitably modified.
1.541 raeburn 14492: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14493: if ($$courseid =~ /^error:/) {
14494: return (0,$outcome);
14495: }
14496:
1.444 albertel 14497: #
14498: # Check if created correctly
14499: #
1.479 albertel 14500: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14501: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14502: if ($crsuhome eq 'no_host') {
14503: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14504: return (0,$outcome);
14505: }
1.541 raeburn 14506: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14507:
1.444 albertel 14508: #
1.566 albertel 14509: # Do the cloning
14510: #
14511: if ($can_clone && $cloneid) {
14512: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14513: if ($context ne 'auto') {
14514: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14515: }
14516: $outcome .= $clonemsg.$linefeed;
14517: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14518: # Copy all files
1.637 www 14519: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14520: # Restore URL
1.566 albertel 14521: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14522: # Restore title
1.566 albertel 14523: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14524: # Restore creation date, creator and creation context.
14525: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14526: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14527: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14528: # Mark as cloned
1.566 albertel 14529: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14530: # Need to clone grading mode
14531: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14532: $cenv{'grading'}=$newenv{'grading'};
14533: # Do not clone these environment entries
14534: &Apache::lonnet::del('environment',
14535: ['default_enrollment_start_date',
14536: 'default_enrollment_end_date',
14537: 'question.email',
14538: 'policy.email',
14539: 'comment.email',
14540: 'pch.users.denied',
1.725 raeburn 14541: 'plc.users.denied',
14542: 'hidefromcat',
1.1121 raeburn 14543: 'checkforpriv',
1.1166 raeburn 14544: 'categories',
14545: 'internal.uniquecode'],
1.638 www 14546: $$crsudom,$$crsunum);
1.1170 raeburn 14547: if ($args->{'textbook'}) {
14548: $cenv{'internal.textbook'} = $args->{'textbook'};
14549: }
1.444 albertel 14550: }
1.566 albertel 14551:
1.444 albertel 14552: #
14553: # Set environment (will override cloned, if existing)
14554: #
14555: my @sections = ();
14556: my @xlists = ();
14557: if ($args->{'crstype'}) {
14558: $cenv{'type'}=$args->{'crstype'};
14559: }
14560: if ($args->{'crsid'}) {
14561: $cenv{'courseid'}=$args->{'crsid'};
14562: }
14563: if ($args->{'crscode'}) {
14564: $cenv{'internal.coursecode'}=$args->{'crscode'};
14565: }
14566: if ($args->{'crsquota'} ne '') {
14567: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14568: } else {
14569: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14570: }
14571: if ($args->{'ccuname'}) {
14572: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14573: ':'.$args->{'ccdomain'};
14574: } else {
14575: $cenv{'internal.courseowner'} = $args->{'curruser'};
14576: }
1.1116 raeburn 14577: if ($args->{'defaultcredits'}) {
14578: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14579: }
1.444 albertel 14580: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14581: if ($args->{'crssections'}) {
14582: $cenv{'internal.sectionnums'} = '';
14583: if ($args->{'crssections'} =~ m/,/) {
14584: @sections = split/,/,$args->{'crssections'};
14585: } else {
14586: $sections[0] = $args->{'crssections'};
14587: }
14588: if (@sections > 0) {
14589: foreach my $item (@sections) {
14590: my ($sec,$gp) = split/:/,$item;
14591: my $class = $args->{'crscode'}.$sec;
14592: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14593: $cenv{'internal.sectionnums'} .= $item.',';
14594: unless ($addcheck eq 'ok') {
14595: push @badclasses, $class;
14596: }
14597: }
14598: $cenv{'internal.sectionnums'} =~ s/,$//;
14599: }
14600: }
14601: # do not hide course coordinator from staff listing,
14602: # even if privileged
14603: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14604: # add course coordinator's domain to domains to check for privileged users
14605: # if different to course domain
14606: if ($$crsudom ne $args->{'ccdomain'}) {
14607: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14608: }
1.444 albertel 14609: # add crosslistings
14610: if ($args->{'crsxlist'}) {
14611: $cenv{'internal.crosslistings'}='';
14612: if ($args->{'crsxlist'} =~ m/,/) {
14613: @xlists = split/,/,$args->{'crsxlist'};
14614: } else {
14615: $xlists[0] = $args->{'crsxlist'};
14616: }
14617: if (@xlists > 0) {
14618: foreach my $item (@xlists) {
14619: my ($xl,$gp) = split/:/,$item;
14620: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14621: $cenv{'internal.crosslistings'} .= $item.',';
14622: unless ($addcheck eq 'ok') {
14623: push @badclasses, $xl;
14624: }
14625: }
14626: $cenv{'internal.crosslistings'} =~ s/,$//;
14627: }
14628: }
14629: if ($args->{'autoadds'}) {
14630: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14631: }
14632: if ($args->{'autodrops'}) {
14633: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14634: }
14635: # check for notification of enrollment changes
14636: my @notified = ();
14637: if ($args->{'notify_owner'}) {
14638: if ($args->{'ccuname'} ne '') {
14639: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14640: }
14641: }
14642: if ($args->{'notify_dc'}) {
14643: if ($uname ne '') {
1.630 raeburn 14644: push(@notified,$uname.':'.$udom);
1.444 albertel 14645: }
14646: }
14647: if (@notified > 0) {
14648: my $notifylist;
14649: if (@notified > 1) {
14650: $notifylist = join(',',@notified);
14651: } else {
14652: $notifylist = $notified[0];
14653: }
14654: $cenv{'internal.notifylist'} = $notifylist;
14655: }
14656: if (@badclasses > 0) {
14657: my %lt=&Apache::lonlocal::texthash(
14658: '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',
14659: 'dnhr' => 'does not have rights to access enrollment in these classes',
14660: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14661: );
1.541 raeburn 14662: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14663: ' ('.$lt{'adby'}.')';
14664: if ($context eq 'auto') {
14665: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14666: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14667: foreach my $item (@badclasses) {
14668: if ($context eq 'auto') {
14669: $outcome .= " - $item\n";
14670: } else {
14671: $outcome .= "<li>$item</li>\n";
14672: }
14673: }
14674: if ($context eq 'auto') {
14675: $outcome .= $linefeed;
14676: } else {
1.566 albertel 14677: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14678: }
14679: }
1.444 albertel 14680: }
14681: if ($args->{'no_end_date'}) {
14682: $args->{'endaccess'} = 0;
14683: }
14684: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14685: $cenv{'internal.autoend'}=$args->{'enrollend'};
14686: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14687: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14688: if ($args->{'showphotos'}) {
14689: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14690: }
14691: $cenv{'internal.authtype'} = $args->{'authtype'};
14692: $cenv{'internal.autharg'} = $args->{'autharg'};
14693: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14694: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14695: 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');
14696: if ($context eq 'auto') {
14697: $outcome .= $krb_msg;
14698: } else {
1.566 albertel 14699: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14700: }
14701: $outcome .= $linefeed;
1.444 albertel 14702: }
14703: }
14704: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14705: if ($args->{'setpolicy'}) {
14706: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14707: }
14708: if ($args->{'setcontent'}) {
14709: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14710: }
14711: }
14712: if ($args->{'reshome'}) {
14713: $cenv{'reshome'}=$args->{'reshome'}.'/';
14714: $cenv{'reshome'}=~s/\/+$/\//;
14715: }
14716: #
14717: # course has keyed access
14718: #
14719: if ($args->{'setkeys'}) {
14720: $cenv{'keyaccess'}='yes';
14721: }
14722: # if specified, key authority is not course, but user
14723: # only active if keyaccess is yes
14724: if ($args->{'keyauth'}) {
1.487 albertel 14725: my ($user,$domain) = split(':',$args->{'keyauth'});
14726: $user = &LONCAPA::clean_username($user);
14727: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14728: if ($user ne '' && $domain ne '') {
1.487 albertel 14729: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14730: }
14731: }
14732:
1.1166 raeburn 14733: #
1.1167 raeburn 14734: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14735: #
14736: if ($args->{'uniquecode'}) {
14737: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14738: if ($code) {
14739: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14740: my %crsinfo =
14741: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14742: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14743: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14744: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14745: }
1.1166 raeburn 14746: if (ref($coderef)) {
14747: $$coderef = $code;
14748: }
14749: }
14750: }
14751:
1.444 albertel 14752: if ($args->{'disresdis'}) {
14753: $cenv{'pch.roles.denied'}='st';
14754: }
14755: if ($args->{'disablechat'}) {
14756: $cenv{'plc.roles.denied'}='st';
14757: }
14758:
14759: # Record we've not yet viewed the Course Initialization Helper for this
14760: # course
14761: $cenv{'course.helper.not.run'} = 1;
14762: #
14763: # Use new Randomseed
14764: #
14765: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14766: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14767: #
14768: # The encryption code and receipt prefix for this course
14769: #
14770: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14771: $cenv{'internal.encpref'}=100+int(9*rand(99));
14772: #
14773: # By default, use standard grading
14774: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14775:
1.541 raeburn 14776: $outcome .= $linefeed.&mt('Setting environment').': '.
14777: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14778: #
14779: # Open all assignments
14780: #
14781: if ($args->{'openall'}) {
14782: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14783: my %storecontent = ($storeunder => time,
14784: $storeunder.'.type' => 'date_start');
14785:
14786: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14787: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14788: }
14789: #
14790: # Set first page
14791: #
14792: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14793: || ($cloneid)) {
1.445 albertel 14794: use LONCAPA::map;
1.444 albertel 14795: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14796:
14797: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14798: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14799:
1.444 albertel 14800: $outcome .= ($fatal?$errtext:'read ok').' - ';
14801: my $title; my $url;
14802: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14803: $title=&mt('Syllabus');
1.444 albertel 14804: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14805: } else {
1.963 raeburn 14806: $title=&mt('Table of Contents');
1.444 albertel 14807: $url='/adm/navmaps';
14808: }
1.445 albertel 14809:
14810: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14811: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14812:
14813: if ($errtext) { $fatal=2; }
1.541 raeburn 14814: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14815: }
1.566 albertel 14816:
14817: return (1,$outcome);
1.444 albertel 14818: }
14819:
1.1166 raeburn 14820: sub make_unique_code {
14821: my ($cdom,$cnum) = @_;
14822: # get lock on uniquecodes db
14823: my $lockhash = {
14824: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14825: ':'.$env{'user.domain'},
14826: };
14827: my $tries = 0;
14828: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14829: my ($code,$error);
14830:
14831: while (($gotlock ne 'ok') && ($tries<3)) {
14832: $tries ++;
14833: sleep 1;
14834: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14835: }
14836: if ($gotlock eq 'ok') {
14837: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14838: my $gotcode;
14839: my $attempts = 0;
14840: while ((!$gotcode) && ($attempts < 100)) {
14841: $code = &generate_code();
14842: if (!exists($currcodes{$code})) {
14843: $gotcode = 1;
14844: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14845: $error = 'nostore';
14846: }
14847: }
14848: $attempts ++;
14849: }
14850: my @del_lock = ($cnum."\0".'uniquecodes');
14851: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14852: } else {
14853: $error = 'nolock';
14854: }
14855: return ($code,$error);
14856: }
14857:
14858: sub generate_code {
14859: my $code;
14860: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14861: for (my $i=0; $i<6; $i++) {
14862: my $lettnum = int (rand 2);
14863: my $item = '';
14864: if ($lettnum) {
14865: $item = $letts[int( rand(18) )];
14866: } else {
14867: $item = 1+int( rand(8) );
14868: }
14869: $code .= $item;
14870: }
14871: return $code;
14872: }
14873:
1.444 albertel 14874: ############################################################
14875: ############################################################
14876:
1.953 droeschl 14877: #SD
14878: # only Community and Course, or anything else?
1.378 raeburn 14879: sub course_type {
14880: my ($cid) = @_;
14881: if (!defined($cid)) {
14882: $cid = $env{'request.course.id'};
14883: }
1.404 albertel 14884: if (defined($env{'course.'.$cid.'.type'})) {
14885: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14886: } else {
14887: return 'Course';
1.377 raeburn 14888: }
14889: }
1.156 albertel 14890:
1.406 raeburn 14891: sub group_term {
14892: my $crstype = &course_type();
14893: my %names = (
14894: 'Course' => 'group',
1.865 raeburn 14895: 'Community' => 'group',
1.406 raeburn 14896: );
14897: return $names{$crstype};
14898: }
14899:
1.902 raeburn 14900: sub course_types {
1.1165 raeburn 14901: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14902: my %typename = (
14903: official => 'Official course',
14904: unofficial => 'Unofficial course',
14905: community => 'Community',
1.1165 raeburn 14906: textbook => 'Textbook course',
1.902 raeburn 14907: );
14908: return (\@types,\%typename);
14909: }
14910:
1.156 albertel 14911: sub icon {
14912: my ($file)=@_;
1.505 albertel 14913: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14914: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14915: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14916: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14917: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14918: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14919: $curfext.".gif") {
14920: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14921: $curfext.".gif";
14922: }
14923: }
1.249 albertel 14924: return &lonhttpdurl($iconname);
1.154 albertel 14925: }
1.84 albertel 14926:
1.575 albertel 14927: sub lonhttpdurl {
1.692 www 14928: #
14929: # Had been used for "small fry" static images on separate port 8080.
14930: # Modify here if lightweight http functionality desired again.
14931: # Currently eliminated due to increasing firewall issues.
14932: #
1.575 albertel 14933: my ($url)=@_;
1.692 www 14934: return $url;
1.215 albertel 14935: }
14936:
1.213 albertel 14937: sub connection_aborted {
14938: my ($r)=@_;
14939: $r->print(" ");$r->rflush();
14940: my $c = $r->connection;
14941: return $c->aborted();
14942: }
14943:
1.221 foxr 14944: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14945: # strings as 'strings'.
14946: sub escape_single {
1.221 foxr 14947: my ($input) = @_;
1.223 albertel 14948: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14949: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14950: return $input;
14951: }
1.223 albertel 14952:
1.222 foxr 14953: # Same as escape_single, but escape's "'s This
14954: # can be used for "strings"
14955: sub escape_double {
14956: my ($input) = @_;
14957: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14958: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14959: return $input;
14960: }
1.223 albertel 14961:
1.222 foxr 14962: # Escapes the last element of a full URL.
14963: sub escape_url {
14964: my ($url) = @_;
1.238 raeburn 14965: my @urlslices = split(/\//, $url,-1);
1.369 www 14966: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 14967: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14968: }
1.462 albertel 14969:
1.820 raeburn 14970: sub compare_arrays {
14971: my ($arrayref1,$arrayref2) = @_;
14972: my (@difference,%count);
14973: @difference = ();
14974: %count = ();
14975: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14976: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14977: foreach my $element (keys(%count)) {
14978: if ($count{$element} == 1) {
14979: push(@difference,$element);
14980: }
14981: }
14982: }
14983: return @difference;
14984: }
14985:
1.817 bisitz 14986: # -------------------------------------------------------- Initialize user login
1.462 albertel 14987: sub init_user_environment {
1.463 albertel 14988: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14989: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14990:
14991: my $public=($username eq 'public' && $domain eq 'public');
14992:
14993: # See if old ID present, if so, remove
14994:
1.1062 raeburn 14995: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14996: my $now=time;
14997:
14998: if ($public) {
14999: my $max_public=100;
15000: my $oldest;
15001: my $oldest_time=0;
15002: for(my $next=1;$next<=$max_public;$next++) {
15003: if (-e $lonids."/publicuser_$next.id") {
15004: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15005: if ($mtime<$oldest_time || !$oldest_time) {
15006: $oldest_time=$mtime;
15007: $oldest=$next;
15008: }
15009: } else {
15010: $cookie="publicuser_$next";
15011: last;
15012: }
15013: }
15014: if (!$cookie) { $cookie="publicuser_$oldest"; }
15015: } else {
1.463 albertel 15016: # if this isn't a robot, kill any existing non-robot sessions
15017: if (!$args->{'robot'}) {
15018: opendir(DIR,$lonids);
15019: while ($filename=readdir(DIR)) {
15020: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15021: unlink($lonids.'/'.$filename);
15022: }
1.462 albertel 15023: }
1.463 albertel 15024: closedir(DIR);
1.1204 raeburn 15025: # If there is a undeleted lockfile for the user's paste buffer remove it.
15026: my $namespace = 'nohist_courseeditor';
15027: my $lockingkey = 'paste'."\0".'locked_num';
15028: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15029: $domain,$username);
15030: if (exists($lockhash{$lockingkey})) {
15031: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15032: unless ($delresult eq 'ok') {
15033: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15034: }
15035: }
1.462 albertel 15036: }
15037: # Give them a new cookie
1.463 albertel 15038: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15039: : $now.$$.int(rand(10000)));
1.463 albertel 15040: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15041:
15042: # Initialize roles
15043:
1.1062 raeburn 15044: ($userroles,$firstaccenv,$timerintenv) =
15045: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15046: }
15047: # ------------------------------------ Check browser type and MathML capability
15048:
1.1194 raeburn 15049: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15050: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15051:
15052: # ------------------------------------------------------------- Get environment
15053:
15054: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15055: my ($tmp) = keys(%userenv);
15056: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15057: } else {
15058: undef(%userenv);
15059: }
15060: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15061: $form->{'interface'}=$userenv{'interface'};
15062: }
15063: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15064:
15065: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15066: foreach my $option ('interface','localpath','localres') {
15067: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15068: }
15069: # --------------------------------------------------------- Write first profile
15070:
15071: {
15072: my %initial_env =
15073: ("user.name" => $username,
15074: "user.domain" => $domain,
15075: "user.home" => $authhost,
15076: "browser.type" => $clientbrowser,
15077: "browser.version" => $clientversion,
15078: "browser.mathml" => $clientmathml,
15079: "browser.unicode" => $clientunicode,
15080: "browser.os" => $clientos,
1.1137 raeburn 15081: "browser.mobile" => $clientmobile,
1.1141 raeburn 15082: "browser.info" => $clientinfo,
1.1194 raeburn 15083: "browser.osversion" => $clientosversion,
1.462 albertel 15084: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15085: "request.course.fn" => '',
15086: "request.course.uri" => '',
15087: "request.course.sec" => '',
15088: "request.role" => 'cm',
15089: "request.role.adv" => $env{'user.adv'},
15090: "request.host" => $ENV{'REMOTE_ADDR'},);
15091:
15092: if ($form->{'localpath'}) {
15093: $initial_env{"browser.localpath"} = $form->{'localpath'};
15094: $initial_env{"browser.localres"} = $form->{'localres'};
15095: }
15096:
15097: if ($form->{'interface'}) {
15098: $form->{'interface'}=~s/\W//gs;
15099: $initial_env{"browser.interface"} = $form->{'interface'};
15100: $env{'browser.interface'}=$form->{'interface'};
15101: }
15102:
1.1157 raeburn 15103: if ($form->{'iptoken'}) {
15104: my $lonhost = $r->dir_config('lonHostID');
15105: $initial_env{"user.noloadbalance"} = $lonhost;
15106: $env{'user.noloadbalance'} = $lonhost;
15107: }
15108:
1.981 raeburn 15109: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15110: my %domdef;
15111: unless ($domain eq 'public') {
15112: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15113: }
1.980 raeburn 15114:
1.1081 raeburn 15115: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15116: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15117: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15118: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15119: }
15120:
1.1165 raeburn 15121: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 15122: $userenv{'canrequest.'.$crstype} =
15123: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15124: 'reload','requestcourses',
15125: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15126: }
15127:
1.1092 raeburn 15128: $userenv{'canrequest.author'} =
15129: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15130: 'reload','requestauthor',
15131: \%userenv,\%domdef,\%is_adv);
15132: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15133: $domain,$username);
15134: my $reqstatus = $reqauthor{'author_status'};
15135: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15136: if (ref($reqauthor{'author'}) eq 'HASH') {
15137: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15138: $reqauthor{'author'}{'timestamp'};
15139: }
15140: }
15141:
1.462 albertel 15142: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15143:
1.462 albertel 15144: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15145: &GDBM_WRCREAT(),0640)) {
15146: &_add_to_env(\%disk_env,\%initial_env);
15147: &_add_to_env(\%disk_env,\%userenv,'environment.');
15148: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15149: if (ref($firstaccenv) eq 'HASH') {
15150: &_add_to_env(\%disk_env,$firstaccenv);
15151: }
15152: if (ref($timerintenv) eq 'HASH') {
15153: &_add_to_env(\%disk_env,$timerintenv);
15154: }
1.463 albertel 15155: if (ref($args->{'extra_env'})) {
15156: &_add_to_env(\%disk_env,$args->{'extra_env'});
15157: }
1.462 albertel 15158: untie(%disk_env);
15159: } else {
1.705 tempelho 15160: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15161: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15162: return 'error: '.$!;
15163: }
15164: }
15165: $env{'request.role'}='cm';
15166: $env{'request.role.adv'}=$env{'user.adv'};
15167: $env{'browser.type'}=$clientbrowser;
15168:
15169: return $cookie;
15170:
15171: }
15172:
15173: sub _add_to_env {
15174: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15175: if (ref($env_data) eq 'HASH') {
15176: while (my ($key,$value) = each(%$env_data)) {
15177: $idf->{$prefix.$key} = $value;
15178: $env{$prefix.$key} = $value;
15179: }
1.462 albertel 15180: }
15181: }
15182:
1.685 tempelho 15183: # --- Get the symbolic name of a problem and the url
15184: sub get_symb {
15185: my ($request,$silent) = @_;
1.726 raeburn 15186: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15187: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15188: if ($symb eq '') {
15189: if (!$silent) {
1.1071 raeburn 15190: if (ref($request)) {
15191: $request->print("Unable to handle ambiguous references:$url:.");
15192: }
1.685 tempelho 15193: return ();
15194: }
15195: }
15196: &Apache::lonenc::check_decrypt(\$symb);
15197: return ($symb);
15198: }
15199:
15200: # --------------------------------------------------------------Get annotation
15201:
15202: sub get_annotation {
15203: my ($symb,$enc) = @_;
15204:
15205: my $key = $symb;
15206: if (!$enc) {
15207: $key =
15208: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15209: }
15210: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15211: return $annotation{$key};
15212: }
15213:
15214: sub clean_symb {
1.731 raeburn 15215: my ($symb,$delete_enc) = @_;
1.685 tempelho 15216:
15217: &Apache::lonenc::check_decrypt(\$symb);
15218: my $enc = $env{'request.enc'};
1.731 raeburn 15219: if ($delete_enc) {
1.730 raeburn 15220: delete($env{'request.enc'});
15221: }
1.685 tempelho 15222:
15223: return ($symb,$enc);
15224: }
1.462 albertel 15225:
1.1181 raeburn 15226: ############################################################
15227: ############################################################
15228:
15229: =pod
15230:
15231: =head1 Routines for building display used to search for courses
15232:
15233:
15234: =over 4
15235:
15236: =item * &build_filters()
15237:
15238: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 15239: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15240: and quotacheck.pl
15241:
1.1181 raeburn 15242:
15243: Inputs:
15244:
15245: filterlist - anonymous array of fields to include as potential filters
15246:
15247: crstype - course type
15248:
15249: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15250: to pop-open a course selector (will contain "extra element").
15251:
15252: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15253:
15254: filter - anonymous hash of criteria and their values
15255:
15256: action - form action
15257:
15258: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15259:
1.1182 raeburn 15260: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 15261:
15262: cloneruname - username of owner of new course who wants to clone
15263:
15264: clonerudom - domain of owner of new course who wants to clone
15265:
15266: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15267:
15268: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15269:
15270: codedom - domain
15271:
15272: formname - value of form element named "form".
15273:
15274: fixeddom - domain, if fixed.
15275:
15276: prevphase - value to assign to form element named "phase" when going back to the previous screen
15277:
15278: cnameelement - name of form element in form on opener page which will receive title of selected course
15279:
15280: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15281:
15282: cdomelement - name of form element in form on opener page which will receive domain of selected course
15283:
15284: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15285:
15286: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15287:
15288: clonewarning - warning message about missing information for intended course owner when DC creates a course
15289:
1.1182 raeburn 15290:
1.1181 raeburn 15291: Returns: $output - HTML for display of search criteria, and hidden form elements.
15292:
1.1182 raeburn 15293:
1.1181 raeburn 15294: Side Effects: None
15295:
15296: =cut
15297:
15298: # ---------------------------------------------- search for courses based on last activity etc.
15299:
15300: sub build_filters {
15301: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15302: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15303: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15304: $cnameelement,$cnumelement,$cdomelement,$setroles,
15305: $clonetext,$clonewarning) = @_;
1.1182 raeburn 15306: my ($list,$jscript);
1.1181 raeburn 15307: my $onchange = 'javascript:updateFilters(this)';
15308: my ($domainselectform,$sincefilterform,$createdfilterform,
15309: $ownerdomselectform,$persondomselectform,$instcodeform,
15310: $typeselectform,$instcodetitle);
15311: if ($formname eq '') {
15312: $formname = $caller;
15313: }
15314: foreach my $item (@{$filterlist}) {
15315: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15316: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15317: if ($item eq 'domainfilter') {
15318: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15319: } elsif ($item eq 'coursefilter') {
15320: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15321: } elsif ($item eq 'ownerfilter') {
15322: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15323: } elsif ($item eq 'ownerdomfilter') {
15324: $filter->{'ownerdomfilter'} =
15325: &LONCAPA::clean_domain($filter->{$item});
15326: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15327: 'ownerdomfilter',1);
15328: } elsif ($item eq 'personfilter') {
15329: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15330: } elsif ($item eq 'persondomfilter') {
15331: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15332: 'persondomfilter',1);
15333: } else {
15334: $filter->{$item} =~ s/\W//g;
15335: }
15336: if (!$filter->{$item}) {
15337: $filter->{$item} = '';
15338: }
15339: }
15340: if ($item eq 'domainfilter') {
15341: my $allow_blank = 1;
15342: if ($formname eq 'portform') {
15343: $allow_blank=0;
15344: } elsif ($formname eq 'studentform') {
15345: $allow_blank=0;
15346: }
15347: if ($fixeddom) {
15348: $domainselectform = '<input type="hidden" name="domainfilter"'.
15349: ' value="'.$codedom.'" />'.
15350: &Apache::lonnet::domain($codedom,'description');
15351: } else {
15352: $domainselectform = &select_dom_form($filter->{$item},
15353: 'domainfilter',
15354: $allow_blank,'',$onchange);
15355: }
15356: } else {
15357: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15358: }
15359: }
15360:
15361: # last course activity filter and selection
15362: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15363:
15364: # course created filter and selection
15365: if (exists($filter->{'createdfilter'})) {
15366: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15367: }
15368:
15369: my %lt = &Apache::lonlocal::texthash(
15370: 'cac' => "$crstype Activity",
15371: 'ccr' => "$crstype Created",
15372: 'cde' => "$crstype Title",
15373: 'cdo' => "$crstype Domain",
15374: 'ins' => 'Institutional Code',
15375: 'inc' => 'Institutional Categorization',
15376: 'cow' => "$crstype Owner/Co-owner",
15377: 'cop' => "$crstype Personnel Includes",
15378: 'cog' => 'Type',
15379: );
15380:
15381: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15382: my $typeval = 'Course';
15383: if ($crstype eq 'Community') {
15384: $typeval = 'Community';
15385: }
15386: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15387: } else {
15388: $typeselectform = '<select name="type" size="1"';
15389: if ($onchange) {
15390: $typeselectform .= ' onchange="'.$onchange.'"';
15391: }
15392: $typeselectform .= '>'."\n";
15393: foreach my $posstype ('Course','Community') {
15394: $typeselectform.='<option value="'.$posstype.'"'.
15395: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15396: }
15397: $typeselectform.="</select>";
15398: }
15399:
15400: my ($cloneableonlyform,$cloneabletitle);
15401: if (exists($filter->{'cloneableonly'})) {
15402: my $cloneableon = '';
15403: my $cloneableoff = ' checked="checked"';
15404: if ($filter->{'cloneableonly'}) {
15405: $cloneableon = $cloneableoff;
15406: $cloneableoff = '';
15407: }
15408: $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>';
15409: if ($formname eq 'ccrs') {
1.1187 bisitz 15410: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 15411: } else {
15412: $cloneabletitle = &mt('Cloneable by you');
15413: }
15414: }
15415: my $officialjs;
15416: if ($crstype eq 'Course') {
15417: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 15418: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15419: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15420: if ($codedom) {
1.1181 raeburn 15421: $officialjs = 1;
15422: ($instcodeform,$jscript,$$numtitlesref) =
15423: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15424: $officialjs,$codetitlesref);
15425: if ($jscript) {
1.1182 raeburn 15426: $jscript = '<script type="text/javascript">'."\n".
15427: '// <![CDATA['."\n".
15428: $jscript."\n".
15429: '// ]]>'."\n".
15430: '</script>'."\n";
1.1181 raeburn 15431: }
15432: }
15433: if ($instcodeform eq '') {
15434: $instcodeform =
15435: '<input type="text" name="instcodefilter" size="10" value="'.
15436: $list->{'instcodefilter'}.'" />';
15437: $instcodetitle = $lt{'ins'};
15438: } else {
15439: $instcodetitle = $lt{'inc'};
15440: }
15441: if ($fixeddom) {
15442: $instcodetitle .= '<br />('.$codedom.')';
15443: }
15444: }
15445: }
15446: my $output = qq|
15447: <form method="post" name="filterpicker" action="$action">
15448: <input type="hidden" name="form" value="$formname" />
15449: |;
15450: if ($formname eq 'modifycourse') {
15451: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15452: '<input type="hidden" name="prevphase" value="'.
15453: $prevphase.'" />'."\n";
1.1198 musolffc 15454: } elsif ($formname eq 'quotacheck') {
15455: $output .= qq|
15456: <input type="hidden" name="sortby" value="" />
15457: <input type="hidden" name="sortorder" value="" />
15458: |;
15459: } else {
1.1181 raeburn 15460: my $name_input;
15461: if ($cnameelement ne '') {
15462: $name_input = '<input type="hidden" name="cnameelement" value="'.
15463: $cnameelement.'" />';
15464: }
15465: $output .= qq|
1.1182 raeburn 15466: <input type="hidden" name="cnumelement" value="$cnumelement" />
15467: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15468: $name_input
15469: $roleelement
15470: $multelement
15471: $typeelement
15472: |;
15473: if ($formname eq 'portform') {
15474: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15475: }
15476: }
15477: if ($fixeddom) {
15478: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15479: }
15480: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15481: if ($sincefilterform) {
15482: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15483: .$sincefilterform
15484: .&Apache::lonhtmlcommon::row_closure();
15485: }
15486: if ($createdfilterform) {
15487: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15488: .$createdfilterform
15489: .&Apache::lonhtmlcommon::row_closure();
15490: }
15491: if ($domainselectform) {
15492: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15493: .$domainselectform
15494: .&Apache::lonhtmlcommon::row_closure();
15495: }
15496: if ($typeselectform) {
15497: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15498: $output .= $typeselectform;
15499: } else {
15500: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15501: .$typeselectform
15502: .&Apache::lonhtmlcommon::row_closure();
15503: }
15504: }
15505: if ($instcodeform) {
15506: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15507: .$instcodeform
15508: .&Apache::lonhtmlcommon::row_closure();
15509: }
15510: if (exists($filter->{'ownerfilter'})) {
15511: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15512: '<table><tr><td>'.&mt('Username').'<br />'.
15513: '<input type="text" name="ownerfilter" size="20" value="'.
15514: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15515: $ownerdomselectform.'</td></tr></table>'.
15516: &Apache::lonhtmlcommon::row_closure();
15517: }
15518: if (exists($filter->{'personfilter'})) {
15519: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15520: '<table><tr><td>'.&mt('Username').'<br />'.
15521: '<input type="text" name="personfilter" size="20" value="'.
15522: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15523: $persondomselectform.'</td></tr></table>'.
15524: &Apache::lonhtmlcommon::row_closure();
15525: }
15526: if (exists($filter->{'coursefilter'})) {
15527: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15528: .'<input type="text" name="coursefilter" size="25" value="'
15529: .$list->{'coursefilter'}.'" />'
15530: .&Apache::lonhtmlcommon::row_closure();
15531: }
15532: if ($cloneableonlyform) {
15533: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15534: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15535: }
15536: if (exists($filter->{'descriptfilter'})) {
15537: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15538: .'<input type="text" name="descriptfilter" size="40" value="'
15539: .$list->{'descriptfilter'}.'" />'
15540: .&Apache::lonhtmlcommon::row_closure(1);
15541: }
15542: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15543: '<input type="hidden" name="updater" value="" />'."\n".
15544: '<input type="submit" name="gosearch" value="'.
15545: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15546: return $jscript.$clonewarning.$output;
15547: }
15548:
15549: =pod
15550:
15551: =item * &timebased_select_form()
15552:
1.1182 raeburn 15553: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15554: filter e.g., Course Activity, Course Created, when searching for courses
15555: or communities
15556:
15557: Inputs:
15558:
15559: item - name of form element (sincefilter or createdfilter)
15560:
15561: filter - anonymous hash of criteria and their values
15562:
15563: Returns: HTML for a select box contained a blank, then six time selections,
15564: with value set in incoming form variables currently selected.
15565:
15566: Side Effects: None
15567:
15568: =cut
15569:
15570: sub timebased_select_form {
15571: my ($item,$filter) = @_;
15572: if (ref($filter) eq 'HASH') {
15573: $filter->{$item} =~ s/[^\d-]//g;
15574: if (!$filter->{$item}) { $filter->{$item}=-1; }
15575: return &select_form(
15576: $filter->{$item},
15577: $item,
15578: { '-1' => '',
15579: '86400' => &mt('today'),
15580: '604800' => &mt('last week'),
15581: '2592000' => &mt('last month'),
15582: '7776000' => &mt('last three months'),
15583: '15552000' => &mt('last six months'),
15584: '31104000' => &mt('last year'),
15585: 'select_form_order' =>
15586: ['-1','86400','604800','2592000','7776000',
15587: '15552000','31104000']});
15588: }
15589: }
15590:
15591: =pod
15592:
15593: =item * &js_changer()
15594:
15595: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15596: when course type or domain is changed, and also to hide 'Searching ...' on
15597: page load completion for page showing search result.
1.1181 raeburn 15598:
15599: Inputs: None
15600:
1.1183 raeburn 15601: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15602:
15603: Side Effects: None
15604:
15605: =cut
15606:
15607: sub js_changer {
15608: return <<ENDJS;
15609: <script type="text/javascript">
15610: // <![CDATA[
15611: function updateFilters(caller) {
15612: if (typeof(caller) != "undefined") {
15613: document.filterpicker.updater.value = caller.name;
15614: }
15615: document.filterpicker.submit();
15616: }
1.1183 raeburn 15617:
15618: function hideSearching() {
15619: if (document.getElementById('searching')) {
15620: document.getElementById('searching').style.display = 'none';
15621: }
15622: return;
15623: }
15624:
1.1181 raeburn 15625: // ]]>
15626: </script>
15627:
15628: ENDJS
15629: }
15630:
15631: =pod
15632:
1.1182 raeburn 15633: =item * &search_courses()
15634:
15635: Process selected filters form course search form and pass to lonnet::courseiddump
15636: to retrieve a hash for which keys are courseIDs which match the selected filters.
15637:
15638: Inputs:
15639:
15640: dom - domain being searched
15641:
15642: type - course type ('Course' or 'Community' or '.' if any).
15643:
15644: filter - anonymous hash of criteria and their values
15645:
15646: numtitles - for institutional codes - number of categories
15647:
15648: cloneruname - optional username of new course owner
15649:
15650: clonerudom - optional domain of new course owner
15651:
15652: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15653: (used when DC is using course creation form)
15654:
15655: codetitles - reference to array of titles of components in institutional codes (official courses).
15656:
15657:
15658: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15659:
15660:
15661: Side Effects: None
15662:
15663: =cut
15664:
15665:
15666: sub search_courses {
15667: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15668: my (%courses,%showcourses,$cloner);
15669: if (($filter->{'ownerfilter'} ne '') ||
15670: ($filter->{'ownerdomfilter'} ne '')) {
15671: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15672: $filter->{'ownerdomfilter'};
15673: }
15674: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15675: if (!$filter->{$item}) {
15676: $filter->{$item}='.';
15677: }
15678: }
15679: my $now = time;
15680: my $timefilter =
15681: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15682: my ($createdbefore,$createdafter);
15683: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15684: $createdbefore = $now;
15685: $createdafter = $now-$filter->{'createdfilter'};
15686: }
15687: my ($instcodefilter,$regexpok);
15688: if ($numtitles) {
15689: if ($env{'form.official'} eq 'on') {
15690: $instcodefilter =
15691: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15692: $regexpok = 1;
15693: } elsif ($env{'form.official'} eq 'off') {
15694: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15695: unless ($instcodefilter eq '') {
15696: $regexpok = -1;
15697: }
15698: }
15699: } else {
15700: $instcodefilter = $filter->{'instcodefilter'};
15701: }
15702: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15703: if ($type eq '') { $type = '.'; }
15704:
15705: if (($clonerudom ne '') && ($cloneruname ne '')) {
15706: $cloner = $cloneruname.':'.$clonerudom;
15707: }
15708: %courses = &Apache::lonnet::courseiddump($dom,
15709: $filter->{'descriptfilter'},
15710: $timefilter,
15711: $instcodefilter,
15712: $filter->{'combownerfilter'},
15713: $filter->{'coursefilter'},
15714: undef,undef,$type,$regexpok,undef,undef,
15715: undef,undef,$cloner,$env{'form.cc_clone'},
15716: $filter->{'cloneableonly'},
15717: $createdbefore,$createdafter,undef,
15718: $domcloner);
15719: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15720: my $ccrole;
15721: if ($type eq 'Community') {
15722: $ccrole = 'co';
15723: } else {
15724: $ccrole = 'cc';
15725: }
15726: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15727: $filter->{'persondomfilter'},
15728: 'userroles',undef,
15729: [$ccrole,'in','ad','ep','ta','cr'],
15730: $dom);
15731: foreach my $role (keys(%rolehash)) {
15732: my ($cnum,$cdom,$courserole) = split(':',$role);
15733: my $cid = $cdom.'_'.$cnum;
15734: if (exists($courses{$cid})) {
15735: if (ref($courses{$cid}) eq 'HASH') {
15736: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15737: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15738: push (@{$courses{$cid}{roles}},$courserole);
15739: }
15740: } else {
15741: $courses{$cid}{roles} = [$courserole];
15742: }
15743: $showcourses{$cid} = $courses{$cid};
15744: }
15745: }
15746: }
15747: %courses = %showcourses;
15748: }
15749: return %courses;
15750: }
15751:
15752: =pod
15753:
1.1181 raeburn 15754: =back
15755:
1.1207 raeburn 15756: =head1 Routines for version requirements for current course.
15757:
15758: =over 4
15759:
15760: =item * &check_release_required()
15761:
15762: Compares required LON-CAPA version with version on server, and
15763: if required version is newer looks for a server with the required version.
15764:
15765: Looks first at servers in user's owen domain; if none suitable, looks at
15766: servers in course's domain are permitted to host sessions for user's domain.
15767:
15768: Inputs:
15769:
15770: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15771:
15772: $courseid - Course ID of current course
15773:
15774: $rolecode - User's current role in course (for switchserver query string).
15775:
15776: $required - LON-CAPA version needed by course (format: Major.Minor).
15777:
15778:
15779: Returns:
15780:
15781: $switchserver - query string tp append to /adm/switchserver call (if
15782: current server's LON-CAPA version is too old.
15783:
15784: $warning - Message is displayed if no suitable server could be found.
15785:
15786: =cut
15787:
15788: sub check_release_required {
15789: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15790: my ($switchserver,$warning);
15791: if ($required ne '') {
15792: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15793: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15794: if ($reqdmajor ne '' && $reqdminor ne '') {
15795: my $otherserver;
15796: if (($major eq '' && $minor eq '') ||
15797: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15798: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15799: my $switchlcrev =
15800: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15801: $userdomserver);
15802: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15803: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15804: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15805: my $cdom = $env{'course.'.$courseid.'.domain'};
15806: if ($cdom ne $env{'user.domain'}) {
15807: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15808: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15809: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15810: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15811: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15812: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15813: my $canhost =
15814: &Apache::lonnet::can_host_session($env{'user.domain'},
15815: $coursedomserver,
15816: $remoterev,
15817: $udomdefaults{'remotesessions'},
15818: $defdomdefaults{'hostedsessions'});
15819:
15820: if ($canhost) {
15821: $otherserver = $coursedomserver;
15822: } else {
15823: $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.");
15824: }
15825: } else {
15826: $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).");
15827: }
15828: } else {
15829: $otherserver = $userdomserver;
15830: }
15831: }
15832: if ($otherserver ne '') {
15833: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15834: }
15835: }
15836: }
15837: return ($switchserver,$warning);
15838: }
15839:
15840: =pod
15841:
15842: =item * &check_release_result()
15843:
15844: Inputs:
15845:
15846: $switchwarning - Warning message if no suitable server found to host session.
15847:
15848: $switchserver - query string to append to /adm/switchserver containing lonHostID
15849: and current role.
15850:
15851: Returns: HTML to display with information about requirement to switch server.
15852: Either displaying warning with link to Roles/Courses screen or
15853: display link to switchserver.
15854:
1.1181 raeburn 15855: =cut
15856:
1.1207 raeburn 15857: sub check_release_result {
15858: my ($switchwarning,$switchserver) = @_;
15859: my $output = &start_page('Selected course unavailable on this server').
15860: '<p class="LC_warning">';
15861: if ($switchwarning) {
15862: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15863: if (&show_course()) {
15864: $output .= &mt('Display courses');
15865: } else {
15866: $output .= &mt('Display roles');
15867: }
15868: $output .= '</a>';
15869: } elsif ($switchserver) {
15870: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15871: '<br />'.
15872: '<a href="/adm/switchserver?'.$switchserver.'">'.
15873: &mt('Switch Server').
15874: '</a>';
15875: }
15876: $output .= '</p>'.&end_page();
15877: return $output;
15878: }
15879:
15880: =pod
15881:
15882: =item * &needs_coursereinit()
15883:
15884: Determine if course contents stored for user's session needs to be
15885: refreshed, because content has changed since "Big Hash" last tied.
15886:
15887: Check for change is made if time last checked is more than 10 minutes ago
15888: (by default).
15889:
15890: Inputs:
15891:
15892: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15893:
15894: $interval (optional) - Time which may elapse (in s) between last check for content
15895: change in current course. (default: 600 s).
15896:
15897: Returns: an array; first element is:
15898:
15899: =over 4
15900:
15901: 'switch' - if content updates mean user's session
15902: needs to be switched to a server running a newer LON-CAPA version
15903:
15904: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15905: on current server hosting user's session
15906:
15907: '' - if no action required.
15908:
15909: =back
15910:
15911: If first item element is 'switch':
15912:
15913: second item is $switchwarning - Warning message if no suitable server found to host session.
15914:
15915: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15916: and current role.
15917:
15918: otherwise: no other elements returned.
15919:
15920: =back
15921:
15922: =cut
15923:
15924: sub needs_coursereinit {
15925: my ($loncaparev,$interval) = @_;
15926: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15927: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15928: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15929: my $now = time;
15930: if ($interval eq '') {
15931: $interval = 600;
15932: }
15933: if (($now-$env{'request.course.timechecked'})>$interval) {
15934: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15935: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15936: if ($lastchange > $env{'request.course.tied'}) {
15937: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15938: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15939: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15940: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15941: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15942: $curr_reqd_hash{'internal.releaserequired'}});
15943: my ($switchserver,$switchwarning) =
15944: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15945: $curr_reqd_hash{'internal.releaserequired'});
15946: if ($switchwarning ne '' || $switchserver ne '') {
15947: return ('switch',$switchwarning,$switchserver);
15948: }
15949: }
15950: }
15951: return ('update');
15952: }
15953: }
15954: return ();
15955: }
1.1181 raeburn 15956:
1.1083 raeburn 15957: sub update_content_constraints {
15958: my ($cdom,$cnum,$chome,$cid) = @_;
15959: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15960: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15961: my %checkresponsetypes;
15962: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1219 ! raeburn 15963: my ($item,$name,$value,$valmatch) = split(/:/,$key);
1.1083 raeburn 15964: if ($item eq 'resourcetag') {
15965: if ($name eq 'responsetype') {
15966: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15967: }
15968: }
15969: }
15970: my $navmap = Apache::lonnavmaps::navmap->new();
15971: if (defined($navmap)) {
15972: my %allresponses;
15973: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15974: my %responses = $res->responseTypes();
15975: foreach my $key (keys(%responses)) {
15976: next unless(exists($checkresponsetypes{$key}));
15977: $allresponses{$key} += $responses{$key};
15978: }
15979: }
15980: foreach my $key (keys(%allresponses)) {
15981: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15982: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15983: ($reqdmajor,$reqdminor) = ($major,$minor);
15984: }
15985: }
15986: undef($navmap);
15987: }
15988: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15989: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15990: }
15991: return;
15992: }
15993:
1.1110 raeburn 15994: sub allmaps_incourse {
15995: my ($cdom,$cnum,$chome,$cid) = @_;
15996: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15997: $cid = $env{'request.course.id'};
15998: $cdom = $env{'course.'.$cid.'.domain'};
15999: $cnum = $env{'course.'.$cid.'.num'};
16000: $chome = $env{'course.'.$cid.'.home'};
16001: }
16002: my %allmaps = ();
16003: my $lastchange =
16004: &Apache::lonnet::get_coursechange($cdom,$cnum);
16005: if ($lastchange > $env{'request.course.tied'}) {
16006: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16007: unless ($ferr) {
16008: &update_content_constraints($cdom,$cnum,$chome,$cid);
16009: }
16010: }
16011: my $navmap = Apache::lonnavmaps::navmap->new();
16012: if (defined($navmap)) {
16013: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16014: $allmaps{$res->src()} = 1;
16015: }
16016: }
16017: return \%allmaps;
16018: }
16019:
1.1083 raeburn 16020: sub parse_supplemental_title {
16021: my ($title) = @_;
16022:
16023: my ($foldertitle,$renametitle);
16024: if ($title =~ /&&&/) {
16025: $title = &HTML::Entites::decode($title);
16026: }
16027: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16028: $renametitle=$4;
16029: my ($time,$uname,$udom) = ($1,$2,$3);
16030: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16031: my $name = &plainname($uname,$udom);
16032: $name = &HTML::Entities::encode($name,'"<>&\'');
16033: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16034: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16035: $name.': <br />'.$foldertitle;
16036: }
16037: if (wantarray) {
16038: return ($title,$foldertitle,$renametitle);
16039: }
16040: return $title;
16041: }
16042:
1.1143 raeburn 16043: sub recurse_supplemental {
16044: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16045: if ($suppmap) {
16046: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16047: if ($fatal) {
16048: $errors ++;
16049: } else {
16050: if ($#LONCAPA::map::resources > 0) {
16051: foreach my $res (@LONCAPA::map::resources) {
16052: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16053: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16054: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16055: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16056: } else {
16057: $numfiles ++;
16058: }
16059: }
16060: }
16061: }
16062: }
16063: }
16064: return ($numfiles,$errors);
16065: }
16066:
1.1101 raeburn 16067: sub symb_to_docspath {
16068: my ($symb) = @_;
16069: return unless ($symb);
16070: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16071: if ($resurl=~/\.(sequence|page)$/) {
16072: $mapurl=$resurl;
16073: } elsif ($resurl eq 'adm/navmaps') {
16074: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16075: }
16076: my $mapresobj;
16077: my $navmap = Apache::lonnavmaps::navmap->new();
16078: if (ref($navmap)) {
16079: $mapresobj = $navmap->getResourceByUrl($mapurl);
16080: }
16081: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16082: my $type=$2;
16083: my $path;
16084: if (ref($mapresobj)) {
16085: my $pcslist = $mapresobj->map_hierarchy();
16086: if ($pcslist ne '') {
16087: foreach my $pc (split(/,/,$pcslist)) {
16088: next if ($pc <= 1);
16089: my $res = $navmap->getByMapPc($pc);
16090: if (ref($res)) {
16091: my $thisurl = $res->src();
16092: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16093: my $thistitle = $res->title();
16094: $path .= '&'.
16095: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16096: &escape($thistitle).
1.1101 raeburn 16097: ':'.$res->randompick().
16098: ':'.$res->randomout().
16099: ':'.$res->encrypted().
16100: ':'.$res->randomorder().
16101: ':'.$res->is_page();
16102: }
16103: }
16104: }
16105: $path =~ s/^\&//;
16106: my $maptitle = $mapresobj->title();
16107: if ($mapurl eq 'default') {
1.1129 raeburn 16108: $maptitle = 'Main Content';
1.1101 raeburn 16109: }
16110: $path .= (($path ne '')? '&' : '').
16111: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16112: &escape($maptitle).
1.1101 raeburn 16113: ':'.$mapresobj->randompick().
16114: ':'.$mapresobj->randomout().
16115: ':'.$mapresobj->encrypted().
16116: ':'.$mapresobj->randomorder().
16117: ':'.$mapresobj->is_page();
16118: } else {
16119: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16120: my $ispage = (($type eq 'page')? 1 : '');
16121: if ($mapurl eq 'default') {
1.1129 raeburn 16122: $maptitle = 'Main Content';
1.1101 raeburn 16123: }
16124: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16125: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16126: }
16127: unless ($mapurl eq 'default') {
16128: $path = 'default&'.
1.1146 raeburn 16129: &escape('Main Content').
1.1101 raeburn 16130: ':::::&'.$path;
16131: }
16132: return $path;
16133: }
16134:
1.1094 raeburn 16135: sub captcha_display {
16136: my ($context,$lonhost) = @_;
16137: my ($output,$error);
16138: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16139: if ($captcha eq 'original') {
1.1094 raeburn 16140: $output = &create_captcha();
16141: unless ($output) {
1.1172 raeburn 16142: $error = 'captcha';
1.1094 raeburn 16143: }
16144: } elsif ($captcha eq 'recaptcha') {
16145: $output = &create_recaptcha($pubkey);
16146: unless ($output) {
1.1172 raeburn 16147: $error = 'recaptcha';
1.1094 raeburn 16148: }
16149: }
1.1176 raeburn 16150: return ($output,$error,$captcha);
1.1094 raeburn 16151: }
16152:
16153: sub captcha_response {
16154: my ($context,$lonhost) = @_;
16155: my ($captcha_chk,$captcha_error);
16156: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16157: if ($captcha eq 'original') {
1.1094 raeburn 16158: ($captcha_chk,$captcha_error) = &check_captcha();
16159: } elsif ($captcha eq 'recaptcha') {
16160: $captcha_chk = &check_recaptcha($privkey);
16161: } else {
16162: $captcha_chk = 1;
16163: }
16164: return ($captcha_chk,$captcha_error);
16165: }
16166:
16167: sub get_captcha_config {
16168: my ($context,$lonhost) = @_;
1.1095 raeburn 16169: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 16170: my $hostname = &Apache::lonnet::hostname($lonhost);
16171: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16172: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 16173: if ($context eq 'usercreation') {
16174: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16175: if (ref($domconfig{$context}) eq 'HASH') {
16176: $hashtocheck = $domconfig{$context}{'cancreate'};
16177: if (ref($hashtocheck) eq 'HASH') {
16178: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16179: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16180: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16181: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16182: }
16183: if ($privkey && $pubkey) {
16184: $captcha = 'recaptcha';
16185: } else {
16186: $captcha = 'original';
16187: }
16188: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16189: $captcha = 'original';
16190: }
1.1094 raeburn 16191: }
1.1095 raeburn 16192: } else {
16193: $captcha = 'captcha';
16194: }
16195: } elsif ($context eq 'login') {
16196: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16197: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16198: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16199: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 16200: if ($privkey && $pubkey) {
16201: $captcha = 'recaptcha';
1.1095 raeburn 16202: } else {
16203: $captcha = 'original';
1.1094 raeburn 16204: }
1.1095 raeburn 16205: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16206: $captcha = 'original';
1.1094 raeburn 16207: }
16208: }
16209: return ($captcha,$pubkey,$privkey);
16210: }
16211:
16212: sub create_captcha {
16213: my %captcha_params = &captcha_settings();
16214: my ($output,$maxtries,$tries) = ('',10,0);
16215: while ($tries < $maxtries) {
16216: $tries ++;
16217: my $captcha = Authen::Captcha->new (
16218: output_folder => $captcha_params{'output_dir'},
16219: data_folder => $captcha_params{'db_dir'},
16220: );
16221: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16222:
16223: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16224: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16225: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 16226: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16227: '<br />'.
16228: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 16229: last;
16230: }
16231: }
16232: return $output;
16233: }
16234:
16235: sub captcha_settings {
16236: my %captcha_params = (
16237: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16238: www_output_dir => "/captchaspool",
16239: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16240: numchars => '5',
16241: );
16242: return %captcha_params;
16243: }
16244:
16245: sub check_captcha {
16246: my ($captcha_chk,$captcha_error);
16247: my $code = $env{'form.code'};
16248: my $md5sum = $env{'form.crypt'};
16249: my %captcha_params = &captcha_settings();
16250: my $captcha = Authen::Captcha->new(
16251: output_folder => $captcha_params{'output_dir'},
16252: data_folder => $captcha_params{'db_dir'},
16253: );
1.1109 raeburn 16254: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 16255: my %captcha_hash = (
16256: 0 => 'Code not checked (file error)',
16257: -1 => 'Failed: code expired',
16258: -2 => 'Failed: invalid code (not in database)',
16259: -3 => 'Failed: invalid code (code does not match crypt)',
16260: );
16261: if ($captcha_chk != 1) {
16262: $captcha_error = $captcha_hash{$captcha_chk}
16263: }
16264: return ($captcha_chk,$captcha_error);
16265: }
16266:
16267: sub create_recaptcha {
16268: my ($pubkey) = @_;
1.1153 raeburn 16269: my $use_ssl;
16270: if ($ENV{'SERVER_PORT'} == 443) {
16271: $use_ssl = 1;
16272: }
1.1094 raeburn 16273: my $captcha = Captcha::reCAPTCHA->new;
16274: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 16275: $captcha->get_html($pubkey,undef,$use_ssl).
1.1213 raeburn 16276: &mt('If the text is hard to read, [_1] will replace them.',
1.1133 raeburn 16277: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 16278: '<br /><br />';
16279: }
16280:
16281: sub check_recaptcha {
16282: my ($privkey) = @_;
16283: my $captcha_chk;
16284: my $captcha = Captcha::reCAPTCHA->new;
16285: my $captcha_result =
16286: $captcha->check_answer(
16287: $privkey,
16288: $ENV{'REMOTE_ADDR'},
16289: $env{'form.recaptcha_challenge_field'},
16290: $env{'form.recaptcha_response_field'},
16291: );
16292: if ($captcha_result->{is_valid}) {
16293: $captcha_chk = 1;
16294: }
16295: return $captcha_chk;
16296: }
16297:
1.1174 raeburn 16298: sub emailusername_info {
1.1177 raeburn 16299: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 16300: my %titles = &Apache::lonlocal::texthash (
16301: lastname => 'Last Name',
16302: firstname => 'First Name',
16303: institution => 'School/college/university',
16304: location => "School's city, state/province, country",
16305: web => "School's web address",
16306: officialemail => 'E-mail address at institution (if different)',
16307: );
16308: return (\@fields,\%titles);
16309: }
16310:
1.1161 raeburn 16311: sub cleanup_html {
16312: my ($incoming) = @_;
16313: my $outgoing;
16314: if ($incoming ne '') {
16315: $outgoing = $incoming;
16316: $outgoing =~ s/;/;/g;
16317: $outgoing =~ s/\#/#/g;
16318: $outgoing =~ s/\&/&/g;
16319: $outgoing =~ s/</</g;
16320: $outgoing =~ s/>/>/g;
16321: $outgoing =~ s/\(/(/g;
16322: $outgoing =~ s/\)/)/g;
16323: $outgoing =~ s/"/"/g;
16324: $outgoing =~ s/'/'/g;
16325: $outgoing =~ s/\$/$/g;
16326: $outgoing =~ s{/}{/}g;
16327: $outgoing =~ s/=/=/g;
16328: $outgoing =~ s/\\/\/g
16329: }
16330: return $outgoing;
16331: }
16332:
1.1190 musolffc 16333: # Checks for critical messages and returns a redirect url if one exists.
16334: # $interval indicates how often to check for messages.
16335: sub critical_redirect {
16336: my ($interval) = @_;
16337: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16338: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16339: $env{'user.name'});
16340: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 16341: my $redirecturl;
1.1190 musolffc 16342: if ($what[0]) {
16343: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16344: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 16345: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16346: return (1, $url);
1.1190 musolffc 16347: }
1.1191 raeburn 16348: }
16349: }
16350: return ();
1.1190 musolffc 16351: }
16352:
1.1174 raeburn 16353: # Use:
16354: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16355: #
16356: ##################################################
16357: # password associated functions #
16358: ##################################################
16359: sub des_keys {
16360: # Make a new key for DES encryption.
16361: # Each key has two parts which are returned separately.
16362: # Please note: Each key must be passed through the &hex function
16363: # before it is output to the web browser. The hex versions cannot
16364: # be used to decrypt.
16365: my @hexstr=('0','1','2','3','4','5','6','7',
16366: '8','9','a','b','c','d','e','f');
16367: my $lkey='';
16368: for (0..7) {
16369: $lkey.=$hexstr[rand(15)];
16370: }
16371: my $ukey='';
16372: for (0..7) {
16373: $ukey.=$hexstr[rand(15)];
16374: }
16375: return ($lkey,$ukey);
16376: }
16377:
16378: sub des_decrypt {
16379: my ($key,$cyphertext) = @_;
16380: my $keybin=pack("H16",$key);
16381: my $cypher;
16382: if ($Crypt::DES::VERSION>=2.03) {
16383: $cypher=new Crypt::DES $keybin;
16384: } else {
16385: $cypher=new DES $keybin;
16386: }
16387: my $plaintext=
16388: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16389: $plaintext.=
16390: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16391: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16392: return $plaintext;
16393: }
16394:
1.112 bowersj2 16395: 1;
16396: __END__;
1.41 ng 16397:
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