Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.161.2.5
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1075.2.161. .5(raebu 4:22): # $Id: loncommon.pm,v 1.1075.2.161.2.4 2022/01/23 02:02:48 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1075.2.25 raeburn 70: use Apache::lonuserutils();
1.1075.2.27 raeburn 71: use Apache::lonuserstate();
1.1075.2.69 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.135 raeburn 74: use HTTP::Request;
1.657 raeburn 75: use DateTime::TimeZone;
1.1075.2.102 raeburn 76: use DateTime::Locale;
1.1075.2.94 raeburn 77: use Encode();
1.1075.2.14 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.1075.2.107 raeburn 80: use JSON::DWIW;
81: use LWP::UserAgent;
1.1075.2.64 raeburn 82: use Crypt::DES;
83: use DynaLoader; # for Crypt::DES version
1.1075.2.128 raeburn 84: use File::Copy();
85: use File::Path();
1.1075.2.161. .1(raebu 86:21): use String::CRC32();
87:21): use Short::URL();
1.117 www 88:
1.517 raeburn 89: # ---------------------------------------------- Designs
90: use vars qw(%defaultdesign);
91:
1.22 www 92: my $readit;
93:
1.517 raeburn 94:
1.157 matthew 95: ##
96: ## Global Variables
97: ##
1.46 matthew 98:
1.643 foxr 99:
100: # ----------------------------------------------- SSI with retries:
101: #
102:
103: =pod
104:
1.648 raeburn 105: =head1 Server Side include with retries:
1.643 foxr 106:
107: =over 4
108:
1.648 raeburn 109: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 110:
111: Performs an ssi with some number of retries. Retries continue either
112: until the result is ok or until the retry count supplied by the
113: caller is exhausted.
114:
115: Inputs:
1.648 raeburn 116:
117: =over 4
118:
1.643 foxr 119: resource - Identifies the resource to insert.
1.648 raeburn 120:
1.643 foxr 121: retries - Count of the number of retries allowed.
1.648 raeburn 122:
1.643 foxr 123: form - Hash that identifies the rendering options.
124:
1.648 raeburn 125: =back
126:
127: Returns:
128:
129: =over 4
130:
1.643 foxr 131: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 132:
1.643 foxr 133: response - The response from the last attempt (which may or may not have been successful.
134:
1.648 raeburn 135: =back
136:
137: =back
138:
1.643 foxr 139: =cut
140:
141: sub ssi_with_retries {
142: my ($resource, $retries, %form) = @_;
143:
144:
145: my $ok = 0; # True if we got a good response.
146: my $content;
147: my $response;
148:
149: # Try to get the ssi done. within the retries count:
150:
151: do {
152: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
153: $ok = $response->is_success;
1.650 www 154: if (!$ok) {
155: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
156: }
1.643 foxr 157: $retries--;
158: } while (!$ok && ($retries > 0));
159:
160: if (!$ok) {
161: $content = ''; # On error return an empty content.
162: }
163: return ($content, $response);
164:
165: }
166:
167:
168:
1.20 www 169: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 170: my %language;
1.124 www 171: my %supported_language;
1.1048 foxr 172: my %latex_language; # For choosing hyphenation in <transl..>
173: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 174: my %cprtag;
1.192 taceyjo1 175: my %scprtag;
1.351 www 176: my %fe; my %fd; my %fm;
1.41 ng 177: my %category_extensions;
1.12 harris41 178:
1.46 matthew 179: # ---------------------------------------------- Thesaurus variables
1.144 matthew 180: #
181: # %Keywords:
182: # A hash used by &keyword to determine if a word is considered a keyword.
183: # $thesaurus_db_file
184: # Scalar containing the full path to the thesaurus database.
1.46 matthew 185:
186: my %Keywords;
187: my $thesaurus_db_file;
188:
1.144 matthew 189: #
190: # Initialize values from language.tab, copyright.tab, filetypes.tab,
191: # thesaurus.tab, and filecategories.tab.
192: #
1.18 www 193: BEGIN {
1.46 matthew 194: # Variable initialization
195: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
196: #
1.22 www 197: unless ($readit) {
1.12 harris41 198: # ------------------------------------------------------------------- languages
199: {
1.158 raeburn 200: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
201: '/language.tab';
1.1075.2.128 raeburn 202: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 203: while (my $line = <$fh>) {
204: next if ($line=~/^\#/);
205: chomp($line);
1.1048 foxr 206: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 207: $language{$key}=$val.' - '.$enc;
208: if ($sup) {
209: $supported_language{$key}=$sup;
210: }
1.1048 foxr 211: if ($latex) {
212: $latex_language_bykey{$key} = $latex;
213: $latex_language{$two} = $latex;
214: }
1.158 raeburn 215: }
216: close($fh);
217: }
1.12 harris41 218: }
219: # ------------------------------------------------------------------ copyrights
220: {
1.158 raeburn 221: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
222: '/copyright.tab';
1.1075.2.128 raeburn 223: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line=~/^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 228: $cprtag{$key}=$val;
229: }
230: close($fh);
231: }
1.12 harris41 232: }
1.351 www 233: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 234: {
235: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
236: '/source_copyright.tab';
1.1075.2.128 raeburn 237: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 242: $scprtag{$key}=$val;
243: }
244: close($fh);
245: }
246: }
1.63 www 247:
1.517 raeburn 248: # -------------------------------------------------------------- default domain designs
1.63 www 249: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 250: my $designfile = $designdir.'/default.tab';
1.1075.2.128 raeburn 251: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 252: while (my $line = <$fh>) {
253: next if ($line =~ /^\#/);
254: chomp($line);
255: my ($key,$val)=(split(/\=/,$line));
256: if ($val) { $defaultdesign{$key}=$val; }
257: }
258: close($fh);
1.63 www 259: }
260:
1.15 harris41 261: # ------------------------------------------------------------- file categories
262: {
1.158 raeburn 263: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
264: '/filecategories.tab';
1.1075.2.128 raeburn 265: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 266: while (my $line = <$fh>) {
267: next if ($line =~ /^\#/);
268: chomp($line);
269: my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119 raeburn 270: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 271: }
272: close($fh);
273: }
274:
1.15 harris41 275: }
1.12 harris41 276: # ------------------------------------------------------------------ file types
277: {
1.158 raeburn 278: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
279: '/filetypes.tab';
1.1075.2.128 raeburn 280: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 281: while (my $line = <$fh>) {
282: next if ($line =~ /^\#/);
283: chomp($line);
284: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 285: if ($descr ne '') {
286: $fe{$ending}=lc($emb);
287: $fd{$ending}=$descr;
1.351 www 288: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 289: }
290: }
291: close($fh);
292: }
1.12 harris41 293: }
1.22 www 294: &Apache::lonnet::logthis(
1.705 tempelho 295: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 296: $readit=1;
1.46 matthew 297: } # end of unless($readit)
1.32 matthew 298:
299: }
1.112 bowersj2 300:
1.42 matthew 301: ###############################################################
302: ## HTML and Javascript Helper Functions ##
303: ###############################################################
304:
305: =pod
306:
1.112 bowersj2 307: =head1 HTML and Javascript Functions
1.42 matthew 308:
1.112 bowersj2 309: =over 4
310:
1.648 raeburn 311: =item * &browser_and_searcher_javascript()
1.112 bowersj2 312:
313: X<browsing, javascript>X<searching, javascript>Returns a string
314: containing javascript with two functions, C<openbrowser> and
315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
316: tags.
1.42 matthew 317:
1.648 raeburn 318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 319:
320: inputs: formname, elementname, only, omit
321:
322: formname and elementname indicate the name of the html form and name of
323: the element that the results of the browsing selection are to be placed in.
324:
325: Specifying 'only' will restrict the browser to displaying only files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 329: with the given extension. Can be a comma separated list.
1.42 matthew 330:
1.648 raeburn 331: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 332:
333: Inputs: formname, elementname
334:
335: formname and elementname specify the name of the html form and the name
336: of the element the selection from the search results will be placed in.
1.542 raeburn 337:
1.42 matthew 338: =cut
339:
340: sub browser_and_searcher_javascript {
1.199 albertel 341: my ($mode)=@_;
342: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 343: my $resurl=&escape_single(&lastresurl());
1.42 matthew 344: return <<END;
1.219 albertel 345: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 346: var editbrowser = null;
1.135 albertel 347: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 348: var url = '$resurl/?';
1.42 matthew 349: if (editbrowser == null) {
350: url += 'launch=1&';
351: }
352: url += 'catalogmode=interactive&';
1.199 albertel 353: url += 'mode=$mode&';
1.611 albertel 354: url += 'inhibitmenu=yes&';
1.42 matthew 355: url += 'form=' + formname + '&';
356: if (only != null) {
357: url += 'only=' + only + '&';
1.217 albertel 358: } else {
359: url += 'only=&';
360: }
1.42 matthew 361: if (omit != null) {
362: url += 'omit=' + omit + '&';
1.217 albertel 363: } else {
364: url += 'omit=&';
365: }
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Browser';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editbrowser = open(url,title,options,'1');
376: editbrowser.focus();
377: }
378: var editsearcher;
1.135 albertel 379: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 380: var url = '/adm/searchcat?';
381: if (editsearcher == null) {
382: url += 'launch=1&';
383: }
384: url += 'catalogmode=interactive&';
1.199 albertel 385: url += 'mode=$mode&';
1.42 matthew 386: url += 'form=' + formname + '&';
1.135 albertel 387: if (titleelement != null) {
388: url += 'titleelement=' + titleelement + '&';
1.217 albertel 389: } else {
390: url += 'titleelement=&';
391: }
1.42 matthew 392: url += 'element=' + elementname + '';
393: var title = 'Search';
1.435 albertel 394: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 395: options += ',width=700,height=600';
396: editsearcher = open(url,title,options,'1');
397: editsearcher.focus();
398: }
1.219 albertel 399: // END LON-CAPA Internal -->
1.42 matthew 400: END
1.170 www 401: }
402:
403: sub lastresurl {
1.258 albertel 404: if ($env{'environment.lastresurl'}) {
405: return $env{'environment.lastresurl'}
1.170 www 406: } else {
407: return '/res';
408: }
409: }
410:
411: sub storeresurl {
412: my $resurl=&Apache::lonnet::clutter(shift);
413: unless ($resurl=~/^\/res/) { return 0; }
414: $resurl=~s/\/$//;
415: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 416: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 417: return 1;
1.42 matthew 418: }
419:
1.74 www 420: sub studentbrowser_javascript {
1.111 www 421: unless (
1.258 albertel 422: (($env{'request.course.id'}) &&
1.302 albertel 423: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
424: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
425: '/'.$env{'request.course.sec'})
426: ))
1.258 albertel 427: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 428: ) { return ''; }
1.74 www 429: return (<<'ENDSTDBRW');
1.776 bisitz 430: <script type="text/javascript" language="Javascript">
1.824 bisitz 431: // <![CDATA[
1.74 www 432: var stdeditbrowser;
1.1075.2.143 raeburn 433: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74 www 434: var url = '/adm/pickstudent?';
435: var filter;
1.558 albertel 436: if (!ignorefilter) {
437: eval('filter=document.'+formname+'.'+uname+'.value;');
438: }
1.74 www 439: if (filter != null) {
440: if (filter != '') {
441: url += 'filter='+filter+'&';
442: }
443: }
444: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 445: '&udomelement='+udom+
446: '&clicker='+clicker;
1.111 www 447: if (roleflag) { url+="&roles=1"; }
1.1075.2.143 raeburn 448: if (courseadv == 'condition') {
449: if (document.getElementById('courseadv')) {
450: courseadv = document.getElementById('courseadv').value;
451: }
452: }
453: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102 www 454: var title = 'Student_Browser';
1.74 www 455: var options = 'scrollbars=1,resizable=1,menubar=0';
456: options += ',width=700,height=600';
457: stdeditbrowser = open(url,title,options,'1');
458: stdeditbrowser.focus();
459: }
1.824 bisitz 460: // ]]>
1.74 www 461: </script>
462: ENDSTDBRW
463: }
1.42 matthew 464:
1.1003 www 465: sub resourcebrowser_javascript {
466: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 467: return (<<'ENDRESBRW');
1.1003 www 468: <script type="text/javascript" language="Javascript">
469: // <![CDATA[
470: var reseditbrowser;
1.1004 www 471: function openresbrowser(formname,reslink) {
1.1005 www 472: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 473: var title = 'Resource_Browser';
474: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 475: options += ',width=700,height=500';
1.1004 www 476: reseditbrowser = open(url,title,options,'1');
477: reseditbrowser.focus();
1.1003 www 478: }
479: // ]]>
480: </script>
1.1004 www 481: ENDRESBRW
1.1003 www 482: }
483:
1.74 www 484: sub selectstudent_link {
1.1075.2.143 raeburn 485: my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999 www 486: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
487: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
488: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 489: if ($env{'request.course.id'}) {
1.302 albertel 490: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
491: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
492: '/'.$env{'request.course.sec'})) {
1.111 www 493: return '';
494: }
1.999 www 495: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1075.2.143 raeburn 496: if ($courseadv eq 'only') {
497: $callargs .= ",'',1,'$courseadv'";
498: } elsif ($courseadv eq 'none') {
499: $callargs .= ",'','','$courseadv'";
500: } elsif ($courseadv eq 'condition') {
501: $callargs .= ",'','','$courseadv'";
1.793 raeburn 502: }
503: return '<span class="LC_nobreak">'.
504: '<a href="javascript:openstdbrowser('.$callargs.');">'.
505: &mt('Select User').'</a></span>';
1.74 www 506: }
1.258 albertel 507: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 508: $callargs .= ",'',1";
1.793 raeburn 509: return '<span class="LC_nobreak">'.
510: '<a href="javascript:openstdbrowser('.$callargs.');">'.
511: &mt('Select User').'</a></span>';
1.111 www 512: }
513: return '';
1.91 www 514: }
515:
1.1004 www 516: sub selectresource_link {
517: my ($form,$reslink,$arg)=@_;
518:
519: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
520: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
521: unless ($env{'request.course.id'}) { return $arg; }
522: return '<span class="LC_nobreak">'.
523: '<a href="javascript:openresbrowser('.$callargs.');">'.
524: $arg.'</a></span>';
525: }
526:
527:
528:
1.653 raeburn 529: sub authorbrowser_javascript {
530: return <<"ENDAUTHORBRW";
1.776 bisitz 531: <script type="text/javascript" language="JavaScript">
1.824 bisitz 532: // <![CDATA[
1.653 raeburn 533: var stdeditbrowser;
534:
535: function openauthorbrowser(formname,udom) {
536: var url = '/adm/pickauthor?';
537: url += 'form='+formname+'&roledom='+udom;
538: var title = 'Author_Browser';
539: var options = 'scrollbars=1,resizable=1,menubar=0';
540: options += ',width=700,height=600';
541: stdeditbrowser = open(url,title,options,'1');
542: stdeditbrowser.focus();
543: }
544:
1.824 bisitz 545: // ]]>
1.653 raeburn 546: </script>
547: ENDAUTHORBRW
548: }
549:
1.91 www 550: sub coursebrowser_javascript {
1.1075.2.31 raeburn 551: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95 raeburn 552: $credits_element,$instcode) = @_;
1.932 raeburn 553: my $wintitle = 'Course_Browser';
1.931 raeburn 554: if ($crstype eq 'Community') {
1.932 raeburn 555: $wintitle = 'Community_Browser';
1.909 raeburn 556: }
1.876 raeburn 557: my $id_functions = &javascript_index_functions();
558: my $output = '
1.776 bisitz 559: <script type="text/javascript" language="JavaScript">
1.824 bisitz 560: // <![CDATA[
1.468 raeburn 561: var stdeditbrowser;'."\n";
1.876 raeburn 562:
563: $output .= <<"ENDSTDBRW";
1.909 raeburn 564: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 565: var url = '/adm/pickcourse?';
1.895 raeburn 566: var formid = getFormIdByName(formname);
1.876 raeburn 567: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 568: if (domainfilter != null) {
569: if (domainfilter != '') {
570: url += 'domainfilter='+domainfilter+'&';
571: }
572: }
1.91 www 573: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 574: '&cdomelement='+udom+
575: '&cnameelement='+desc;
1.468 raeburn 576: if (extra_element !=null && extra_element != '') {
1.594 raeburn 577: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 578: url += '&roleelement='+extra_element;
579: if (domainfilter == null || domainfilter == '') {
580: url += '&domainfilter='+extra_element;
581: }
1.234 raeburn 582: }
1.468 raeburn 583: else {
584: if (formname == 'portform') {
585: url += '&setroles='+extra_element;
1.800 raeburn 586: } else {
587: if (formname == 'rules') {
588: url += '&fixeddom='+extra_element;
589: }
1.468 raeburn 590: }
591: }
1.230 raeburn 592: }
1.909 raeburn 593: if (type != null && type != '') {
594: url += '&type='+type;
595: }
596: if (type_elem != null && type_elem != '') {
597: url += '&typeelement='+type_elem;
598: }
1.872 raeburn 599: if (formname == 'ccrs') {
600: var ownername = document.forms[formid].ccuname.value;
601: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101 raeburn 602: url += '&cloner='+ownername+':'+ownerdom;
603: if (type == 'Course') {
604: url += '&crscode='+document.forms[formid].crscode.value;
605: }
1.1075.2.95 raeburn 606: }
607: if (formname == 'requestcrs') {
608: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 609: }
1.293 raeburn 610: if (multflag !=null && multflag != '') {
611: url += '&multiple='+multflag;
612: }
1.909 raeburn 613: var title = '$wintitle';
1.91 www 614: var options = 'scrollbars=1,resizable=1,menubar=0';
615: options += ',width=700,height=600';
616: stdeditbrowser = open(url,title,options,'1');
617: stdeditbrowser.focus();
618: }
1.876 raeburn 619: $id_functions
620: ENDSTDBRW
1.1075.2.31 raeburn 621: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
622: $output .= &setsec_javascript($sec_element,$formname,$role_element,
623: $credits_element);
1.876 raeburn 624: }
625: $output .= '
626: // ]]>
627: </script>';
628: return $output;
629: }
630:
631: sub javascript_index_functions {
632: return <<"ENDJS";
633:
634: function getFormIdByName(formname) {
635: for (var i=0;i<document.forms.length;i++) {
636: if (document.forms[i].name == formname) {
637: return i;
638: }
639: }
640: return -1;
641: }
642:
643: function getIndexByName(formid,item) {
644: for (var i=0;i<document.forms[formid].elements.length;i++) {
645: if (document.forms[formid].elements[i].name == item) {
646: return i;
647: }
648: }
649: return -1;
650: }
1.468 raeburn 651:
1.876 raeburn 652: function getDomainFromSelectbox(formname,udom) {
653: var userdom;
654: var formid = getFormIdByName(formname);
655: if (formid > -1) {
656: var domid = getIndexByName(formid,udom);
657: if (domid > -1) {
658: if (document.forms[formid].elements[domid].type == 'select-one') {
659: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
660: }
661: if (document.forms[formid].elements[domid].type == 'hidden') {
662: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 663: }
664: }
665: }
1.876 raeburn 666: return userdom;
667: }
668:
669: ENDJS
1.468 raeburn 670:
1.876 raeburn 671: }
672:
1.1017 raeburn 673: sub javascript_array_indexof {
1.1018 raeburn 674: return <<ENDJS;
1.1017 raeburn 675: <script type="text/javascript" language="JavaScript">
676: // <![CDATA[
677:
678: if (!Array.prototype.indexOf) {
679: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
680: "use strict";
681: if (this === void 0 || this === null) {
682: throw new TypeError();
683: }
684: var t = Object(this);
685: var len = t.length >>> 0;
686: if (len === 0) {
687: return -1;
688: }
689: var n = 0;
690: if (arguments.length > 0) {
691: n = Number(arguments[1]);
692: if (n !== n) { // shortcut for verifying if it's NaN
693: n = 0;
694: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
695: n = (n > 0 || -1) * Math.floor(Math.abs(n));
696: }
697: }
698: if (n >= len) {
699: return -1;
700: }
701: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
702: for (; k < len; k++) {
703: if (k in t && t[k] === searchElement) {
704: return k;
705: }
706: }
707: return -1;
708: }
709: }
710:
711: // ]]>
712: </script>
713:
714: ENDJS
715:
716: }
717:
1.876 raeburn 718: sub userbrowser_javascript {
719: my $id_functions = &javascript_index_functions();
720: return <<"ENDUSERBRW";
721:
1.888 raeburn 722: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 723: var url = '/adm/pickuser?';
724: var userdom = getDomainFromSelectbox(formname,udom);
725: if (userdom != null) {
726: if (userdom != '') {
727: url += 'srchdom='+userdom+'&';
728: }
729: }
730: url += 'form=' + formname + '&unameelement='+uname+
731: '&udomelement='+udom+
732: '&ulastelement='+ulast+
733: '&ufirstelement='+ufirst+
734: '&uemailelement='+uemail+
1.881 raeburn 735: '&hideudomelement='+hideudom+
736: '&coursedom='+crsdom;
1.888 raeburn 737: if ((caller != null) && (caller != undefined)) {
738: url += '&caller='+caller;
739: }
1.876 raeburn 740: var title = 'User_Browser';
741: var options = 'scrollbars=1,resizable=1,menubar=0';
742: options += ',width=700,height=600';
743: var stdeditbrowser = open(url,title,options,'1');
744: stdeditbrowser.focus();
745: }
746:
1.888 raeburn 747: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 748: var formid = getFormIdByName(formname);
749: if (formid > -1) {
1.888 raeburn 750: var unameid = getIndexByName(formid,uname);
1.876 raeburn 751: var domid = getIndexByName(formid,udom);
752: var hidedomid = getIndexByName(formid,origdom);
753: if (hidedomid > -1) {
754: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 755: var unameval = document.forms[formid].elements[unameid].value;
756: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
757: if (domid > -1) {
758: var slct = document.forms[formid].elements[domid];
759: if (slct.type == 'select-one') {
760: var i;
761: for (i=0;i<slct.length;i++) {
762: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
763: }
764: }
765: if (slct.type == 'hidden') {
766: slct.value = fixeddom;
1.876 raeburn 767: }
768: }
1.468 raeburn 769: }
770: }
771: }
1.876 raeburn 772: return;
773: }
774:
775: $id_functions
776: ENDUSERBRW
1.468 raeburn 777: }
778:
779: sub setsec_javascript {
1.1075.2.31 raeburn 780: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 781: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
782: $communityrolestr);
783: if ($role_element ne '') {
784: my @allroles = ('st','ta','ep','in','ad');
785: foreach my $crstype ('Course','Community') {
786: if ($crstype eq 'Community') {
787: foreach my $role (@allroles) {
788: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
789: }
790: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
791: } else {
792: foreach my $role (@allroles) {
793: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
794: }
795: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
796: }
797: }
798: $rolestr = '"'.join('","',@allroles).'"';
799: $courserolestr = '"'.join('","',@courserolenames).'"';
800: $communityrolestr = '"'.join('","',@communityrolenames).'"';
801: }
1.468 raeburn 802: my $setsections = qq|
803: function setSect(sectionlist) {
1.629 raeburn 804: var sectionsArray = new Array();
805: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
806: sectionsArray = sectionlist.split(",");
807: }
1.468 raeburn 808: var numSections = sectionsArray.length;
809: document.$formname.$sec_element.length = 0;
810: if (numSections == 0) {
811: document.$formname.$sec_element.multiple=false;
812: document.$formname.$sec_element.size=1;
813: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
814: } else {
815: if (numSections == 1) {
816: document.$formname.$sec_element.multiple=false;
817: document.$formname.$sec_element.size=1;
818: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
819: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
820: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
821: } else {
822: for (var i=0; i<numSections; i++) {
823: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
824: }
825: document.$formname.$sec_element.multiple=true
826: if (numSections < 3) {
827: document.$formname.$sec_element.size=numSections;
828: } else {
829: document.$formname.$sec_element.size=3;
830: }
831: document.$formname.$sec_element.options[0].selected = false
832: }
833: }
1.91 www 834: }
1.905 raeburn 835:
836: function setRole(crstype) {
1.468 raeburn 837: |;
1.905 raeburn 838: if ($role_element eq '') {
839: $setsections .= ' return;
840: }
841: ';
842: } else {
843: $setsections .= qq|
844: var elementLength = document.$formname.$role_element.length;
845: var allroles = Array($rolestr);
846: var courserolenames = Array($courserolestr);
847: var communityrolenames = Array($communityrolestr);
848: if (elementLength != undefined) {
849: if (document.$formname.$role_element.options[5].value == 'cc') {
850: if (crstype == 'Course') {
851: return;
852: } else {
853: allroles[5] = 'co';
854: for (var i=0; i<6; i++) {
855: document.$formname.$role_element.options[i].value = allroles[i];
856: document.$formname.$role_element.options[i].text = communityrolenames[i];
857: }
858: }
859: } else {
860: if (crstype == 'Community') {
861: return;
862: } else {
863: allroles[5] = 'cc';
864: for (var i=0; i<6; i++) {
865: document.$formname.$role_element.options[i].value = allroles[i];
866: document.$formname.$role_element.options[i].text = courserolenames[i];
867: }
868: }
869: }
870: }
871: return;
872: }
873: |;
874: }
1.1075.2.31 raeburn 875: if ($credits_element) {
876: $setsections .= qq|
877: function setCredits(defaultcredits) {
878: document.$formname.$credits_element.value = defaultcredits;
879: return;
880: }
881: |;
882: }
1.468 raeburn 883: return $setsections;
884: }
885:
1.91 www 886: sub selectcourse_link {
1.909 raeburn 887: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
888: $typeelement) = @_;
889: my $type = $selecttype;
1.871 raeburn 890: my $linktext = &mt('Select Course');
891: if ($selecttype eq 'Community') {
1.909 raeburn 892: $linktext = &mt('Select Community');
1.906 raeburn 893: } elsif ($selecttype eq 'Course/Community') {
894: $linktext = &mt('Select Course/Community');
1.909 raeburn 895: $type = '';
1.1019 raeburn 896: } elsif ($selecttype eq 'Select') {
897: $linktext = &mt('Select');
898: $type = '';
1.871 raeburn 899: }
1.787 bisitz 900: return '<span class="LC_nobreak">'
901: ."<a href='"
902: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
903: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 904: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 905: ."'>".$linktext.'</a>'
1.787 bisitz 906: .'</span>';
1.74 www 907: }
1.42 matthew 908:
1.653 raeburn 909: sub selectauthor_link {
910: my ($form,$udom)=@_;
911: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
912: &mt('Select Author').'</a>';
913: }
914:
1.876 raeburn 915: sub selectuser_link {
1.881 raeburn 916: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 917: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 918: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 919: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 920: ');">'.$linktext.'</a>';
1.876 raeburn 921: }
922:
1.273 raeburn 923: sub check_uncheck_jscript {
924: my $jscript = <<"ENDSCRT";
925: function checkAll(field) {
926: if (field.length > 0) {
927: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 928: if (!field[i].disabled) {
929: field[i].checked = true;
930: }
1.273 raeburn 931: }
932: } else {
1.1075.2.14 raeburn 933: if (!field.disabled) {
934: field.checked = true;
935: }
1.273 raeburn 936: }
937: }
938:
939: function uncheckAll(field) {
940: if (field.length > 0) {
941: for (i = 0; i < field.length; i++) {
942: field[i].checked = false ;
1.543 albertel 943: }
944: } else {
1.273 raeburn 945: field.checked = false ;
946: }
947: }
948: ENDSCRT
949: return $jscript;
950: }
951:
1.656 www 952: sub select_timezone {
1.1075.2.115 raeburn 953: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
954: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 955: if ($includeempty) {
956: $output .= '<option value=""';
957: if (($selected eq '') || ($selected eq 'local')) {
958: $output .= ' selected="selected" ';
959: }
960: $output .= '> </option>';
961: }
1.657 raeburn 962: my @timezones = DateTime::TimeZone->all_names;
963: foreach my $tzone (@timezones) {
964: $output.= '<option value="'.$tzone.'"';
965: if ($tzone eq $selected) {
966: $output.=' selected="selected"';
967: }
968: $output.=">$tzone</option>\n";
1.656 www 969: }
970: $output.="</select>";
971: return $output;
972: }
1.273 raeburn 973:
1.687 raeburn 974: sub select_datelocale {
1.1075.2.115 raeburn 975: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
976: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 977: if ($includeempty) {
978: $output .= '<option value=""';
979: if ($selected eq '') {
980: $output .= ' selected="selected" ';
981: }
982: $output .= '> </option>';
983: }
1.1075.2.102 raeburn 984: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 985: my (@possibles,%locale_names);
1.1075.2.102 raeburn 986: my @locales = DateTime::Locale->ids();
987: foreach my $id (@locales) {
988: if ($id ne '') {
989: my ($en_terr,$native_terr);
990: my $loc = DateTime::Locale->load($id);
991: if (ref($loc)) {
992: $en_terr = $loc->name();
993: $native_terr = $loc->native_name();
1.687 raeburn 994: if (grep(/^en$/,@languages) || !@languages) {
995: if ($en_terr ne '') {
996: $locale_names{$id} = '('.$en_terr.')';
997: } elsif ($native_terr ne '') {
998: $locale_names{$id} = $native_terr;
999: }
1000: } else {
1001: if ($native_terr ne '') {
1002: $locale_names{$id} = $native_terr.' ';
1003: } elsif ($en_terr ne '') {
1004: $locale_names{$id} = '('.$en_terr.')';
1005: }
1006: }
1.1075.2.94 raeburn 1007: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102 raeburn 1008: push(@possibles,$id);
1.687 raeburn 1009: }
1010: }
1011: }
1012: foreach my $item (sort(@possibles)) {
1013: $output.= '<option value="'.$item.'"';
1014: if ($item eq $selected) {
1015: $output.=' selected="selected"';
1016: }
1017: $output.=">$item";
1018: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1019: $output.=' '.$locale_names{$item};
1.687 raeburn 1020: }
1021: $output.="</option>\n";
1022: }
1023: $output.="</select>";
1024: return $output;
1025: }
1026:
1.792 raeburn 1027: sub select_language {
1.1075.2.115 raeburn 1028: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1029: my %langchoices;
1030: if ($includeempty) {
1.1075.2.32 raeburn 1031: %langchoices = ('' => 'No language preference');
1.792 raeburn 1032: }
1033: foreach my $id (&languageids()) {
1034: my $code = &supportedlanguagecode($id);
1035: if ($code) {
1036: $langchoices{$code} = &plainlanguagedescription($id);
1037: }
1038: }
1.1075.2.32 raeburn 1039: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115 raeburn 1040: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1041: }
1042:
1.42 matthew 1043: =pod
1.36 matthew 1044:
1.648 raeburn 1045: =item * &linked_select_forms(...)
1.36 matthew 1046:
1047: linked_select_forms returns a string containing a <script></script> block
1048: and html for two <select> menus. The select menus will be linked in that
1049: changing the value of the first menu will result in new values being placed
1050: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1051: order unless a defined order is provided.
1.36 matthew 1052:
1053: linked_select_forms takes the following ordered inputs:
1054:
1055: =over 4
1056:
1.112 bowersj2 1057: =item * $formname, the name of the <form> tag
1.36 matthew 1058:
1.112 bowersj2 1059: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1060:
1.112 bowersj2 1061: =item * $firstdefault, the default value for the first menu
1.36 matthew 1062:
1.112 bowersj2 1063: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1064:
1.112 bowersj2 1065: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1066:
1.112 bowersj2 1067: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1068:
1.609 raeburn 1069: =item * $menuorder, the order of values in the first menu
1070:
1.1075.2.31 raeburn 1071: =item * $onchangefirst, additional javascript call to execute for an onchange
1072: event for the first <select> tag
1073:
1074: =item * $onchangesecond, additional javascript call to execute for an onchange
1075: event for the second <select> tag
1076:
1.41 ng 1077: =back
1078:
1.36 matthew 1079: Below is an example of such a hash. Only the 'text', 'default', and
1080: 'select2' keys must appear as stated. keys(%menu) are the possible
1081: values for the first select menu. The text that coincides with the
1.41 ng 1082: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1083: and text for the second menu are given in the hash pointed to by
1084: $menu{$choice1}->{'select2'}.
1085:
1.112 bowersj2 1086: my %menu = ( A1 => { text =>"Choice A1" ,
1087: default => "B3",
1088: select2 => {
1089: B1 => "Choice B1",
1090: B2 => "Choice B2",
1091: B3 => "Choice B3",
1092: B4 => "Choice B4"
1.609 raeburn 1093: },
1094: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1095: },
1096: A2 => { text =>"Choice A2" ,
1097: default => "C2",
1098: select2 => {
1099: C1 => "Choice C1",
1100: C2 => "Choice C2",
1101: C3 => "Choice C3"
1.609 raeburn 1102: },
1103: order => ['C2','C1','C3'],
1.112 bowersj2 1104: },
1105: A3 => { text =>"Choice A3" ,
1106: default => "D6",
1107: select2 => {
1108: D1 => "Choice D1",
1109: D2 => "Choice D2",
1110: D3 => "Choice D3",
1111: D4 => "Choice D4",
1112: D5 => "Choice D5",
1113: D6 => "Choice D6",
1114: D7 => "Choice D7"
1.609 raeburn 1115: },
1116: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1117: }
1118: );
1.36 matthew 1119:
1120: =cut
1121:
1122: sub linked_select_forms {
1123: my ($formname,
1124: $middletext,
1125: $firstdefault,
1126: $firstselectname,
1127: $secondselectname,
1.609 raeburn 1128: $hashref,
1129: $menuorder,
1.1075.2.31 raeburn 1130: $onchangefirst,
1131: $onchangesecond
1.36 matthew 1132: ) = @_;
1133: my $second = "document.$formname.$secondselectname";
1134: my $first = "document.$formname.$firstselectname";
1135: # output the javascript to do the changing
1136: my $result = '';
1.776 bisitz 1137: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1138: $result.="// <![CDATA[\n";
1.36 matthew 1139: $result.="var select2data = new Object();\n";
1140: $" = '","';
1141: my $debug = '';
1142: foreach my $s1 (sort(keys(%$hashref))) {
1143: $result.="select2data.d_$s1 = new Object();\n";
1144: $result.="select2data.d_$s1.def = new String('".
1145: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1146: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1147: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1148: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1149: @s2values = @{$hashref->{$s1}->{'order'}};
1150: }
1.36 matthew 1151: $result.="\"@s2values\");\n";
1152: $result.="select2data.d_$s1.texts = new Array(";
1153: my @s2texts;
1154: foreach my $value (@s2values) {
1.1075.2.119 raeburn 1155: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1156: }
1157: $result.="\"@s2texts\");\n";
1158: }
1159: $"=' ';
1160: $result.= <<"END";
1161:
1162: function select1_changed() {
1163: // Determine new choice
1164: var newvalue = "d_" + $first.value;
1165: // update select2
1166: var values = select2data[newvalue].values;
1167: var texts = select2data[newvalue].texts;
1168: var select2def = select2data[newvalue].def;
1169: var i;
1170: // out with the old
1171: for (i = 0; i < $second.options.length; i++) {
1172: $second.options[i] = null;
1173: }
1174: // in with the nuclear
1175: for (i=0;i<values.length; i++) {
1176: $second.options[i] = new Option(values[i]);
1.143 matthew 1177: $second.options[i].value = values[i];
1.36 matthew 1178: $second.options[i].text = texts[i];
1179: if (values[i] == select2def) {
1180: $second.options[i].selected = true;
1181: }
1182: }
1183: }
1.824 bisitz 1184: // ]]>
1.36 matthew 1185: </script>
1186: END
1187: # output the initial values for the selection lists
1.1075.2.31 raeburn 1188: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1189: my @order = sort(keys(%{$hashref}));
1190: if (ref($menuorder) eq 'ARRAY') {
1191: @order = @{$menuorder};
1192: }
1193: foreach my $value (@order) {
1.36 matthew 1194: $result.=" <option value=\"$value\" ";
1.253 albertel 1195: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1196: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1197: }
1198: $result .= "</select>\n";
1199: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1200: $result .= $middletext;
1.1075.2.31 raeburn 1201: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1202: if ($onchangesecond) {
1203: $result .= ' onchange="'.$onchangesecond.'"';
1204: }
1205: $result .= ">\n";
1.36 matthew 1206: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1207:
1208: my @secondorder = sort(keys(%select2));
1209: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1210: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1211: }
1212: foreach my $value (@secondorder) {
1.36 matthew 1213: $result.=" <option value=\"$value\" ";
1.253 albertel 1214: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1215: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1216: }
1217: $result .= "</select>\n";
1218: # return $debug;
1219: return $result;
1220: } # end of sub linked_select_forms {
1221:
1.45 matthew 1222: =pod
1.44 bowersj2 1223:
1.973 raeburn 1224: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1225:
1.112 bowersj2 1226: Returns a string corresponding to an HTML link to the given help
1227: $topic, where $topic corresponds to the name of a .tex file in
1228: /home/httpd/html/adm/help/tex, with underscores replaced by
1229: spaces.
1230:
1231: $text will optionally be linked to the same topic, allowing you to
1232: link text in addition to the graphic. If you do not want to link
1233: text, but wish to specify one of the later parameters, pass an
1234: empty string.
1235:
1236: $stayOnPage is a value that will be interpreted as a boolean. If true,
1237: the link will not open a new window. If false, the link will open
1238: a new window using Javascript. (Default is false.)
1239:
1240: $width and $height are optional numerical parameters that will
1241: override the width and height of the popped up window, which may
1.973 raeburn 1242: be useful for certain help topics with big pictures included.
1243:
1244: $imgid is the id of the img tag used for the help icon. This may be
1245: used in a javascript call to switch the image src. See
1246: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1247:
1248: =cut
1249:
1250: sub help_open_topic {
1.973 raeburn 1251: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1252: $text = "" if (not defined $text);
1.44 bowersj2 1253: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1254: $width = 500 if (not defined $width);
1.44 bowersj2 1255: $height = 400 if (not defined $height);
1256: my $filename = $topic;
1257: $filename =~ s/ /_/g;
1258:
1.48 bowersj2 1259: my $template = "";
1260: my $link;
1.572 banghart 1261:
1.159 www 1262: $topic=~s/\W/\_/g;
1.44 bowersj2 1263:
1.572 banghart 1264: if (!$stayOnPage) {
1.1075.2.50 raeburn 1265: if ($env{'browser.mobile'}) {
1266: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1267: } else {
1268: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1269: }
1.1037 www 1270: } elsif ($stayOnPage eq 'popup') {
1271: $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 1272: } else {
1.48 bowersj2 1273: $link = "/adm/help/${filename}.hlp";
1274: }
1275:
1276: # Add the text
1.755 neumanie 1277: if ($text ne "") {
1.763 bisitz 1278: $template.='<span class="LC_help_open_topic">'
1279: .'<a target="_top" href="'.$link.'">'
1280: .$text.'</a>';
1.48 bowersj2 1281: }
1282:
1.763 bisitz 1283: # (Always) Add the graphic
1.179 matthew 1284: my $title = &mt('Online Help');
1.667 raeburn 1285: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1286: if ($imgid ne '') {
1287: $imgid = ' id="'.$imgid.'"';
1288: }
1.763 bisitz 1289: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1290: .'<img src="'.$helpicon.'" border="0"'
1291: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1292: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1293: .' /></a>';
1294: if ($text ne "") {
1295: $template.='</span>';
1296: }
1.44 bowersj2 1297: return $template;
1298:
1.106 bowersj2 1299: }
1300:
1301: # This is a quicky function for Latex cheatsheet editing, since it
1302: # appears in at least four places
1303: sub helpLatexCheatsheet {
1.1037 www 1304: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1305: my $out;
1.106 bowersj2 1306: my $addOther = '';
1.732 raeburn 1307: if ($topic) {
1.1037 www 1308: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1309: }
1310: $out = '<span>' # Start cheatsheet
1311: .$addOther
1312: .'<span>'
1.1037 www 1313: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1314: .'</span> <span>'
1.1037 www 1315: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1316: .'</span>';
1.732 raeburn 1317: unless ($not_author) {
1.763 bisitz 1318: $out .= ' <span>'
1.1037 www 1319: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1320: .'</span> <span>'
1.1075.2.78 raeburn 1321: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1322: .'</span>';
1.732 raeburn 1323: }
1.763 bisitz 1324: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1325: return $out;
1.172 www 1326: }
1327:
1.430 albertel 1328: sub general_help {
1329: my $helptopic='Student_Intro';
1330: if ($env{'request.role'}=~/^(ca|au)/) {
1331: $helptopic='Authoring_Intro';
1.907 raeburn 1332: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1333: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1334: } elsif ($env{'request.role'}=~/^dc/) {
1335: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1336: }
1337: return $helptopic;
1338: }
1339:
1340: sub update_help_link {
1341: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1342: my $origurl = $ENV{'REQUEST_URI'};
1343: $origurl=~s|^/~|/priv/|;
1344: my $timestamp = time;
1345: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1346: $$datum = &escape($$datum);
1347: }
1348:
1349: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1350: my $output .= <<"ENDOUTPUT";
1351: <script type="text/javascript">
1.824 bisitz 1352: // <![CDATA[
1.430 albertel 1353: banner_link = '$banner_link';
1.824 bisitz 1354: // ]]>
1.430 albertel 1355: </script>
1356: ENDOUTPUT
1357: return $output;
1358: }
1359:
1360: # now just updates the help link and generates a blue icon
1.193 raeburn 1361: sub help_open_menu {
1.430 albertel 1362: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1363: = @_;
1.949 droeschl 1364: $stayOnPage = 1;
1.430 albertel 1365: my $output;
1366: if ($component_help) {
1367: if (!$text) {
1368: $output=&help_open_topic($component_help,undef,$stayOnPage,
1369: $width,$height);
1370: } else {
1371: my $help_text;
1372: $help_text=&unescape($topic);
1373: $output='<table><tr><td>'.
1374: &help_open_topic($component_help,$help_text,$stayOnPage,
1375: $width,$height).'</td></tr></table>';
1376: }
1377: }
1378: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1379: return $output.$banner_link;
1380: }
1381:
1382: sub top_nav_help {
1.1075.2.158 raeburn 1383: my ($text,$linkattr) = @_;
1.436 albertel 1384: $text = &mt($text);
1.1075.2.60 raeburn 1385: my $stay_on_page;
1386: unless ($env{'environment.remote'} eq 'on') {
1387: $stay_on_page = 1;
1388: }
1.1075.2.61 raeburn 1389: my ($link,$banner_link);
1390: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1391: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1392: : "javascript:helpMenu('open')";
1393: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1394: }
1.201 raeburn 1395: my $title = &mt('Get help');
1.1075.2.61 raeburn 1396: if ($link) {
1397: return <<"END";
1.436 albertel 1398: $banner_link
1.1075.2.158 raeburn 1399: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1400: END
1.1075.2.61 raeburn 1401: } else {
1402: return ' '.$text.' ';
1403: }
1.436 albertel 1404: }
1405:
1406: sub help_menu_js {
1.1075.2.52 raeburn 1407: my ($httphost) = @_;
1.949 droeschl 1408: my $stayOnPage = 1;
1.436 albertel 1409: my $width = 620;
1410: my $height = 600;
1.430 albertel 1411: my $helptopic=&general_help();
1.1075.2.52 raeburn 1412: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1413: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1414: my $start_page =
1415: &Apache::loncommon::start_page('Help Menu', undef,
1416: {'frameset' => 1,
1417: 'js_ready' => 1,
1.1075.2.136 raeburn 1418: 'use_absolute' => $httphost,
1.331 albertel 1419: 'add_entries' => {
1420: 'border' => '0',
1.579 raeburn 1421: 'rows' => "110,*",},});
1.331 albertel 1422: my $end_page =
1423: &Apache::loncommon::end_page({'frameset' => 1,
1424: 'js_ready' => 1,});
1425:
1.436 albertel 1426: my $template .= <<"ENDTEMPLATE";
1427: <script type="text/javascript">
1.877 bisitz 1428: // <![CDATA[
1.253 albertel 1429: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1430: var banner_link = '';
1.243 raeburn 1431: function helpMenu(target) {
1432: var caller = this;
1433: if (target == 'open') {
1434: var newWindow = null;
1435: try {
1.262 albertel 1436: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1437: }
1438: catch(error) {
1439: writeHelp(caller);
1440: return;
1441: }
1442: if (newWindow) {
1443: caller = newWindow;
1444: }
1.193 raeburn 1445: }
1.243 raeburn 1446: writeHelp(caller);
1447: return;
1448: }
1449: function writeHelp(caller) {
1.1075.2.61 raeburn 1450: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1451: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1452: caller.document.close();
1453: caller.focus();
1.193 raeburn 1454: }
1.877 bisitz 1455: // END LON-CAPA Internal -->
1.253 albertel 1456: // ]]>
1.436 albertel 1457: </script>
1.193 raeburn 1458: ENDTEMPLATE
1459: return $template;
1460: }
1461:
1.172 www 1462: sub help_open_bug {
1463: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1464: unless ($env{'user.adv'}) { return ''; }
1.172 www 1465: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1466: $text = "" if (not defined $text);
1467: $stayOnPage=1;
1.184 albertel 1468: $width = 600 if (not defined $width);
1469: $height = 600 if (not defined $height);
1.172 www 1470:
1471: $topic=~s/\W+/\+/g;
1472: my $link='';
1473: my $template='';
1.379 albertel 1474: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1475: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1476: if (!$stayOnPage)
1477: {
1478: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1479: }
1480: else
1481: {
1482: $link = $url;
1483: }
1484: # Add the text
1485: if ($text ne "")
1486: {
1487: $template .=
1488: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1489: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1490: }
1491:
1492: # Add the graphic
1.179 matthew 1493: my $title = &mt('Report a Bug');
1.215 albertel 1494: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1495: $template .= <<"ENDTEMPLATE";
1.436 albertel 1496: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1497: ENDTEMPLATE
1498: if ($text ne '') { $template.='</td></tr></table>' };
1499: return $template;
1500:
1501: }
1502:
1503: sub help_open_faq {
1504: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1505: unless ($env{'user.adv'}) { return ''; }
1.172 www 1506: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1507: $text = "" if (not defined $text);
1508: $stayOnPage=1;
1509: $width = 350 if (not defined $width);
1510: $height = 400 if (not defined $height);
1511:
1512: $topic=~s/\W+/\+/g;
1513: my $link='';
1514: my $template='';
1515: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1516: if (!$stayOnPage)
1517: {
1518: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1519: }
1520: else
1521: {
1522: $link = $url;
1523: }
1524:
1525: # Add the text
1526: if ($text ne "")
1527: {
1528: $template .=
1.173 www 1529: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1530: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1531: }
1532:
1533: # Add the graphic
1.179 matthew 1534: my $title = &mt('View the FAQ');
1.215 albertel 1535: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1536: $template .= <<"ENDTEMPLATE";
1.436 albertel 1537: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1538: ENDTEMPLATE
1539: if ($text ne '') { $template.='</td></tr></table>' };
1540: return $template;
1541:
1.44 bowersj2 1542: }
1.37 matthew 1543:
1.180 matthew 1544: ###############################################################
1545: ###############################################################
1546:
1.45 matthew 1547: =pod
1548:
1.648 raeburn 1549: =item * &change_content_javascript():
1.256 matthew 1550:
1551: This and the next function allow you to create small sections of an
1552: otherwise static HTML page that you can update on the fly with
1553: Javascript, even in Netscape 4.
1554:
1555: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1556: must be written to the HTML page once. It will prove the Javascript
1557: function "change(name, content)". Calling the change function with the
1558: name of the section
1559: you want to update, matching the name passed to C<changable_area>, and
1560: the new content you want to put in there, will put the content into
1561: that area.
1562:
1563: B<Note>: Netscape 4 only reserves enough space for the changable area
1564: to contain room for the original contents. You need to "make space"
1565: for whatever changes you wish to make, and be B<sure> to check your
1566: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1567: it's adequate for updating a one-line status display, but little more.
1568: This script will set the space to 100% width, so you only need to
1569: worry about height in Netscape 4.
1570:
1571: Modern browsers are much less limiting, and if you can commit to the
1572: user not using Netscape 4, this feature may be used freely with
1573: pretty much any HTML.
1574:
1575: =cut
1576:
1577: sub change_content_javascript {
1578: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1579: if ($env{'browser.type'} eq 'netscape' &&
1580: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1581: return (<<NETSCAPE4);
1582: function change(name, content) {
1583: doc = document.layers[name+"___escape"].layers[0].document;
1584: doc.open();
1585: doc.write(content);
1586: doc.close();
1587: }
1588: NETSCAPE4
1589: } else {
1590: # Otherwise, we need to use semi-standards-compliant code
1591: # (technically, "innerHTML" isn't standard but the equivalent
1592: # is really scary, and every useful browser supports it
1593: return (<<DOMBASED);
1594: function change(name, content) {
1595: element = document.getElementById(name);
1596: element.innerHTML = content;
1597: }
1598: DOMBASED
1599: }
1600: }
1601:
1602: =pod
1603:
1.648 raeburn 1604: =item * &changable_area($name,$origContent):
1.256 matthew 1605:
1606: This provides a "changable area" that can be modified on the fly via
1607: the Javascript code provided in C<change_content_javascript>. $name is
1608: the name you will use to reference the area later; do not repeat the
1609: same name on a given HTML page more then once. $origContent is what
1610: the area will originally contain, which can be left blank.
1611:
1612: =cut
1613:
1614: sub changable_area {
1615: my ($name, $origContent) = @_;
1616:
1.258 albertel 1617: if ($env{'browser.type'} eq 'netscape' &&
1618: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1619: # If this is netscape 4, we need to use the Layer tag
1620: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1621: } else {
1622: return "<span id='$name'>$origContent</span>";
1623: }
1624: }
1625:
1626: =pod
1627:
1.648 raeburn 1628: =item * &viewport_geometry_js
1.590 raeburn 1629:
1630: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1631:
1632: =cut
1633:
1634:
1635: sub viewport_geometry_js {
1636: return <<"GEOMETRY";
1637: var Geometry = {};
1638: function init_geometry() {
1639: if (Geometry.init) { return };
1640: Geometry.init=1;
1641: if (window.innerHeight) {
1642: Geometry.getViewportHeight = function() { return window.innerHeight; };
1643: Geometry.getViewportWidth = function() { return window.innerWidth; };
1644: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1645: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1646: }
1647: else if (document.documentElement && document.documentElement.clientHeight) {
1648: Geometry.getViewportHeight =
1649: function() { return document.documentElement.clientHeight; };
1650: Geometry.getViewportWidth =
1651: function() { return document.documentElement.clientWidth; };
1652:
1653: Geometry.getHorizontalScroll =
1654: function() { return document.documentElement.scrollLeft; };
1655: Geometry.getVerticalScroll =
1656: function() { return document.documentElement.scrollTop; };
1657: }
1658: else if (document.body.clientHeight) {
1659: Geometry.getViewportHeight =
1660: function() { return document.body.clientHeight; };
1661: Geometry.getViewportWidth =
1662: function() { return document.body.clientWidth; };
1663: Geometry.getHorizontalScroll =
1664: function() { return document.body.scrollLeft; };
1665: Geometry.getVerticalScroll =
1666: function() { return document.body.scrollTop; };
1667: }
1668: }
1669:
1670: GEOMETRY
1671: }
1672:
1673: =pod
1674:
1.648 raeburn 1675: =item * &viewport_size_js()
1.590 raeburn 1676:
1677: 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.
1678:
1679: =cut
1680:
1681: sub viewport_size_js {
1682: my $geometry = &viewport_geometry_js();
1683: return <<"DIMS";
1684:
1685: $geometry
1686:
1687: function getViewportDims(width,height) {
1688: init_geometry();
1689: width.value = Geometry.getViewportWidth();
1690: height.value = Geometry.getViewportHeight();
1691: return;
1692: }
1693:
1694: DIMS
1695: }
1696:
1697: =pod
1698:
1.648 raeburn 1699: =item * &resize_textarea_js()
1.565 albertel 1700:
1701: emits the needed javascript to resize a textarea to be as big as possible
1702:
1703: creates a function resize_textrea that takes two IDs first should be
1704: the id of the element to resize, second should be the id of a div that
1705: surrounds everything that comes after the textarea, this routine needs
1706: to be attached to the <body> for the onload and onresize events.
1707:
1.648 raeburn 1708: =back
1.565 albertel 1709:
1710: =cut
1711:
1712: sub resize_textarea_js {
1.590 raeburn 1713: my $geometry = &viewport_geometry_js();
1.565 albertel 1714: return <<"RESIZE";
1715: <script type="text/javascript">
1.824 bisitz 1716: // <![CDATA[
1.590 raeburn 1717: $geometry
1.565 albertel 1718:
1.588 albertel 1719: function getX(element) {
1720: var x = 0;
1721: while (element) {
1722: x += element.offsetLeft;
1723: element = element.offsetParent;
1724: }
1725: return x;
1726: }
1727: function getY(element) {
1728: var y = 0;
1729: while (element) {
1730: y += element.offsetTop;
1731: element = element.offsetParent;
1732: }
1733: return y;
1734: }
1735:
1736:
1.565 albertel 1737: function resize_textarea(textarea_id,bottom_id) {
1738: init_geometry();
1739: var textarea = document.getElementById(textarea_id);
1740: //alert(textarea);
1741:
1.588 albertel 1742: var textarea_top = getY(textarea);
1.565 albertel 1743: var textarea_height = textarea.offsetHeight;
1744: var bottom = document.getElementById(bottom_id);
1.588 albertel 1745: var bottom_top = getY(bottom);
1.565 albertel 1746: var bottom_height = bottom.offsetHeight;
1747: var window_height = Geometry.getViewportHeight();
1.588 albertel 1748: var fudge = 23;
1.565 albertel 1749: var new_height = window_height-fudge-textarea_top-bottom_height;
1750: if (new_height < 300) {
1751: new_height = 300;
1752: }
1753: textarea.style.height=new_height+'px';
1754: }
1.824 bisitz 1755: // ]]>
1.565 albertel 1756: </script>
1757: RESIZE
1758:
1759: }
1760:
1.1075.2.112 raeburn 1761: sub colorfuleditor_js {
1762: return <<"COLORFULEDIT"
1763: <script type="text/javascript">
1764: // <![CDATA[>
1765: function fold_box(curDepth, lastresource){
1766:
1767: // we need a list because there can be several blocks you need to fold in one tag
1768: var block = document.getElementsByName('foldblock_'+curDepth);
1769: // but there is only one folding button per tag
1770: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1771:
1772: if(block.item(0).style.display == 'none'){
1773:
1774: foldbutton.value = '@{[&mt("Hide")]}';
1775: for (i = 0; i < block.length; i++){
1776: block.item(i).style.display = '';
1777: }
1778: }else{
1779:
1780: foldbutton.value = '@{[&mt("Show")]}';
1781: for (i = 0; i < block.length; i++){
1782: // block.item(i).style.visibility = 'collapse';
1783: block.item(i).style.display = 'none';
1784: }
1785: };
1786: saveState(lastresource);
1787: }
1788:
1789: function saveState (lastresource) {
1790:
1791: var tag_list = getTagList();
1792: if(tag_list != null){
1793: var timestamp = new Date().getTime();
1794: var key = lastresource;
1795:
1796: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1797: // starting with timestamp
1798: var value = timestamp+';';
1799:
1800: // building the list of key-value pairs
1801: for(var i = 0; i < tag_list.length; i++){
1802: value += tag_list[i]+',';
1803: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1804: }
1805:
1806: // only iterate whole storage if nothing to override
1807: if(localStorage.getItem(key) == null){
1808:
1809: // prevent storage from growing large
1810: if(localStorage.length > 50){
1811: var regex_getTimestamp = /^(?:\d)+;/;
1812: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1813: var oldest_key;
1814:
1815: for(var i = 1; i < localStorage.length; i++){
1816: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1817: oldest_key = localStorage.key(i);
1818: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1819: }
1820: }
1821: localStorage.removeItem(oldest_key);
1822: }
1823: }
1824: localStorage.setItem(key,value);
1825: }
1826: }
1827:
1828: // restore folding status of blocks (on page load)
1829: function restoreState (lastresource) {
1830: if(localStorage.getItem(lastresource) != null){
1831: var key = lastresource;
1832: var value = localStorage.getItem(key);
1833: var regex_delTimestamp = /^\d+;/;
1834:
1835: value.replace(regex_delTimestamp, '');
1836:
1837: var valueArr = value.split(';');
1838: var pairs;
1839: var elements;
1840: for (var i = 0; i < valueArr.length; i++){
1841: pairs = valueArr[i].split(',');
1842: elements = document.getElementsByName(pairs[0]);
1843:
1844: for (var j = 0; j < elements.length; j++){
1845: elements[j].style.display = pairs[1];
1846: if (pairs[1] == "none"){
1847: var regex_id = /([_\\d]+)\$/;
1848: regex_id.exec(pairs[0]);
1849: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1850: }
1851: }
1852: }
1853: }
1854: }
1855:
1856: function getTagList () {
1857:
1858: var stringToSearch = document.lonhomework.innerHTML;
1859:
1860: var ret = new Array();
1861: var regex_findBlock = /(foldblock_.*?)"/g;
1862: var tag_list = stringToSearch.match(regex_findBlock);
1863:
1864: if(tag_list != null){
1865: for(var i = 0; i < tag_list.length; i++){
1866: ret.push(tag_list[i].replace(/"/, ''));
1867: }
1868: }
1869: return ret;
1870: }
1871:
1872: function saveScrollPosition (resource) {
1873: var tag_list = getTagList();
1874:
1875: // we dont always want to jump to the first block
1876: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1877: if(\$(window).scrollTop() > 170){
1878: if(tag_list != null){
1879: var result;
1880: for(var i = 0; i < tag_list.length; i++){
1881: if(isElementInViewport(tag_list[i])){
1882: result += tag_list[i]+';';
1883: }
1884: }
1885: sessionStorage.setItem('anchor_'+resource, result);
1886: }
1887: } else {
1888: // we dont need to save zero, just delete the item to leave everything tidy
1889: sessionStorage.removeItem('anchor_'+resource);
1890: }
1891: }
1892:
1893: function restoreScrollPosition(resource){
1894:
1895: var elem = sessionStorage.getItem('anchor_'+resource);
1896: if(elem != null){
1897: var tag_list = elem.split(';');
1898: var elem_list;
1899:
1900: for(var i = 0; i < tag_list.length; i++){
1901: elem_list = document.getElementsByName(tag_list[i]);
1902:
1903: if(elem_list.length > 0){
1904: elem = elem_list[0];
1905: break;
1906: }
1907: }
1908: elem.scrollIntoView();
1909: }
1910: }
1911:
1912: function isElementInViewport(el) {
1913:
1914: // change to last element instead of first
1915: var elem = document.getElementsByName(el);
1916: var rect = elem[0].getBoundingClientRect();
1917:
1918: return (
1919: rect.top >= 0 &&
1920: rect.left >= 0 &&
1921: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1922: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1923: );
1924: }
1925:
1926: function autosize(depth){
1927: var cmInst = window['cm'+depth];
1928: var fitsizeButton = document.getElementById('fitsize'+depth);
1929:
1930: // is fixed size, switching to dynamic
1931: if (sessionStorage.getItem("autosized_"+depth) == null) {
1932: cmInst.setSize("","auto");
1933: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1934: sessionStorage.setItem("autosized_"+depth, "yes");
1935:
1936: // is dynamic size, switching to fixed
1937: } else {
1938: cmInst.setSize("","300px");
1939: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1940: sessionStorage.removeItem("autosized_"+depth);
1941: }
1942: }
1943:
1944:
1945:
1946: // ]]>
1947: </script>
1948: COLORFULEDIT
1949: }
1950:
1951: sub xmleditor_js {
1952: return <<XMLEDIT
1953: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1954: <script type="text/javascript">
1955: // <![CDATA[>
1956:
1957: function saveScrollPosition (resource) {
1958:
1959: var scrollPos = \$(window).scrollTop();
1960: sessionStorage.setItem(resource,scrollPos);
1961: }
1962:
1963: function restoreScrollPosition(resource){
1964:
1965: var scrollPos = sessionStorage.getItem(resource);
1966: \$(window).scrollTop(scrollPos);
1967: }
1968:
1969: // unless internet explorer
1970: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1971:
1972: \$(document).ready(function() {
1973: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1974: });
1975: }
1976:
1977: // inserts text at cursor position into codemirror (xml editor only)
1978: function insertText(text){
1979: cm.focus();
1980: var curPos = cm.getCursor();
1981: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1982: }
1983: // ]]>
1984: </script>
1985: XMLEDIT
1986: }
1987:
1988: sub insert_folding_button {
1989: my $curDepth = $Apache::lonxml::curdepth;
1990: my $lastresource = $env{'request.ambiguous'};
1991:
1992: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
1993: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
1994: }
1995:
1996:
1.565 albertel 1997: =pod
1998:
1.256 matthew 1999: =head1 Excel and CSV file utility routines
2000:
2001: =cut
2002:
2003: ###############################################################
2004: ###############################################################
2005:
2006: =pod
2007:
1.1075.2.56 raeburn 2008: =over 4
2009:
1.648 raeburn 2010: =item * &csv_translate($text)
1.37 matthew 2011:
1.185 www 2012: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2013: format.
2014:
2015: =cut
2016:
1.180 matthew 2017: ###############################################################
2018: ###############################################################
1.37 matthew 2019: sub csv_translate {
2020: my $text = shift;
2021: $text =~ s/\"/\"\"/g;
1.209 albertel 2022: $text =~ s/\n/ /g;
1.37 matthew 2023: return $text;
2024: }
1.180 matthew 2025:
2026: ###############################################################
2027: ###############################################################
2028:
2029: =pod
2030:
1.648 raeburn 2031: =item * &define_excel_formats()
1.180 matthew 2032:
2033: Define some commonly used Excel cell formats.
2034:
2035: Currently supported formats:
2036:
2037: =over 4
2038:
2039: =item header
2040:
2041: =item bold
2042:
2043: =item h1
2044:
2045: =item h2
2046:
2047: =item h3
2048:
1.256 matthew 2049: =item h4
2050:
2051: =item i
2052:
1.180 matthew 2053: =item date
2054:
2055: =back
2056:
2057: Inputs: $workbook
2058:
2059: Returns: $format, a hash reference.
2060:
1.1057 foxr 2061:
1.180 matthew 2062: =cut
2063:
2064: ###############################################################
2065: ###############################################################
2066: sub define_excel_formats {
2067: my ($workbook) = @_;
2068: my $format;
2069: $format->{'header'} = $workbook->add_format(bold => 1,
2070: bottom => 1,
2071: align => 'center');
2072: $format->{'bold'} = $workbook->add_format(bold=>1);
2073: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2074: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2075: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2076: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2077: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2078: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2079: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2080: return $format;
2081: }
2082:
2083: ###############################################################
2084: ###############################################################
1.113 bowersj2 2085:
2086: =pod
2087:
1.648 raeburn 2088: =item * &create_workbook()
1.255 matthew 2089:
2090: Create an Excel worksheet. If it fails, output message on the
2091: request object and return undefs.
2092:
2093: Inputs: Apache request object
2094:
2095: Returns (undef) on failure,
2096: Excel worksheet object, scalar with filename, and formats
2097: from &Apache::loncommon::define_excel_formats on success
2098:
2099: =cut
2100:
2101: ###############################################################
2102: ###############################################################
2103: sub create_workbook {
2104: my ($r) = @_;
2105: #
2106: # Create the excel spreadsheet
2107: my $filename = '/prtspool/'.
1.258 albertel 2108: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2109: time.'_'.rand(1000000000).'.xls';
2110: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2111: if (! defined($workbook)) {
2112: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2113: $r->print(
2114: '<p class="LC_error">'
2115: .&mt('Problems occurred in creating the new Excel file.')
2116: .' '.&mt('This error has been logged.')
2117: .' '.&mt('Please alert your LON-CAPA administrator.')
2118: .'</p>'
2119: );
1.255 matthew 2120: return (undef);
2121: }
2122: #
1.1014 foxr 2123: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2124: #
2125: my $format = &Apache::loncommon::define_excel_formats($workbook);
2126: return ($workbook,$filename,$format);
2127: }
2128:
2129: ###############################################################
2130: ###############################################################
2131:
2132: =pod
2133:
1.648 raeburn 2134: =item * &create_text_file()
1.113 bowersj2 2135:
1.542 raeburn 2136: Create a file to write to and eventually make available to the user.
1.256 matthew 2137: If file creation fails, outputs an error message on the request object and
2138: return undefs.
1.113 bowersj2 2139:
1.256 matthew 2140: Inputs: Apache request object, and file suffix
1.113 bowersj2 2141:
1.256 matthew 2142: Returns (undef) on failure,
2143: Filehandle and filename on success.
1.113 bowersj2 2144:
2145: =cut
2146:
1.256 matthew 2147: ###############################################################
2148: ###############################################################
2149: sub create_text_file {
2150: my ($r,$suffix) = @_;
2151: if (! defined($suffix)) { $suffix = 'txt'; };
2152: my $fh;
2153: my $filename = '/prtspool/'.
1.258 albertel 2154: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2155: time.'_'.rand(1000000000).'.'.$suffix;
2156: $fh = Apache::File->new('>/home/httpd'.$filename);
2157: if (! defined($fh)) {
2158: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2159: $r->print(
2160: '<p class="LC_error">'
2161: .&mt('Problems occurred in creating the output file.')
2162: .' '.&mt('This error has been logged.')
2163: .' '.&mt('Please alert your LON-CAPA administrator.')
2164: .'</p>'
2165: );
1.113 bowersj2 2166: }
1.256 matthew 2167: return ($fh,$filename)
1.113 bowersj2 2168: }
2169:
2170:
1.256 matthew 2171: =pod
1.113 bowersj2 2172:
2173: =back
2174:
2175: =cut
1.37 matthew 2176:
2177: ###############################################################
1.33 matthew 2178: ## Home server <option> list generating code ##
2179: ###############################################################
1.35 matthew 2180:
1.169 www 2181: # ------------------------------------------
2182:
2183: sub domain_select {
2184: my ($name,$value,$multiple)=@_;
2185: my %domains=map {
1.514 albertel 2186: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2187: } &Apache::lonnet::all_domains();
1.169 www 2188: if ($multiple) {
2189: $domains{''}=&mt('Any domain');
1.550 albertel 2190: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2191: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2192: } else {
1.550 albertel 2193: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2194: return &select_form($name,$value,\%domains);
1.169 www 2195: }
2196: }
2197:
1.282 albertel 2198: #-------------------------------------------
2199:
2200: =pod
2201:
1.519 raeburn 2202: =head1 Routines for form select boxes
2203:
2204: =over 4
2205:
1.648 raeburn 2206: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2207:
2208: Returns a string containing a <select> element int multiple mode
2209:
2210:
2211: Args:
2212: $name - name of the <select> element
1.506 raeburn 2213: $value - scalar or array ref of values that should already be selected
1.282 albertel 2214: $size - number of rows long the select element is
1.283 albertel 2215: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2216: (shown text should already have been &mt())
1.506 raeburn 2217: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2218:
1.282 albertel 2219: =cut
2220:
2221: #-------------------------------------------
1.169 www 2222: sub multiple_select_form {
1.284 albertel 2223: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2224: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2225: my $output='';
1.191 matthew 2226: if (! defined($size)) {
2227: $size = 4;
1.283 albertel 2228: if (scalar(keys(%$hash))<4) {
2229: $size = scalar(keys(%$hash));
1.191 matthew 2230: }
2231: }
1.734 bisitz 2232: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2233: my @order;
1.506 raeburn 2234: if (ref($order) eq 'ARRAY') {
2235: @order = @{$order};
2236: } else {
2237: @order = sort(keys(%$hash));
1.501 banghart 2238: }
2239: if (exists($$hash{'select_form_order'})) {
2240: @order = @{$$hash{'select_form_order'}};
2241: }
2242:
1.284 albertel 2243: foreach my $key (@order) {
1.356 albertel 2244: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2245: $output.='selected="selected" ' if ($selected{$key});
2246: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2247: }
2248: $output.="</select>\n";
2249: return $output;
2250: }
2251:
1.88 www 2252: #-------------------------------------------
2253:
2254: =pod
2255:
1.1075.2.115 raeburn 2256: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2257:
2258: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2259: allow a user to select options from a ref to a hash containing:
2260: option_name => displayed text. An optional $onchange can include
1.1075.2.115 raeburn 2261: a javascript onchange item, e.g., onchange="this.form.submit();".
2262: An optional arg -- $readonly -- if true will cause the select form
2263: to be disabled, e.g., for the case where an instructor has a section-
2264: specific role, and is viewing/modifying parameters.
1.970 raeburn 2265:
1.88 www 2266: See lonrights.pm for an example invocation and use.
2267:
2268: =cut
2269:
2270: #-------------------------------------------
2271: sub select_form {
1.1075.2.115 raeburn 2272: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2273: return unless (ref($hashref) eq 'HASH');
2274: if ($onchange) {
2275: $onchange = ' onchange="'.$onchange.'"';
2276: }
1.1075.2.129 raeburn 2277: my $disabled;
2278: if ($readonly) {
2279: $disabled = ' disabled="disabled"';
2280: }
2281: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2282: my @keys;
1.970 raeburn 2283: if (exists($hashref->{'select_form_order'})) {
2284: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2285: } else {
1.970 raeburn 2286: @keys=sort(keys(%{$hashref}));
1.128 albertel 2287: }
1.356 albertel 2288: foreach my $key (@keys) {
2289: $selectform.=
2290: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2291: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2292: ">".$hashref->{$key}."</option>\n";
1.88 www 2293: }
2294: $selectform.="</select>";
2295: return $selectform;
2296: }
2297:
1.475 www 2298: # For display filters
2299:
2300: sub display_filter {
1.1074 raeburn 2301: my ($context) = @_;
1.475 www 2302: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2303: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2304: my $phraseinput = 'hidden';
2305: my $includeinput = 'hidden';
2306: my ($checked,$includetypestext);
2307: if ($env{'form.displayfilter'} eq 'containing') {
2308: $phraseinput = 'text';
2309: if ($context eq 'parmslog') {
2310: $includeinput = 'checkbox';
2311: if ($env{'form.includetypes'}) {
2312: $checked = ' checked="checked"';
2313: }
2314: $includetypestext = &mt('Include parameter types');
2315: }
2316: } else {
2317: $includetypestext = ' ';
2318: }
2319: my ($additional,$secondid,$thirdid);
2320: if ($context eq 'parmslog') {
2321: $additional =
2322: '<label><input type="'.$includeinput.'" name="includetypes"'.
2323: $checked.' name="includetypes" value="1" id="includetypes" />'.
2324: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2325: '</label>';
2326: $secondid = 'includetypes';
2327: $thirdid = 'includetypestext';
2328: }
2329: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2330: '$secondid','$thirdid')";
2331: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2332: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2333: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2334: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2335: &mt('Filter: [_1]',
1.477 www 2336: &select_form($env{'form.displayfilter'},
2337: 'displayfilter',
1.970 raeburn 2338: {'currentfolder' => 'Current folder/page',
1.477 www 2339: 'containing' => 'Containing phrase',
1.1074 raeburn 2340: 'none' => 'None'},$onchange)).' '.
2341: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2342: &HTML::Entities::encode($env{'form.containingphrase'}).
2343: '" />'.$additional;
2344: }
2345:
2346: sub display_filter_js {
2347: my $includetext = &mt('Include parameter types');
2348: return <<"ENDJS";
2349:
2350: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2351: var firstType = 'hidden';
2352: if (setter.options[setter.selectedIndex].value == 'containing') {
2353: firstType = 'text';
2354: }
2355: firstObject = document.getElementById(firstid);
2356: if (typeof(firstObject) == 'object') {
2357: if (firstObject.type != firstType) {
2358: changeInputType(firstObject,firstType);
2359: }
2360: }
2361: if (context == 'parmslog') {
2362: var secondType = 'hidden';
2363: if (firstType == 'text') {
2364: secondType = 'checkbox';
2365: }
2366: secondObject = document.getElementById(secondid);
2367: if (typeof(secondObject) == 'object') {
2368: if (secondObject.type != secondType) {
2369: changeInputType(secondObject,secondType);
2370: }
2371: }
2372: var textItem = document.getElementById(thirdid);
2373: var currtext = textItem.innerHTML;
2374: var newtext;
2375: if (firstType == 'text') {
2376: newtext = '$includetext';
2377: } else {
2378: newtext = ' ';
2379: }
2380: if (currtext != newtext) {
2381: textItem.innerHTML = newtext;
2382: }
2383: }
2384: return;
2385: }
2386:
2387: function changeInputType(oldObject,newType) {
2388: var newObject = document.createElement('input');
2389: newObject.type = newType;
2390: if (oldObject.size) {
2391: newObject.size = oldObject.size;
2392: }
2393: if (oldObject.value) {
2394: newObject.value = oldObject.value;
2395: }
2396: if (oldObject.name) {
2397: newObject.name = oldObject.name;
2398: }
2399: if (oldObject.id) {
2400: newObject.id = oldObject.id;
2401: }
2402: oldObject.parentNode.replaceChild(newObject,oldObject);
2403: return;
2404: }
2405:
2406: ENDJS
1.475 www 2407: }
2408:
1.167 www 2409: sub gradeleveldescription {
2410: my $gradelevel=shift;
2411: my %gradelevels=(0 => 'Not specified',
2412: 1 => 'Grade 1',
2413: 2 => 'Grade 2',
2414: 3 => 'Grade 3',
2415: 4 => 'Grade 4',
2416: 5 => 'Grade 5',
2417: 6 => 'Grade 6',
2418: 7 => 'Grade 7',
2419: 8 => 'Grade 8',
2420: 9 => 'Grade 9',
2421: 10 => 'Grade 10',
2422: 11 => 'Grade 11',
2423: 12 => 'Grade 12',
2424: 13 => 'Grade 13',
2425: 14 => '100 Level',
2426: 15 => '200 Level',
2427: 16 => '300 Level',
2428: 17 => '400 Level',
2429: 18 => 'Graduate Level');
2430: return &mt($gradelevels{$gradelevel});
2431: }
2432:
1.163 www 2433: sub select_level_form {
2434: my ($deflevel,$name)=@_;
2435: unless ($deflevel) { $deflevel=0; }
1.167 www 2436: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2437: for (my $i=0; $i<=18; $i++) {
2438: $selectform.="<option value=\"$i\" ".
1.253 albertel 2439: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2440: ">".&gradeleveldescription($i)."</option>\n";
2441: }
2442: $selectform.="</select>";
2443: return $selectform;
1.163 www 2444: }
1.167 www 2445:
1.35 matthew 2446: #-------------------------------------------
2447:
1.45 matthew 2448: =pod
2449:
1.1075.2.115 raeburn 2450: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2451:
2452: Returns a string containing a <select name='$name' size='1'> form to
2453: allow a user to select the domain to preform an operation in.
2454: See loncreateuser.pm for an example invocation and use.
2455:
1.90 www 2456: If the $includeempty flag is set, it also includes an empty choice ("no domain
2457: selected");
2458:
1.743 raeburn 2459: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2460:
1.910 raeburn 2461: 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.
2462:
1.1075.2.36 raeburn 2463: The optional $incdoms is a reference to an array of domains which will be the only available options.
2464:
1.1075.2.115 raeburn 2465: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
2466:
2467: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
1.563 raeburn 2468:
1.35 matthew 2469: =cut
2470:
2471: #-------------------------------------------
1.34 matthew 2472: sub select_dom_form {
1.1075.2.115 raeburn 2473: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2474: if ($onchange) {
1.874 raeburn 2475: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2476: }
1.1075.2.115 raeburn 2477: if ($disabled) {
2478: $disabled = ' disabled="disabled"';
2479: }
1.1075.2.36 raeburn 2480: my (@domains,%exclude);
1.910 raeburn 2481: if (ref($incdoms) eq 'ARRAY') {
2482: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2483: } else {
2484: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2485: }
1.90 www 2486: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2487: if (ref($excdoms) eq 'ARRAY') {
2488: map { $exclude{$_} = 1; } @{$excdoms};
2489: }
1.1075.2.115 raeburn 2490: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2491: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2492: next if ($exclude{$dom});
1.356 albertel 2493: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2494: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2495: if ($showdomdesc) {
2496: if ($dom ne '') {
2497: my $domdesc = &Apache::lonnet::domain($dom,'description');
2498: if ($domdesc ne '') {
2499: $selectdomain .= ' ('.$domdesc.')';
2500: }
2501: }
2502: }
2503: $selectdomain .= "</option>\n";
1.34 matthew 2504: }
2505: $selectdomain.="</select>";
2506: return $selectdomain;
2507: }
2508:
1.35 matthew 2509: #-------------------------------------------
2510:
1.45 matthew 2511: =pod
2512:
1.648 raeburn 2513: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2514:
1.586 raeburn 2515: input: 4 arguments (two required, two optional) -
2516: $domain - domain of new user
2517: $name - name of form element
2518: $default - Value of 'default' causes a default item to be first
2519: option, and selected by default.
2520: $hide - Value of 'hide' causes hiding of the name of the server,
2521: if 1 server found, or default, if 0 found.
1.594 raeburn 2522: output: returns 2 items:
1.586 raeburn 2523: (a) form element which contains either:
2524: (i) <select name="$name">
2525: <option value="$hostid1">$hostid $servers{$hostid}</option>
2526: <option value="$hostid2">$hostid $servers{$hostid}</option>
2527: </select>
2528: form item if there are multiple library servers in $domain, or
2529: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2530: if there is only one library server in $domain.
2531:
2532: (b) number of library servers found.
2533:
2534: See loncreateuser.pm for example of use.
1.35 matthew 2535:
2536: =cut
2537:
2538: #-------------------------------------------
1.586 raeburn 2539: sub home_server_form_item {
2540: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2541: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2542: my $result;
2543: my $numlib = keys(%servers);
2544: if ($numlib > 1) {
2545: $result .= '<select name="'.$name.'" />'."\n";
2546: if ($default) {
1.804 bisitz 2547: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2548: '</option>'."\n";
2549: }
2550: foreach my $hostid (sort(keys(%servers))) {
2551: $result.= '<option value="'.$hostid.'">'.
2552: $hostid.' '.$servers{$hostid}."</option>\n";
2553: }
2554: $result .= '</select>'."\n";
2555: } elsif ($numlib == 1) {
2556: my $hostid;
2557: foreach my $item (keys(%servers)) {
2558: $hostid = $item;
2559: }
2560: $result .= '<input type="hidden" name="'.$name.'" value="'.
2561: $hostid.'" />';
2562: if (!$hide) {
2563: $result .= $hostid.' '.$servers{$hostid};
2564: }
2565: $result .= "\n";
2566: } elsif ($default) {
2567: $result .= '<input type="hidden" name="'.$name.
2568: '" value="default" />';
2569: if (!$hide) {
2570: $result .= &mt('default');
2571: }
2572: $result .= "\n";
1.33 matthew 2573: }
1.586 raeburn 2574: return ($result,$numlib);
1.33 matthew 2575: }
1.112 bowersj2 2576:
2577: =pod
2578:
1.534 albertel 2579: =back
2580:
1.112 bowersj2 2581: =cut
1.87 matthew 2582:
2583: ###############################################################
1.112 bowersj2 2584: ## Decoding User Agent ##
1.87 matthew 2585: ###############################################################
2586:
2587: =pod
2588:
1.112 bowersj2 2589: =head1 Decoding the User Agent
2590:
2591: =over 4
2592:
2593: =item * &decode_user_agent()
1.87 matthew 2594:
2595: Inputs: $r
2596:
2597: Outputs:
2598:
2599: =over 4
2600:
1.112 bowersj2 2601: =item * $httpbrowser
1.87 matthew 2602:
1.112 bowersj2 2603: =item * $clientbrowser
1.87 matthew 2604:
1.112 bowersj2 2605: =item * $clientversion
1.87 matthew 2606:
1.112 bowersj2 2607: =item * $clientmathml
1.87 matthew 2608:
1.112 bowersj2 2609: =item * $clientunicode
1.87 matthew 2610:
1.112 bowersj2 2611: =item * $clientos
1.87 matthew 2612:
1.1075.2.42 raeburn 2613: =item * $clientmobile
2614:
2615: =item * $clientinfo
2616:
1.1075.2.77 raeburn 2617: =item * $clientosversion
2618:
1.87 matthew 2619: =back
2620:
1.157 matthew 2621: =back
2622:
1.87 matthew 2623: =cut
2624:
2625: ###############################################################
2626: ###############################################################
2627: sub decode_user_agent {
1.247 albertel 2628: my ($r)=@_;
1.87 matthew 2629: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2630: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2631: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2632: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2633: my $clientbrowser='unknown';
2634: my $clientversion='0';
2635: my $clientmathml='';
2636: my $clientunicode='0';
1.1075.2.42 raeburn 2637: my $clientmobile=0;
1.1075.2.77 raeburn 2638: my $clientosversion='';
1.87 matthew 2639: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2640: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2641: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2642: $clientbrowser=$bname;
2643: $httpbrowser=~/$vreg/i;
2644: $clientversion=$1;
2645: $clientmathml=($clientversion>=$minv);
2646: $clientunicode=($clientversion>=$univ);
2647: }
2648: }
2649: my $clientos='unknown';
1.1075.2.42 raeburn 2650: my $clientinfo;
1.87 matthew 2651: if (($httpbrowser=~/linux/i) ||
2652: ($httpbrowser=~/unix/i) ||
2653: ($httpbrowser=~/ux/i) ||
2654: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2655: if (($httpbrowser=~/vax/i) ||
2656: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2657: if ($httpbrowser=~/next/i) { $clientos='next'; }
2658: if (($httpbrowser=~/mac/i) ||
2659: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2660: if ($httpbrowser=~/win/i) {
2661: $clientos='win';
2662: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2663: $clientosversion = $1;
2664: }
2665: }
1.87 matthew 2666: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2667: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2668: $clientmobile=lc($1);
2669: }
2670: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2671: $clientinfo = 'firefox-'.$1;
2672: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2673: $clientinfo = 'chromeframe-'.$1;
2674: }
1.87 matthew 2675: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2676: $clientunicode,$clientos,$clientmobile,$clientinfo,
2677: $clientosversion);
1.87 matthew 2678: }
2679:
1.32 matthew 2680: ###############################################################
2681: ## Authentication changing form generation subroutines ##
2682: ###############################################################
2683: ##
2684: ## All of the authform_xxxxxxx subroutines take their inputs in a
2685: ## hash, and have reasonable default values.
2686: ##
2687: ## formname = the name given in the <form> tag.
1.35 matthew 2688: #-------------------------------------------
2689:
1.45 matthew 2690: =pod
2691:
1.112 bowersj2 2692: =head1 Authentication Routines
2693:
2694: =over 4
2695:
1.648 raeburn 2696: =item * &authform_xxxxxx()
1.35 matthew 2697:
2698: The authform_xxxxxx subroutines provide javascript and html forms which
2699: handle some of the conveniences required for authentication forms.
2700: This is not an optimal method, but it works.
2701:
2702: =over 4
2703:
1.112 bowersj2 2704: =item * authform_header
1.35 matthew 2705:
1.112 bowersj2 2706: =item * authform_authorwarning
1.35 matthew 2707:
1.112 bowersj2 2708: =item * authform_nochange
1.35 matthew 2709:
1.112 bowersj2 2710: =item * authform_kerberos
1.35 matthew 2711:
1.112 bowersj2 2712: =item * authform_internal
1.35 matthew 2713:
1.112 bowersj2 2714: =item * authform_filesystem
1.35 matthew 2715:
2716: =back
2717:
1.648 raeburn 2718: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2719:
1.35 matthew 2720: =cut
2721:
2722: #-------------------------------------------
1.32 matthew 2723: sub authform_header{
2724: my %in = (
2725: formname => 'cu',
1.80 albertel 2726: kerb_def_dom => '',
1.32 matthew 2727: @_,
2728: );
2729: $in{'formname'} = 'document.' . $in{'formname'};
2730: my $result='';
1.80 albertel 2731:
2732: #---------------------------------------------- Code for upper case translation
2733: my $Javascript_toUpperCase;
2734: unless ($in{kerb_def_dom}) {
2735: $Javascript_toUpperCase =<<"END";
2736: switch (choice) {
2737: case 'krb': currentform.elements[choicearg].value =
2738: currentform.elements[choicearg].value.toUpperCase();
2739: break;
2740: default:
2741: }
2742: END
2743: } else {
2744: $Javascript_toUpperCase = "";
2745: }
2746:
1.165 raeburn 2747: my $radioval = "'nochange'";
1.591 raeburn 2748: if (defined($in{'curr_authtype'})) {
2749: if ($in{'curr_authtype'} ne '') {
2750: $radioval = "'".$in{'curr_authtype'}."arg'";
2751: }
1.174 matthew 2752: }
1.165 raeburn 2753: my $argfield = 'null';
1.591 raeburn 2754: if (defined($in{'mode'})) {
1.165 raeburn 2755: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2756: if (defined($in{'curr_autharg'})) {
2757: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2758: $argfield = "'$in{'curr_autharg'}'";
2759: }
2760: }
2761: }
2762: }
2763:
1.32 matthew 2764: $result.=<<"END";
2765: var current = new Object();
1.165 raeburn 2766: current.radiovalue = $radioval;
2767: current.argfield = $argfield;
1.32 matthew 2768:
2769: function changed_radio(choice,currentform) {
2770: var choicearg = choice + 'arg';
2771: // If a radio button in changed, we need to change the argfield
2772: if (current.radiovalue != choice) {
2773: current.radiovalue = choice;
2774: if (current.argfield != null) {
2775: currentform.elements[current.argfield].value = '';
2776: }
2777: if (choice == 'nochange') {
2778: current.argfield = null;
2779: } else {
2780: current.argfield = choicearg;
2781: switch(choice) {
2782: case 'krb':
2783: currentform.elements[current.argfield].value =
2784: "$in{'kerb_def_dom'}";
2785: break;
2786: default:
2787: break;
2788: }
2789: }
2790: }
2791: return;
2792: }
1.22 www 2793:
1.32 matthew 2794: function changed_text(choice,currentform) {
2795: var choicearg = choice + 'arg';
2796: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2797: $Javascript_toUpperCase
1.32 matthew 2798: // clear old field
2799: if ((current.argfield != choicearg) && (current.argfield != null)) {
2800: currentform.elements[current.argfield].value = '';
2801: }
2802: current.argfield = choicearg;
2803: }
2804: set_auth_radio_buttons(choice,currentform);
2805: return;
1.20 www 2806: }
1.32 matthew 2807:
2808: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2809: var numauthchoices = currentform.login.length;
2810: if (typeof numauthchoices == "undefined") {
2811: return;
2812: }
1.32 matthew 2813: var i=0;
1.986 raeburn 2814: while (i < numauthchoices) {
1.32 matthew 2815: if (currentform.login[i].value == newvalue) { break; }
2816: i++;
2817: }
1.986 raeburn 2818: if (i == numauthchoices) {
1.32 matthew 2819: return;
2820: }
2821: current.radiovalue = newvalue;
2822: currentform.login[i].checked = true;
2823: return;
2824: }
2825: END
2826: return $result;
2827: }
2828:
1.1075.2.20 raeburn 2829: sub authform_authorwarning {
1.32 matthew 2830: my $result='';
1.144 matthew 2831: $result='<i>'.
2832: &mt('As a general rule, only authors or co-authors should be '.
2833: 'filesystem authenticated '.
2834: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2835: return $result;
2836: }
2837:
1.1075.2.20 raeburn 2838: sub authform_nochange {
1.32 matthew 2839: my %in = (
2840: formname => 'document.cu',
2841: kerb_def_dom => 'MSU.EDU',
2842: @_,
2843: );
1.1075.2.20 raeburn 2844: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2845: my $result;
1.1075.2.20 raeburn 2846: if (!$authnum) {
2847: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2848: } else {
2849: $result = '<label>'.&mt('[_1] Do not change login data',
2850: '<input type="radio" name="login" value="nochange" '.
2851: 'checked="checked" onclick="'.
1.281 albertel 2852: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2853: '</label>';
1.586 raeburn 2854: }
1.32 matthew 2855: return $result;
2856: }
2857:
1.591 raeburn 2858: sub authform_kerberos {
1.32 matthew 2859: my %in = (
2860: formname => 'document.cu',
2861: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2862: kerb_def_auth => 'krb4',
1.32 matthew 2863: @_,
2864: );
1.586 raeburn 2865: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117 raeburn 2866: $autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2867: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2868: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2869: $check5 = ' checked="checked"';
1.80 albertel 2870: } else {
1.772 bisitz 2871: $check4 = ' checked="checked"';
1.80 albertel 2872: }
1.1075.2.117 raeburn 2873: if ($in{'readonly'}) {
2874: $disabled = ' disabled="disabled"';
2875: }
1.165 raeburn 2876: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2877: if (defined($in{'curr_authtype'})) {
2878: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2879: $krbcheck = ' checked="checked"';
1.623 raeburn 2880: if (defined($in{'mode'})) {
2881: if ($in{'mode'} eq 'modifyuser') {
2882: $krbcheck = '';
2883: }
2884: }
1.591 raeburn 2885: if (defined($in{'curr_kerb_ver'})) {
2886: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2887: $check5 = ' checked="checked"';
1.591 raeburn 2888: $check4 = '';
2889: } else {
1.772 bisitz 2890: $check4 = ' checked="checked"';
1.591 raeburn 2891: $check5 = '';
2892: }
1.586 raeburn 2893: }
1.591 raeburn 2894: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2895: $krbarg = $in{'curr_autharg'};
2896: }
1.586 raeburn 2897: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2898: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2899: $result =
2900: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2901: $in{'curr_autharg'},$krbver);
2902: } else {
2903: $result =
2904: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2905: }
2906: return $result;
2907: }
2908: }
2909: } else {
2910: if ($authnum == 1) {
1.784 bisitz 2911: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2912: }
2913: }
1.586 raeburn 2914: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2915: return;
1.587 raeburn 2916: } elsif ($authtype eq '') {
1.591 raeburn 2917: if (defined($in{'mode'})) {
1.587 raeburn 2918: if ($in{'mode'} eq 'modifycourse') {
2919: if ($authnum == 1) {
1.1075.2.117 raeburn 2920: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 2921: }
2922: }
2923: }
1.586 raeburn 2924: }
2925: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2926: if ($authtype eq '') {
2927: $authtype = '<input type="radio" name="login" value="krb" '.
2928: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117 raeburn 2929: $krbcheck.$disabled.' />';
1.586 raeburn 2930: }
2931: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2932: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2933: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2934: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2935: $in{'curr_authtype'} eq 'krb4')) {
2936: $result .= &mt
1.144 matthew 2937: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2938: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2939: '<label>'.$authtype,
1.281 albertel 2940: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2941: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2942: 'onchange="'.$jscall.'"'.$disabled.' />',
2943: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
2944: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 2945: '</label>');
1.586 raeburn 2946: } elsif ($can_assign{'krb4'}) {
2947: $result .= &mt
2948: ('[_1] Kerberos authenticated with domain [_2] '.
2949: '[_3] Version 4 [_4]',
2950: '<label>'.$authtype,
2951: '</label><input type="text" size="10" name="krbarg" '.
2952: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2953: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2954: '<label><input type="hidden" name="krbver" value="4" />',
2955: '</label>');
2956: } elsif ($can_assign{'krb5'}) {
2957: $result .= &mt
2958: ('[_1] Kerberos authenticated with domain [_2] '.
2959: '[_3] Version 5 [_4]',
2960: '<label>'.$authtype,
2961: '</label><input type="text" size="10" name="krbarg" '.
2962: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2963: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2964: '<label><input type="hidden" name="krbver" value="5" />',
2965: '</label>');
2966: }
1.32 matthew 2967: return $result;
2968: }
2969:
1.1075.2.20 raeburn 2970: sub authform_internal {
1.586 raeburn 2971: my %in = (
1.32 matthew 2972: formname => 'document.cu',
2973: kerb_def_dom => 'MSU.EDU',
2974: @_,
2975: );
1.1075.2.117 raeburn 2976: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2977: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 2978: if ($in{'readonly'}) {
2979: $disabled = ' disabled="disabled"';
2980: }
1.591 raeburn 2981: if (defined($in{'curr_authtype'})) {
2982: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2983: if ($can_assign{'int'}) {
1.772 bisitz 2984: $intcheck = 'checked="checked" ';
1.623 raeburn 2985: if (defined($in{'mode'})) {
2986: if ($in{'mode'} eq 'modifyuser') {
2987: $intcheck = '';
2988: }
2989: }
1.591 raeburn 2990: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2991: $intarg = $in{'curr_autharg'};
2992: }
2993: } else {
2994: $result = &mt('Currently internally authenticated.');
2995: return $result;
1.165 raeburn 2996: }
2997: }
1.586 raeburn 2998: } else {
2999: if ($authnum == 1) {
1.784 bisitz 3000: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3001: }
3002: }
3003: if (!$can_assign{'int'}) {
3004: return;
1.587 raeburn 3005: } elsif ($authtype eq '') {
1.591 raeburn 3006: if (defined($in{'mode'})) {
1.587 raeburn 3007: if ($in{'mode'} eq 'modifycourse') {
3008: if ($authnum == 1) {
1.1075.2.117 raeburn 3009: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3010: }
3011: }
3012: }
1.165 raeburn 3013: }
1.586 raeburn 3014: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3015: if ($authtype eq '') {
3016: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117 raeburn 3017: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3018: }
1.605 bisitz 3019: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117 raeburn 3020: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3021: $result = &mt
1.144 matthew 3022: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3023: '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118 raeburn 3024: $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
1.32 matthew 3025: return $result;
3026: }
3027:
1.1075.2.20 raeburn 3028: sub authform_local {
1.32 matthew 3029: my %in = (
3030: formname => 'document.cu',
3031: kerb_def_dom => 'MSU.EDU',
3032: @_,
3033: );
1.1075.2.117 raeburn 3034: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3035: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3036: if ($in{'readonly'}) {
3037: $disabled = ' disabled="disabled"';
3038: }
1.591 raeburn 3039: if (defined($in{'curr_authtype'})) {
3040: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3041: if ($can_assign{'loc'}) {
1.772 bisitz 3042: $loccheck = 'checked="checked" ';
1.623 raeburn 3043: if (defined($in{'mode'})) {
3044: if ($in{'mode'} eq 'modifyuser') {
3045: $loccheck = '';
3046: }
3047: }
1.591 raeburn 3048: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3049: $locarg = $in{'curr_autharg'};
3050: }
3051: } else {
3052: $result = &mt('Currently using local (institutional) authentication.');
3053: return $result;
1.165 raeburn 3054: }
3055: }
1.586 raeburn 3056: } else {
3057: if ($authnum == 1) {
1.784 bisitz 3058: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3059: }
3060: }
3061: if (!$can_assign{'loc'}) {
3062: return;
1.587 raeburn 3063: } elsif ($authtype eq '') {
1.591 raeburn 3064: if (defined($in{'mode'})) {
1.587 raeburn 3065: if ($in{'mode'} eq 'modifycourse') {
3066: if ($authnum == 1) {
1.1075.2.117 raeburn 3067: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3068: }
3069: }
3070: }
1.165 raeburn 3071: }
1.586 raeburn 3072: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3073: if ($authtype eq '') {
3074: $authtype = '<input type="radio" name="login" value="loc" '.
3075: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3076: $jscall.'"'.$disabled.' />';
1.586 raeburn 3077: }
3078: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117 raeburn 3079: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3080: $result = &mt('[_1] Local Authentication with argument [_2]',
3081: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3082: return $result;
3083: }
3084:
1.1075.2.20 raeburn 3085: sub authform_filesystem {
1.32 matthew 3086: my %in = (
3087: formname => 'document.cu',
3088: kerb_def_dom => 'MSU.EDU',
3089: @_,
3090: );
1.1075.2.117 raeburn 3091: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3092: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3093: if ($in{'readonly'}) {
3094: $disabled = ' disabled="disabled"';
3095: }
1.591 raeburn 3096: if (defined($in{'curr_authtype'})) {
3097: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3098: if ($can_assign{'fsys'}) {
1.772 bisitz 3099: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3100: if (defined($in{'mode'})) {
3101: if ($in{'mode'} eq 'modifyuser') {
3102: $fsyscheck = '';
3103: }
3104: }
1.586 raeburn 3105: } else {
3106: $result = &mt('Currently Filesystem Authenticated.');
3107: return $result;
3108: }
3109: }
3110: } else {
3111: if ($authnum == 1) {
1.784 bisitz 3112: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3113: }
3114: }
3115: if (!$can_assign{'fsys'}) {
3116: return;
1.587 raeburn 3117: } elsif ($authtype eq '') {
1.591 raeburn 3118: if (defined($in{'mode'})) {
1.587 raeburn 3119: if ($in{'mode'} eq 'modifycourse') {
3120: if ($authnum == 1) {
1.1075.2.117 raeburn 3121: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3122: }
3123: }
3124: }
1.586 raeburn 3125: }
3126: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3127: if ($authtype eq '') {
3128: $authtype = '<input type="radio" name="login" value="fsys" '.
3129: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3130: $jscall.'"'.$disabled.' />';
1.586 raeburn 3131: }
1.1075.2.158 raeburn 3132: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1075.2.117 raeburn 3133: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3134: $result = &mt
1.144 matthew 3135: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1075.2.158 raeburn 3136: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3137: return $result;
3138: }
3139:
1.586 raeburn 3140: sub get_assignable_auth {
3141: my ($dom) = @_;
3142: if ($dom eq '') {
3143: $dom = $env{'request.role.domain'};
3144: }
3145: my %can_assign = (
3146: krb4 => 1,
3147: krb5 => 1,
3148: int => 1,
3149: loc => 1,
3150: );
3151: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3152: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3153: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3154: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3155: my $context;
3156: if ($env{'request.role'} =~ /^au/) {
3157: $context = 'author';
1.1075.2.117 raeburn 3158: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3159: $context = 'domain';
3160: } elsif ($env{'request.course.id'}) {
3161: $context = 'course';
3162: }
3163: if ($context) {
3164: if (ref($authhash->{$context}) eq 'HASH') {
3165: %can_assign = %{$authhash->{$context}};
3166: }
3167: }
3168: }
3169: }
3170: my $authnum = 0;
3171: foreach my $key (keys(%can_assign)) {
3172: if ($can_assign{$key}) {
3173: $authnum ++;
3174: }
3175: }
3176: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3177: $authnum --;
3178: }
3179: return ($authnum,%can_assign);
3180: }
3181:
1.1075.2.137 raeburn 3182: sub check_passwd_rules {
3183: my ($domain,$plainpass) = @_;
3184: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3185: my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138 raeburn 3186: $min = $Apache::lonnet::passwdmin;
1.1075.2.137 raeburn 3187: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3188: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138 raeburn 3189: if ($passwdconf{'min'} > $min) {
3190: $min = $passwdconf{'min'};
3191: }
1.1075.2.137 raeburn 3192: }
3193: if ($passwdconf{'max'} =~ /^\d+$/) {
3194: $max = $passwdconf{'max'};
3195: }
3196: @chars = @{$passwdconf{'chars'}};
3197: }
3198: if (($min) && (length($plainpass) < $min)) {
3199: push(@brokerule,'min');
3200: }
3201: if (($max) && (length($plainpass) > $max)) {
3202: push(@brokerule,'max');
3203: }
3204: if (@chars) {
3205: my %rules;
3206: map { $rules{$_} = 1; } @chars;
3207: if ($rules{'uc'}) {
3208: unless ($plainpass =~ /[A-Z]/) {
3209: push(@brokerule,'uc');
3210: }
3211: }
3212: if ($rules{'lc'}) {
3213: unless ($plainpass =~ /[a-z]/) {
3214: push(@brokerule,'lc');
3215: }
3216: }
3217: if ($rules{'num'}) {
3218: unless ($plainpass =~ /\d/) {
3219: push(@brokerule,'num');
3220: }
3221: }
3222: if ($rules{'spec'}) {
3223: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3224: push(@brokerule,'spec');
3225: }
3226: }
3227: }
3228: if (@brokerule) {
3229: my %rulenames = &Apache::lonlocal::texthash(
3230: uc => 'At least one upper case letter',
3231: lc => 'At least one lower case letter',
3232: num => 'At least one number',
3233: spec => 'At least one non-alphanumeric',
3234: );
3235: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3236: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3237: $rulenames{'num'} .= ': 0123456789';
3238: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3239: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3240: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3241: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1075.2.143 raeburn 3242: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1075.2.137 raeburn 3243: if (grep(/^$rule$/,@brokerule)) {
3244: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3245: }
3246: }
3247: $warning .= '</ul>';
3248: }
3249: if (wantarray) {
3250: return @brokerule;
3251: }
3252: return $warning;
3253: }
3254:
1.1075.2.161. .5(raebu 3255:22): sub passwd_validation_js {
3256:22): my ($currpasswdval,$domain,$context,$id) = @_;
3257:22): my (%passwdconf,$alertmsg);
3258:22): if ($context eq 'linkprot') {
3259:22): my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3260:22): if (ref($domconfig{'ltisec'}) eq 'HASH') {
3261:22): if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3262:22): %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3263:22): }
3264:22): }
3265:22): if ($id eq 'add') {
3266:22): $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3267:22): } elsif ($id =~ /^\d+$/) {
3268:22): my $pos = $id+1;
3269:22): $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3270:22): } else {
3271:22): $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3272:22): }
3273:22): } else {
3274:22): %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3275:22): $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3276:22): }
3277:22): my ($min,$max,@chars,$numrules,$intargjs,%alert);
3278:22): $numrules = 0;
3279:22): $min = $Apache::lonnet::passwdmin;
3280:22): if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3281:22): if ($passwdconf{'min'} =~ /^\d+$/) {
3282:22): if ($passwdconf{'min'} > $min) {
3283:22): $min = $passwdconf{'min'};
3284:22): }
3285:22): }
3286:22): if ($passwdconf{'max'} =~ /^\d+$/) {
3287:22): $max = $passwdconf{'max'};
3288:22): $numrules ++;
3289:22): }
3290:22): @chars = @{$passwdconf{'chars'}};
3291:22): if (@chars) {
3292:22): $numrules ++;
3293:22): }
3294:22): }
3295:22): if ($min > 0) {
3296:22): $numrules ++;
3297:22): }
3298:22): if (($min > 0) || ($max ne '') || (@chars > 0)) {
3299:22): if ($min) {
3300:22): $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3301:22): }
3302:22): if ($max) {
3303:22): $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3304:22): }
3305:22): my (@charalerts,@charrules);
3306:22): if (@chars) {
3307:22): if (grep(/^uc$/,@chars)) {
3308:22): push(@charalerts,&mt('contain at least one upper case letter'));
3309:22): push(@charrules,'uc');
3310:22): }
3311:22): if (grep(/^lc$/,@chars)) {
3312:22): push(@charalerts,&mt('contain at least one lower case letter'));
3313:22): push(@charrules,'lc');
3314:22): }
3315:22): if (grep(/^num$/,@chars)) {
3316:22): push(@charalerts,&mt('contain at least one number'));
3317:22): push(@charrules,'num');
3318:22): }
3319:22): if (grep(/^spec$/,@chars)) {
3320:22): push(@charalerts,&mt('contain at least one non-alphanumeric'));
3321:22): push(@charrules,'spec');
3322:22): }
3323:22): }
3324:22): $intargjs = qq| var rulesmsg = '';\n|.
3325:22): qq| var currpwval = $currpasswdval;\n|;
3326:22): if ($min) {
3327:22): $intargjs .= qq|
3328:22): if (currpwval.length < $min) {
3329:22): rulesmsg += ' - $alert{min}';
3330:22): }
3331:22): |;
3332:22): }
3333:22): if ($max) {
3334:22): $intargjs .= qq|
3335:22): if (currpwval.length > $max) {
3336:22): rulesmsg += ' - $alert{max}';
3337:22): }
3338:22): |;
3339:22): }
3340:22): if (@chars > 0) {
3341:22): my $charrulestr = '"'.join('","',@charrules).'"';
3342:22): my $charalertstr = '"'.join('","',@charalerts).'"';
3343:22): $intargjs .= qq| var brokerules = new Array();\n|.
3344:22): qq| var charrules = new Array($charrulestr);\n|.
3345:22): qq| var charalerts = new Array($charalertstr);\n|;
3346:22): my %rules;
3347:22): map { $rules{$_} = 1; } @chars;
3348:22): if ($rules{'uc'}) {
3349:22): $intargjs .= qq|
3350:22): var ucRegExp = /[A-Z]/;
3351:22): if (!ucRegExp.test(currpwval)) {
3352:22): brokerules.push('uc');
3353:22): }
3354:22): |;
3355:22): }
3356:22): if ($rules{'lc'}) {
3357:22): $intargjs .= qq|
3358:22): var lcRegExp = /[a-z]/;
3359:22): if (!lcRegExp.test(currpwval)) {
3360:22): brokerules.push('lc');
3361:22): }
3362:22): |;
3363:22): }
3364:22): if ($rules{'num'}) {
3365:22): $intargjs .= qq|
3366:22): var numRegExp = /[0-9]/;
3367:22): if (!numRegExp.test(currpwval)) {
3368:22): brokerules.push('num');
3369:22): }
3370:22): |;
3371:22): }
3372:22): if ($rules{'spec'}) {
3373:22): $intargjs .= q|
3374:22): var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3375:22): if (!specRegExp.test(currpwval)) {
3376:22): brokerules.push('spec');
3377:22): }
3378:22): |;
3379:22): }
3380:22): $intargjs .= qq|
3381:22): if (brokerules.length > 0) {
3382:22): for (var i=0; i<brokerules.length; i++) {
3383:22): for (var j=0; j<charrules.length; j++) {
3384:22): if (brokerules[i] == charrules[j]) {
3385:22): rulesmsg += ' - '+charalerts[j]+'\\n';
3386:22): break;
3387:22): }
3388:22): }
3389:22): }
3390:22): }
3391:22): |;
3392:22): }
3393:22): $intargjs .= qq|
3394:22): if (rulesmsg != '') {
3395:22): rulesmsg = '$alertmsg'+rulesmsg;
3396:22): alert(rulesmsg);
3397:22): return false;
3398:22): }
3399:22): |;
3400:22): }
3401:22): return ($numrules,$intargjs);
3402:22): }
3403:22):
1.80 albertel 3404: ###############################################################
3405: ## Get Kerberos Defaults for Domain ##
3406: ###############################################################
3407: ##
3408: ## Returns default kerberos version and an associated argument
3409: ## as listed in file domain.tab. If not listed, provides
3410: ## appropriate default domain and kerberos version.
3411: ##
3412: #-------------------------------------------
3413:
3414: =pod
3415:
1.648 raeburn 3416: =item * &get_kerberos_defaults()
1.80 albertel 3417:
3418: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3419: version and domain. If not found, it defaults to version 4 and the
3420: domain of the server.
1.80 albertel 3421:
1.648 raeburn 3422: =over 4
3423:
1.80 albertel 3424: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3425:
1.648 raeburn 3426: =back
3427:
3428: =back
3429:
1.80 albertel 3430: =cut
3431:
3432: #-------------------------------------------
3433: sub get_kerberos_defaults {
3434: my $domain=shift;
1.641 raeburn 3435: my ($krbdef,$krbdefdom);
3436: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3437: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3438: $krbdef = $domdefaults{'auth_def'};
3439: $krbdefdom = $domdefaults{'auth_arg_def'};
3440: } else {
1.80 albertel 3441: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3442: my $krbdefdom=$1;
3443: $krbdefdom=~tr/a-z/A-Z/;
3444: $krbdef = "krb4";
3445: }
3446: return ($krbdef,$krbdefdom);
3447: }
1.112 bowersj2 3448:
1.32 matthew 3449:
1.46 matthew 3450: ###############################################################
3451: ## Thesaurus Functions ##
3452: ###############################################################
1.20 www 3453:
1.46 matthew 3454: =pod
1.20 www 3455:
1.112 bowersj2 3456: =head1 Thesaurus Functions
3457:
3458: =over 4
3459:
1.648 raeburn 3460: =item * &initialize_keywords()
1.46 matthew 3461:
3462: Initializes the package variable %Keywords if it is empty. Uses the
3463: package variable $thesaurus_db_file.
3464:
3465: =cut
3466:
3467: ###################################################
3468:
3469: sub initialize_keywords {
3470: return 1 if (scalar keys(%Keywords));
3471: # If we are here, %Keywords is empty, so fill it up
3472: # Make sure the file we need exists...
3473: if (! -e $thesaurus_db_file) {
3474: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3475: " failed because it does not exist");
3476: return 0;
3477: }
3478: # Set up the hash as a database
3479: my %thesaurus_db;
3480: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3481: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3482: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3483: $thesaurus_db_file);
3484: return 0;
3485: }
3486: # Get the average number of appearances of a word.
3487: my $avecount = $thesaurus_db{'average.count'};
3488: # Put keywords (those that appear > average) into %Keywords
3489: while (my ($word,$data)=each (%thesaurus_db)) {
3490: my ($count,undef) = split /:/,$data;
3491: $Keywords{$word}++ if ($count > $avecount);
3492: }
3493: untie %thesaurus_db;
3494: # Remove special values from %Keywords.
1.356 albertel 3495: foreach my $value ('total.count','average.count') {
3496: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3497: }
1.46 matthew 3498: return 1;
3499: }
3500:
3501: ###################################################
3502:
3503: =pod
3504:
1.648 raeburn 3505: =item * &keyword($word)
1.46 matthew 3506:
3507: Returns true if $word is a keyword. A keyword is a word that appears more
3508: than the average number of times in the thesaurus database. Calls
3509: &initialize_keywords
3510:
3511: =cut
3512:
3513: ###################################################
1.20 www 3514:
3515: sub keyword {
1.46 matthew 3516: return if (!&initialize_keywords());
3517: my $word=lc(shift());
3518: $word=~s/\W//g;
3519: return exists($Keywords{$word});
1.20 www 3520: }
1.46 matthew 3521:
3522: ###############################################################
3523:
3524: =pod
1.20 www 3525:
1.648 raeburn 3526: =item * &get_related_words()
1.46 matthew 3527:
1.160 matthew 3528: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3529: an array of words. If the keyword is not in the thesaurus, an empty array
3530: will be returned. The order of the words returned is determined by the
3531: database which holds them.
3532:
3533: Uses global $thesaurus_db_file.
3534:
1.1057 foxr 3535:
1.46 matthew 3536: =cut
3537:
3538: ###############################################################
3539: sub get_related_words {
3540: my $keyword = shift;
3541: my %thesaurus_db;
3542: if (! -e $thesaurus_db_file) {
3543: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3544: "failed because the file does not exist");
3545: return ();
3546: }
3547: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3548: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3549: return ();
3550: }
3551: my @Words=();
1.429 www 3552: my $count=0;
1.46 matthew 3553: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3554: # The first element is the number of times
3555: # the word appears. We do not need it now.
1.429 www 3556: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3557: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3558: my $threshold=$mostfrequentcount/10;
3559: foreach my $possibleword (@RelatedWords) {
3560: my ($word,$wordcount)=split(/\,/,$possibleword);
3561: if ($wordcount>$threshold) {
3562: push(@Words,$word);
3563: $count++;
3564: if ($count>10) { last; }
3565: }
1.20 www 3566: }
3567: }
1.46 matthew 3568: untie %thesaurus_db;
3569: return @Words;
1.14 harris41 3570: }
1.46 matthew 3571:
1.112 bowersj2 3572: =pod
3573:
3574: =back
3575:
3576: =cut
1.61 www 3577:
3578: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3579: =pod
3580:
1.112 bowersj2 3581: =head1 User Name Functions
3582:
3583: =over 4
3584:
1.648 raeburn 3585: =item * &plainname($uname,$udom,$first)
1.81 albertel 3586:
1.112 bowersj2 3587: Takes a users logon name and returns it as a string in
1.226 albertel 3588: "first middle last generation" form
3589: if $first is set to 'lastname' then it returns it as
3590: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3591:
3592: =cut
1.61 www 3593:
1.295 www 3594:
1.81 albertel 3595: ###############################################################
1.61 www 3596: sub plainname {
1.226 albertel 3597: my ($uname,$udom,$first)=@_;
1.537 albertel 3598: return if (!defined($uname) || !defined($udom));
1.295 www 3599: my %names=&getnames($uname,$udom);
1.226 albertel 3600: my $name=&Apache::lonnet::format_name($names{'firstname'},
3601: $names{'middlename'},
3602: $names{'lastname'},
3603: $names{'generation'},$first);
3604: $name=~s/^\s+//;
1.62 www 3605: $name=~s/\s+$//;
3606: $name=~s/\s+/ /g;
1.353 albertel 3607: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3608: return $name;
1.61 www 3609: }
1.66 www 3610:
3611: # -------------------------------------------------------------------- Nickname
1.81 albertel 3612: =pod
3613:
1.648 raeburn 3614: =item * &nickname($uname,$udom)
1.81 albertel 3615:
3616: Gets a users name and returns it as a string as
3617:
3618: ""nickname""
1.66 www 3619:
1.81 albertel 3620: if the user has a nickname or
3621:
3622: "first middle last generation"
3623:
3624: if the user does not
3625:
3626: =cut
1.66 www 3627:
3628: sub nickname {
3629: my ($uname,$udom)=@_;
1.537 albertel 3630: return if (!defined($uname) || !defined($udom));
1.295 www 3631: my %names=&getnames($uname,$udom);
1.68 albertel 3632: my $name=$names{'nickname'};
1.66 www 3633: if ($name) {
3634: $name='"'.$name.'"';
3635: } else {
3636: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3637: $names{'lastname'}.' '.$names{'generation'};
3638: $name=~s/\s+$//;
3639: $name=~s/\s+/ /g;
3640: }
3641: return $name;
3642: }
3643:
1.295 www 3644: sub getnames {
3645: my ($uname,$udom)=@_;
1.537 albertel 3646: return if (!defined($uname) || !defined($udom));
1.433 albertel 3647: if ($udom eq 'public' && $uname eq 'public') {
3648: return ('lastname' => &mt('Public'));
3649: }
1.295 www 3650: my $id=$uname.':'.$udom;
3651: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3652: if ($cached) {
3653: return %{$names};
3654: } else {
3655: my %loadnames=&Apache::lonnet::get('environment',
3656: ['firstname','middlename','lastname','generation','nickname'],
3657: $udom,$uname);
3658: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3659: return %loadnames;
3660: }
3661: }
1.61 www 3662:
1.542 raeburn 3663: # -------------------------------------------------------------------- getemails
1.648 raeburn 3664:
1.542 raeburn 3665: =pod
3666:
1.648 raeburn 3667: =item * &getemails($uname,$udom)
1.542 raeburn 3668:
3669: Gets a user's email information and returns it as a hash with keys:
3670: notification, critnotification, permanentemail
3671:
3672: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3673: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3674:
1.648 raeburn 3675:
1.542 raeburn 3676: =cut
3677:
1.648 raeburn 3678:
1.466 albertel 3679: sub getemails {
3680: my ($uname,$udom)=@_;
3681: if ($udom eq 'public' && $uname eq 'public') {
3682: return;
3683: }
1.467 www 3684: if (!$udom) { $udom=$env{'user.domain'}; }
3685: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3686: my $id=$uname.':'.$udom;
3687: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3688: if ($cached) {
3689: return %{$names};
3690: } else {
3691: my %loadnames=&Apache::lonnet::get('environment',
3692: ['notification','critnotification',
3693: 'permanentemail'],
3694: $udom,$uname);
3695: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3696: return %loadnames;
3697: }
3698: }
3699:
1.551 albertel 3700: sub flush_email_cache {
3701: my ($uname,$udom)=@_;
3702: if (!$udom) { $udom =$env{'user.domain'}; }
3703: if (!$uname) { $uname=$env{'user.name'}; }
3704: return if ($udom eq 'public' && $uname eq 'public');
3705: my $id=$uname.':'.$udom;
3706: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3707: }
3708:
1.728 raeburn 3709: # -------------------------------------------------------------------- getlangs
3710:
3711: =pod
3712:
3713: =item * &getlangs($uname,$udom)
3714:
3715: Gets a user's language preference and returns it as a hash with key:
3716: language.
3717:
3718: =cut
3719:
3720:
3721: sub getlangs {
3722: my ($uname,$udom) = @_;
3723: if (!$udom) { $udom =$env{'user.domain'}; }
3724: if (!$uname) { $uname=$env{'user.name'}; }
3725: my $id=$uname.':'.$udom;
3726: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3727: if ($cached) {
3728: return %{$langs};
3729: } else {
3730: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3731: $udom,$uname);
3732: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3733: return %loadlangs;
3734: }
3735: }
3736:
3737: sub flush_langs_cache {
3738: my ($uname,$udom)=@_;
3739: if (!$udom) { $udom =$env{'user.domain'}; }
3740: if (!$uname) { $uname=$env{'user.name'}; }
3741: return if ($udom eq 'public' && $uname eq 'public');
3742: my $id=$uname.':'.$udom;
3743: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3744: }
3745:
1.61 www 3746: # ------------------------------------------------------------------ Screenname
1.81 albertel 3747:
3748: =pod
3749:
1.648 raeburn 3750: =item * &screenname($uname,$udom)
1.81 albertel 3751:
3752: Gets a users screenname and returns it as a string
3753:
3754: =cut
1.61 www 3755:
3756: sub screenname {
3757: my ($uname,$udom)=@_;
1.258 albertel 3758: if ($uname eq $env{'user.name'} &&
3759: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3760: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3761: return $names{'screenname'};
1.62 www 3762: }
3763:
1.212 albertel 3764:
1.802 bisitz 3765: # ------------------------------------------------------------- Confirm Wrapper
3766: =pod
3767:
1.1075.2.42 raeburn 3768: =item * &confirmwrapper($message)
1.802 bisitz 3769:
3770: Wrap messages about completion of operation in box
3771:
3772: =cut
3773:
3774: sub confirmwrapper {
3775: my ($message)=@_;
3776: if ($message) {
3777: return "\n".'<div class="LC_confirm_box">'."\n"
3778: .$message."\n"
3779: .'</div>'."\n";
3780: } else {
3781: return $message;
3782: }
3783: }
3784:
1.62 www 3785: # ------------------------------------------------------------- Message Wrapper
3786:
3787: sub messagewrapper {
1.369 www 3788: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3789: return
1.441 albertel 3790: '<a href="/adm/email?compose=individual&'.
3791: 'recname='.$username.'&recdom='.$domain.
3792: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3793: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3794: }
1.802 bisitz 3795:
1.74 www 3796: # --------------------------------------------------------------- Notes Wrapper
3797:
3798: sub noteswrapper {
3799: my ($link,$un,$do)=@_;
3800: return
1.896 amueller 3801: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3802: }
1.802 bisitz 3803:
1.62 www 3804: # ------------------------------------------------------------- Aboutme Wrapper
3805:
3806: sub aboutmewrapper {
1.1070 raeburn 3807: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3808: if (!defined($username) && !defined($domain)) {
3809: return;
3810: }
1.1075.2.15 raeburn 3811: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3812: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3813: }
3814:
3815: # ------------------------------------------------------------ Syllabus Wrapper
3816:
3817: sub syllabuswrapper {
1.707 bisitz 3818: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3819: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3820: }
1.14 harris41 3821:
1.802 bisitz 3822: # -----------------------------------------------------------------------------
3823:
1.208 matthew 3824: sub track_student_link {
1.887 raeburn 3825: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3826: my $link ="/adm/trackstudent?";
1.208 matthew 3827: my $title = 'View recent activity';
3828: if (defined($sname) && $sname !~ /^\s*$/ &&
3829: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3830: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3831: $title .= ' of this student';
1.268 albertel 3832: }
1.208 matthew 3833: if (defined($target) && $target !~ /^\s*$/) {
3834: $target = qq{target="$target"};
3835: } else {
3836: $target = '';
3837: }
1.268 albertel 3838: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3839: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3840: $title = &mt($title);
3841: $linktext = &mt($linktext);
1.448 albertel 3842: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3843: &help_open_topic('View_recent_activity');
1.208 matthew 3844: }
3845:
1.781 raeburn 3846: sub slot_reservations_link {
3847: my ($linktext,$sname,$sdom,$target) = @_;
3848: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3849: my $title = 'View slot reservation history';
3850: if (defined($sname) && $sname !~ /^\s*$/ &&
3851: defined($sdom) && $sdom !~ /^\s*$/) {
3852: $link .= "&uname=$sname&udom=$sdom";
3853: $title .= ' of this student';
3854: }
3855: if (defined($target) && $target !~ /^\s*$/) {
3856: $target = qq{target="$target"};
3857: } else {
3858: $target = '';
3859: }
3860: $title = &mt($title);
3861: $linktext = &mt($linktext);
3862: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3863: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3864:
3865: }
3866:
1.508 www 3867: # ===================================================== Display a student photo
3868:
3869:
1.509 albertel 3870: sub student_image_tag {
1.508 www 3871: my ($domain,$user)=@_;
3872: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3873: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3874: return '<img src="'.$imgsrc.'" align="right" />';
3875: } else {
3876: return '';
3877: }
3878: }
3879:
1.112 bowersj2 3880: =pod
3881:
3882: =back
3883:
3884: =head1 Access .tab File Data
3885:
3886: =over 4
3887:
1.648 raeburn 3888: =item * &languageids()
1.112 bowersj2 3889:
3890: returns list of all language ids
3891:
3892: =cut
3893:
1.14 harris41 3894: sub languageids {
1.16 harris41 3895: return sort(keys(%language));
1.14 harris41 3896: }
3897:
1.112 bowersj2 3898: =pod
3899:
1.648 raeburn 3900: =item * &languagedescription()
1.112 bowersj2 3901:
3902: returns description of a specified language id
3903:
3904: =cut
3905:
1.14 harris41 3906: sub languagedescription {
1.125 www 3907: my $code=shift;
3908: return ($supported_language{$code}?'* ':'').
3909: $language{$code}.
1.126 www 3910: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3911: }
3912:
1.1048 foxr 3913: =pod
3914:
3915: =item * &plainlanguagedescription
3916:
3917: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3918: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3919:
3920: =cut
3921:
1.145 www 3922: sub plainlanguagedescription {
3923: my $code=shift;
3924: return $language{$code};
3925: }
3926:
1.1048 foxr 3927: =pod
3928:
3929: =item * &supportedlanguagecode
3930:
3931: Returns the supported language code (e.g. sptutf maps to pt) given a language
3932: code.
3933:
3934: =cut
3935:
1.145 www 3936: sub supportedlanguagecode {
3937: my $code=shift;
3938: return $supported_language{$code};
1.97 www 3939: }
3940:
1.112 bowersj2 3941: =pod
3942:
1.1048 foxr 3943: =item * &latexlanguage()
3944:
3945: Given a language key code returns the correspondnig language to use
3946: to select the correct hyphenation on LaTeX printouts. This is undef if there
3947: is no supported hyphenation for the language code.
3948:
3949: =cut
3950:
3951: sub latexlanguage {
3952: my $code = shift;
3953: return $latex_language{$code};
3954: }
3955:
3956: =pod
3957:
3958: =item * &latexhyphenation()
3959:
3960: Same as above but what's supplied is the language as it might be stored
3961: in the metadata.
3962:
3963: =cut
3964:
3965: sub latexhyphenation {
3966: my $key = shift;
3967: return $latex_language_bykey{$key};
3968: }
3969:
3970: =pod
3971:
1.648 raeburn 3972: =item * ©rightids()
1.112 bowersj2 3973:
3974: returns list of all copyrights
3975:
3976: =cut
3977:
3978: sub copyrightids {
3979: return sort(keys(%cprtag));
3980: }
3981:
3982: =pod
3983:
1.648 raeburn 3984: =item * ©rightdescription()
1.112 bowersj2 3985:
3986: returns description of a specified copyright id
3987:
3988: =cut
3989:
3990: sub copyrightdescription {
1.166 www 3991: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3992: }
1.197 matthew 3993:
3994: =pod
3995:
1.648 raeburn 3996: =item * &source_copyrightids()
1.192 taceyjo1 3997:
3998: returns list of all source copyrights
3999:
4000: =cut
4001:
4002: sub source_copyrightids {
4003: return sort(keys(%scprtag));
4004: }
4005:
4006: =pod
4007:
1.648 raeburn 4008: =item * &source_copyrightdescription()
1.192 taceyjo1 4009:
4010: returns description of a specified source copyright id
4011:
4012: =cut
4013:
4014: sub source_copyrightdescription {
4015: return &mt($scprtag{shift(@_)});
4016: }
1.112 bowersj2 4017:
4018: =pod
4019:
1.648 raeburn 4020: =item * &filecategories()
1.112 bowersj2 4021:
4022: returns list of all file categories
4023:
4024: =cut
4025:
4026: sub filecategories {
4027: return sort(keys(%category_extensions));
4028: }
4029:
4030: =pod
4031:
1.648 raeburn 4032: =item * &filecategorytypes()
1.112 bowersj2 4033:
4034: returns list of file types belonging to a given file
4035: category
4036:
4037: =cut
4038:
4039: sub filecategorytypes {
1.356 albertel 4040: my ($cat) = @_;
4041: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 4042: }
4043:
4044: =pod
4045:
1.648 raeburn 4046: =item * &fileembstyle()
1.112 bowersj2 4047:
4048: returns embedding style for a specified file type
4049:
4050: =cut
4051:
4052: sub fileembstyle {
4053: return $fe{lc(shift(@_))};
1.169 www 4054: }
4055:
1.351 www 4056: sub filemimetype {
4057: return $fm{lc(shift(@_))};
4058: }
4059:
1.169 www 4060:
4061: sub filecategoryselect {
4062: my ($name,$value)=@_;
1.189 matthew 4063: return &select_form($value,$name,
1.970 raeburn 4064: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4065: }
4066:
4067: =pod
4068:
1.648 raeburn 4069: =item * &filedescription()
1.112 bowersj2 4070:
4071: returns description for a specified file type
4072:
4073: =cut
4074:
4075: sub filedescription {
1.188 matthew 4076: my $file_description = $fd{lc(shift())};
4077: $file_description =~ s:([\[\]]):~$1:g;
4078: return &mt($file_description);
1.112 bowersj2 4079: }
4080:
4081: =pod
4082:
1.648 raeburn 4083: =item * &filedescriptionex()
1.112 bowersj2 4084:
4085: returns description for a specified file type with
4086: extra formatting
4087:
4088: =cut
4089:
4090: sub filedescriptionex {
4091: my $ex=shift;
1.188 matthew 4092: my $file_description = $fd{lc($ex)};
4093: $file_description =~ s:([\[\]]):~$1:g;
4094: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4095: }
4096:
4097: # End of .tab access
4098: =pod
4099:
4100: =back
4101:
4102: =cut
4103:
4104: # ------------------------------------------------------------------ File Types
4105: sub fileextensions {
4106: return sort(keys(%fe));
4107: }
4108:
1.97 www 4109: # ----------------------------------------------------------- Display Languages
4110: # returns a hash with all desired display languages
4111: #
4112:
4113: sub display_languages {
4114: my %languages=();
1.695 raeburn 4115: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4116: $languages{$lang}=1;
1.97 www 4117: }
4118: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4119: if ($env{'form.displaylanguage'}) {
1.356 albertel 4120: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4121: $languages{$lang}=1;
1.97 www 4122: }
4123: }
4124: return %languages;
1.14 harris41 4125: }
4126:
1.582 albertel 4127: sub languages {
4128: my ($possible_langs) = @_;
1.695 raeburn 4129: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4130: if (!ref($possible_langs)) {
4131: if( wantarray ) {
4132: return @preferred_langs;
4133: } else {
4134: return $preferred_langs[0];
4135: }
4136: }
4137: my %possibilities = map { $_ => 1 } (@$possible_langs);
4138: my @preferred_possibilities;
4139: foreach my $preferred_lang (@preferred_langs) {
4140: if (exists($possibilities{$preferred_lang})) {
4141: push(@preferred_possibilities, $preferred_lang);
4142: }
4143: }
4144: if( wantarray ) {
4145: return @preferred_possibilities;
4146: }
4147: return $preferred_possibilities[0];
4148: }
4149:
1.742 raeburn 4150: sub user_lang {
4151: my ($touname,$toudom,$fromcid) = @_;
4152: my @userlangs;
4153: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4154: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4155: $env{'course.'.$fromcid.'.languages'}));
4156: } else {
4157: my %langhash = &getlangs($touname,$toudom);
4158: if ($langhash{'languages'} ne '') {
4159: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4160: } else {
4161: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4162: if ($domdefs{'lang_def'} ne '') {
4163: @userlangs = ($domdefs{'lang_def'});
4164: }
4165: }
4166: }
4167: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4168: my $user_lh = Apache::localize->get_handle(@languages);
4169: return $user_lh;
4170: }
4171:
4172:
1.112 bowersj2 4173: ###############################################################
4174: ## Student Answer Attempts ##
4175: ###############################################################
4176:
4177: =pod
4178:
4179: =head1 Alternate Problem Views
4180:
4181: =over 4
4182:
1.648 raeburn 4183: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 4184: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4185:
4186: Return string with previous attempt on problem. Arguments:
4187:
4188: =over 4
4189:
4190: =item * $symb: Problem, including path
4191:
4192: =item * $username: username of the desired student
4193:
4194: =item * $domain: domain of the desired student
1.14 harris41 4195:
1.112 bowersj2 4196: =item * $course: Course ID
1.14 harris41 4197:
1.112 bowersj2 4198: =item * $getattempt: Leave blank for all attempts, otherwise put
4199: something
1.14 harris41 4200:
1.112 bowersj2 4201: =item * $regexp: if string matches this regexp, the string will be
4202: sent to $gradesub
1.14 harris41 4203:
1.112 bowersj2 4204: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4205:
1.1075.2.86 raeburn 4206: =item * $usec: section of the desired student
4207:
4208: =item * $identifier: counter for student (multiple students one problem) or
4209: problem (one student; whole sequence).
4210:
1.112 bowersj2 4211: =back
1.14 harris41 4212:
1.112 bowersj2 4213: The output string is a table containing all desired attempts, if any.
1.16 harris41 4214:
1.112 bowersj2 4215: =cut
1.1 albertel 4216:
4217: sub get_previous_attempt {
1.1075.2.86 raeburn 4218: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4219: my $prevattempts='';
1.43 ng 4220: no strict 'refs';
1.1 albertel 4221: if ($symb) {
1.3 albertel 4222: my (%returnhash)=
4223: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4224: if ($returnhash{'version'}) {
4225: my %lasthash=();
4226: my $version;
4227: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 4228: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4229: if ($key =~ /\.rawrndseed$/) {
4230: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4231: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4232: } else {
4233: $lasthash{$key}=$returnhash{$version.':'.$key};
4234: }
1.19 harris41 4235: }
1.1 albertel 4236: }
1.596 albertel 4237: $prevattempts=&start_data_table().&start_data_table_header_row();
4238: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 4239: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4240: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4241: foreach my $key (sort(keys(%lasthash))) {
4242: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4243: if ($#parts > 0) {
1.31 albertel 4244: my $data=$parts[-1];
1.989 raeburn 4245: next if ($data eq 'foilorder');
1.31 albertel 4246: pop(@parts);
1.1010 www 4247: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4248: if ($data eq 'type') {
4249: unless ($showsurv) {
4250: my $id = join(',',@parts);
4251: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4252: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4253: $lasthidden{$ign.'.'.$id} = 1;
4254: }
1.945 raeburn 4255: }
1.1075.2.86 raeburn 4256: if ($identifier ne '') {
4257: my $id = join(',',@parts);
4258: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4259: $domain,$username,$usec,undef,$course) =~ /^no/) {
4260: $hidestatus{$ign.'.'.$id} = 1;
4261: }
4262: }
4263: } elsif ($data eq 'regrader') {
4264: if (($identifier ne '') && (@parts)) {
4265: my $id = join(',',@parts);
4266: $regraded{$ign.'.'.$id} = 1;
4267: }
1.1010 www 4268: }
1.31 albertel 4269: } else {
1.41 ng 4270: if ($#parts == 0) {
4271: $prevattempts.='<th>'.$parts[0].'</th>';
4272: } else {
4273: $prevattempts.='<th>'.$ign.'</th>';
4274: }
1.31 albertel 4275: }
1.16 harris41 4276: }
1.596 albertel 4277: $prevattempts.=&end_data_table_header_row();
1.40 ng 4278: if ($getattempt eq '') {
1.1075.2.86 raeburn 4279: my (%solved,%resets,%probstatus);
4280: if (($identifier ne '') && (keys(%regraded) > 0)) {
4281: for ($version=1;$version<=$returnhash{'version'};$version++) {
4282: foreach my $id (keys(%regraded)) {
4283: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4284: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4285: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4286: push(@{$resets{$id}},$version);
4287: }
4288: }
4289: }
4290: }
1.40 ng 4291: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 4292: my (@hidden,@unsolved);
1.945 raeburn 4293: if (%typeparts) {
4294: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 4295: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4296: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4297: push(@hidden,$id);
1.1075.2.86 raeburn 4298: } elsif ($identifier ne '') {
4299: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4300: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4301: ($hidestatus{$id})) {
4302: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
4303: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4304: push(@{$solved{$id}},$version);
4305: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4306: (ref($solved{$id}) eq 'ARRAY')) {
4307: my $skip;
4308: if (ref($resets{$id}) eq 'ARRAY') {
4309: foreach my $reset (@{$resets{$id}}) {
4310: if ($reset > $solved{$id}[-1]) {
4311: $skip=1;
4312: last;
4313: }
4314: }
4315: }
4316: unless ($skip) {
4317: my ($ign,$partslist) = split(/\./,$id,2);
4318: push(@unsolved,$partslist);
4319: }
4320: }
4321: }
1.945 raeburn 4322: }
4323: }
4324: }
4325: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 4326: '<td>'.&mt('Transaction [_1]',$version);
4327: if (@unsolved) {
4328: $prevattempts .= '<span class="LC_nobreak"><label>'.
4329: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4330: &mt('Hide').'</label></span>';
4331: }
4332: $prevattempts .= '</td>';
1.945 raeburn 4333: if (@hidden) {
4334: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4335: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4336: my $hide;
4337: foreach my $id (@hidden) {
4338: if ($key =~ /^\Q$id\E/) {
4339: $hide = 1;
4340: last;
4341: }
4342: }
4343: if ($hide) {
4344: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4345: if (($data eq 'award') || ($data eq 'awarddetail')) {
4346: my $value = &format_previous_attempt_value($key,
4347: $returnhash{$version.':'.$key});
4348: $prevattempts.='<td>'.$value.' </td>';
4349: } else {
4350: $prevattempts.='<td> </td>';
4351: }
4352: } else {
4353: if ($key =~ /\./) {
1.1075.2.91 raeburn 4354: my $value = $returnhash{$version.':'.$key};
4355: if ($key =~ /\.rndseed$/) {
4356: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4357: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4358: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4359: }
4360: }
4361: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4362: ' </td>';
1.945 raeburn 4363: } else {
4364: $prevattempts.='<td> </td>';
4365: }
4366: }
4367: }
4368: } else {
4369: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4370: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 4371: my $value = $returnhash{$version.':'.$key};
4372: if ($key =~ /\.rndseed$/) {
4373: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4374: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4375: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4376: }
4377: }
4378: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4379: ' </td>';
1.945 raeburn 4380: }
4381: }
4382: $prevattempts.=&end_data_table_row();
1.40 ng 4383: }
1.1 albertel 4384: }
1.945 raeburn 4385: my @currhidden = keys(%lasthidden);
1.596 albertel 4386: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4387: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4388: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4389: if (%typeparts) {
4390: my $hidden;
4391: foreach my $id (@currhidden) {
4392: if ($key =~ /^\Q$id\E/) {
4393: $hidden = 1;
4394: last;
4395: }
4396: }
4397: if ($hidden) {
4398: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4399: if (($data eq 'award') || ($data eq 'awarddetail')) {
4400: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4401: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4402: $value = &$gradesub($value);
4403: }
4404: $prevattempts.='<td>'.$value.' </td>';
4405: } else {
4406: $prevattempts.='<td> </td>';
4407: }
4408: } else {
4409: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4410: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4411: $value = &$gradesub($value);
4412: }
4413: $prevattempts.='<td>'.$value.' </td>';
4414: }
4415: } else {
4416: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4417: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4418: $value = &$gradesub($value);
4419: }
4420: $prevattempts.='<td>'.$value.' </td>';
4421: }
1.16 harris41 4422: }
1.596 albertel 4423: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4424: } else {
1.596 albertel 4425: $prevattempts=
4426: &start_data_table().&start_data_table_row().
4427: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4428: &end_data_table_row().&end_data_table();
1.1 albertel 4429: }
4430: } else {
1.596 albertel 4431: $prevattempts=
4432: &start_data_table().&start_data_table_row().
4433: '<td>'.&mt('No data.').'</td>'.
4434: &end_data_table_row().&end_data_table();
1.1 albertel 4435: }
1.10 albertel 4436: }
4437:
1.581 albertel 4438: sub format_previous_attempt_value {
4439: my ($key,$value) = @_;
1.1011 www 4440: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 4441: $value = &Apache::lonlocal::locallocaltime($value);
4442: } elsif (ref($value) eq 'ARRAY') {
4443: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 4444: } elsif ($key =~ /answerstring$/) {
4445: my %answers = &Apache::lonnet::str2hash($value);
4446: my @anskeys = sort(keys(%answers));
4447: if (@anskeys == 1) {
4448: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4449: if ($answer =~ m{\0}) {
4450: $answer =~ s{\0}{,}g;
1.988 raeburn 4451: }
4452: my $tag_internal_answer_name = 'INTERNAL';
4453: if ($anskeys[0] eq $tag_internal_answer_name) {
4454: $value = $answer;
4455: } else {
4456: $value = $anskeys[0].'='.$answer;
4457: }
4458: } else {
4459: foreach my $ans (@anskeys) {
4460: my $answer = $answers{$ans};
1.1001 raeburn 4461: if ($answer =~ m{\0}) {
4462: $answer =~ s{\0}{,}g;
1.988 raeburn 4463: }
4464: $value .= $ans.'='.$answer.'<br />';;
4465: }
4466: }
1.581 albertel 4467: } else {
4468: $value = &unescape($value);
4469: }
4470: return $value;
4471: }
4472:
4473:
1.107 albertel 4474: sub relative_to_absolute {
4475: my ($url,$output)=@_;
4476: my $parser=HTML::TokeParser->new(\$output);
4477: my $token;
4478: my $thisdir=$url;
4479: my @rlinks=();
4480: while ($token=$parser->get_token) {
4481: if ($token->[0] eq 'S') {
4482: if ($token->[1] eq 'a') {
4483: if ($token->[2]->{'href'}) {
4484: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4485: }
4486: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4487: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4488: } elsif ($token->[1] eq 'base') {
4489: $thisdir=$token->[2]->{'href'};
4490: }
4491: }
4492: }
4493: $thisdir=~s-/[^/]*$--;
1.356 albertel 4494: foreach my $link (@rlinks) {
1.726 raeburn 4495: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4496: ($link=~/^\//) ||
4497: ($link=~/^javascript:/i) ||
4498: ($link=~/^mailto:/i) ||
4499: ($link=~/^\#/)) {
4500: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4501: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4502: }
4503: }
4504: # -------------------------------------------------- Deal with Applet codebases
4505: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4506: return $output;
4507: }
4508:
1.112 bowersj2 4509: =pod
4510:
1.648 raeburn 4511: =item * &get_student_view()
1.112 bowersj2 4512:
4513: show a snapshot of what student was looking at
4514:
4515: =cut
4516:
1.10 albertel 4517: sub get_student_view {
1.186 albertel 4518: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4519: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4520: my (%form);
1.10 albertel 4521: my @elements=('symb','courseid','domain','username');
4522: foreach my $element (@elements) {
1.186 albertel 4523: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4524: }
1.186 albertel 4525: if (defined($moreenv)) {
4526: %form=(%form,%{$moreenv});
4527: }
1.236 albertel 4528: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4529: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4530: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4531: $userview=~s/\<body[^\>]*\>//gi;
4532: $userview=~s/\<\/body\>//gi;
4533: $userview=~s/\<html\>//gi;
4534: $userview=~s/\<\/html\>//gi;
4535: $userview=~s/\<head\>//gi;
4536: $userview=~s/\<\/head\>//gi;
4537: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4538: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4539: if (wantarray) {
4540: return ($userview,$response);
4541: } else {
4542: return $userview;
4543: }
4544: }
4545:
4546: sub get_student_view_with_retries {
4547: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4548:
4549: my $ok = 0; # True if we got a good response.
4550: my $content;
4551: my $response;
4552:
4553: # Try to get the student_view done. within the retries count:
4554:
4555: do {
4556: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4557: $ok = $response->is_success;
4558: if (!$ok) {
4559: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4560: }
4561: $retries--;
4562: } while (!$ok && ($retries > 0));
4563:
4564: if (!$ok) {
4565: $content = ''; # On error return an empty content.
4566: }
1.651 www 4567: if (wantarray) {
4568: return ($content, $response);
4569: } else {
4570: return $content;
4571: }
1.11 albertel 4572: }
4573:
1.1075.2.149 raeburn 4574: sub css_links {
4575: my ($currsymb,$level) = @_;
4576: my ($links,@symbs,%cssrefs,%httpref);
4577: if ($level eq 'map') {
4578: my $navmap = Apache::lonnavmaps::navmap->new();
4579: if (ref($navmap)) {
4580: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
4581: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
4582: foreach my $res (@resources) {
4583: if (ref($res) && $res->symb()) {
4584: push(@symbs,$res->symb());
4585: }
4586: }
4587: }
4588: } else {
4589: @symbs = ($currsymb);
4590: }
4591: foreach my $symb (@symbs) {
4592: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
4593: if ($css_href =~ /\S/) {
4594: unless ($css_href =~ m{https?://}) {
4595: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
4596: my $proburl = &Apache::lonnet::clutter($url);
4597: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
4598: unless ($css_href =~ m{^/}) {
4599: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
4600: }
4601: if ($css_href =~ m{^/(res|uploaded)/}) {
4602: unless (($httpref{'httpref.'.$css_href}) ||
4603: (&Apache::lonnet::is_on_map($css_href))) {
4604: my $thisurl = $proburl;
4605: if ($env{'httpref.'.$proburl}) {
4606: $thisurl = $env{'httpref.'.$proburl};
4607: }
4608: $httpref{'httpref.'.$css_href} = $thisurl;
4609: }
4610: }
4611: }
4612: $cssrefs{$css_href} = 1;
4613: }
4614: }
4615: if (keys(%httpref)) {
4616: &Apache::lonnet::appenv(\%httpref);
4617: }
4618: if (keys(%cssrefs)) {
4619: foreach my $css_href (keys(%cssrefs)) {
4620: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
4621: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
4622: }
4623: }
4624: return $links;
4625: }
4626:
1.112 bowersj2 4627: =pod
4628:
1.648 raeburn 4629: =item * &get_student_answers()
1.112 bowersj2 4630:
4631: show a snapshot of how student was answering problem
4632:
4633: =cut
4634:
1.11 albertel 4635: sub get_student_answers {
1.100 sakharuk 4636: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4637: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4638: my (%moreenv);
1.11 albertel 4639: my @elements=('symb','courseid','domain','username');
4640: foreach my $element (@elements) {
1.186 albertel 4641: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4642: }
1.186 albertel 4643: $moreenv{'grade_target'}='answer';
4644: %moreenv=(%form,%moreenv);
1.497 raeburn 4645: $feedurl = &Apache::lonnet::clutter($feedurl);
4646: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4647: return $userview;
1.1 albertel 4648: }
1.116 albertel 4649:
4650: =pod
4651:
4652: =item * &submlink()
4653:
1.242 albertel 4654: Inputs: $text $uname $udom $symb $target
1.116 albertel 4655:
4656: Returns: A link to grades.pm such as to see the SUBM view of a student
4657:
4658: =cut
4659:
4660: ###############################################
4661: sub submlink {
1.242 albertel 4662: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4663: if (!($uname && $udom)) {
4664: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4665: &Apache::lonnet::whichuser($symb);
1.116 albertel 4666: if (!$symb) { $symb=$cursymb; }
4667: }
1.254 matthew 4668: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4669: $symb=&escape($symb);
1.960 bisitz 4670: if ($target) { $target=" target=\"$target\""; }
4671: return
4672: '<a href="/adm/grades?command=submission'.
4673: '&symb='.$symb.
4674: '&student='.$uname.
4675: '&userdom='.$udom.'"'.
4676: $target.'>'.$text.'</a>';
1.242 albertel 4677: }
4678: ##############################################
4679:
4680: =pod
4681:
4682: =item * &pgrdlink()
4683:
4684: Inputs: $text $uname $udom $symb $target
4685:
4686: Returns: A link to grades.pm such as to see the PGRD view of a student
4687:
4688: =cut
4689:
4690: ###############################################
4691: sub pgrdlink {
4692: my $link=&submlink(@_);
4693: $link=~s/(&command=submission)/$1&showgrading=yes/;
4694: return $link;
4695: }
4696: ##############################################
4697:
4698: =pod
4699:
4700: =item * &pprmlink()
4701:
4702: Inputs: $text $uname $udom $symb $target
4703:
4704: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4705: student and a specific resource
1.242 albertel 4706:
4707: =cut
4708:
4709: ###############################################
4710: sub pprmlink {
4711: my ($text,$uname,$udom,$symb,$target)=@_;
4712: if (!($uname && $udom)) {
4713: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4714: &Apache::lonnet::whichuser($symb);
1.242 albertel 4715: if (!$symb) { $symb=$cursymb; }
4716: }
1.254 matthew 4717: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4718: $symb=&escape($symb);
1.242 albertel 4719: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4720: return '<a href="/adm/parmset?command=set&'.
4721: 'symb='.$symb.'&uname='.$uname.
4722: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4723: }
4724: ##############################################
1.37 matthew 4725:
1.112 bowersj2 4726: =pod
4727:
4728: =back
4729:
4730: =cut
4731:
1.37 matthew 4732: ###############################################
1.51 www 4733:
4734:
4735: sub timehash {
1.687 raeburn 4736: my ($thistime) = @_;
4737: my $timezone = &Apache::lonlocal::gettimezone();
4738: my $dt = DateTime->from_epoch(epoch => $thistime)
4739: ->set_time_zone($timezone);
4740: my $wday = $dt->day_of_week();
4741: if ($wday == 7) { $wday = 0; }
4742: return ( 'second' => $dt->second(),
4743: 'minute' => $dt->minute(),
4744: 'hour' => $dt->hour(),
4745: 'day' => $dt->day_of_month(),
4746: 'month' => $dt->month(),
4747: 'year' => $dt->year(),
4748: 'weekday' => $wday,
4749: 'dayyear' => $dt->day_of_year(),
4750: 'dlsav' => $dt->is_dst() );
1.51 www 4751: }
4752:
1.370 www 4753: sub utc_string {
4754: my ($date)=@_;
1.371 www 4755: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4756: }
4757:
1.51 www 4758: sub maketime {
4759: my %th=@_;
1.687 raeburn 4760: my ($epoch_time,$timezone,$dt);
4761: $timezone = &Apache::lonlocal::gettimezone();
4762: eval {
4763: $dt = DateTime->new( year => $th{'year'},
4764: month => $th{'month'},
4765: day => $th{'day'},
4766: hour => $th{'hour'},
4767: minute => $th{'minute'},
4768: second => $th{'second'},
4769: time_zone => $timezone,
4770: );
4771: };
4772: if (!$@) {
4773: $epoch_time = $dt->epoch;
4774: if ($epoch_time) {
4775: return $epoch_time;
4776: }
4777: }
1.51 www 4778: return POSIX::mktime(
4779: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4780: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4781: }
4782:
4783: #########################################
1.51 www 4784:
4785: sub findallcourses {
1.482 raeburn 4786: my ($roles,$uname,$udom) = @_;
1.355 albertel 4787: my %roles;
4788: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4789: my %courses;
1.51 www 4790: my $now=time;
1.482 raeburn 4791: if (!defined($uname)) {
4792: $uname = $env{'user.name'};
4793: }
4794: if (!defined($udom)) {
4795: $udom = $env{'user.domain'};
4796: }
4797: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4798: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4799: if (!%roles) {
4800: %roles = (
4801: cc => 1,
1.907 raeburn 4802: co => 1,
1.482 raeburn 4803: in => 1,
4804: ep => 1,
4805: ta => 1,
4806: cr => 1,
4807: st => 1,
4808: );
4809: }
4810: foreach my $entry (keys(%roleshash)) {
4811: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4812: if ($trole =~ /^cr/) {
4813: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4814: } else {
4815: next if (!exists($roles{$trole}));
4816: }
4817: if ($tend) {
4818: next if ($tend < $now);
4819: }
4820: if ($tstart) {
4821: next if ($tstart > $now);
4822: }
1.1058 raeburn 4823: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4824: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4825: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4826: if ($secpart eq '') {
4827: ($cnum,$role) = split(/_/,$cnumpart);
4828: $sec = 'none';
1.1058 raeburn 4829: $value .= $cnum.'/';
1.482 raeburn 4830: } else {
4831: $cnum = $cnumpart;
4832: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4833: $value .= $cnum.'/'.$sec;
4834: }
4835: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4836: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4837: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4838: }
4839: } else {
4840: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4841: }
1.482 raeburn 4842: }
4843: } else {
4844: foreach my $key (keys(%env)) {
1.483 albertel 4845: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4846: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4847: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4848: next if ($role eq 'ca' || $role eq 'aa');
4849: next if (%roles && !exists($roles{$role}));
4850: my ($starttime,$endtime)=split(/\./,$env{$key});
4851: my $active=1;
4852: if ($starttime) {
4853: if ($now<$starttime) { $active=0; }
4854: }
4855: if ($endtime) {
4856: if ($now>$endtime) { $active=0; }
4857: }
4858: if ($active) {
1.1058 raeburn 4859: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4860: if ($sec eq '') {
4861: $sec = 'none';
1.1058 raeburn 4862: } else {
4863: $value .= $sec;
4864: }
4865: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4866: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4867: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4868: }
4869: } else {
4870: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4871: }
1.474 raeburn 4872: }
4873: }
1.51 www 4874: }
4875: }
1.474 raeburn 4876: return %courses;
1.51 www 4877: }
1.37 matthew 4878:
1.54 www 4879: ###############################################
1.474 raeburn 4880:
4881: sub blockcheck {
1.1075.2.158 raeburn 4882: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.490 raeburn 4883:
1.1075.2.161. .4(raebu 4884:22): unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
1.1075.2.158 raeburn 4885: my ($has_evb,$check_ipaccess);
4886: my $dom = $env{'user.domain'};
4887: if ($env{'request.course.id'}) {
4888: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
4889: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
4890: my $checkrole = "cm./$cdom/$cnum";
4891: my $sec = $env{'request.course.sec'};
4892: if ($sec ne '') {
4893: $checkrole .= "/$sec";
4894: }
4895: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
4896: ($env{'request.role'} !~ /^st/)) {
4897: $has_evb = 1;
4898: }
4899: unless ($has_evb) {
4900: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
4901: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
4902: if ($udom eq $cdom) {
4903: $check_ipaccess = 1;
4904: }
4905: }
4906: }
1.1075.2.161. .3(raebu 4907:22): } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
4908:22): ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
4909:22): my $checkrole;
4910:22): if ($env{'request.role.domain'} eq '') {
4911:22): $checkrole = "cm./$env{'user.domain'}/";
4912:22): } else {
4913:22): $checkrole = "cm./$env{'request.role.domain'}/";
4914:22): }
4915:22): if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
4916:22): $has_evb = 1;
4917:22): }
1.1075.2.158 raeburn 4918: }
4919: unless ($has_evb || $check_ipaccess) {
4920: my @machinedoms = &Apache::lonnet::current_machine_domains();
4921: if (($dom eq 'public') && ($activity eq 'port')) {
4922: $dom = $udom;
4923: }
4924: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
4925: $check_ipaccess = 1;
4926: } else {
4927: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
4928: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
4929: my $prim = &Apache::lonnet::domain($dom,'primary');
4930: my $intdom = &Apache::lonnet::internet_dom($prim);
4931: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
4932: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
4933: $check_ipaccess = 1;
4934: }
4935: }
4936: }
4937: }
4938: if ($check_ipaccess) {
4939: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
4940: unless (defined($cached)) {
4941: my %domconfig =
4942: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
4943: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
4944: }
4945: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
4946: foreach my $id (keys(%{$ipaccessref})) {
4947: if (ref($ipaccessref->{$id}) eq 'HASH') {
4948: my $range = $ipaccessref->{$id}->{'ip'};
4949: if ($range) {
4950: if (&Apache::lonnet::ip_match($clientip,$range)) {
4951: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
4952: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
4953: return ('','','',$id,$dom);
4954: last;
4955: }
4956: }
4957: }
4958: }
4959: }
4960: }
4961: }
4962: }
1.1075.2.161. .4(raebu 4963:22): if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
4964:22): return ();
4965:22): }
1.1075.2.158 raeburn 4966: }
1.1075.2.73 raeburn 4967: if (defined($udom) && defined($uname)) {
4968: # If uname and udom are for a course, check for blocks in the course.
4969: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4970: my ($startblock,$endblock,$triggerblock) =
1.1075.2.147 raeburn 4971: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1075.2.73 raeburn 4972: return ($startblock,$endblock,$triggerblock);
4973: }
4974: } else {
1.490 raeburn 4975: $udom = $env{'user.domain'};
4976: $uname = $env{'user.name'};
4977: }
4978:
1.502 raeburn 4979: my $startblock = 0;
4980: my $endblock = 0;
1.1062 raeburn 4981: my $triggerblock = '';
1.1075.2.160 raeburn 4982: my %live_courses;
4983: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
4984: %live_courses = &findallcourses(undef,$uname,$udom);
4985: }
1.474 raeburn 4986:
1.490 raeburn 4987: # If uname is for a user, and activity is course-specific, i.e.,
4988: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4989:
1.490 raeburn 4990: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.161. .1(raebu 4991:21): $activity eq 'groups' || $activity eq 'printout' ||
4992:21): $activity eq 'search' || $activity eq 'reinit' ||
4993:21): $activity eq 'alert') && ($env{'request.course.id'})) {
1.490 raeburn 4994: foreach my $key (keys(%live_courses)) {
4995: if ($key ne $env{'request.course.id'}) {
4996: delete($live_courses{$key});
4997: }
4998: }
4999: }
5000:
5001: my $otheruser = 0;
5002: my %own_courses;
5003: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5004: # Resource belongs to user other than current user.
5005: $otheruser = 1;
5006: # Gather courses for current user
5007: %own_courses =
5008: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5009: }
5010:
5011: # Gather active course roles - course coordinator, instructor,
5012: # exam proctor, ta, student, or custom role.
1.474 raeburn 5013:
5014: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5015: my ($cdom,$cnum);
5016: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5017: $cdom = $env{'course.'.$course.'.domain'};
5018: $cnum = $env{'course.'.$course.'.num'};
5019: } else {
1.490 raeburn 5020: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5021: }
5022: my $no_ownblock = 0;
5023: my $no_userblock = 0;
1.533 raeburn 5024: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5025: # Check if current user has 'evb' priv for this
5026: if (defined($own_courses{$course})) {
5027: foreach my $sec (keys(%{$own_courses{$course}})) {
5028: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5029: if ($sec ne 'none') {
5030: $checkrole .= '/'.$sec;
5031: }
5032: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5033: $no_ownblock = 1;
5034: last;
5035: }
5036: }
5037: }
5038: # if they have 'evb' priv and are currently not playing student
5039: next if (($no_ownblock) &&
5040: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5041: }
1.474 raeburn 5042: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5043: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5044: if ($sec ne 'none') {
1.482 raeburn 5045: $checkrole .= '/'.$sec;
1.474 raeburn 5046: }
1.490 raeburn 5047: if ($otheruser) {
5048: # Resource belongs to user other than current user.
5049: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5050: my (%allroles,%userroles);
5051: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5052: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5053: my ($trole,$tdom,$tnum,$tsec);
5054: if ($entry =~ /^cr/) {
5055: ($trole,$tdom,$tnum,$tsec) =
5056: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5057: } else {
5058: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5059: }
5060: my ($spec,$area,$trest);
5061: $area = '/'.$tdom.'/'.$tnum;
5062: $trest = $tnum;
5063: if ($tsec ne '') {
5064: $area .= '/'.$tsec;
5065: $trest .= '/'.$tsec;
5066: }
5067: $spec = $trole.'.'.$area;
5068: if ($trole =~ /^cr/) {
5069: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5070: $tdom,$spec,$trest,$area);
5071: } else {
5072: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5073: $tdom,$spec,$trest,$area);
5074: }
5075: }
1.1075.2.124 raeburn 5076: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5077: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5078: if ($1) {
5079: $no_userblock = 1;
5080: last;
5081: }
1.486 raeburn 5082: }
5083: }
1.490 raeburn 5084: } else {
5085: # Resource belongs to current user
5086: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5087: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5088: $no_ownblock = 1;
5089: last;
5090: }
1.474 raeburn 5091: }
5092: }
5093: # if they have the evb priv and are currently not playing student
1.482 raeburn 5094: next if (($no_ownblock) &&
1.491 albertel 5095: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5096: next if ($no_userblock);
1.474 raeburn 5097:
1.1075.2.128 raeburn 5098: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5099: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 5100:
1.1062 raeburn 5101: my ($start,$end,$trigger) =
1.1075.2.147 raeburn 5102: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5103: if (($start != 0) &&
5104: (($startblock == 0) || ($startblock > $start))) {
5105: $startblock = $start;
1.1062 raeburn 5106: if ($trigger ne '') {
5107: $triggerblock = $trigger;
5108: }
1.502 raeburn 5109: }
5110: if (($end != 0) &&
5111: (($endblock == 0) || ($endblock < $end))) {
5112: $endblock = $end;
1.1062 raeburn 5113: if ($trigger ne '') {
5114: $triggerblock = $trigger;
5115: }
1.502 raeburn 5116: }
1.490 raeburn 5117: }
1.1062 raeburn 5118: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5119: }
5120:
5121: sub get_blocks {
1.1075.2.147 raeburn 5122: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5123: my $startblock = 0;
5124: my $endblock = 0;
1.1062 raeburn 5125: my $triggerblock = '';
1.490 raeburn 5126: my $course = $cdom.'_'.$cnum;
5127: $setters->{$course} = {};
5128: $setters->{$course}{'staff'} = [];
5129: $setters->{$course}{'times'} = [];
1.1062 raeburn 5130: $setters->{$course}{'triggers'} = [];
5131: my (@blockers,%triggered);
5132: my $now = time;
5133: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5134: if ($activity eq 'docs') {
1.1075.2.148 raeburn 5135: my ($blocked,$nosymbcache,$noenccheck);
1.1075.2.147 raeburn 5136: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5137: $blocked = 1;
5138: $nosymbcache = 1;
1.1075.2.148 raeburn 5139: $noenccheck = 1;
1.1075.2.147 raeburn 5140: }
1.1075.2.148 raeburn 5141: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5142: foreach my $block (@blockers) {
5143: if ($block =~ /^firstaccess____(.+)$/) {
5144: my $item = $1;
5145: my $type = 'map';
5146: my $timersymb = $item;
5147: if ($item eq 'course') {
5148: $type = 'course';
5149: } elsif ($item =~ /___\d+___/) {
5150: $type = 'resource';
5151: } else {
5152: $timersymb = &Apache::lonnet::symbread($item);
5153: }
5154: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5155: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5156: $triggered{$block} = {
5157: start => $start,
5158: end => $end,
5159: type => $type,
5160: };
5161: }
5162: }
5163: } else {
5164: foreach my $block (keys(%commblocks)) {
5165: if ($block =~ m/^(\d+)____(\d+)$/) {
5166: my ($start,$end) = ($1,$2);
5167: if ($start <= time && $end >= time) {
5168: if (ref($commblocks{$block}) eq 'HASH') {
5169: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5170: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5171: unless(grep(/^\Q$block\E$/,@blockers)) {
5172: push(@blockers,$block);
5173: }
5174: }
5175: }
5176: }
5177: }
5178: } elsif ($block =~ /^firstaccess____(.+)$/) {
5179: my $item = $1;
5180: my $timersymb = $item;
5181: my $type = 'map';
5182: if ($item eq 'course') {
5183: $type = 'course';
5184: } elsif ($item =~ /___\d+___/) {
5185: $type = 'resource';
5186: } else {
5187: $timersymb = &Apache::lonnet::symbread($item);
5188: }
5189: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5190: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5191: if ($start && $end) {
5192: if (($start <= time) && ($end >= time)) {
1.1075.2.158 raeburn 5193: if (ref($commblocks{$block}) eq 'HASH') {
5194: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5195: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5196: unless(grep(/^\Q$block\E$/,@blockers)) {
5197: push(@blockers,$block);
5198: $triggered{$block} = {
5199: start => $start,
5200: end => $end,
5201: type => $type,
5202: };
5203: }
5204: }
5205: }
1.1062 raeburn 5206: }
5207: }
1.490 raeburn 5208: }
1.1062 raeburn 5209: }
5210: }
5211: }
5212: foreach my $blocker (@blockers) {
5213: my ($staff_name,$staff_dom,$title,$blocks) =
5214: &parse_block_record($commblocks{$blocker});
5215: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5216: my ($start,$end,$triggertype);
5217: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5218: ($start,$end) = ($1,$2);
5219: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5220: $start = $triggered{$blocker}{'start'};
5221: $end = $triggered{$blocker}{'end'};
5222: $triggertype = $triggered{$blocker}{'type'};
5223: }
5224: if ($start) {
5225: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5226: if ($triggertype) {
5227: push(@{$$setters{$course}{'triggers'}},$triggertype);
5228: } else {
5229: push(@{$$setters{$course}{'triggers'}},0);
5230: }
5231: if ( ($startblock == 0) || ($startblock > $start) ) {
5232: $startblock = $start;
5233: if ($triggertype) {
5234: $triggerblock = $blocker;
1.474 raeburn 5235: }
5236: }
1.1062 raeburn 5237: if ( ($endblock == 0) || ($endblock < $end) ) {
5238: $endblock = $end;
5239: if ($triggertype) {
5240: $triggerblock = $blocker;
5241: }
5242: }
1.474 raeburn 5243: }
5244: }
1.1062 raeburn 5245: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5246: }
5247:
5248: sub parse_block_record {
5249: my ($record) = @_;
5250: my ($setuname,$setudom,$title,$blocks);
5251: if (ref($record) eq 'HASH') {
5252: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5253: $title = &unescape($record->{'event'});
5254: $blocks = $record->{'blocks'};
5255: } else {
5256: my @data = split(/:/,$record,3);
5257: if (scalar(@data) eq 2) {
5258: $title = $data[1];
5259: ($setuname,$setudom) = split(/@/,$data[0]);
5260: } else {
5261: ($setuname,$setudom,$title) = @data;
5262: }
5263: $blocks = { 'com' => 'on' };
5264: }
5265: return ($setuname,$setudom,$title,$blocks);
5266: }
5267:
1.854 kalberla 5268: sub blocking_status {
1.1075.2.158 raeburn 5269: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5270: my %setters;
1.890 droeschl 5271:
1.1061 raeburn 5272: # check for active blocking
1.1075.2.158 raeburn 5273: if ($clientip eq '') {
5274: $clientip = &Apache::lonnet::get_requestor_ip();
5275: }
5276: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5277: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5278: my $blocked = 0;
1.1075.2.158 raeburn 5279: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5280: $blocked = 1;
5281: }
1.890 droeschl 5282:
1.1061 raeburn 5283: # caller just wants to know whether a block is active
5284: if (!wantarray) { return $blocked; }
5285:
5286: # build a link to a popup window containing the details
5287: my $querystring = "?activity=$activity";
1.1075.2.158 raeburn 5288: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5289: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1075.2.97 raeburn 5290: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5291: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5292: } elsif ($activity eq 'docs') {
1.1075.2.147 raeburn 5293: my $showurl = &Apache::lonenc::check_encrypt($url);
5294: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5295: if ($symb) {
5296: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5297: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5298: }
1.1062 raeburn 5299: }
1.1061 raeburn 5300:
5301: my $output .= <<'END_MYBLOCK';
5302: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5303: var options = "width=" + w + ",height=" + h + ",";
5304: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5305: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5306: var newWin = window.open(url, wdwName, options);
5307: newWin.focus();
5308: }
1.890 droeschl 5309: END_MYBLOCK
1.854 kalberla 5310:
1.1061 raeburn 5311: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5312:
1.1061 raeburn 5313: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5314: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 5315: my $class = 'LC_comblock';
1.1062 raeburn 5316: if ($activity eq 'docs') {
5317: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 5318: $class = '';
1.1063 raeburn 5319: } elsif ($activity eq 'printout') {
5320: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 5321: } elsif ($activity eq 'passwd') {
5322: $text = &mt('Password Changing Blocked');
1.1075.2.158 raeburn 5323: } elsif ($activity eq 'grades') {
5324: $text = &mt('Gradebook Blocked');
5325: } elsif ($activity eq 'search') {
5326: $text = &mt('Search Blocked');
1.1075.2.161. .1(raebu 5327:21): } elsif ($activity eq 'alert') {
5328:21): $text = &mt('Checking Critical Messages Blocked');
5329:21): } elsif ($activity eq 'reinit') {
5330:21): $text = &mt('Checking Course Update Blocked');
1.1075.2.158 raeburn 5331: } elsif ($activity eq 'about') {
5332: $text = &mt('Access to User Information Pages Blocked');
1.1075.2.160 raeburn 5333: } elsif ($activity eq 'wishlist') {
5334: $text = &mt('Access to Stored Links Blocked');
5335: } elsif ($activity eq 'annotate') {
5336: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5337: }
1.1061 raeburn 5338: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 5339: <div class='$class'>
1.869 kalberla 5340: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5341: title='$text'>
5342: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5343: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5344: title='$text'>$text</a>
1.867 kalberla 5345: </div>
5346:
5347: END_BLOCK
1.474 raeburn 5348:
1.1061 raeburn 5349: return ($blocked, $output);
1.854 kalberla 5350: }
1.490 raeburn 5351:
1.60 matthew 5352: ###############################################
5353:
1.682 raeburn 5354: sub check_ip_acc {
1.1075.2.105 raeburn 5355: my ($acc,$clientip)=@_;
1.682 raeburn 5356: &Apache::lonxml::debug("acc is $acc");
5357: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5358: return 1;
5359: }
5360: my $allowed=0;
1.1075.2.144 raeburn 5361: my $ip;
5362: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5363: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5364: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5365: } else {
1.1075.2.150 raeburn 5366: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5367: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1075.2.144 raeburn 5368: }
1.682 raeburn 5369:
5370: my $name;
1.1075.2.161. .1(raebu 5371:21): my %access = (
5372:21): allowfrom => 1,
5373:21): denyfrom => 0,
5374:21): );
5375:21): my @allows;
5376:21): my @denies;
5377:21): foreach my $item (split(',',$acc)) {
5378:21): $item =~ s/^\s*//;
5379:21): $item =~ s/\s*$//;
5380:21): if ($item =~ /^\!(.+)$/) {
5381:21): push(@denies,$1);
5382:21): } else {
5383:21): push(@allows,$item);
5384:21): }
5385:21): }
5386:21): my $numdenies = scalar(@denies);
5387:21): my $numallows = scalar(@allows);
5388:21): my $count = 0;
5389:21): foreach my $pattern (@denies,@allows) {
5390:21): $count ++;
5391:21): my $acctype = 'allowfrom';
5392:21): if ($count <= $numdenies) {
5393:21): $acctype = 'denyfrom';
5394:21): }
1.682 raeburn 5395: if ($pattern =~ /\*$/) {
5396: #35.8.*
5397: $pattern=~s/\*//;
1.1075.2.161. .1(raebu 5398:21): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5399: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5400: #35.8.3.[34-56]
5401: my $low=$2;
5402: my $high=$3;
5403: $pattern=$1;
5404: if ($ip =~ /^\Q$pattern\E/) {
5405: my $last=(split(/\./,$ip))[3];
1.1075.2.161. .1(raebu 5406:21): if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5407: }
5408: } elsif ($pattern =~ /^\*/) {
5409: #*.msu.edu
5410: $pattern=~s/\*//;
5411: if (!defined($name)) {
5412: use Socket;
5413: my $netaddr=inet_aton($ip);
5414: ($name)=gethostbyaddr($netaddr,AF_INET);
5415: }
1.1075.2.161. .1(raebu 5416:21): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5417: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5418: #127.0.0.1
1.1075.2.161. .1(raebu 5419:21): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5420: } else {
5421: #some.name.com
5422: if (!defined($name)) {
5423: use Socket;
5424: my $netaddr=inet_aton($ip);
5425: ($name)=gethostbyaddr($netaddr,AF_INET);
5426: }
1.1075.2.161. .1(raebu 5427:21): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5428:21): }
5429:21): if ($allowed =~ /^(0|1)$/) { last; }
5430:21): }
5431:21): if ($allowed eq '') {
5432:21): if ($numdenies && !$numallows) {
5433:21): $allowed = 1;
5434:21): } else {
5435:21): $allowed = 0;
1.682 raeburn 5436: }
5437: }
5438: return $allowed;
5439: }
5440:
5441: ###############################################
5442:
1.60 matthew 5443: =pod
5444:
1.112 bowersj2 5445: =head1 Domain Template Functions
5446:
5447: =over 4
5448:
5449: =item * &determinedomain()
1.60 matthew 5450:
5451: Inputs: $domain (usually will be undef)
5452:
1.63 www 5453: Returns: Determines which domain should be used for designs
1.60 matthew 5454:
5455: =cut
1.54 www 5456:
1.60 matthew 5457: ###############################################
1.63 www 5458: sub determinedomain {
5459: my $domain=shift;
1.531 albertel 5460: if (! $domain) {
1.60 matthew 5461: # Determine domain if we have not been given one
1.893 raeburn 5462: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5463: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5464: if ($env{'request.role.domain'}) {
5465: $domain=$env{'request.role.domain'};
1.60 matthew 5466: }
5467: }
1.63 www 5468: return $domain;
5469: }
5470: ###############################################
1.517 raeburn 5471:
1.518 albertel 5472: sub devalidate_domconfig_cache {
5473: my ($udom)=@_;
5474: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5475: }
5476:
5477: # ---------------------- Get domain configuration for a domain
5478: sub get_domainconf {
5479: my ($udom) = @_;
5480: my $cachetime=1800;
5481: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5482: if (defined($cached)) { return %{$result}; }
5483:
5484: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5485: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5486: my (%designhash,%legacy);
1.518 albertel 5487: if (keys(%domconfig) > 0) {
5488: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5489: if (keys(%{$domconfig{'login'}})) {
5490: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5491: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 5492: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5493: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5494: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5495: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5496: if ($key eq 'loginvia') {
5497: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5498: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5499: $designhash{$udom.'.login.loginvia'} = $server;
5500: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5501: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5502: } else {
5503: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5504: }
1.948 raeburn 5505: }
1.1075.2.87 raeburn 5506: } elsif ($key eq 'headtag') {
5507: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5508: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5509: }
1.946 raeburn 5510: }
1.1075.2.87 raeburn 5511: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5512: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5513: }
1.946 raeburn 5514: }
5515: }
5516: }
1.1075.2.158 raeburn 5517: } elsif ($key eq 'saml') {
5518: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5519: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
5520: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
5521: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
5522: foreach my $item ('text','img','alt','url','title','notsso') {
5523: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
5524: }
5525: }
5526: }
5527: }
1.946 raeburn 5528: } else {
5529: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5530: $designhash{$udom.'.login.'.$key.'_'.$img} =
5531: $domconfig{'login'}{$key}{$img};
5532: }
1.699 raeburn 5533: }
5534: } else {
5535: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5536: }
1.632 raeburn 5537: }
5538: } else {
5539: $legacy{'login'} = 1;
1.518 albertel 5540: }
1.632 raeburn 5541: } else {
5542: $legacy{'login'} = 1;
1.518 albertel 5543: }
5544: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5545: if (keys(%{$domconfig{'rolecolors'}})) {
5546: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5547: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5548: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5549: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5550: }
1.518 albertel 5551: }
5552: }
1.632 raeburn 5553: } else {
5554: $legacy{'rolecolors'} = 1;
1.518 albertel 5555: }
1.632 raeburn 5556: } else {
5557: $legacy{'rolecolors'} = 1;
1.518 albertel 5558: }
1.948 raeburn 5559: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5560: if ($domconfig{'autoenroll'}{'co-owners'}) {
5561: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5562: }
5563: }
1.632 raeburn 5564: if (keys(%legacy) > 0) {
5565: my %legacyhash = &get_legacy_domconf($udom);
5566: foreach my $item (keys(%legacyhash)) {
5567: if ($item =~ /^\Q$udom\E\.login/) {
5568: if ($legacy{'login'}) {
5569: $designhash{$item} = $legacyhash{$item};
5570: }
5571: } else {
5572: if ($legacy{'rolecolors'}) {
5573: $designhash{$item} = $legacyhash{$item};
5574: }
1.518 albertel 5575: }
5576: }
5577: }
1.632 raeburn 5578: } else {
5579: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5580: }
5581: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5582: $cachetime);
5583: return %designhash;
5584: }
5585:
1.632 raeburn 5586: sub get_legacy_domconf {
5587: my ($udom) = @_;
5588: my %legacyhash;
5589: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5590: my $designfile = $designdir.'/'.$udom.'.tab';
5591: if (-e $designfile) {
1.1075.2.128 raeburn 5592: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 5593: while (my $line = <$fh>) {
5594: next if ($line =~ /^\#/);
5595: chomp($line);
5596: my ($key,$val)=(split(/\=/,$line));
5597: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5598: }
5599: close($fh);
5600: }
5601: }
1.1026 raeburn 5602: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5603: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5604: }
5605: return %legacyhash;
5606: }
5607:
1.63 www 5608: =pod
5609:
1.112 bowersj2 5610: =item * &domainlogo()
1.63 www 5611:
5612: Inputs: $domain (usually will be undef)
5613:
5614: Returns: A link to a domain logo, if the domain logo exists.
5615: If the domain logo does not exist, a description of the domain.
5616:
5617: =cut
1.112 bowersj2 5618:
1.63 www 5619: ###############################################
5620: sub domainlogo {
1.517 raeburn 5621: my $domain = &determinedomain(shift);
1.518 albertel 5622: my %designhash = &get_domainconf($domain);
1.517 raeburn 5623: # See if there is a logo
5624: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5625: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5626: if ($imgsrc =~ m{^/(adm|res)/}) {
5627: if ($imgsrc =~ m{^/res/}) {
5628: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5629: &Apache::lonnet::repcopy($local_name);
5630: }
5631: $imgsrc = &lonhttpdurl($imgsrc);
1.1075.2.161. .2(raebu 5632:22): }
5633:22): my $alttext = $domain;
5634:22): if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
5635:22): $alttext = $designhash{$domain.'.login.alttext_domlogo'};
5636:22): }
5637:22): return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 5638: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5639: return &Apache::lonnet::domain($domain,'description');
1.59 www 5640: } else {
1.60 matthew 5641: return '';
1.59 www 5642: }
5643: }
1.63 www 5644: ##############################################
5645:
5646: =pod
5647:
1.112 bowersj2 5648: =item * &designparm()
1.63 www 5649:
5650: Inputs: $which parameter; $domain (usually will be undef)
5651:
5652: Returns: value of designparamter $which
5653:
5654: =cut
1.112 bowersj2 5655:
1.397 albertel 5656:
1.400 albertel 5657: ##############################################
1.397 albertel 5658: sub designparm {
5659: my ($which,$domain)=@_;
5660: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5661: return $env{'environment.color.'.$which};
1.96 www 5662: }
1.63 www 5663: $domain=&determinedomain($domain);
1.1016 raeburn 5664: my %domdesign;
5665: unless ($domain eq 'public') {
5666: %domdesign = &get_domainconf($domain);
5667: }
1.520 raeburn 5668: my $output;
1.517 raeburn 5669: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5670: $output = $domdesign{$domain.'.'.$which};
1.63 www 5671: } else {
1.520 raeburn 5672: $output = $defaultdesign{$which};
5673: }
5674: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5675: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5676: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5677: if ($output =~ m{^/res/}) {
5678: my $local_name = &Apache::lonnet::filelocation('',$output);
5679: &Apache::lonnet::repcopy($local_name);
5680: }
1.520 raeburn 5681: $output = &lonhttpdurl($output);
5682: }
1.63 www 5683: }
1.520 raeburn 5684: return $output;
1.63 www 5685: }
1.59 www 5686:
1.822 bisitz 5687: ##############################################
5688: =pod
5689:
1.832 bisitz 5690: =item * &authorspace()
5691:
1.1028 raeburn 5692: Inputs: $url (usually will be undef).
1.832 bisitz 5693:
1.1075.2.40 raeburn 5694: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5695: directory being viewed (or for which action is being taken).
5696: If $url is provided, and begins /priv/<domain>/<uname>
5697: the path will be that portion of the $context argument.
5698: Otherwise the path will be for the author space of the current
5699: user when the current role is author, or for that of the
5700: co-author/assistant co-author space when the current role
5701: is co-author or assistant co-author.
1.832 bisitz 5702:
5703: =cut
5704:
5705: sub authorspace {
1.1028 raeburn 5706: my ($url) = @_;
5707: if ($url ne '') {
5708: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5709: return $1;
5710: }
5711: }
1.832 bisitz 5712: my $caname = '';
1.1024 www 5713: my $cadom = '';
1.1028 raeburn 5714: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5715: ($cadom,$caname) =
1.832 bisitz 5716: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5717: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5718: $caname = $env{'user.name'};
1.1024 www 5719: $cadom = $env{'user.domain'};
1.832 bisitz 5720: }
1.1028 raeburn 5721: if (($caname ne '') && ($cadom ne '')) {
5722: return "/priv/$cadom/$caname/";
5723: }
5724: return;
1.832 bisitz 5725: }
5726:
5727: ##############################################
5728: =pod
5729:
1.822 bisitz 5730: =item * &head_subbox()
5731:
5732: Inputs: $content (contains HTML code with page functions, etc.)
5733:
5734: Returns: HTML div with $content
5735: To be included in page header
5736:
5737: =cut
5738:
5739: sub head_subbox {
5740: my ($content)=@_;
5741: my $output =
1.993 raeburn 5742: '<div class="LC_head_subbox">'
1.822 bisitz 5743: .$content
5744: .'</div>'
5745: }
5746:
5747: ##############################################
5748: =pod
5749:
5750: =item * &CSTR_pageheader()
5751:
1.1026 raeburn 5752: Input: (optional) filename from which breadcrumb trail is built.
5753: In most cases no input as needed, as $env{'request.filename'}
5754: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5755:
5756: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5757: To be included on Authoring Space pages
1.822 bisitz 5758:
5759: =cut
5760:
5761: sub CSTR_pageheader {
1.1026 raeburn 5762: my ($trailfile) = @_;
5763: if ($trailfile eq '') {
5764: $trailfile = $env{'request.filename'};
5765: }
5766:
5767: # this is for resources; directories have customtitle, and crumbs
5768: # and select recent are created in lonpubdir.pm
5769:
5770: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5771: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5772: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5773: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5774: $formaction =~ s{/+}{/}g;
1.822 bisitz 5775:
5776: my $parentpath = '';
5777: my $lastitem = '';
5778: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5779: $parentpath = $1;
5780: $lastitem = $2;
5781: } else {
5782: $lastitem = $thisdisfn;
5783: }
1.921 bisitz 5784:
5785: my $output =
1.822 bisitz 5786: '<div>'
5787: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5788: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5789: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5790: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5791: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5792:
5793: if ($lastitem) {
5794: $output .=
5795: '<span class="LC_filename">'
5796: .$lastitem
5797: .'</span>';
5798: }
5799: $output .=
5800: '<br />'
1.822 bisitz 5801: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5802: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5803: .'</form>'
5804: .&Apache::lonmenu::constspaceform()
5805: .'</div>';
1.921 bisitz 5806:
5807: return $output;
1.822 bisitz 5808: }
5809:
1.60 matthew 5810: ###############################################
5811: ###############################################
5812:
5813: =pod
5814:
1.112 bowersj2 5815: =back
5816:
1.549 albertel 5817: =head1 HTML Helpers
1.112 bowersj2 5818:
5819: =over 4
5820:
5821: =item * &bodytag()
1.60 matthew 5822:
5823: Returns a uniform header for LON-CAPA web pages.
5824:
5825: Inputs:
5826:
1.112 bowersj2 5827: =over 4
5828:
5829: =item * $title, A title to be displayed on the page.
5830:
5831: =item * $function, the current role (can be undef).
5832:
5833: =item * $addentries, extra parameters for the <body> tag.
5834:
5835: =item * $bodyonly, if defined, only return the <body> tag.
5836:
5837: =item * $domain, if defined, force a given domain.
5838:
5839: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5840: text interface only)
1.60 matthew 5841:
1.814 bisitz 5842: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5843: navigational links
1.317 albertel 5844:
1.338 albertel 5845: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5846:
1.1075.2.12 raeburn 5847: =item * $no_inline_link, if true and in remote mode, don't show the
5848: 'Switch To Inline Menu' link
5849:
1.460 albertel 5850: =item * $args, optional argument valid values are
5851: no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133 raeburn 5852: use_absolute -> for external resource or syllabus, this will
5853: contain https://<hostname> if server uses
5854: https (as per hosts.tab), but request is for http
5855: hostname -> hostname, from $r->hostname().
1.460 albertel 5856:
1.1075.2.15 raeburn 5857: =item * $advtoolsref, optional argument, ref to an array containing
5858: inlineremote items to be added in "Functions" menu below
5859: breadcrumbs.
5860:
1.1075.2.161. .1(raebu 5861:21): =item * $ltiscope, optional argument, will be one of: resource, map or
5862:21): course, if LON-CAPA is in LTI Provider context. Value is
5863:21): the scope of use, i.e., launch was for access to a single, a map
5864:21): or the entire course.
5865:21):
5866:21): =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
5867:21): context, this will contain the URL for the landing item in
5868:21): the course, after launch from an LTI Consumer
5869:21):
5870:21): =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
5871:21): context, this will contain a reference to hash of items
5872:21): to be included in the page header and/or inline menu.
5873:21):
1.112 bowersj2 5874: =back
5875:
1.60 matthew 5876: Returns: A uniform header for LON-CAPA web pages.
5877: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5878: If $bodyonly is undef or zero, an html string containing a <body> tag and
5879: other decorations will be returned.
5880:
5881: =cut
5882:
1.54 www 5883: sub bodytag {
1.831 bisitz 5884: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.161. .1(raebu 5885:21): $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,
5886:21): $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_;
1.339 albertel 5887:
1.954 raeburn 5888: my $public;
5889: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5890: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5891: $public = 1;
5892: }
1.460 albertel 5893: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5894: my $httphost = $args->{'use_absolute'};
1.1075.2.133 raeburn 5895: my $hostname = $args->{'hostname'};
1.339 albertel 5896:
1.183 matthew 5897: $function = &get_users_function() if (!$function);
1.339 albertel 5898: my $img = &designparm($function.'.img',$domain);
5899: my $font = &designparm($function.'.font',$domain);
5900: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5901:
1.803 bisitz 5902: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5903: 'bgcolor' => $pgbg,
1.339 albertel 5904: 'text' => $font,
5905: 'alink' => &designparm($function.'.alink',$domain),
5906: 'vlink' => &designparm($function.'.vlink',$domain),
5907: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5908: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5909:
1.63 www 5910: # role and realm
1.1075.2.68 raeburn 5911: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5912: if ($realm) {
5913: $realm = '/'.$realm;
5914: }
1.1075.2.159 raeburn 5915: if ($role eq 'ca') {
1.479 albertel 5916: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5917: $realm = &plainname($rname,$rdom);
1.378 raeburn 5918: }
1.55 www 5919: # realm
1.1075.2.158 raeburn 5920: my ($cid,$sec);
1.258 albertel 5921: if ($env{'request.course.id'}) {
1.1075.2.158 raeburn 5922: $cid = $env{'request.course.id'};
5923: if ($env{'request.course.sec'}) {
5924: $sec = $env{'request.course.sec'};
5925: }
5926: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
5927: if (&Apache::lonnet::is_course($1,$2)) {
5928: $cid = $1.'_'.$2;
5929: $sec = $3;
5930: }
5931: }
5932: if ($cid) {
1.378 raeburn 5933: if ($env{'request.role'} !~ /^cr/) {
5934: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115 raeburn 5935: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121 raeburn 5936: if ($env{'request.role.desc'}) {
5937: $role = $env{'request.role.desc'};
5938: } else {
5939: $role = &mt('Helpdesk[_1]',' '.$2);
5940: }
1.1075.2.115 raeburn 5941: } else {
5942: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5943: }
1.1075.2.158 raeburn 5944: if ($sec) {
5945: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 5946: }
1.1075.2.158 raeburn 5947: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 5948: } else {
5949: $role = &Apache::lonnet::plaintext($role);
1.54 www 5950: }
1.433 albertel 5951:
1.359 albertel 5952: if (!$realm) { $realm=' '; }
1.330 albertel 5953:
1.438 albertel 5954: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5955:
1.101 www 5956: # construct main body tag
1.359 albertel 5957: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 5958: &Apache::lontexconvert::init_math_support();
1.252 albertel 5959:
1.1075.2.38 raeburn 5960: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5961:
5962: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5963: return $bodytag;
1.1075.2.38 raeburn 5964: }
1.359 albertel 5965:
1.954 raeburn 5966: if ($public) {
1.433 albertel 5967: undef($role);
5968: }
1.1075.2.158 raeburn 5969:
1.1075.2.161. .1(raebu 5970:21): my $showcrstitle = 1;
5971:21): if (($cid) && ($env{'request.lti.login'})) {
5972:21): if (ref($ltimenu) eq 'HASH') {
5973:21): unless ($ltimenu->{'role'}) {
5974:21): undef($role);
5975:21): }
5976:21): unless ($ltimenu->{'coursetitle'}) {
5977:21): $realm=' ';
5978:21): $showcrstitle = 0;
5979:21): }
5980:21): }
5981:21): } elsif (($cid) && ($menucoll)) {
5982:21): if (ref($menuref) eq 'HASH') {
5983:21): unless ($menuref->{'role'}) {
5984:21): undef($role);
5985:21): }
5986:21): unless ($menuref->{'crs'}) {
5987:21): $realm=' ';
5988:21): $showcrstitle = 0;
5989:21): }
5990:21): }
5991:21): }
5992:21):
1.762 bisitz 5993: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5994: #
5995: # Extra info if you are the DC
5996: my $dc_info = '';
1.1075.2.161. .1(raebu 5997:21): if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1075.2.158 raeburn 5998: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 5999: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6000: $dc_info =~ s/\s+$//;
1.359 albertel 6001: }
6002:
1.1075.2.161. .1(raebu 6003:21): my $crstype;
6004:21): if ($cid) {
6005:21): $crstype = $env{'course.'.$cid.'.type'};
6006:21): } elsif ($args->{'crstype'}) {
6007:21): $crstype = $args->{'crstype'};
6008:21): }
6009:21):
1.1075.2.108 raeburn 6010: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903 droeschl 6011:
1.1075.2.13 raeburn 6012: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6013:
1.1075.2.38 raeburn 6014:
6015:
1.1075.2.21 raeburn 6016: my $funclist;
6017: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 6018: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 6019: Apache::lonmenu::serverform();
6020: my $forbodytag;
6021: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6022: $forcereg,$args->{'group'},
6023: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 6024: $advtoolsref,'','',\$forbodytag);
1.1075.2.21 raeburn 6025: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6026: $funclist = $forbodytag;
6027: }
6028: } else {
1.903 droeschl 6029:
6030: # if ($env{'request.state'} eq 'construct') {
6031: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6032: # }
6033:
1.1075.2.38 raeburn 6034: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 6035: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6036:
1.1075.2.161. .1(raebu 6037:21): unless ($args->{'no_primary_menu'}) {
.4(raebu 6038:22): my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
6039:22): $args->{'links_disabled'});
.1(raebu 6040:21): if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6041:21): if ($dc_info) {
6042:21): $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6043:21): }
6044:21): $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6045:21): <em>$realm</em> $dc_info</div>|;
6046:21): return $bodytag;
1.1075.2.1 raeburn 6047: }
1.894 droeschl 6048:
1.1075.2.161. .1(raebu 6049:21): unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6050:21): $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6051:21): }
1.916 droeschl 6052:
1.1075.2.161. .1(raebu 6053:21): $bodytag .= $right;
1.852 droeschl 6054:
1.1075.2.161. .1(raebu 6055:21): if ($dc_info) {
6056:21): $dc_info = &dc_courseid_toggle($dc_info);
6057:21): }
6058:21): $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6059: }
1.916 droeschl 6060:
1.1075.2.61 raeburn 6061: #if directed to not display the secondary menu, don't.
6062: if ($args->{'no_secondary_menu'}) {
6063: return $bodytag;
6064: }
1.903 droeschl 6065: #don't show menus for public users
1.954 raeburn 6066: if (!$public){
1.1075.2.161. .1(raebu 6067:21): unless ($args->{'no_inline_menu'}) {
6068:21): $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
6069:21): $args->{'no_primary_menu'},
6070:21): $menucoll,$menuref,
6071:21): $args->{'links_disabled'});
6072:21): }
1.903 droeschl 6073: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6074: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6075: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6076: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.161. .1(raebu 6077:21): $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
1.1075.2.116 raeburn 6078: } elsif ($forcereg) {
1.1075.2.22 raeburn 6079: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.116 raeburn 6080: $args->{'group'},
1.1075.2.161 raeburn 6081: $args->{'hide_buttons'},
1.1075.2.161. .1(raebu 6082:21): $hostname,$ltiscope,$ltiuri);
1.1075.2.15 raeburn 6083: } else {
1.1075.2.21 raeburn 6084: my $forbodytag;
6085: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6086: $forcereg,$args->{'group'},
6087: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 6088: $advtoolsref,'',$hostname,
6089: \$forbodytag);
1.1075.2.21 raeburn 6090: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6091: $bodytag .= $forbodytag;
6092: }
1.920 raeburn 6093: }
1.903 droeschl 6094: }else{
6095: # this is to seperate menu from content when there's no secondary
6096: # menu. Especially needed for public accessible ressources.
6097: $bodytag .= '<hr style="clear:both" />';
6098: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6099: }
1.903 droeschl 6100:
1.235 raeburn 6101: return $bodytag;
1.1075.2.12 raeburn 6102: }
6103:
6104: #
6105: # Top frame rendering, Remote is up
6106: #
6107:
6108: my $imgsrc = $img;
6109: if ($img =~ /^\/adm/) {
6110: $imgsrc = &lonhttpdurl($img);
6111: }
6112: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
6113:
1.1075.2.60 raeburn 6114: my $help=($no_inline_link?''
6115: :&Apache::loncommon::top_nav_help('Help'));
6116:
1.1075.2.12 raeburn 6117: # Explicit link to get inline menu
6118: my $menu= ($no_inline_link?''
6119: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
6120:
6121: if ($dc_info) {
6122: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
6123: }
6124:
1.1075.2.38 raeburn 6125: my $name = &plainname($env{'user.name'},$env{'user.domain'});
6126: unless ($public) {
6127: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
6128: undef,'LC_menubuttons_link');
6129: }
6130:
1.1075.2.12 raeburn 6131: unless ($env{'form.inhibitmenu'}) {
6132: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 6133: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 6134: <li>$help</li>
1.1075.2.12 raeburn 6135: <li>$menu</li>
6136: </ol><div id="LC_realm"> $realm $dc_info</div>|;
6137: }
1.1075.2.13 raeburn 6138: if ($env{'request.state'} eq 'construct') {
6139: if (!$public){
6140: if ($env{'request.state'} eq 'construct') {
6141: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 6142: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 6143: &Apache::lonhtmlcommon::scripttag('','end').
6144: &Apache::lonmenu::innerregister($forcereg,
6145: $args->{'bread_crumbs'});
6146: }
6147: }
6148: }
1.1075.2.21 raeburn 6149: return $bodytag."\n".$funclist;
1.182 matthew 6150: }
6151:
1.917 raeburn 6152: sub dc_courseid_toggle {
6153: my ($dc_info) = @_;
1.980 raeburn 6154: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6155: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6156: &mt('(More ...)').'</a></span>'.
6157: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6158: }
6159:
1.330 albertel 6160: sub make_attr_string {
6161: my ($register,$attr_ref) = @_;
6162:
6163: if ($attr_ref && !ref($attr_ref)) {
6164: die("addentries Must be a hash ref ".
6165: join(':',caller(1))." ".
6166: join(':',caller(0))." ");
6167: }
6168:
6169: if ($register) {
1.339 albertel 6170: my ($on_load,$on_unload);
6171: foreach my $key (keys(%{$attr_ref})) {
6172: if (lc($key) eq 'onload') {
6173: $on_load.=$attr_ref->{$key}.';';
6174: delete($attr_ref->{$key});
6175:
6176: } elsif (lc($key) eq 'onunload') {
6177: $on_unload.=$attr_ref->{$key}.';';
6178: delete($attr_ref->{$key});
6179: }
6180: }
1.1075.2.12 raeburn 6181: if ($env{'environment.remote'} eq 'on') {
6182: $attr_ref->{'onload'} =
6183: &Apache::lonmenu::loadevents(). $on_load;
6184: $attr_ref->{'onunload'}=
6185: &Apache::lonmenu::unloadevents().$on_unload;
6186: } else {
6187: $attr_ref->{'onload'} = $on_load;
6188: $attr_ref->{'onunload'}= $on_unload;
6189: }
1.330 albertel 6190: }
1.339 albertel 6191:
1.330 albertel 6192: my $attr_string;
1.1075.2.56 raeburn 6193: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6194: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6195: }
6196: return $attr_string;
6197: }
6198:
6199:
1.182 matthew 6200: ###############################################
1.251 albertel 6201: ###############################################
6202:
6203: =pod
6204:
6205: =item * &endbodytag()
6206:
6207: Returns a uniform footer for LON-CAPA web pages.
6208:
1.635 raeburn 6209: Inputs: 1 - optional reference to an args hash
6210: If in the hash, key for noredirectlink has a value which evaluates to true,
6211: a 'Continue' link is not displayed if the page contains an
6212: internal redirect in the <head></head> section,
6213: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6214:
6215: =cut
6216:
6217: sub endbodytag {
1.635 raeburn 6218: my ($args) = @_;
1.1075.2.6 raeburn 6219: my $endbodytag;
6220: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6221: $endbodytag='</body>';
6222: }
1.315 albertel 6223: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6224: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6225: $endbodytag=
6226: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6227: &mt('Continue').'</a>'.
6228: $endbodytag;
6229: }
1.315 albertel 6230: }
1.251 albertel 6231: return $endbodytag;
6232: }
6233:
1.352 albertel 6234: =pod
6235:
6236: =item * &standard_css()
6237:
6238: Returns a style sheet
6239:
6240: Inputs: (all optional)
6241: domain -> force to color decorate a page for a specific
6242: domain
6243: function -> force usage of a specific rolish color scheme
6244: bgcolor -> override the default page bgcolor
6245:
6246: =cut
6247:
1.343 albertel 6248: sub standard_css {
1.345 albertel 6249: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6250: $function = &get_users_function() if (!$function);
6251: my $img = &designparm($function.'.img', $domain);
6252: my $tabbg = &designparm($function.'.tabbg', $domain);
6253: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6254: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6255: #second colour for later usage
1.345 albertel 6256: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6257: my $pgbg_or_bgcolor =
6258: $bgcolor ||
1.352 albertel 6259: &designparm($function.'.pgbg', $domain);
1.382 albertel 6260: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6261: my $alink = &designparm($function.'.alink', $domain);
6262: my $vlink = &designparm($function.'.vlink', $domain);
6263: my $link = &designparm($function.'.link', $domain);
6264:
1.602 albertel 6265: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6266: my $mono = 'monospace';
1.850 bisitz 6267: my $data_table_head = $sidebg;
6268: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6269: my $data_table_dark = '#E0E0E0';
1.470 banghart 6270: my $data_table_darker = '#CCCCCC';
1.349 albertel 6271: my $data_table_highlight = '#FFFF00';
1.352 albertel 6272: my $mail_new = '#FFBB77';
6273: my $mail_new_hover = '#DD9955';
6274: my $mail_read = '#BBBB77';
6275: my $mail_read_hover = '#999944';
6276: my $mail_replied = '#AAAA88';
6277: my $mail_replied_hover = '#888855';
6278: my $mail_other = '#99BBBB';
6279: my $mail_other_hover = '#669999';
1.391 albertel 6280: my $table_header = '#DDDDDD';
1.489 raeburn 6281: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6282: my $lg_border_color = '#C8C8C8';
1.952 onken 6283: my $button_hover = '#BF2317';
1.392 albertel 6284:
1.608 albertel 6285: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6286: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6287: : '0 3px 0 4px';
1.448 albertel 6288:
1.523 albertel 6289:
1.343 albertel 6290: return <<END;
1.947 droeschl 6291:
6292: /* needed for iframe to allow 100% height in FF */
6293: body, html {
6294: margin: 0;
6295: padding: 0 0.5%;
6296: height: 99%; /* to avoid scrollbars */
6297: }
6298:
1.795 www 6299: body {
1.911 bisitz 6300: font-family: $sans;
6301: line-height:130%;
6302: font-size:0.83em;
6303: color:$font;
1.795 www 6304: }
6305:
1.959 onken 6306: a:focus,
6307: a:focus img {
1.795 www 6308: color: red;
6309: }
1.698 harmsja 6310:
1.911 bisitz 6311: form, .inline {
6312: display: inline;
1.795 www 6313: }
1.721 harmsja 6314:
1.795 www 6315: .LC_right {
1.911 bisitz 6316: text-align:right;
1.795 www 6317: }
6318:
6319: .LC_middle {
1.911 bisitz 6320: vertical-align:middle;
1.795 www 6321: }
1.721 harmsja 6322:
1.1075.2.38 raeburn 6323: .LC_floatleft {
6324: float: left;
6325: }
6326:
6327: .LC_floatright {
6328: float: right;
6329: }
6330:
1.911 bisitz 6331: .LC_400Box {
6332: width:400px;
6333: }
1.721 harmsja 6334:
1.947 droeschl 6335: .LC_iframecontainer {
6336: width: 98%;
6337: margin: 0;
6338: position: fixed;
6339: top: 8.5em;
6340: bottom: 0;
6341: }
6342:
6343: .LC_iframecontainer iframe{
6344: border: none;
6345: width: 100%;
6346: height: 100%;
6347: }
6348:
1.778 bisitz 6349: .LC_filename {
6350: font-family: $mono;
6351: white-space:pre;
1.921 bisitz 6352: font-size: 120%;
1.778 bisitz 6353: }
6354:
6355: .LC_fileicon {
6356: border: none;
6357: height: 1.3em;
6358: vertical-align: text-bottom;
6359: margin-right: 0.3em;
6360: text-decoration:none;
6361: }
6362:
1.1008 www 6363: .LC_setting {
6364: text-decoration:underline;
6365: }
6366:
1.350 albertel 6367: .LC_error {
6368: color: red;
6369: }
1.795 www 6370:
1.1075.2.15 raeburn 6371: .LC_warning {
6372: color: darkorange;
6373: }
6374:
1.457 albertel 6375: .LC_diff_removed {
1.733 bisitz 6376: color: red;
1.394 albertel 6377: }
1.532 albertel 6378:
6379: .LC_info,
1.457 albertel 6380: .LC_success,
6381: .LC_diff_added {
1.350 albertel 6382: color: green;
6383: }
1.795 www 6384:
1.802 bisitz 6385: div.LC_confirm_box {
6386: background-color: #FAFAFA;
6387: border: 1px solid $lg_border_color;
6388: margin-right: 0;
6389: padding: 5px;
6390: }
6391:
6392: div.LC_confirm_box .LC_error img,
6393: div.LC_confirm_box .LC_success img {
6394: vertical-align: middle;
6395: }
6396:
1.1075.2.108 raeburn 6397: .LC_maxwidth {
6398: max-width: 100%;
6399: height: auto;
6400: }
6401:
6402: .LC_textsize_mobile {
6403: \@media only screen and (max-device-width: 480px) {
6404: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6405: }
6406: }
6407:
1.440 albertel 6408: .LC_icon {
1.771 droeschl 6409: border: none;
1.790 droeschl 6410: vertical-align: middle;
1.771 droeschl 6411: }
6412:
1.543 albertel 6413: .LC_docs_spacer {
6414: width: 25px;
6415: height: 1px;
1.771 droeschl 6416: border: none;
1.543 albertel 6417: }
1.346 albertel 6418:
1.532 albertel 6419: .LC_internal_info {
1.735 bisitz 6420: color: #999999;
1.532 albertel 6421: }
6422:
1.794 www 6423: .LC_discussion {
1.1050 www 6424: background: $data_table_dark;
1.911 bisitz 6425: border: 1px solid black;
6426: margin: 2px;
1.794 www 6427: }
6428:
6429: .LC_disc_action_left {
1.1050 www 6430: background: $sidebg;
1.911 bisitz 6431: text-align: left;
1.1050 www 6432: padding: 4px;
6433: margin: 2px;
1.794 www 6434: }
6435:
6436: .LC_disc_action_right {
1.1050 www 6437: background: $sidebg;
1.911 bisitz 6438: text-align: right;
1.1050 www 6439: padding: 4px;
6440: margin: 2px;
1.794 www 6441: }
6442:
6443: .LC_disc_new_item {
1.911 bisitz 6444: background: white;
6445: border: 2px solid red;
1.1050 www 6446: margin: 4px;
6447: padding: 4px;
1.794 www 6448: }
6449:
6450: .LC_disc_old_item {
1.911 bisitz 6451: background: white;
1.1050 www 6452: margin: 4px;
6453: padding: 4px;
1.794 www 6454: }
6455:
1.458 albertel 6456: table.LC_pastsubmission {
6457: border: 1px solid black;
6458: margin: 2px;
6459: }
6460:
1.924 bisitz 6461: table#LC_menubuttons {
1.345 albertel 6462: width: 100%;
6463: background: $pgbg;
1.392 albertel 6464: border: 2px;
1.402 albertel 6465: border-collapse: separate;
1.803 bisitz 6466: padding: 0;
1.345 albertel 6467: }
1.392 albertel 6468:
1.801 tempelho 6469: table#LC_title_bar a {
6470: color: $fontmenu;
6471: }
1.836 bisitz 6472:
1.807 droeschl 6473: table#LC_title_bar {
1.819 tempelho 6474: clear: both;
1.836 bisitz 6475: display: none;
1.807 droeschl 6476: }
6477:
1.795 www 6478: table#LC_title_bar,
1.933 droeschl 6479: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6480: table#LC_title_bar.LC_with_remote {
1.359 albertel 6481: width: 100%;
1.392 albertel 6482: border-color: $pgbg;
6483: border-style: solid;
6484: border-width: $border;
1.379 albertel 6485: background: $pgbg;
1.801 tempelho 6486: color: $fontmenu;
1.392 albertel 6487: border-collapse: collapse;
1.803 bisitz 6488: padding: 0;
1.819 tempelho 6489: margin: 0;
1.359 albertel 6490: }
1.795 www 6491:
1.933 droeschl 6492: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6493: margin: 0;
6494: padding: 0;
1.933 droeschl 6495: position: relative;
6496: list-style: none;
1.913 droeschl 6497: }
1.933 droeschl 6498: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6499: display: inline;
6500: }
1.933 droeschl 6501:
6502: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6503: padding: 0;
1.933 droeschl 6504: margin: 0;
6505: float: left;
1.913 droeschl 6506: }
1.933 droeschl 6507: .LC_breadcrumb_tools_tools {
6508: padding: 0;
6509: margin: 0;
1.913 droeschl 6510: float: right;
6511: }
6512:
1.359 albertel 6513: table#LC_title_bar td {
6514: background: $tabbg;
6515: }
1.795 www 6516:
1.911 bisitz 6517: table#LC_menubuttons img {
1.803 bisitz 6518: border: none;
1.346 albertel 6519: }
1.795 www 6520:
1.842 droeschl 6521: .LC_breadcrumbs_component {
1.911 bisitz 6522: float: right;
6523: margin: 0 1em;
1.357 albertel 6524: }
1.842 droeschl 6525: .LC_breadcrumbs_component img {
1.911 bisitz 6526: vertical-align: middle;
1.777 tempelho 6527: }
1.795 www 6528:
1.1075.2.108 raeburn 6529: .LC_breadcrumbs_hoverable {
6530: background: $sidebg;
6531: }
6532:
1.383 albertel 6533: td.LC_table_cell_checkbox {
6534: text-align: center;
6535: }
1.795 www 6536:
6537: .LC_fontsize_small {
1.911 bisitz 6538: font-size: 70%;
1.705 tempelho 6539: }
6540:
1.844 bisitz 6541: #LC_breadcrumbs {
1.911 bisitz 6542: clear:both;
6543: background: $sidebg;
6544: border-bottom: 1px solid $lg_border_color;
6545: line-height: 2.5em;
1.933 droeschl 6546: overflow: hidden;
1.911 bisitz 6547: margin: 0;
6548: padding: 0;
1.995 raeburn 6549: text-align: left;
1.819 tempelho 6550: }
1.862 bisitz 6551:
1.1075.2.16 raeburn 6552: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6553: clear:both;
6554: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6555: border: 1px solid $sidebg;
1.1075.2.16 raeburn 6556: margin: 0 0 10px 0;
1.966 bisitz 6557: padding: 3px;
1.995 raeburn 6558: text-align: left;
1.822 bisitz 6559: }
6560:
1.795 www 6561: .LC_fontsize_medium {
1.911 bisitz 6562: font-size: 85%;
1.705 tempelho 6563: }
6564:
1.795 www 6565: .LC_fontsize_large {
1.911 bisitz 6566: font-size: 120%;
1.705 tempelho 6567: }
6568:
1.346 albertel 6569: .LC_menubuttons_inline_text {
6570: color: $font;
1.698 harmsja 6571: font-size: 90%;
1.701 harmsja 6572: padding-left:3px;
1.346 albertel 6573: }
6574:
1.934 droeschl 6575: .LC_menubuttons_inline_text img{
6576: vertical-align: middle;
6577: }
6578:
1.1051 www 6579: li.LC_menubuttons_inline_text img {
1.951 onken 6580: cursor:pointer;
1.1002 droeschl 6581: text-decoration: none;
1.951 onken 6582: }
6583:
1.526 www 6584: .LC_menubuttons_link {
6585: text-decoration: none;
6586: }
1.795 www 6587:
1.522 albertel 6588: .LC_menubuttons_category {
1.521 www 6589: color: $font;
1.526 www 6590: background: $pgbg;
1.521 www 6591: font-size: larger;
6592: font-weight: bold;
6593: }
6594:
1.346 albertel 6595: td.LC_menubuttons_text {
1.911 bisitz 6596: color: $font;
1.346 albertel 6597: }
1.706 harmsja 6598:
1.346 albertel 6599: .LC_current_location {
6600: background: $tabbg;
6601: }
1.795 www 6602:
1.1075.2.134 raeburn 6603: td.LC_zero_height {
6604: line-height: 0;
6605: cellpadding: 0;
6606: }
6607:
1.938 bisitz 6608: table.LC_data_table {
1.347 albertel 6609: border: 1px solid #000000;
1.402 albertel 6610: border-collapse: separate;
1.426 albertel 6611: border-spacing: 1px;
1.610 albertel 6612: background: $pgbg;
1.347 albertel 6613: }
1.795 www 6614:
1.422 albertel 6615: .LC_data_table_dense {
6616: font-size: small;
6617: }
1.795 www 6618:
1.507 raeburn 6619: table.LC_nested_outer {
6620: border: 1px solid #000000;
1.589 raeburn 6621: border-collapse: collapse;
1.803 bisitz 6622: border-spacing: 0;
1.507 raeburn 6623: width: 100%;
6624: }
1.795 www 6625:
1.879 raeburn 6626: table.LC_innerpickbox,
1.507 raeburn 6627: table.LC_nested {
1.803 bisitz 6628: border: none;
1.589 raeburn 6629: border-collapse: collapse;
1.803 bisitz 6630: border-spacing: 0;
1.507 raeburn 6631: width: 100%;
6632: }
1.795 www 6633:
1.911 bisitz 6634: table.LC_data_table tr th,
6635: table.LC_calendar tr th,
1.879 raeburn 6636: table.LC_prior_tries tr th,
6637: table.LC_innerpickbox tr th {
1.349 albertel 6638: font-weight: bold;
6639: background-color: $data_table_head;
1.801 tempelho 6640: color:$fontmenu;
1.701 harmsja 6641: font-size:90%;
1.347 albertel 6642: }
1.795 www 6643:
1.879 raeburn 6644: table.LC_innerpickbox tr th,
6645: table.LC_innerpickbox tr td {
6646: vertical-align: top;
6647: }
6648:
1.711 raeburn 6649: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6650: background-color: #CCCCCC;
1.711 raeburn 6651: font-weight: bold;
6652: text-align: left;
6653: }
1.795 www 6654:
1.912 bisitz 6655: table.LC_data_table tr.LC_odd_row > td {
6656: background-color: $data_table_light;
6657: padding: 2px;
6658: vertical-align: top;
6659: }
6660:
1.809 bisitz 6661: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6662: background-color: $data_table_light;
1.912 bisitz 6663: vertical-align: top;
6664: }
6665:
6666: table.LC_data_table tr.LC_even_row > td {
6667: background-color: $data_table_dark;
1.425 albertel 6668: padding: 2px;
1.900 bisitz 6669: vertical-align: top;
1.347 albertel 6670: }
1.795 www 6671:
1.809 bisitz 6672: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6673: background-color: $data_table_dark;
1.900 bisitz 6674: vertical-align: top;
1.347 albertel 6675: }
1.795 www 6676:
1.425 albertel 6677: table.LC_data_table tr.LC_data_table_highlight td {
6678: background-color: $data_table_darker;
6679: }
1.795 www 6680:
1.639 raeburn 6681: table.LC_data_table tr td.LC_leftcol_header {
6682: background-color: $data_table_head;
6683: font-weight: bold;
6684: }
1.795 www 6685:
1.451 albertel 6686: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6687: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6688: font-weight: bold;
6689: font-style: italic;
6690: text-align: center;
6691: padding: 8px;
1.347 albertel 6692: }
1.795 www 6693:
1.1075.2.30 raeburn 6694: table.LC_data_table tr.LC_empty_row td,
6695: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6696: background-color: $sidebg;
6697: }
6698:
6699: table.LC_nested tr.LC_empty_row td {
6700: background-color: #FFFFFF;
6701: }
6702:
1.890 droeschl 6703: table.LC_caption {
6704: }
6705:
1.507 raeburn 6706: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6707: padding: 4ex
6708: }
1.795 www 6709:
1.507 raeburn 6710: table.LC_nested_outer tr th {
6711: font-weight: bold;
1.801 tempelho 6712: color:$fontmenu;
1.507 raeburn 6713: background-color: $data_table_head;
1.701 harmsja 6714: font-size: small;
1.507 raeburn 6715: border-bottom: 1px solid #000000;
6716: }
1.795 www 6717:
1.507 raeburn 6718: table.LC_nested_outer tr td.LC_subheader {
6719: background-color: $data_table_head;
6720: font-weight: bold;
6721: font-size: small;
6722: border-bottom: 1px solid #000000;
6723: text-align: right;
1.451 albertel 6724: }
1.795 www 6725:
1.507 raeburn 6726: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6727: background-color: #CCCCCC;
1.451 albertel 6728: font-weight: bold;
6729: font-size: small;
1.507 raeburn 6730: text-align: center;
6731: }
1.795 www 6732:
1.589 raeburn 6733: table.LC_nested tr.LC_info_row td.LC_left_item,
6734: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6735: text-align: left;
1.451 albertel 6736: }
1.795 www 6737:
1.507 raeburn 6738: table.LC_nested td {
1.735 bisitz 6739: background-color: #FFFFFF;
1.451 albertel 6740: font-size: small;
1.507 raeburn 6741: }
1.795 www 6742:
1.507 raeburn 6743: table.LC_nested_outer tr th.LC_right_item,
6744: table.LC_nested tr.LC_info_row td.LC_right_item,
6745: table.LC_nested tr.LC_odd_row td.LC_right_item,
6746: table.LC_nested tr td.LC_right_item {
1.451 albertel 6747: text-align: right;
6748: }
6749:
1.507 raeburn 6750: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6751: background-color: #EEEEEE;
1.451 albertel 6752: }
6753:
1.473 raeburn 6754: table.LC_createuser {
6755: }
6756:
6757: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6758: font-size: small;
1.473 raeburn 6759: }
6760:
6761: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6762: background-color: #CCCCCC;
1.473 raeburn 6763: font-weight: bold;
6764: text-align: center;
6765: }
6766:
1.349 albertel 6767: table.LC_calendar {
6768: border: 1px solid #000000;
6769: border-collapse: collapse;
1.917 raeburn 6770: width: 98%;
1.349 albertel 6771: }
1.795 www 6772:
1.349 albertel 6773: table.LC_calendar_pickdate {
6774: font-size: xx-small;
6775: }
1.795 www 6776:
1.349 albertel 6777: table.LC_calendar tr td {
6778: border: 1px solid #000000;
6779: vertical-align: top;
1.917 raeburn 6780: width: 14%;
1.349 albertel 6781: }
1.795 www 6782:
1.349 albertel 6783: table.LC_calendar tr td.LC_calendar_day_empty {
6784: background-color: $data_table_dark;
6785: }
1.795 www 6786:
1.779 bisitz 6787: table.LC_calendar tr td.LC_calendar_day_current {
6788: background-color: $data_table_highlight;
1.777 tempelho 6789: }
1.795 www 6790:
1.938 bisitz 6791: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6792: background-color: $mail_new;
6793: }
1.795 www 6794:
1.938 bisitz 6795: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6796: background-color: $mail_new_hover;
6797: }
1.795 www 6798:
1.938 bisitz 6799: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6800: background-color: $mail_read;
6801: }
1.795 www 6802:
1.938 bisitz 6803: /*
6804: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6805: background-color: $mail_read_hover;
6806: }
1.938 bisitz 6807: */
1.795 www 6808:
1.938 bisitz 6809: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6810: background-color: $mail_replied;
6811: }
1.795 www 6812:
1.938 bisitz 6813: /*
6814: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6815: background-color: $mail_replied_hover;
6816: }
1.938 bisitz 6817: */
1.795 www 6818:
1.938 bisitz 6819: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6820: background-color: $mail_other;
6821: }
1.795 www 6822:
1.938 bisitz 6823: /*
6824: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6825: background-color: $mail_other_hover;
6826: }
1.938 bisitz 6827: */
1.494 raeburn 6828:
1.777 tempelho 6829: table.LC_data_table tr > td.LC_browser_file,
6830: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6831: background: #AAEE77;
1.389 albertel 6832: }
1.795 www 6833:
1.777 tempelho 6834: table.LC_data_table tr > td.LC_browser_file_locked,
6835: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6836: background: #FFAA99;
1.387 albertel 6837: }
1.795 www 6838:
1.777 tempelho 6839: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6840: background: #888888;
1.779 bisitz 6841: }
1.795 www 6842:
1.777 tempelho 6843: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6844: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6845: background: #F8F866;
1.777 tempelho 6846: }
1.795 www 6847:
1.696 bisitz 6848: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6849: background: #E0E8FF;
1.387 albertel 6850: }
1.696 bisitz 6851:
1.707 bisitz 6852: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6853: /* background: #77FF77; */
1.707 bisitz 6854: }
1.795 www 6855:
1.707 bisitz 6856: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6857: border-right: 8px solid #FFFF77;
1.707 bisitz 6858: }
1.795 www 6859:
1.707 bisitz 6860: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6861: border-right: 8px solid #FFAA77;
1.707 bisitz 6862: }
1.795 www 6863:
1.707 bisitz 6864: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6865: border-right: 8px solid #FF7777;
1.707 bisitz 6866: }
1.795 www 6867:
1.707 bisitz 6868: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6869: border-right: 8px solid #AAFF77;
1.707 bisitz 6870: }
1.795 www 6871:
1.707 bisitz 6872: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6873: border-right: 8px solid #11CC55;
1.707 bisitz 6874: }
6875:
1.388 albertel 6876: span.LC_current_location {
1.701 harmsja 6877: font-size:larger;
1.388 albertel 6878: background: $pgbg;
6879: }
1.387 albertel 6880:
1.1029 www 6881: span.LC_current_nav_location {
6882: font-weight:bold;
6883: background: $sidebg;
6884: }
6885:
1.395 albertel 6886: span.LC_parm_menu_item {
6887: font-size: larger;
6888: }
1.795 www 6889:
1.395 albertel 6890: span.LC_parm_scope_all {
6891: color: red;
6892: }
1.795 www 6893:
1.395 albertel 6894: span.LC_parm_scope_folder {
6895: color: green;
6896: }
1.795 www 6897:
1.395 albertel 6898: span.LC_parm_scope_resource {
6899: color: orange;
6900: }
1.795 www 6901:
1.395 albertel 6902: span.LC_parm_part {
6903: color: blue;
6904: }
1.795 www 6905:
1.911 bisitz 6906: span.LC_parm_folder,
6907: span.LC_parm_symb {
1.395 albertel 6908: font-size: x-small;
6909: font-family: $mono;
6910: color: #AAAAAA;
6911: }
6912:
1.977 bisitz 6913: ul.LC_parm_parmlist li {
6914: display: inline-block;
6915: padding: 0.3em 0.8em;
6916: vertical-align: top;
6917: width: 150px;
6918: border-top:1px solid $lg_border_color;
6919: }
6920:
1.795 www 6921: td.LC_parm_overview_level_menu,
6922: td.LC_parm_overview_map_menu,
6923: td.LC_parm_overview_parm_selectors,
6924: td.LC_parm_overview_restrictions {
1.396 albertel 6925: border: 1px solid black;
6926: border-collapse: collapse;
6927: }
1.795 www 6928:
1.396 albertel 6929: table.LC_parm_overview_restrictions td {
6930: border-width: 1px 4px 1px 4px;
6931: border-style: solid;
6932: border-color: $pgbg;
6933: text-align: center;
6934: }
1.795 www 6935:
1.396 albertel 6936: table.LC_parm_overview_restrictions th {
6937: background: $tabbg;
6938: border-width: 1px 4px 1px 4px;
6939: border-style: solid;
6940: border-color: $pgbg;
6941: }
1.795 www 6942:
1.398 albertel 6943: table#LC_helpmenu {
1.803 bisitz 6944: border: none;
1.398 albertel 6945: height: 55px;
1.803 bisitz 6946: border-spacing: 0;
1.398 albertel 6947: }
6948:
6949: table#LC_helpmenu fieldset legend {
6950: font-size: larger;
6951: }
1.795 www 6952:
1.397 albertel 6953: table#LC_helpmenu_links {
6954: width: 100%;
6955: border: 1px solid black;
6956: background: $pgbg;
1.803 bisitz 6957: padding: 0;
1.397 albertel 6958: border-spacing: 1px;
6959: }
1.795 www 6960:
1.397 albertel 6961: table#LC_helpmenu_links tr td {
6962: padding: 1px;
6963: background: $tabbg;
1.399 albertel 6964: text-align: center;
6965: font-weight: bold;
1.397 albertel 6966: }
1.396 albertel 6967:
1.795 www 6968: table#LC_helpmenu_links a:link,
6969: table#LC_helpmenu_links a:visited,
1.397 albertel 6970: table#LC_helpmenu_links a:active {
6971: text-decoration: none;
6972: color: $font;
6973: }
1.795 www 6974:
1.397 albertel 6975: table#LC_helpmenu_links a:hover {
6976: text-decoration: underline;
6977: color: $vlink;
6978: }
1.396 albertel 6979:
1.417 albertel 6980: .LC_chrt_popup_exists {
6981: border: 1px solid #339933;
6982: margin: -1px;
6983: }
1.795 www 6984:
1.417 albertel 6985: .LC_chrt_popup_up {
6986: border: 1px solid yellow;
6987: margin: -1px;
6988: }
1.795 www 6989:
1.417 albertel 6990: .LC_chrt_popup {
6991: border: 1px solid #8888FF;
6992: background: #CCCCFF;
6993: }
1.795 www 6994:
1.421 albertel 6995: table.LC_pick_box {
6996: border-collapse: separate;
6997: background: white;
6998: border: 1px solid black;
6999: border-spacing: 1px;
7000: }
1.795 www 7001:
1.421 albertel 7002: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7003: background: $sidebg;
1.421 albertel 7004: font-weight: bold;
1.900 bisitz 7005: text-align: left;
1.740 bisitz 7006: vertical-align: top;
1.421 albertel 7007: width: 184px;
7008: padding: 8px;
7009: }
1.795 www 7010:
1.579 raeburn 7011: table.LC_pick_box td.LC_pick_box_value {
7012: text-align: left;
7013: padding: 8px;
7014: }
1.795 www 7015:
1.579 raeburn 7016: table.LC_pick_box td.LC_pick_box_select {
7017: text-align: left;
7018: padding: 8px;
7019: }
1.795 www 7020:
1.424 albertel 7021: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7022: padding: 0;
1.421 albertel 7023: height: 1px;
7024: background: black;
7025: }
1.795 www 7026:
1.421 albertel 7027: table.LC_pick_box td.LC_pick_box_submit {
7028: text-align: right;
7029: }
1.795 www 7030:
1.579 raeburn 7031: table.LC_pick_box td.LC_evenrow_value {
7032: text-align: left;
7033: padding: 8px;
7034: background-color: $data_table_light;
7035: }
1.795 www 7036:
1.579 raeburn 7037: table.LC_pick_box td.LC_oddrow_value {
7038: text-align: left;
7039: padding: 8px;
7040: background-color: $data_table_light;
7041: }
1.795 www 7042:
1.579 raeburn 7043: span.LC_helpform_receipt_cat {
7044: font-weight: bold;
7045: }
1.795 www 7046:
1.424 albertel 7047: table.LC_group_priv_box {
7048: background: white;
7049: border: 1px solid black;
7050: border-spacing: 1px;
7051: }
1.795 www 7052:
1.424 albertel 7053: table.LC_group_priv_box td.LC_pick_box_title {
7054: background: $tabbg;
7055: font-weight: bold;
7056: text-align: right;
7057: width: 184px;
7058: }
1.795 www 7059:
1.424 albertel 7060: table.LC_group_priv_box td.LC_groups_fixed {
7061: background: $data_table_light;
7062: text-align: center;
7063: }
1.795 www 7064:
1.424 albertel 7065: table.LC_group_priv_box td.LC_groups_optional {
7066: background: $data_table_dark;
7067: text-align: center;
7068: }
1.795 www 7069:
1.424 albertel 7070: table.LC_group_priv_box td.LC_groups_functionality {
7071: background: $data_table_darker;
7072: text-align: center;
7073: font-weight: bold;
7074: }
1.795 www 7075:
1.424 albertel 7076: table.LC_group_priv td {
7077: text-align: left;
1.803 bisitz 7078: padding: 0;
1.424 albertel 7079: }
7080:
7081: .LC_navbuttons {
7082: margin: 2ex 0ex 2ex 0ex;
7083: }
1.795 www 7084:
1.423 albertel 7085: .LC_topic_bar {
7086: font-weight: bold;
7087: background: $tabbg;
1.918 wenzelju 7088: margin: 1em 0em 1em 2em;
1.805 bisitz 7089: padding: 3px;
1.918 wenzelju 7090: font-size: 1.2em;
1.423 albertel 7091: }
1.795 www 7092:
1.423 albertel 7093: .LC_topic_bar span {
1.918 wenzelju 7094: left: 0.5em;
7095: position: absolute;
1.423 albertel 7096: vertical-align: middle;
1.918 wenzelju 7097: font-size: 1.2em;
1.423 albertel 7098: }
1.795 www 7099:
1.423 albertel 7100: table.LC_course_group_status {
7101: margin: 20px;
7102: }
1.795 www 7103:
1.423 albertel 7104: table.LC_status_selector td {
7105: vertical-align: top;
7106: text-align: center;
1.424 albertel 7107: padding: 4px;
7108: }
1.795 www 7109:
1.599 albertel 7110: div.LC_feedback_link {
1.616 albertel 7111: clear: both;
1.829 kalberla 7112: background: $sidebg;
1.779 bisitz 7113: width: 100%;
1.829 kalberla 7114: padding-bottom: 10px;
7115: border: 1px $tabbg solid;
1.833 kalberla 7116: height: 22px;
7117: line-height: 22px;
7118: padding-top: 5px;
7119: }
7120:
7121: div.LC_feedback_link img {
7122: height: 22px;
1.867 kalberla 7123: vertical-align:middle;
1.829 kalberla 7124: }
7125:
1.911 bisitz 7126: div.LC_feedback_link a {
1.829 kalberla 7127: text-decoration: none;
1.489 raeburn 7128: }
1.795 www 7129:
1.867 kalberla 7130: div.LC_comblock {
1.911 bisitz 7131: display:inline;
1.867 kalberla 7132: color:$font;
7133: font-size:90%;
7134: }
7135:
7136: div.LC_feedback_link div.LC_comblock {
7137: padding-left:5px;
7138: }
7139:
7140: div.LC_feedback_link div.LC_comblock a {
7141: color:$font;
7142: }
7143:
1.489 raeburn 7144: span.LC_feedback_link {
1.858 bisitz 7145: /* background: $feedback_link_bg; */
1.599 albertel 7146: font-size: larger;
7147: }
1.795 www 7148:
1.599 albertel 7149: span.LC_message_link {
1.858 bisitz 7150: /* background: $feedback_link_bg; */
1.599 albertel 7151: font-size: larger;
7152: position: absolute;
7153: right: 1em;
1.489 raeburn 7154: }
1.421 albertel 7155:
1.515 albertel 7156: table.LC_prior_tries {
1.524 albertel 7157: border: 1px solid #000000;
7158: border-collapse: separate;
7159: border-spacing: 1px;
1.515 albertel 7160: }
1.523 albertel 7161:
1.515 albertel 7162: table.LC_prior_tries td {
1.524 albertel 7163: padding: 2px;
1.515 albertel 7164: }
1.523 albertel 7165:
7166: .LC_answer_correct {
1.795 www 7167: background: lightgreen;
7168: color: darkgreen;
7169: padding: 6px;
1.523 albertel 7170: }
1.795 www 7171:
1.523 albertel 7172: .LC_answer_charged_try {
1.797 www 7173: background: #FFAAAA;
1.795 www 7174: color: darkred;
7175: padding: 6px;
1.523 albertel 7176: }
1.795 www 7177:
1.779 bisitz 7178: .LC_answer_not_charged_try,
1.523 albertel 7179: .LC_answer_no_grade,
7180: .LC_answer_late {
1.795 www 7181: background: lightyellow;
1.523 albertel 7182: color: black;
1.795 www 7183: padding: 6px;
1.523 albertel 7184: }
1.795 www 7185:
1.523 albertel 7186: .LC_answer_previous {
1.795 www 7187: background: lightblue;
7188: color: darkblue;
7189: padding: 6px;
1.523 albertel 7190: }
1.795 www 7191:
1.779 bisitz 7192: .LC_answer_no_message {
1.777 tempelho 7193: background: #FFFFFF;
7194: color: black;
1.795 www 7195: padding: 6px;
1.779 bisitz 7196: }
1.795 www 7197:
1.1075.2.140 raeburn 7198: .LC_answer_unknown,
7199: .LC_answer_warning {
1.779 bisitz 7200: background: orange;
7201: color: black;
1.795 www 7202: padding: 6px;
1.777 tempelho 7203: }
1.795 www 7204:
1.529 albertel 7205: span.LC_prior_numerical,
7206: span.LC_prior_string,
7207: span.LC_prior_custom,
7208: span.LC_prior_reaction,
7209: span.LC_prior_math {
1.925 bisitz 7210: font-family: $mono;
1.523 albertel 7211: white-space: pre;
7212: }
7213:
1.525 albertel 7214: span.LC_prior_string {
1.925 bisitz 7215: font-family: $mono;
1.525 albertel 7216: white-space: pre;
7217: }
7218:
1.523 albertel 7219: table.LC_prior_option {
7220: width: 100%;
7221: border-collapse: collapse;
7222: }
1.795 www 7223:
1.911 bisitz 7224: table.LC_prior_rank,
1.795 www 7225: table.LC_prior_match {
1.528 albertel 7226: border-collapse: collapse;
7227: }
1.795 www 7228:
1.528 albertel 7229: table.LC_prior_option tr td,
7230: table.LC_prior_rank tr td,
7231: table.LC_prior_match tr td {
1.524 albertel 7232: border: 1px solid #000000;
1.515 albertel 7233: }
7234:
1.855 bisitz 7235: .LC_nobreak {
1.544 albertel 7236: white-space: nowrap;
1.519 raeburn 7237: }
7238:
1.576 raeburn 7239: span.LC_cusr_emph {
7240: font-style: italic;
7241: }
7242:
1.633 raeburn 7243: span.LC_cusr_subheading {
7244: font-weight: normal;
7245: font-size: 85%;
7246: }
7247:
1.861 bisitz 7248: div.LC_docs_entry_move {
1.859 bisitz 7249: border: 1px solid #BBBBBB;
1.545 albertel 7250: background: #DDDDDD;
1.861 bisitz 7251: width: 22px;
1.859 bisitz 7252: padding: 1px;
7253: margin: 0;
1.545 albertel 7254: }
7255:
1.861 bisitz 7256: table.LC_data_table tr > td.LC_docs_entry_commands,
7257: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7258: font-size: x-small;
7259: }
1.795 www 7260:
1.861 bisitz 7261: .LC_docs_entry_parameter {
7262: white-space: nowrap;
7263: }
7264:
1.544 albertel 7265: .LC_docs_copy {
1.545 albertel 7266: color: #000099;
1.544 albertel 7267: }
1.795 www 7268:
1.544 albertel 7269: .LC_docs_cut {
1.545 albertel 7270: color: #550044;
1.544 albertel 7271: }
1.795 www 7272:
1.544 albertel 7273: .LC_docs_rename {
1.545 albertel 7274: color: #009900;
1.544 albertel 7275: }
1.795 www 7276:
1.544 albertel 7277: .LC_docs_remove {
1.545 albertel 7278: color: #990000;
7279: }
7280:
1.1075.2.134 raeburn 7281: .LC_domprefs_email,
1.547 albertel 7282: .LC_docs_reinit_warn,
7283: .LC_docs_ext_edit {
7284: font-size: x-small;
7285: }
7286:
1.545 albertel 7287: table.LC_docs_adddocs td,
7288: table.LC_docs_adddocs th {
7289: border: 1px solid #BBBBBB;
7290: padding: 4px;
7291: background: #DDDDDD;
1.543 albertel 7292: }
7293:
1.584 albertel 7294: table.LC_sty_begin {
7295: background: #BBFFBB;
7296: }
1.795 www 7297:
1.584 albertel 7298: table.LC_sty_end {
7299: background: #FFBBBB;
7300: }
7301:
1.589 raeburn 7302: table.LC_double_column {
1.803 bisitz 7303: border-width: 0;
1.589 raeburn 7304: border-collapse: collapse;
7305: width: 100%;
7306: padding: 2px;
7307: }
7308:
7309: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7310: top: 2px;
1.589 raeburn 7311: left: 2px;
7312: width: 47%;
7313: vertical-align: top;
7314: }
7315:
7316: table.LC_double_column tr td.LC_right_col {
7317: top: 2px;
1.779 bisitz 7318: right: 2px;
1.589 raeburn 7319: width: 47%;
7320: vertical-align: top;
7321: }
7322:
1.591 raeburn 7323: div.LC_left_float {
7324: float: left;
7325: padding-right: 5%;
1.597 albertel 7326: padding-bottom: 4px;
1.591 raeburn 7327: }
7328:
7329: div.LC_clear_float_header {
1.597 albertel 7330: padding-bottom: 2px;
1.591 raeburn 7331: }
7332:
7333: div.LC_clear_float_footer {
1.597 albertel 7334: padding-top: 10px;
1.591 raeburn 7335: clear: both;
7336: }
7337:
1.597 albertel 7338: div.LC_grade_show_user {
1.941 bisitz 7339: /* border-left: 5px solid $sidebg; */
7340: border-top: 5px solid #000000;
7341: margin: 50px 0 0 0;
1.936 bisitz 7342: padding: 15px 0 5px 10px;
1.597 albertel 7343: }
1.795 www 7344:
1.936 bisitz 7345: div.LC_grade_show_user_odd_row {
1.941 bisitz 7346: /* border-left: 5px solid #000000; */
7347: }
7348:
7349: div.LC_grade_show_user div.LC_Box {
7350: margin-right: 50px;
1.597 albertel 7351: }
7352:
7353: div.LC_grade_submissions,
7354: div.LC_grade_message_center,
1.936 bisitz 7355: div.LC_grade_info_links {
1.597 albertel 7356: margin: 5px;
7357: width: 99%;
7358: background: #FFFFFF;
7359: }
1.795 www 7360:
1.597 albertel 7361: div.LC_grade_submissions_header,
1.936 bisitz 7362: div.LC_grade_message_center_header {
1.705 tempelho 7363: font-weight: bold;
7364: font-size: large;
1.597 albertel 7365: }
1.795 www 7366:
1.597 albertel 7367: div.LC_grade_submissions_body,
1.936 bisitz 7368: div.LC_grade_message_center_body {
1.597 albertel 7369: border: 1px solid black;
7370: width: 99%;
7371: background: #FFFFFF;
7372: }
1.795 www 7373:
1.613 albertel 7374: table.LC_scantron_action {
7375: width: 100%;
7376: }
1.795 www 7377:
1.613 albertel 7378: table.LC_scantron_action tr th {
1.698 harmsja 7379: font-weight:bold;
7380: font-style:normal;
1.613 albertel 7381: }
1.795 www 7382:
1.779 bisitz 7383: .LC_edit_problem_header,
1.614 albertel 7384: div.LC_edit_problem_footer {
1.705 tempelho 7385: font-weight: normal;
7386: font-size: medium;
1.602 albertel 7387: margin: 2px;
1.1060 bisitz 7388: background-color: $sidebg;
1.600 albertel 7389: }
1.795 www 7390:
1.600 albertel 7391: div.LC_edit_problem_header,
1.602 albertel 7392: div.LC_edit_problem_header div,
1.614 albertel 7393: div.LC_edit_problem_footer,
7394: div.LC_edit_problem_footer div,
1.602 albertel 7395: div.LC_edit_problem_editxml_header,
7396: div.LC_edit_problem_editxml_header div {
1.1075.2.112 raeburn 7397: z-index: 100;
1.600 albertel 7398: }
1.795 www 7399:
1.600 albertel 7400: div.LC_edit_problem_header_title {
1.705 tempelho 7401: font-weight: bold;
7402: font-size: larger;
1.602 albertel 7403: background: $tabbg;
7404: padding: 3px;
1.1060 bisitz 7405: margin: 0 0 5px 0;
1.602 albertel 7406: }
1.795 www 7407:
1.602 albertel 7408: table.LC_edit_problem_header_title {
7409: width: 100%;
1.600 albertel 7410: background: $tabbg;
1.602 albertel 7411: }
7412:
1.1075.2.112 raeburn 7413: div.LC_edit_actionbar {
7414: background-color: $sidebg;
7415: margin: 0;
7416: padding: 0;
7417: line-height: 200%;
1.602 albertel 7418: }
1.795 www 7419:
1.1075.2.112 raeburn 7420: div.LC_edit_actionbar div{
7421: padding: 0;
7422: margin: 0;
7423: display: inline-block;
1.600 albertel 7424: }
1.795 www 7425:
1.1075.2.34 raeburn 7426: .LC_edit_opt {
7427: padding-left: 1em;
7428: white-space: nowrap;
7429: }
7430:
1.1075.2.57 raeburn 7431: .LC_edit_problem_latexhelper{
7432: text-align: right;
7433: }
7434:
7435: #LC_edit_problem_colorful div{
7436: margin-left: 40px;
7437: }
7438:
1.1075.2.112 raeburn 7439: #LC_edit_problem_codemirror div{
7440: margin-left: 0px;
7441: }
7442:
1.911 bisitz 7443: img.stift {
1.803 bisitz 7444: border-width: 0;
7445: vertical-align: middle;
1.677 riegler 7446: }
1.680 riegler 7447:
1.923 bisitz 7448: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7449: vertical-align: top;
1.777 tempelho 7450: }
1.795 www 7451:
1.716 raeburn 7452: div.LC_createcourse {
1.911 bisitz 7453: margin: 10px 10px 10px 10px;
1.716 raeburn 7454: }
7455:
1.917 raeburn 7456: .LC_dccid {
1.1075.2.38 raeburn 7457: float: right;
1.917 raeburn 7458: margin: 0.2em 0 0 0;
7459: padding: 0;
7460: font-size: 90%;
7461: display:none;
7462: }
7463:
1.897 wenzelju 7464: ol.LC_primary_menu a:hover,
1.721 harmsja 7465: ol#LC_MenuBreadcrumbs a:hover,
7466: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7467: ul#LC_secondary_menu a:hover,
1.721 harmsja 7468: .LC_FormSectionClearButton input:hover
1.795 www 7469: ul.LC_TabContent li:hover a {
1.952 onken 7470: color:$button_hover;
1.911 bisitz 7471: text-decoration:none;
1.693 droeschl 7472: }
7473:
1.779 bisitz 7474: h1 {
1.911 bisitz 7475: padding: 0;
7476: line-height:130%;
1.693 droeschl 7477: }
1.698 harmsja 7478:
1.911 bisitz 7479: h2,
7480: h3,
7481: h4,
7482: h5,
7483: h6 {
7484: margin: 5px 0 5px 0;
7485: padding: 0;
7486: line-height:130%;
1.693 droeschl 7487: }
1.795 www 7488:
7489: .LC_hcell {
1.911 bisitz 7490: padding:3px 15px 3px 15px;
7491: margin: 0;
7492: background-color:$tabbg;
7493: color:$fontmenu;
7494: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7495: }
1.795 www 7496:
1.840 bisitz 7497: .LC_Box > .LC_hcell {
1.911 bisitz 7498: margin: 0 -10px 10px -10px;
1.835 bisitz 7499: }
7500:
1.721 harmsja 7501: .LC_noBorder {
1.911 bisitz 7502: border: 0;
1.698 harmsja 7503: }
1.693 droeschl 7504:
1.721 harmsja 7505: .LC_FormSectionClearButton input {
1.911 bisitz 7506: background-color:transparent;
7507: border: none;
7508: cursor:pointer;
7509: text-decoration:underline;
1.693 droeschl 7510: }
1.763 bisitz 7511:
7512: .LC_help_open_topic {
1.911 bisitz 7513: color: #FFFFFF;
7514: background-color: #EEEEFF;
7515: margin: 1px;
7516: padding: 4px;
7517: border: 1px solid #000033;
7518: white-space: nowrap;
7519: /* vertical-align: middle; */
1.759 neumanie 7520: }
1.693 droeschl 7521:
1.911 bisitz 7522: dl,
7523: ul,
7524: div,
7525: fieldset {
7526: margin: 10px 10px 10px 0;
7527: /* overflow: hidden; */
1.693 droeschl 7528: }
1.795 www 7529:
1.1075.2.90 raeburn 7530: article.geogebraweb div {
7531: margin: 0;
7532: }
7533:
1.838 bisitz 7534: fieldset > legend {
1.911 bisitz 7535: font-weight: bold;
7536: padding: 0 5px 0 5px;
1.838 bisitz 7537: }
7538:
1.813 bisitz 7539: #LC_nav_bar {
1.911 bisitz 7540: float: left;
1.995 raeburn 7541: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7542: margin: 0 0 2px 0;
1.807 droeschl 7543: }
7544:
1.916 droeschl 7545: #LC_realm {
7546: margin: 0.2em 0 0 0;
7547: padding: 0;
7548: font-weight: bold;
7549: text-align: center;
1.995 raeburn 7550: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7551: }
7552:
1.911 bisitz 7553: #LC_nav_bar em {
7554: font-weight: bold;
7555: font-style: normal;
1.807 droeschl 7556: }
7557:
1.897 wenzelju 7558: ol.LC_primary_menu {
1.934 droeschl 7559: margin: 0;
1.1075.2.2 raeburn 7560: padding: 0;
1.807 droeschl 7561: }
7562:
1.852 droeschl 7563: ol#LC_PathBreadcrumbs {
1.911 bisitz 7564: margin: 0;
1.693 droeschl 7565: }
7566:
1.897 wenzelju 7567: ol.LC_primary_menu li {
1.1075.2.2 raeburn 7568: color: RGB(80, 80, 80);
7569: vertical-align: middle;
7570: text-align: left;
7571: list-style: none;
1.1075.2.112 raeburn 7572: position: relative;
1.1075.2.2 raeburn 7573: float: left;
1.1075.2.112 raeburn 7574: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7575: line-height: 1.5em;
1.1075.2.2 raeburn 7576: }
7577:
1.1075.2.113 raeburn 7578: ol.LC_primary_menu li a,
1.1075.2.112 raeburn 7579: ol.LC_primary_menu li p {
1.1075.2.2 raeburn 7580: display: block;
7581: margin: 0;
7582: padding: 0 5px 0 10px;
7583: text-decoration: none;
7584: }
7585:
1.1075.2.112 raeburn 7586: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7587: display: inline-block;
7588: width: 95%;
7589: text-align: left;
7590: }
7591:
7592: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7593: display: inline-block;
7594: width: 5%;
7595: float: right;
7596: text-align: right;
7597: font-size: 70%;
7598: }
7599:
7600: ol.LC_primary_menu ul {
1.1075.2.2 raeburn 7601: display: none;
1.1075.2.112 raeburn 7602: width: 15em;
1.1075.2.2 raeburn 7603: background-color: $data_table_light;
1.1075.2.112 raeburn 7604: position: absolute;
7605: top: 100%;
7606: }
7607:
7608: ol.LC_primary_menu ul ul {
7609: left: 100%;
7610: top: 0;
1.1075.2.2 raeburn 7611: }
7612:
1.1075.2.112 raeburn 7613: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2 raeburn 7614: display: block;
7615: position: absolute;
7616: margin: 0;
7617: padding: 0;
1.1075.2.5 raeburn 7618: z-index: 2;
1.1075.2.2 raeburn 7619: }
7620:
7621: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112 raeburn 7622: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2 raeburn 7623: font-size: 90%;
1.911 bisitz 7624: vertical-align: top;
1.1075.2.2 raeburn 7625: float: none;
1.1075.2.5 raeburn 7626: border-left: 1px solid black;
7627: border-right: 1px solid black;
1.1075.2.112 raeburn 7628: /* A dark bottom border to visualize different menu options;
7629: overwritten in the create_submenu routine for the last border-bottom of the menu */
7630: border-bottom: 1px solid $data_table_dark;
1.1075.2.2 raeburn 7631: }
7632:
1.1075.2.112 raeburn 7633: ol.LC_primary_menu li li p:hover {
7634: color:$button_hover;
7635: text-decoration:none;
7636: background-color:$data_table_dark;
1.1075.2.2 raeburn 7637: }
7638:
7639: ol.LC_primary_menu li li a:hover {
7640: color:$button_hover;
7641: background-color:$data_table_dark;
1.693 droeschl 7642: }
7643:
1.1075.2.112 raeburn 7644: /* Font-size equal to the size of the predecessors*/
7645: ol.LC_primary_menu li:hover li li {
7646: font-size: 100%;
7647: }
7648:
1.897 wenzelju 7649: ol.LC_primary_menu li img {
1.911 bisitz 7650: vertical-align: bottom;
1.934 droeschl 7651: height: 1.1em;
1.1075.2.3 raeburn 7652: margin: 0.2em 0 0 0;
1.693 droeschl 7653: }
7654:
1.897 wenzelju 7655: ol.LC_primary_menu a {
1.911 bisitz 7656: color: RGB(80, 80, 80);
7657: text-decoration: none;
1.693 droeschl 7658: }
1.795 www 7659:
1.949 droeschl 7660: ol.LC_primary_menu a.LC_new_message {
7661: font-weight:bold;
7662: color: darkred;
7663: }
7664:
1.975 raeburn 7665: ol.LC_docs_parameters {
7666: margin-left: 0;
7667: padding: 0;
7668: list-style: none;
7669: }
7670:
7671: ol.LC_docs_parameters li {
7672: margin: 0;
7673: padding-right: 20px;
7674: display: inline;
7675: }
7676:
1.976 raeburn 7677: ol.LC_docs_parameters li:before {
7678: content: "\\002022 \\0020";
7679: }
7680:
7681: li.LC_docs_parameters_title {
7682: font-weight: bold;
7683: }
7684:
7685: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7686: content: "";
7687: }
7688:
1.897 wenzelju 7689: ul#LC_secondary_menu {
1.1075.2.23 raeburn 7690: clear: right;
1.911 bisitz 7691: color: $fontmenu;
7692: background: $tabbg;
7693: list-style: none;
7694: padding: 0;
7695: margin: 0;
7696: width: 100%;
1.995 raeburn 7697: text-align: left;
1.1075.2.4 raeburn 7698: float: left;
1.808 droeschl 7699: }
7700:
1.897 wenzelju 7701: ul#LC_secondary_menu li {
1.911 bisitz 7702: font-weight: bold;
7703: line-height: 1.8em;
7704: border-right: 1px solid black;
1.1075.2.4 raeburn 7705: float: left;
7706: }
7707:
7708: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7709: background-color: $data_table_light;
7710: }
7711:
7712: ul#LC_secondary_menu li a {
7713: padding: 0 0.8em;
7714: }
7715:
7716: ul#LC_secondary_menu li ul {
7717: display: none;
7718: }
7719:
7720: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7721: display: block;
7722: position: absolute;
7723: margin: 0;
7724: padding: 0;
7725: list-style:none;
7726: float: none;
7727: background-color: $data_table_light;
1.1075.2.5 raeburn 7728: z-index: 2;
1.1075.2.10 raeburn 7729: margin-left: -1px;
1.1075.2.4 raeburn 7730: }
7731:
7732: ul#LC_secondary_menu li ul li {
7733: font-size: 90%;
7734: vertical-align: top;
7735: border-left: 1px solid black;
7736: border-right: 1px solid black;
1.1075.2.33 raeburn 7737: background-color: $data_table_light;
1.1075.2.4 raeburn 7738: list-style:none;
7739: float: none;
7740: }
7741:
7742: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7743: background-color: $data_table_dark;
1.807 droeschl 7744: }
7745:
1.847 tempelho 7746: ul.LC_TabContent {
1.911 bisitz 7747: display:block;
7748: background: $sidebg;
7749: border-bottom: solid 1px $lg_border_color;
7750: list-style:none;
1.1020 raeburn 7751: margin: -1px -10px 0 -10px;
1.911 bisitz 7752: padding: 0;
1.693 droeschl 7753: }
7754:
1.795 www 7755: ul.LC_TabContent li,
7756: ul.LC_TabContentBigger li {
1.911 bisitz 7757: float:left;
1.741 harmsja 7758: }
1.795 www 7759:
1.897 wenzelju 7760: ul#LC_secondary_menu li a {
1.911 bisitz 7761: color: $fontmenu;
7762: text-decoration: none;
1.693 droeschl 7763: }
1.795 www 7764:
1.721 harmsja 7765: ul.LC_TabContent {
1.952 onken 7766: min-height:20px;
1.721 harmsja 7767: }
1.795 www 7768:
7769: ul.LC_TabContent li {
1.911 bisitz 7770: vertical-align:middle;
1.959 onken 7771: padding: 0 16px 0 10px;
1.911 bisitz 7772: background-color:$tabbg;
7773: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7774: border-left: solid 1px $font;
1.721 harmsja 7775: }
1.795 www 7776:
1.847 tempelho 7777: ul.LC_TabContent .right {
1.911 bisitz 7778: float:right;
1.847 tempelho 7779: }
7780:
1.911 bisitz 7781: ul.LC_TabContent li a,
7782: ul.LC_TabContent li {
7783: color:rgb(47,47,47);
7784: text-decoration:none;
7785: font-size:95%;
7786: font-weight:bold;
1.952 onken 7787: min-height:20px;
7788: }
7789:
1.959 onken 7790: ul.LC_TabContent li a:hover,
7791: ul.LC_TabContent li a:focus {
1.952 onken 7792: color: $button_hover;
1.959 onken 7793: background:none;
7794: outline:none;
1.952 onken 7795: }
7796:
7797: ul.LC_TabContent li:hover {
7798: color: $button_hover;
7799: cursor:pointer;
1.721 harmsja 7800: }
1.795 www 7801:
1.911 bisitz 7802: ul.LC_TabContent li.active {
1.952 onken 7803: color: $font;
1.911 bisitz 7804: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7805: border-bottom:solid 1px #FFFFFF;
7806: cursor: default;
1.744 ehlerst 7807: }
1.795 www 7808:
1.959 onken 7809: ul.LC_TabContent li.active a {
7810: color:$font;
7811: background:#FFFFFF;
7812: outline: none;
7813: }
1.1047 raeburn 7814:
7815: ul.LC_TabContent li.goback {
7816: float: left;
7817: border-left: none;
7818: }
7819:
1.870 tempelho 7820: #maincoursedoc {
1.911 bisitz 7821: clear:both;
1.870 tempelho 7822: }
7823:
7824: ul.LC_TabContentBigger {
1.911 bisitz 7825: display:block;
7826: list-style:none;
7827: padding: 0;
1.870 tempelho 7828: }
7829:
1.795 www 7830: ul.LC_TabContentBigger li {
1.911 bisitz 7831: vertical-align:bottom;
7832: height: 30px;
7833: font-size:110%;
7834: font-weight:bold;
7835: color: #737373;
1.841 tempelho 7836: }
7837:
1.957 onken 7838: ul.LC_TabContentBigger li.active {
7839: position: relative;
7840: top: 1px;
7841: }
7842:
1.870 tempelho 7843: ul.LC_TabContentBigger li a {
1.911 bisitz 7844: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7845: height: 30px;
7846: line-height: 30px;
7847: text-align: center;
7848: display: block;
7849: text-decoration: none;
1.958 onken 7850: outline: none;
1.741 harmsja 7851: }
1.795 www 7852:
1.870 tempelho 7853: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7854: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7855: color:$font;
1.744 ehlerst 7856: }
1.795 www 7857:
1.870 tempelho 7858: ul.LC_TabContentBigger li b {
1.911 bisitz 7859: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7860: display: block;
7861: float: left;
7862: padding: 0 30px;
1.957 onken 7863: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7864: }
7865:
1.956 onken 7866: ul.LC_TabContentBigger li:hover b {
7867: color:$button_hover;
7868: }
7869:
1.870 tempelho 7870: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7871: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7872: color:$font;
1.957 onken 7873: border: 0;
1.741 harmsja 7874: }
1.693 droeschl 7875:
1.870 tempelho 7876:
1.862 bisitz 7877: ul.LC_CourseBreadcrumbs {
7878: background: $sidebg;
1.1020 raeburn 7879: height: 2em;
1.862 bisitz 7880: padding-left: 10px;
1.1020 raeburn 7881: margin: 0;
1.862 bisitz 7882: list-style-position: inside;
7883: }
7884:
1.911 bisitz 7885: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7886: ol#LC_PathBreadcrumbs {
1.911 bisitz 7887: padding-left: 10px;
7888: margin: 0;
1.933 droeschl 7889: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7890: }
7891:
1.911 bisitz 7892: ol#LC_MenuBreadcrumbs li,
7893: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7894: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7895: display: inline;
1.933 droeschl 7896: white-space: normal;
1.693 droeschl 7897: }
7898:
1.823 bisitz 7899: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7900: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7901: text-decoration: none;
7902: font-size:90%;
1.693 droeschl 7903: }
1.795 www 7904:
1.969 droeschl 7905: ol#LC_MenuBreadcrumbs h1 {
7906: display: inline;
7907: font-size: 90%;
7908: line-height: 2.5em;
7909: margin: 0;
7910: padding: 0;
7911: }
7912:
1.795 www 7913: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7914: text-decoration:none;
7915: font-size:100%;
7916: font-weight:bold;
1.693 droeschl 7917: }
1.795 www 7918:
1.840 bisitz 7919: .LC_Box {
1.911 bisitz 7920: border: solid 1px $lg_border_color;
7921: padding: 0 10px 10px 10px;
1.746 neumanie 7922: }
1.795 www 7923:
1.1020 raeburn 7924: .LC_DocsBox {
7925: border: solid 1px $lg_border_color;
7926: padding: 0 0 10px 10px;
7927: }
7928:
1.795 www 7929: .LC_AboutMe_Image {
1.911 bisitz 7930: float:left;
7931: margin-right:10px;
1.747 neumanie 7932: }
1.795 www 7933:
7934: .LC_Clear_AboutMe_Image {
1.911 bisitz 7935: clear:left;
1.747 neumanie 7936: }
1.795 www 7937:
1.721 harmsja 7938: dl.LC_ListStyleClean dt {
1.911 bisitz 7939: padding-right: 5px;
7940: display: table-header-group;
1.693 droeschl 7941: }
7942:
1.721 harmsja 7943: dl.LC_ListStyleClean dd {
1.911 bisitz 7944: display: table-row;
1.693 droeschl 7945: }
7946:
1.721 harmsja 7947: .LC_ListStyleClean,
7948: .LC_ListStyleSimple,
7949: .LC_ListStyleNormal,
1.795 www 7950: .LC_ListStyleSpecial {
1.911 bisitz 7951: /* display:block; */
7952: list-style-position: inside;
7953: list-style-type: none;
7954: overflow: hidden;
7955: padding: 0;
1.693 droeschl 7956: }
7957:
1.721 harmsja 7958: .LC_ListStyleSimple li,
7959: .LC_ListStyleSimple dd,
7960: .LC_ListStyleNormal li,
7961: .LC_ListStyleNormal dd,
7962: .LC_ListStyleSpecial li,
1.795 www 7963: .LC_ListStyleSpecial dd {
1.911 bisitz 7964: margin: 0;
7965: padding: 5px 5px 5px 10px;
7966: clear: both;
1.693 droeschl 7967: }
7968:
1.721 harmsja 7969: .LC_ListStyleClean li,
7970: .LC_ListStyleClean dd {
1.911 bisitz 7971: padding-top: 0;
7972: padding-bottom: 0;
1.693 droeschl 7973: }
7974:
1.721 harmsja 7975: .LC_ListStyleSimple dd,
1.795 www 7976: .LC_ListStyleSimple li {
1.911 bisitz 7977: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7978: }
7979:
1.721 harmsja 7980: .LC_ListStyleSpecial li,
7981: .LC_ListStyleSpecial dd {
1.911 bisitz 7982: list-style-type: none;
7983: background-color: RGB(220, 220, 220);
7984: margin-bottom: 4px;
1.693 droeschl 7985: }
7986:
1.721 harmsja 7987: table.LC_SimpleTable {
1.911 bisitz 7988: margin:5px;
7989: border:solid 1px $lg_border_color;
1.795 www 7990: }
1.693 droeschl 7991:
1.721 harmsja 7992: table.LC_SimpleTable tr {
1.911 bisitz 7993: padding: 0;
7994: border:solid 1px $lg_border_color;
1.693 droeschl 7995: }
1.795 www 7996:
7997: table.LC_SimpleTable thead {
1.911 bisitz 7998: background:rgb(220,220,220);
1.693 droeschl 7999: }
8000:
1.721 harmsja 8001: div.LC_columnSection {
1.911 bisitz 8002: display: block;
8003: clear: both;
8004: overflow: hidden;
8005: margin: 0;
1.693 droeschl 8006: }
8007:
1.721 harmsja 8008: div.LC_columnSection>* {
1.911 bisitz 8009: float: left;
8010: margin: 10px 20px 10px 0;
8011: overflow:hidden;
1.693 droeschl 8012: }
1.721 harmsja 8013:
1.795 www 8014: table em {
1.911 bisitz 8015: font-weight: bold;
8016: font-style: normal;
1.748 schulted 8017: }
1.795 www 8018:
1.779 bisitz 8019: table.LC_tableBrowseRes,
1.795 www 8020: table.LC_tableOfContent {
1.911 bisitz 8021: border:none;
8022: border-spacing: 1px;
8023: padding: 3px;
8024: background-color: #FFFFFF;
8025: font-size: 90%;
1.753 droeschl 8026: }
1.789 droeschl 8027:
1.911 bisitz 8028: table.LC_tableOfContent {
8029: border-collapse: collapse;
1.789 droeschl 8030: }
8031:
1.771 droeschl 8032: table.LC_tableBrowseRes a,
1.768 schulted 8033: table.LC_tableOfContent a {
1.911 bisitz 8034: background-color: transparent;
8035: text-decoration: none;
1.753 droeschl 8036: }
8037:
1.795 www 8038: table.LC_tableOfContent img {
1.911 bisitz 8039: border: none;
8040: height: 1.3em;
8041: vertical-align: text-bottom;
8042: margin-right: 0.3em;
1.753 droeschl 8043: }
1.757 schulted 8044:
1.795 www 8045: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8046: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8047: }
8048:
1.795 www 8049: a#LC_content_toolbar_everything {
1.911 bisitz 8050: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8051: }
8052:
1.795 www 8053: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8054: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8055: }
8056:
1.795 www 8057: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8058: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8059: }
8060:
1.795 www 8061: a#LC_content_toolbar_changefolder {
1.911 bisitz 8062: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8063: }
8064:
1.795 www 8065: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8066: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8067: }
8068:
1.1043 raeburn 8069: a#LC_content_toolbar_edittoplevel {
8070: background-image:url(/res/adm/pages/edittoplevel.gif);
8071: }
8072:
1.795 www 8073: ul#LC_toolbar li a:hover {
1.911 bisitz 8074: background-position: bottom center;
1.757 schulted 8075: }
8076:
1.795 www 8077: ul#LC_toolbar {
1.911 bisitz 8078: padding: 0;
8079: margin: 2px;
8080: list-style:none;
8081: position:relative;
8082: background-color:white;
1.1075.2.9 raeburn 8083: overflow: auto;
1.757 schulted 8084: }
8085:
1.795 www 8086: ul#LC_toolbar li {
1.911 bisitz 8087: border:1px solid white;
8088: padding: 0;
8089: margin: 0;
8090: float: left;
8091: display:inline;
8092: vertical-align:middle;
1.1075.2.9 raeburn 8093: white-space: nowrap;
1.911 bisitz 8094: }
1.757 schulted 8095:
1.783 amueller 8096:
1.795 www 8097: a.LC_toolbarItem {
1.911 bisitz 8098: display:block;
8099: padding: 0;
8100: margin: 0;
8101: height: 32px;
8102: width: 32px;
8103: color:white;
8104: border: none;
8105: background-repeat:no-repeat;
8106: background-color:transparent;
1.757 schulted 8107: }
8108:
1.915 droeschl 8109: ul.LC_funclist {
8110: margin: 0;
8111: padding: 0.5em 1em 0.5em 0;
8112: }
8113:
1.933 droeschl 8114: ul.LC_funclist > li:first-child {
8115: font-weight:bold;
8116: margin-left:0.8em;
8117: }
8118:
1.915 droeschl 8119: ul.LC_funclist + ul.LC_funclist {
8120: /*
8121: left border as a seperator if we have more than
8122: one list
8123: */
8124: border-left: 1px solid $sidebg;
8125: /*
8126: this hides the left border behind the border of the
8127: outer box if element is wrapped to the next 'line'
8128: */
8129: margin-left: -1px;
8130: }
8131:
1.843 bisitz 8132: ul.LC_funclist li {
1.915 droeschl 8133: display: inline;
1.782 bisitz 8134: white-space: nowrap;
1.915 droeschl 8135: margin: 0 0 0 25px;
8136: line-height: 150%;
1.782 bisitz 8137: }
8138:
1.974 wenzelju 8139: .LC_hidden {
8140: display: none;
8141: }
8142:
1.1030 www 8143: .LCmodal-overlay {
8144: position:fixed;
8145: top:0;
8146: right:0;
8147: bottom:0;
8148: left:0;
8149: height:100%;
8150: width:100%;
8151: margin:0;
8152: padding:0;
8153: background:#999;
8154: opacity:.75;
8155: filter: alpha(opacity=75);
8156: -moz-opacity: 0.75;
8157: z-index:101;
8158: }
8159:
8160: * html .LCmodal-overlay {
8161: position: absolute;
8162: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8163: }
8164:
8165: .LCmodal-window {
8166: position:fixed;
8167: top:50%;
8168: left:50%;
8169: margin:0;
8170: padding:0;
8171: z-index:102;
8172: }
8173:
8174: * html .LCmodal-window {
8175: position:absolute;
8176: }
8177:
8178: .LCclose-window {
8179: position:absolute;
8180: width:32px;
8181: height:32px;
8182: right:8px;
8183: top:8px;
8184: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8185: text-indent:-99999px;
8186: overflow:hidden;
8187: cursor:pointer;
8188: }
8189:
1.1075.2.158 raeburn 8190: .LCisDisabled {
8191: cursor: not-allowed;
8192: opacity: 0.5;
8193: }
8194:
8195: a[aria-disabled="true"] {
8196: color: currentColor;
8197: display: inline-block; /* For IE11/ MS Edge bug */
8198: pointer-events: none;
8199: text-decoration: none;
8200: }
8201:
1.1075.2.141 raeburn 8202: pre.LC_wordwrap {
8203: white-space: pre-wrap;
8204: white-space: -moz-pre-wrap;
8205: white-space: -pre-wrap;
8206: white-space: -o-pre-wrap;
8207: word-wrap: break-word;
8208: }
8209:
1.1075.2.17 raeburn 8210: /*
8211: styles used by TTH when "Default set of options to pass to tth/m
8212: when converting TeX" in course settings has been set
8213:
8214: option passed: -t
8215:
8216: */
8217:
8218: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8219: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8220: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8221: td div.norm {line-height:normal;}
8222:
8223: /*
8224: option passed -y3
8225: */
8226:
8227: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8228: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8229: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8230:
1.1075.2.121 raeburn 8231: #LC_minitab_header {
8232: float:left;
8233: width:100%;
8234: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8235: font-size:93%;
8236: line-height:normal;
8237: margin: 0.5em 0 0.5em 0;
8238: }
8239: #LC_minitab_header ul {
8240: margin:0;
8241: padding:10px 10px 0;
8242: list-style:none;
8243: }
8244: #LC_minitab_header li {
8245: float:left;
8246: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8247: margin:0;
8248: padding:0 0 0 9px;
8249: }
8250: #LC_minitab_header a {
8251: display:block;
8252: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8253: padding:5px 15px 4px 6px;
8254: }
8255: #LC_minitab_header #LC_current_minitab {
8256: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8257: }
8258: #LC_minitab_header #LC_current_minitab a {
8259: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8260: padding-bottom:5px;
8261: }
8262:
8263:
1.343 albertel 8264: END
8265: }
8266:
1.306 albertel 8267: =pod
8268:
8269: =item * &headtag()
8270:
8271: Returns a uniform footer for LON-CAPA web pages.
8272:
1.307 albertel 8273: Inputs: $title - optional title for the head
8274: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8275: $args - optional arguments
1.319 albertel 8276: force_register - if is true call registerurl so the remote is
8277: informed
1.415 albertel 8278: redirect -> array ref of
8279: 1- seconds before redirect occurs
8280: 2- url to redirect to
8281: 3- whether the side effect should occur
1.315 albertel 8282: (side effect of setting
8283: $env{'internal.head.redirect'} to the url
8284: redirected too)
1.352 albertel 8285: domain -> force to color decorate a page for a specific
8286: domain
8287: function -> force usage of a specific rolish color scheme
8288: bgcolor -> override the default page bgcolor
1.460 albertel 8289: no_auto_mt_title
8290: -> prevent &mt()ing the title arg
1.464 albertel 8291:
1.306 albertel 8292: =cut
8293:
8294: sub headtag {
1.313 albertel 8295: my ($title,$head_extra,$args) = @_;
1.306 albertel 8296:
1.363 albertel 8297: my $function = $args->{'function'} || &get_users_function();
8298: my $domain = $args->{'domain'} || &determinedomain();
8299: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 8300: my $httphost = $args->{'use_absolute'};
1.418 albertel 8301: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8302: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8303: #time(),
1.418 albertel 8304: $env{'environment.color.timestamp'},
1.363 albertel 8305: $function,$domain,$bgcolor);
8306:
1.369 www 8307: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8308:
1.308 albertel 8309: my $result =
8310: '<head>'.
1.1075.2.56 raeburn 8311: &font_settings($args);
1.319 albertel 8312:
1.1075.2.72 raeburn 8313: my $inhibitprint;
8314: if ($args->{'print_suppress'}) {
8315: $inhibitprint = &print_suppression();
8316: }
1.1064 raeburn 8317:
1.461 albertel 8318: if (!$args->{'frameset'}) {
8319: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8320: }
1.1075.2.12 raeburn 8321: if ($args->{'force_register'}) {
8322: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 8323: }
1.436 albertel 8324: if (!$args->{'no_nav_bar'}
8325: && !$args->{'only_body'}
8326: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 8327: $result .= &help_menu_js($httphost);
1.1032 www 8328: $result.=&modal_window();
1.1038 www 8329: $result.=&togglebox_script();
1.1034 www 8330: $result.=&wishlist_window();
1.1041 www 8331: $result.=&LCprogressbarUpdate_script();
1.1034 www 8332: } else {
8333: if ($args->{'add_modal'}) {
8334: $result.=&modal_window();
8335: }
8336: if ($args->{'add_wishlist'}) {
8337: $result.=&wishlist_window();
8338: }
1.1038 www 8339: if ($args->{'add_togglebox'}) {
8340: $result.=&togglebox_script();
8341: }
1.1041 www 8342: if ($args->{'add_progressbar'}) {
8343: $result.=&LCprogressbarUpdate_script();
8344: }
1.436 albertel 8345: }
1.314 albertel 8346: if (ref($args->{'redirect'})) {
1.414 albertel 8347: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8348: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8349: if (!$inhibit_continue) {
8350: $env{'internal.head.redirect'} = $url;
8351: }
1.313 albertel 8352: $result.=<<ADDMETA
8353: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8354: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8355: ADDMETA
1.1075.2.89 raeburn 8356: } else {
8357: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8358: my $requrl = $env{'request.uri'};
8359: if ($requrl eq '') {
8360: $requrl = $ENV{'REQUEST_URI'};
8361: $requrl =~ s/\?.+$//;
8362: }
8363: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8364: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8365: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8366: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8367: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8368: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1075.2.145 raeburn 8369: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1075.2.151 raeburn 8370: my ($offload,$offloadoth);
1.1075.2.89 raeburn 8371: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8372: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1075.2.145 raeburn 8373: $offload = 1;
1.1075.2.151 raeburn 8374: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8375: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8376: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8377: $offloadoth = 1;
8378: $dom_in_use = $env{'user.domain'};
8379: }
8380: }
1.1075.2.145 raeburn 8381: }
8382: }
8383: unless ($offload) {
8384: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
8385: if ($domdefs{'offloadoth'}{$lonhost}) {
8386: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8387: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8388: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8389: $offload = 1;
1.1075.2.151 raeburn 8390: $offloadoth = 1;
1.1075.2.145 raeburn 8391: $dom_in_use = $env{'user.domain'};
8392: }
1.1075.2.89 raeburn 8393: }
1.1075.2.145 raeburn 8394: }
8395: }
8396: }
8397: if ($offload) {
1.1075.2.158 raeburn 8398: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1075.2.151 raeburn 8399: if (($newserver eq '') && ($offloadoth)) {
8400: my @domains = &Apache::lonnet::current_machine_domains();
1.1075.2.161. .1(raebu 8401:21): if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
1.1075.2.151 raeburn 8402: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
8403: }
8404: }
1.1075.2.145 raeburn 8405: if (($newserver) && ($newserver ne $lonhost)) {
8406: my $numsec = 5;
8407: my $timeout = $numsec * 1000;
8408: my ($newurl,$locknum,%locks,$msg);
8409: if ($env{'request.role.adv'}) {
8410: ($locknum,%locks) = &Apache::lonnet::get_locks();
8411: }
8412: my $disable_submit = 0;
8413: if ($requrl =~ /$LONCAPA::assess_re/) {
8414: $disable_submit = 1;
8415: }
8416: if ($locknum) {
8417: my @lockinfo = sort(values(%locks));
1.1075.2.153 raeburn 8418: $msg = &mt('Once the following tasks are complete:')." \n".
1.1075.2.145 raeburn 8419: join(", ",sort(values(%locks)))."\n";
8420: if (&show_course()) {
8421: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
1.1075.2.89 raeburn 8422: } else {
1.1075.2.145 raeburn 8423: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
8424: }
8425: } else {
8426: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8427: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
8428: }
8429: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8430: $newurl = '/adm/switchserver?otherserver='.$newserver;
8431: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8432: $newurl .= '&role='.$env{'request.role'};
8433: }
8434: if ($env{'request.symb'}) {
8435: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
8436: if ($shownsymb =~ m{^/enc/}) {
8437: my $reqdmajor = 2;
8438: my $reqdminor = 11;
8439: my $reqdsubminor = 3;
8440: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
8441: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
8442: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
8443: if (($major eq '' && $minor eq '') ||
8444: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
8445: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
8446: ($reqdsubminor > $subminor))))) {
8447: undef($shownsymb);
8448: }
1.1075.2.89 raeburn 8449: }
1.1075.2.145 raeburn 8450: if ($shownsymb) {
8451: &js_escape(\$shownsymb);
8452: $newurl .= '&symb='.$shownsymb;
1.1075.2.89 raeburn 8453: }
1.1075.2.145 raeburn 8454: } else {
8455: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
8456: &js_escape(\$shownurl);
8457: $newurl .= '&origurl='.$shownurl;
1.1075.2.89 raeburn 8458: }
1.1075.2.145 raeburn 8459: }
8460: &js_escape(\$msg);
8461: $result.=<<OFFLOAD
1.1075.2.89 raeburn 8462: <meta http-equiv="pragma" content="no-cache" />
8463: <script type="text/javascript">
1.1075.2.92 raeburn 8464: // <![CDATA[
1.1075.2.89 raeburn 8465: function LC_Offload_Now() {
8466: var dest = "$newurl";
8467: if (dest != '') {
8468: window.location.href="$newurl";
8469: }
8470: }
1.1075.2.92 raeburn 8471: \$(document).ready(function () {
8472: window.alert('$msg');
8473: if ($disable_submit) {
1.1075.2.89 raeburn 8474: \$(".LC_hwk_submit").prop("disabled", true);
8475: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 8476: }
8477: setTimeout('LC_Offload_Now()', $timeout);
8478: });
8479: // ]]>
1.1075.2.89 raeburn 8480: </script>
8481: OFFLOAD
8482: }
8483: }
8484: }
8485: }
8486: }
1.313 albertel 8487: }
1.306 albertel 8488: if (!defined($title)) {
8489: $title = 'The LearningOnline Network with CAPA';
8490: }
1.460 albertel 8491: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8492: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 8493: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8494: if (!$args->{'frameset'}) {
8495: $result .= ' /';
8496: }
8497: $result .= '>'
1.1064 raeburn 8498: .$inhibitprint
1.414 albertel 8499: .$head_extra;
1.1075.2.108 raeburn 8500: my $clientmobile;
8501: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8502: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8503: } else {
8504: $clientmobile = $env{'browser.mobile'};
8505: }
8506: if ($clientmobile) {
1.1075.2.42 raeburn 8507: $result .= '
8508: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8509: <meta name="apple-mobile-web-app-capable" content="yes" />';
8510: }
1.1075.2.126 raeburn 8511: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8512: return $result.'</head>';
1.306 albertel 8513: }
8514:
8515: =pod
8516:
1.340 albertel 8517: =item * &font_settings()
8518:
8519: Returns neccessary <meta> to set the proper encoding
8520:
1.1075.2.56 raeburn 8521: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8522:
8523: =cut
8524:
8525: sub font_settings {
1.1075.2.56 raeburn 8526: my ($args) = @_;
1.340 albertel 8527: my $headerstring='';
1.1075.2.56 raeburn 8528: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8529: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 8530: $headerstring.=
1.1075.2.61 raeburn 8531: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8532: if (!$args->{'frameset'}) {
8533: $headerstring.= ' /';
8534: }
8535: $headerstring .= '>'."\n";
1.340 albertel 8536: }
8537: return $headerstring;
8538: }
8539:
1.341 albertel 8540: =pod
8541:
1.1064 raeburn 8542: =item * &print_suppression()
8543:
8544: In course context returns css which causes the body to be blank when media="print",
8545: if printout generation is unavailable for the current resource.
8546:
8547: This could be because:
8548:
8549: (a) printstartdate is in the future
8550:
8551: (b) printenddate is in the past
8552:
8553: (c) there is an active exam block with "printout"
8554: functionality blocked
8555:
8556: Users with pav, pfo or evb privileges are exempt.
8557:
8558: Inputs: none
8559:
8560: =cut
8561:
8562:
8563: sub print_suppression {
8564: my $noprint;
8565: if ($env{'request.course.id'}) {
8566: my $scope = $env{'request.course.id'};
8567: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8568: (&Apache::lonnet::allowed('pfo',$scope))) {
8569: return;
8570: }
8571: if ($env{'request.course.sec'} ne '') {
8572: $scope .= "/$env{'request.course.sec'}";
8573: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8574: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8575: return;
1.1064 raeburn 8576: }
8577: }
8578: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8579: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.158 raeburn 8580: my $clientip = &Apache::lonnet::get_requestor_ip();
8581: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 8582: if ($blocked) {
8583: my $checkrole = "cm./$cdom/$cnum";
8584: if ($env{'request.course.sec'} ne '') {
8585: $checkrole .= "/$env{'request.course.sec'}";
8586: }
8587: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8588: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8589: $noprint = 1;
8590: }
8591: }
8592: unless ($noprint) {
8593: my $symb = &Apache::lonnet::symbread();
8594: if ($symb ne '') {
8595: my $navmap = Apache::lonnavmaps::navmap->new();
8596: if (ref($navmap)) {
8597: my $res = $navmap->getBySymb($symb);
8598: if (ref($res)) {
8599: if (!$res->resprintable()) {
8600: $noprint = 1;
8601: }
8602: }
8603: }
8604: }
8605: }
8606: if ($noprint) {
8607: return <<"ENDSTYLE";
8608: <style type="text/css" media="print">
8609: body { display:none }
8610: </style>
8611: ENDSTYLE
8612: }
8613: }
8614: return;
8615: }
8616:
8617: =pod
8618:
1.341 albertel 8619: =item * &xml_begin()
8620:
8621: Returns the needed doctype and <html>
8622:
8623: Inputs: none
8624:
8625: =cut
8626:
8627: sub xml_begin {
1.1075.2.61 raeburn 8628: my ($is_frameset) = @_;
1.341 albertel 8629: my $output='';
8630:
8631: if ($env{'browser.mathml'}) {
8632: $output='<?xml version="1.0"?>'
8633: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8634: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8635:
8636: # .'<!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">] >'
8637: .'<!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">'
8638: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8639: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 8640: } elsif ($is_frameset) {
8641: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8642: '<html>'."\n";
1.341 albertel 8643: } else {
1.1075.2.61 raeburn 8644: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8645: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8646: }
8647: return $output;
8648: }
1.340 albertel 8649:
8650: =pod
8651:
1.306 albertel 8652: =item * &start_page()
8653:
8654: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8655:
1.648 raeburn 8656: Inputs:
8657:
8658: =over 4
8659:
8660: $title - optional title for the page
8661:
8662: $head_extra - optional extra HTML to incude inside the <head>
8663:
8664: $args - additional optional args supported are:
8665:
8666: =over 8
8667:
8668: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8669: arg on
1.814 bisitz 8670: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8671: add_entries -> additional attributes to add to the <body>
8672: domain -> force to color decorate a page for a
1.317 albertel 8673: specific domain
1.648 raeburn 8674: function -> force usage of a specific rolish color
1.317 albertel 8675: scheme
1.648 raeburn 8676: redirect -> see &headtag()
8677: bgcolor -> override the default page bg color
8678: js_ready -> return a string ready for being used in
1.317 albertel 8679: a javascript writeln
1.648 raeburn 8680: html_encode -> return a string ready for being used in
1.320 albertel 8681: a html attribute
1.648 raeburn 8682: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8683: $forcereg arg
1.648 raeburn 8684: frameset -> if true will start with a <frameset>
1.330 albertel 8685: rather than <body>
1.648 raeburn 8686: skip_phases -> hash ref of
1.338 albertel 8687: head -> skip the <html><head> generation
8688: body -> skip all <body> generation
1.1075.2.12 raeburn 8689: no_inline_link -> if true and in remote mode, don't show the
8690: 'Switch To Inline Menu' link
1.648 raeburn 8691: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8692: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8693: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.123 raeburn 8694: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8695: to lonhtmlcommon::breadcrumbs
1.1075.2.15 raeburn 8696: group -> includes the current group, if page is for a
8697: specific group
1.1075.2.133 raeburn 8698: use_absolute -> for request for external resource or syllabus, this
8699: will contain https://<hostname> if server uses
8700: https (as per hosts.tab), but request is for http
8701: hostname -> hostname, originally from $r->hostname(), (optional).
1.1075.2.158 raeburn 8702: links_disabled -> Links in primary and secondary menus are disabled
8703: (Can enable them once page has loaded - see lonroles.pm
8704: for an example).
1.361 albertel 8705:
1.648 raeburn 8706: =back
1.460 albertel 8707:
1.648 raeburn 8708: =back
1.562 albertel 8709:
1.306 albertel 8710: =cut
8711:
8712: sub start_page {
1.309 albertel 8713: my ($title,$head_extra,$args) = @_;
1.318 albertel 8714: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8715:
1.315 albertel 8716: $env{'internal.start_page'}++;
1.1075.2.161. .1(raebu 8717:21): my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 8718:
1.338 albertel 8719: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 8720: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8721: }
1.1075.2.161. .1(raebu 8722:21):
8723:21): if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
8724:21): if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
8725:21): unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
8726:21): $args->{'no_primary_menu'} = 1;
8727:21): }
8728:21): unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
8729:21): $args->{'no_inline_menu'} = 1;
8730:21): }
8731:21): if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
8732:21): map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
8733:21): }
8734:21): } else {
8735:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8736:21): my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
8737:21): if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
8738:21): unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
8739:21): $args->{'no_primary_menu'} = 1;
8740:21): }
8741:21): unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
8742:21): $args->{'no_inline_menu'} = 1;
8743:21): }
8744:21): if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
8745:21): map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
8746:21): }
8747:21): }
8748:21): }
8749:21): ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
8750:21): $env{'course.'.$env{'request.course.id'}.'.domain'},
8751:21): $env{'course.'.$env{'request.course.id'}.'.num'});
8752:21): } elsif ($env{'request.course.id'}) {
8753:21): my $expiretime=600;
8754:21): if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
8755:21): &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
8756:21): }
8757:21): my ($deeplinkmenu,$menuref);
8758:21): ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
8759:21): if ($menucoll) {
8760:21): if (ref($menuref) eq 'HASH') {
8761:21): %menu = %{$menuref};
8762:21): }
8763:21): if ($menu{'top'} eq 'n') {
8764:21): $args->{'no_primary_menu'} = 1;
8765:21): }
8766:21): if ($menu{'inline'} eq 'n') {
8767:21): unless (&Apache::lonnet::allowed('opa')) {
8768:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8769:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
8770:21): my $crstype = &course_type();
8771:21): my $now = time;
8772:21): my $ccrole;
8773:21): if ($crstype eq 'Community') {
8774:21): $ccrole = 'co';
8775:21): } else {
8776:21): $ccrole = 'cc';
8777:21): }
8778:21): if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
8779:21): my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
8780:21): if ((($start) && ($start<0)) ||
8781:21): (($end) && ($end<$now)) ||
8782:21): (($start) && ($now<$start))) {
8783:21): $args->{'no_inline_menu'} = 1;
8784:21): }
8785:21): } else {
8786:21): $args->{'no_inline_menu'} = 1;
8787:21): }
8788:21): }
8789:21): }
8790:21): }
8791:21): }
.4(raebu 8792:22):
1.338 albertel 8793: if (! exists($args->{'skip_phases'}{'body'}) ) {
8794: if ($args->{'frameset'}) {
8795: my $attr_string = &make_attr_string($args->{'force_register'},
8796: $args->{'add_entries'});
8797: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8798: } else {
8799: $result .=
8800: &bodytag($title,
8801: $args->{'function'}, $args->{'add_entries'},
8802: $args->{'only_body'}, $args->{'domain'},
8803: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 8804: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.161. .1(raebu 8805:21): $args, \@advtools,
8806:21): $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
1.831 bisitz 8807: }
1.330 albertel 8808: }
1.338 albertel 8809:
1.315 albertel 8810: if ($args->{'js_ready'}) {
1.713 kaisler 8811: $result = &js_ready($result);
1.315 albertel 8812: }
1.320 albertel 8813: if ($args->{'html_encode'}) {
1.713 kaisler 8814: $result = &html_encode($result);
8815: }
8816:
1.813 bisitz 8817: # Preparation for new and consistent functionlist at top of screen
8818: # if ($args->{'functionlist'}) {
8819: # $result .= &build_functionlist();
8820: #}
8821:
1.964 droeschl 8822: # Don't add anything more if only_body wanted or in const space
8823: return $result if $args->{'only_body'}
8824: || $env{'request.state'} eq 'construct';
1.813 bisitz 8825:
8826: #Breadcrumbs
1.758 kaisler 8827: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8828: &Apache::lonhtmlcommon::clear_breadcrumbs();
8829: #if any br links exists, add them to the breadcrumbs
8830: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8831: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8832: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8833: }
8834: }
1.1075.2.19 raeburn 8835: # if @advtools array contains items add then to the breadcrumbs
8836: if (@advtools > 0) {
8837: &Apache::lonmenu::advtools_crumbs(@advtools);
8838: }
1.1075.2.123 raeburn 8839: my $menulink;
8840: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
1.1075.2.161. .1(raebu 8841:21): if ((exists($args->{'bread_crumbs_nomenu'})) ||
8842:21): ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
1.1075.2.123 raeburn 8843: $menulink = 0;
8844: } else {
8845: undef($menulink);
8846: }
1.758 kaisler 8847: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8848: if(exists($args->{'bread_crumbs_component'})){
1.1075.2.123 raeburn 8849: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1075.2.161. .1(raebu 8850:21): } else {
1.1075.2.123 raeburn 8851: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8852: }
1.1075.2.24 raeburn 8853: } elsif (($env{'environment.remote'} eq 'on') &&
8854: ($env{'form.inhibitmenu'} ne 'yes') &&
8855: ($env{'request.noversionuri'} =~ m{^/res/}) &&
8856: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 8857: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 8858: }
1.315 albertel 8859: return $result;
1.306 albertel 8860: }
8861:
8862: sub end_page {
1.315 albertel 8863: my ($args) = @_;
8864: $env{'internal.end_page'}++;
1.330 albertel 8865: my $result;
1.335 albertel 8866: if ($args->{'discussion'}) {
8867: my ($target,$parser);
8868: if (ref($args->{'discussion'})) {
8869: ($target,$parser) =($args->{'discussion'}{'target'},
8870: $args->{'discussion'}{'parser'});
8871: }
8872: $result .= &Apache::lonxml::xmlend($target,$parser);
8873: }
1.330 albertel 8874: if ($args->{'frameset'}) {
8875: $result .= '</frameset>';
8876: } else {
1.635 raeburn 8877: $result .= &endbodytag($args);
1.330 albertel 8878: }
1.1075.2.6 raeburn 8879: unless ($args->{'notbody'}) {
8880: $result .= "\n</html>";
8881: }
1.330 albertel 8882:
1.315 albertel 8883: if ($args->{'js_ready'}) {
1.317 albertel 8884: $result = &js_ready($result);
1.315 albertel 8885: }
1.335 albertel 8886:
1.320 albertel 8887: if ($args->{'html_encode'}) {
8888: $result = &html_encode($result);
8889: }
1.335 albertel 8890:
1.315 albertel 8891: return $result;
8892: }
8893:
1.1075.2.161. .1(raebu 8894:21): sub menucoll_in_effect {
8895:21): my ($menucoll,$deeplinkmenu,%menu);
8896:21): if ($env{'request.course.id'}) {
8897:21): $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
8898:21): if ($env{'request.deeplink.login'}) {
8899:21): my ($deeplink_symb,$deeplink,$check_login_symb);
8900:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
8901:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8902:21): if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
8903:21): if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
8904:21): my $navmap = Apache::lonnavmaps::navmap->new();
8905:21): if (ref($navmap)) {
8906:21): $deeplink = $navmap->get_mapparam(undef,
8907:21): &Apache::lonnet::declutter($env{'request.noversionuri'}),
8908:21): '0.deeplink');
8909:21): } else {
8910:21): $check_login_symb = 1;
8911:21): }
8912:21): } else {
8913:21): my $symb=&Apache::lonnet::symbread();
8914:21): if ($symb) {
8915:21): $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
8916:21): } else {
8917:21): $check_login_symb = 1;
8918:21): }
8919:21): }
8920:21): } else {
8921:21): $check_login_symb = 1;
8922:21): }
8923:21): if ($check_login_symb) {
8924:21): $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
8925:21): if ($deeplink_symb =~ /\.(page|sequence)$/) {
8926:21): my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
8927:21): my $navmap = Apache::lonnavmaps::navmap->new();
8928:21): if (ref($navmap)) {
8929:21): $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
8930:21): }
8931:21): } else {
8932:21): $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
8933:21): }
8934:21): }
8935:21): if ($deeplink ne '') {
8936:21): my ($state,$others,$listed,$scope,$protect,$display) = split(/,/,$deeplink);
8937:21): if ($display =~ /^\d+$/) {
8938:21): $deeplinkmenu = 1;
8939:21): $menucoll = $display;
8940:21): }
8941:21): }
8942:21): }
8943:21): if ($menucoll) {
8944:21): %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
8945:21): }
8946:21): }
8947:21): return ($menucoll,$deeplinkmenu,\%menu);
8948:21): }
8949:21):
8950:21): sub deeplink_login_symb {
8951:21): my ($cnum,$cdom) = @_;
8952:21): my $login_symb;
8953:21): if ($env{'request.deeplink.login'}) {
8954:21): $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
8955:21): }
8956:21): return $login_symb;
8957:21): }
8958:21):
8959:21): sub symb_from_tinyurl {
8960:21): my ($url,$cnum,$cdom) = @_;
8961:21): if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
8962:21): my $key = $1;
8963:21): my ($tinyurl,$login);
8964:21): my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
8965:21): if (defined($cached)) {
8966:21): $tinyurl = $result;
8967:21): } else {
8968:21): my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
8969:21): my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
8970:21): if ($currtiny{$key} ne '') {
8971:21): $tinyurl = $currtiny{$key};
8972:21): &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
8973:21): }
8974:21): }
8975:21): if ($tinyurl ne '') {
8976:21): my ($cnumreq,$symb) = split(/\&/,$tinyurl);
8977:21): if (wantarray) {
8978:21): return ($cnumreq,$symb);
8979:21): } elsif ($cnumreq eq $cnum) {
8980:21): return $symb;
8981:21): }
8982:21): }
8983:21): }
8984:21): if (wantarray) {
8985:21): return ();
8986:21): } else {
8987:21): return;
8988:21): }
8989:21): }
8990:21):
1.1034 www 8991: sub wishlist_window {
8992: return(<<'ENDWISHLIST');
1.1046 raeburn 8993: <script type="text/javascript">
1.1034 www 8994: // <![CDATA[
8995: // <!-- BEGIN LON-CAPA Internal
8996: function set_wishlistlink(title, path) {
8997: if (!title) {
8998: title = document.title;
8999: title = title.replace(/^LON-CAPA /,'');
9000: }
1.1075.2.65 raeburn 9001: title = encodeURIComponent(title);
1.1075.2.83 raeburn 9002: title = title.replace("'","\\\'");
1.1034 www 9003: if (!path) {
9004: path = location.pathname;
9005: }
1.1075.2.65 raeburn 9006: path = encodeURIComponent(path);
1.1075.2.83 raeburn 9007: path = path.replace("'","\\\'");
1.1034 www 9008: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9009: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9010: }
9011: // END LON-CAPA Internal -->
9012: // ]]>
9013: </script>
9014: ENDWISHLIST
9015: }
9016:
1.1030 www 9017: sub modal_window {
9018: return(<<'ENDMODAL');
1.1046 raeburn 9019: <script type="text/javascript">
1.1030 www 9020: // <![CDATA[
9021: // <!-- BEGIN LON-CAPA Internal
9022: var modalWindow = {
9023: parent:"body",
9024: windowId:null,
9025: content:null,
9026: width:null,
9027: height:null,
9028: close:function()
9029: {
9030: $(".LCmodal-window").remove();
9031: $(".LCmodal-overlay").remove();
9032: },
9033: open:function()
9034: {
9035: var modal = "";
9036: modal += "<div class=\"LCmodal-overlay\"></div>";
9037: 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;\">";
9038: modal += this.content;
9039: modal += "</div>";
9040:
9041: $(this.parent).append(modal);
9042:
9043: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9044: $(".LCclose-window").click(function(){modalWindow.close();});
9045: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9046: }
9047: };
1.1075.2.42 raeburn 9048: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9049: {
1.1075.2.119 raeburn 9050: source = source.replace(/'/g,"'");
1.1030 www 9051: modalWindow.windowId = "myModal";
9052: modalWindow.width = width;
9053: modalWindow.height = height;
1.1075.2.80 raeburn 9054: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9055: modalWindow.open();
1.1075.2.87 raeburn 9056: };
1.1030 www 9057: // END LON-CAPA Internal -->
9058: // ]]>
9059: </script>
9060: ENDMODAL
9061: }
9062:
9063: sub modal_link {
1.1075.2.42 raeburn 9064: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9065: unless ($width) { $width=480; }
9066: unless ($height) { $height=400; }
1.1031 www 9067: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 9068: unless ($transparency) { $transparency='true'; }
9069:
1.1074 raeburn 9070: my $target_attr;
9071: if (defined($target)) {
9072: $target_attr = 'target="'.$target.'"';
9073: }
9074: return <<"ENDLINK";
1.1075.2.143 raeburn 9075: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9076: ENDLINK
1.1030 www 9077: }
9078:
1.1032 www 9079: sub modal_adhoc_script {
1.1075.2.155 raeburn 9080: my ($funcname,$width,$height,$content,$possmathjax)=@_;
9081: my $mathjax;
9082: if ($possmathjax) {
9083: $mathjax = <<'ENDJAX';
9084: if (typeof MathJax == 'object') {
9085: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
9086: }
9087: ENDJAX
9088: }
1.1032 www 9089: return (<<ENDADHOC);
1.1046 raeburn 9090: <script type="text/javascript">
1.1032 www 9091: // <![CDATA[
9092: var $funcname = function()
9093: {
9094: modalWindow.windowId = "myModal";
9095: modalWindow.width = $width;
9096: modalWindow.height = $height;
9097: modalWindow.content = '$content';
9098: modalWindow.open();
1.1075.2.155 raeburn 9099: $mathjax
1.1032 www 9100: };
9101: // ]]>
9102: </script>
9103: ENDADHOC
9104: }
9105:
1.1041 www 9106: sub modal_adhoc_inner {
1.1075.2.155 raeburn 9107: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 9108: my $innerwidth=$width-20;
9109: $content=&js_ready(
1.1042 www 9110: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 9111: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9112: $content.
1.1041 www 9113: &end_scrollbox().
1.1075.2.42 raeburn 9114: &end_page()
1.1041 www 9115: );
1.1075.2.155 raeburn 9116: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 9117: }
9118:
9119: sub modal_adhoc_window {
1.1075.2.155 raeburn 9120: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
9121: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 9122: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9123: }
9124:
9125: sub modal_adhoc_launch {
9126: my ($funcname,$width,$height,$content)=@_;
9127: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9128: <script type="text/javascript">
9129: // <![CDATA[
9130: $funcname();
9131: // ]]>
9132: </script>
9133: ENDLAUNCH
9134: }
9135:
9136: sub modal_adhoc_close {
9137: return (<<ENDCLOSE);
9138: <script type="text/javascript">
9139: // <![CDATA[
9140: modalWindow.close();
9141: // ]]>
9142: </script>
9143: ENDCLOSE
9144: }
9145:
1.1038 www 9146: sub togglebox_script {
9147: return(<<ENDTOGGLE);
9148: <script type="text/javascript">
9149: // <![CDATA[
9150: function LCtoggleDisplay(id,hidetext,showtext) {
9151: link = document.getElementById(id + "link").childNodes[0];
9152: with (document.getElementById(id).style) {
9153: if (display == "none" ) {
9154: display = "inline";
9155: link.nodeValue = hidetext;
9156: } else {
9157: display = "none";
9158: link.nodeValue = showtext;
9159: }
9160: }
9161: }
9162: // ]]>
9163: </script>
9164: ENDTOGGLE
9165: }
9166:
1.1039 www 9167: sub start_togglebox {
9168: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9169: unless ($heading) { $heading=''; } else { $heading.=' '; }
9170: unless ($showtext) { $showtext=&mt('show'); }
9171: unless ($hidetext) { $hidetext=&mt('hide'); }
9172: unless ($headerbg) { $headerbg='#FFFFFF'; }
9173: return &start_data_table().
9174: &start_data_table_header_row().
9175: '<td bgcolor="'.$headerbg.'">'.$heading.
9176: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9177: $showtext.'\')">'.$showtext.'</a>]</td>'.
9178: &end_data_table_header_row().
9179: '<tr id="'.$id.'" style="display:none""><td>';
9180: }
9181:
9182: sub end_togglebox {
9183: return '</td></tr>'.&end_data_table();
9184: }
9185:
1.1041 www 9186: sub LCprogressbar_script {
1.1075.2.130 raeburn 9187: my ($id,$number_to_do)=@_;
9188: if ($number_to_do) {
9189: return(<<ENDPROGRESS);
1.1041 www 9190: <script type="text/javascript">
9191: // <![CDATA[
1.1045 www 9192: \$('#progressbar$id').progressbar({
1.1041 www 9193: value: 0,
9194: change: function(event, ui) {
9195: var newVal = \$(this).progressbar('option', 'value');
9196: \$('.pblabel', this).text(LCprogressTxt);
9197: }
9198: });
9199: // ]]>
9200: </script>
9201: ENDPROGRESS
1.1075.2.130 raeburn 9202: } else {
9203: return(<<ENDPROGRESS);
9204: <script type="text/javascript">
9205: // <![CDATA[
9206: \$('#progressbar$id').progressbar({
9207: value: false,
9208: create: function(event, ui) {
9209: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9210: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9211: }
9212: });
9213: // ]]>
9214: </script>
9215: ENDPROGRESS
9216: }
1.1041 www 9217: }
9218:
9219: sub LCprogressbarUpdate_script {
9220: return(<<ENDPROGRESSUPDATE);
9221: <style type="text/css">
9222: .ui-progressbar { position:relative; }
1.1075.2.130 raeburn 9223: .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
1.1041 www 9224: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9225: </style>
9226: <script type="text/javascript">
9227: // <![CDATA[
1.1045 www 9228: var LCprogressTxt='---';
9229:
1.1075.2.130 raeburn 9230: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9231: LCprogressTxt=progresstext;
1.1075.2.130 raeburn 9232: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9233: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9234: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
9235: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9236: } else {
9237: \$('#progressbar'+id).progressbar('value',percent);
9238: }
1.1041 www 9239: }
9240: // ]]>
9241: </script>
9242: ENDPROGRESSUPDATE
9243: }
9244:
1.1042 www 9245: my $LClastpercent;
1.1045 www 9246: my $LCidcnt;
9247: my $LCcurrentid;
1.1042 www 9248:
1.1041 www 9249: sub LCprogressbar {
1.1075.2.130 raeburn 9250: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9251: $LClastpercent=0;
1.1045 www 9252: $LCidcnt++;
9253: $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130 raeburn 9254: my ($starting,$content);
9255: if ($number_to_do) {
9256: $starting=&mt('Starting');
9257: $content=(<<ENDPROGBAR);
9258: $preamble
1.1045 www 9259: <div id="progressbar$LCcurrentid">
1.1041 www 9260: <span class="pblabel">$starting</span>
9261: </div>
9262: ENDPROGBAR
1.1075.2.130 raeburn 9263: } else {
9264: $starting=&mt('Loading...');
9265: $LClastpercent='false';
9266: $content=(<<ENDPROGBAR);
9267: $preamble
9268: <div id="progressbar$LCcurrentid">
9269: <div class="progress-label">$starting</div>
9270: </div>
9271: ENDPROGBAR
9272: }
9273: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9274: }
9275:
9276: sub LCprogressbarUpdate {
1.1075.2.130 raeburn 9277: my ($r,$val,$text,$number_to_do)=@_;
9278: if ($number_to_do) {
9279: unless ($val) {
9280: if ($LClastpercent) {
9281: $val=$LClastpercent;
9282: } else {
9283: $val=0;
9284: }
9285: }
9286: if ($val<0) { $val=0; }
9287: if ($val>100) { $val=0; }
9288: $LClastpercent=$val;
9289: unless ($text) { $text=$val.'%'; }
9290: } else {
9291: $val = 'false';
1.1042 www 9292: }
1.1041 www 9293: $text=&js_ready($text);
1.1044 www 9294: &r_print($r,<<ENDUPDATE);
1.1041 www 9295: <script type="text/javascript">
9296: // <![CDATA[
1.1075.2.130 raeburn 9297: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9298: // ]]>
9299: </script>
9300: ENDUPDATE
1.1035 www 9301: }
9302:
1.1042 www 9303: sub LCprogressbarClose {
9304: my ($r)=@_;
9305: $LClastpercent=0;
1.1044 www 9306: &r_print($r,<<ENDCLOSE);
1.1042 www 9307: <script type="text/javascript">
9308: // <![CDATA[
1.1045 www 9309: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9310: // ]]>
9311: </script>
9312: ENDCLOSE
1.1044 www 9313: }
9314:
9315: sub r_print {
9316: my ($r,$to_print)=@_;
9317: if ($r) {
9318: $r->print($to_print);
9319: $r->rflush();
9320: } else {
9321: print($to_print);
9322: }
1.1042 www 9323: }
9324:
1.320 albertel 9325: sub html_encode {
9326: my ($result) = @_;
9327:
1.322 albertel 9328: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9329:
9330: return $result;
9331: }
1.1044 www 9332:
1.317 albertel 9333: sub js_ready {
9334: my ($result) = @_;
9335:
1.323 albertel 9336: $result =~ s/[\n\r]/ /xmsg;
9337: $result =~ s/\\/\\\\/xmsg;
9338: $result =~ s/'/\\'/xmsg;
1.372 albertel 9339: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9340:
9341: return $result;
9342: }
9343:
1.315 albertel 9344: sub validate_page {
9345: if ( exists($env{'internal.start_page'})
1.316 albertel 9346: && $env{'internal.start_page'} > 1) {
9347: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9348: $env{'internal.start_page'}.' '.
1.316 albertel 9349: $ENV{'request.filename'});
1.315 albertel 9350: }
9351: if ( exists($env{'internal.end_page'})
1.316 albertel 9352: && $env{'internal.end_page'} > 1) {
9353: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9354: $env{'internal.end_page'}.' '.
1.316 albertel 9355: $env{'request.filename'});
1.315 albertel 9356: }
9357: if ( exists($env{'internal.start_page'})
9358: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9359: &Apache::lonnet::logthis('start_page called without end_page '.
9360: $env{'request.filename'});
1.315 albertel 9361: }
9362: if ( ! exists($env{'internal.start_page'})
9363: && exists($env{'internal.end_page'})) {
1.316 albertel 9364: &Apache::lonnet::logthis('end_page called without start_page'.
9365: $env{'request.filename'});
1.315 albertel 9366: }
1.306 albertel 9367: }
1.315 albertel 9368:
1.996 www 9369:
9370: sub start_scrollbox {
1.1075.2.56 raeburn 9371: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9372: unless ($outerwidth) { $outerwidth='520px'; }
9373: unless ($width) { $width='500px'; }
9374: unless ($height) { $height='200px'; }
1.1075 raeburn 9375: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9376: if ($id ne '') {
1.1075.2.42 raeburn 9377: $table_id = ' id="table_'.$id.'"';
9378: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9379: }
1.1075 raeburn 9380: if ($bgcolor ne '') {
9381: $tdcol = "background-color: $bgcolor;";
9382: }
1.1075.2.42 raeburn 9383: my $nicescroll_js;
9384: if ($env{'browser.mobile'}) {
9385: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9386: }
1.1075 raeburn 9387: return <<"END";
1.1075.2.42 raeburn 9388: $nicescroll_js
9389:
9390: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 9391: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 9392: END
1.996 www 9393: }
9394:
9395: sub end_scrollbox {
1.1036 www 9396: return '</div></td></tr></table>';
1.996 www 9397: }
9398:
1.1075.2.42 raeburn 9399: sub nicescroll_javascript {
9400: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9401: my %options;
9402: if (ref($cursor) eq 'HASH') {
9403: %options = %{$cursor};
9404: }
9405: unless ($options{'railalign'} =~ /^left|right$/) {
9406: $options{'railalign'} = 'left';
9407: }
9408: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9409: my $function = &get_users_function();
9410: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
9411: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9412: $options{'cursorcolor'} = '#00F';
9413: }
9414: }
9415: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9416: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
9417: $options{'cursoropacity'}='1.0';
9418: }
9419: } else {
9420: $options{'cursoropacity'}='1.0';
9421: }
9422: if ($options{'cursorfixedheight'} eq 'none') {
9423: delete($options{'cursorfixedheight'});
9424: } else {
9425: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9426: }
9427: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9428: delete($options{'railoffset'});
9429: }
9430: my @niceoptions;
9431: while (my($key,$value) = each(%options)) {
9432: if ($value =~ /^\{.+\}$/) {
9433: push(@niceoptions,$key.':'.$value);
9434: } else {
9435: push(@niceoptions,$key.':"'.$value.'"');
9436: }
9437: }
9438: my $nicescroll_js = '
9439: $(document).ready(
9440: function() {
9441: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9442: }
9443: );
9444: ';
9445: if ($framecheck) {
9446: $nicescroll_js .= '
9447: function expand_div(caller) {
9448: if (top === self) {
9449: document.getElementById("'.$id.'").style.width = "auto";
9450: document.getElementById("'.$id.'").style.height = "auto";
9451: } else {
9452: try {
9453: if (parent.frames) {
9454: if (parent.frames.length > 1) {
9455: var framesrc = parent.frames[1].location.href;
9456: var currsrc = framesrc.replace(/\#.*$/,"");
9457: if ((caller == "search") || (currsrc == "'.$location.'")) {
9458: document.getElementById("'.$id.'").style.width = "auto";
9459: document.getElementById("'.$id.'").style.height = "auto";
9460: }
9461: }
9462: }
9463: } catch (e) {
9464: return;
9465: }
9466: }
9467: return;
9468: }
9469: ';
9470: }
9471: if ($needjsready) {
9472: $nicescroll_js = '
9473: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9474: } else {
9475: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9476: }
9477: return $nicescroll_js;
9478: }
9479:
1.318 albertel 9480: sub simple_error_page {
1.1075.2.49 raeburn 9481: my ($r,$title,$msg,$args) = @_;
1.1075.2.161. .4(raebu 9482:22): my %displayargs;
1.1075.2.49 raeburn 9483: if (ref($args) eq 'HASH') {
9484: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1075.2.161. .4(raebu 9485:22): if ($args->{'only_body'}) {
9486:22): $displayargs{'only_body'} = 1;
9487:22): }
9488:22): if ($args->{'no_nav_bar'}) {
9489:22): $displayargs{'no_nav_bar'} = 1;
9490:22): }
1.1075.2.49 raeburn 9491: } else {
9492: $msg = &mt($msg);
9493: }
9494:
1.318 albertel 9495: my $page =
1.1075.2.161. .4(raebu 9496:22): &Apache::loncommon::start_page($title,'',\%displayargs).
1.1075.2.49 raeburn 9497: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9498: &Apache::loncommon::end_page();
9499: if (ref($r)) {
9500: $r->print($page);
1.327 albertel 9501: return;
1.318 albertel 9502: }
9503: return $page;
9504: }
1.347 albertel 9505:
9506: {
1.610 albertel 9507: my @row_count;
1.961 onken 9508:
9509: sub start_data_table_count {
9510: unshift(@row_count, 0);
9511: return;
9512: }
9513:
9514: sub end_data_table_count {
9515: shift(@row_count);
9516: return;
9517: }
9518:
1.347 albertel 9519: sub start_data_table {
1.1018 raeburn 9520: my ($add_class,$id) = @_;
1.422 albertel 9521: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9522: my $table_id;
9523: if (defined($id)) {
9524: $table_id = ' id="'.$id.'"';
9525: }
1.961 onken 9526: &start_data_table_count();
1.1018 raeburn 9527: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9528: }
9529:
9530: sub end_data_table {
1.961 onken 9531: &end_data_table_count();
1.389 albertel 9532: return '</table>'."\n";;
1.347 albertel 9533: }
9534:
9535: sub start_data_table_row {
1.974 wenzelju 9536: my ($add_class, $id) = @_;
1.610 albertel 9537: $row_count[0]++;
9538: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9539: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9540: $id = (' id="'.$id.'"') unless ($id eq '');
9541: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9542: }
1.471 banghart 9543:
9544: sub continue_data_table_row {
1.974 wenzelju 9545: my ($add_class, $id) = @_;
1.610 albertel 9546: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9547: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9548: $id = (' id="'.$id.'"') unless ($id eq '');
9549: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9550: }
1.347 albertel 9551:
9552: sub end_data_table_row {
1.389 albertel 9553: return '</tr>'."\n";;
1.347 albertel 9554: }
1.367 www 9555:
1.421 albertel 9556: sub start_data_table_empty_row {
1.707 bisitz 9557: # $row_count[0]++;
1.421 albertel 9558: return '<tr class="LC_empty_row" >'."\n";;
9559: }
9560:
9561: sub end_data_table_empty_row {
9562: return '</tr>'."\n";;
9563: }
9564:
1.367 www 9565: sub start_data_table_header_row {
1.389 albertel 9566: return '<tr class="LC_header_row">'."\n";;
1.367 www 9567: }
9568:
9569: sub end_data_table_header_row {
1.389 albertel 9570: return '</tr>'."\n";;
1.367 www 9571: }
1.890 droeschl 9572:
9573: sub data_table_caption {
9574: my $caption = shift;
9575: return "<caption class=\"LC_caption\">$caption</caption>";
9576: }
1.347 albertel 9577: }
9578:
1.548 albertel 9579: =pod
9580:
9581: =item * &inhibit_menu_check($arg)
9582:
9583: Checks for a inhibitmenu state and generates output to preserve it
9584:
9585: Inputs: $arg - can be any of
9586: - undef - in which case the return value is a string
9587: to add into arguments list of a uri
9588: - 'input' - in which case the return value is a HTML
9589: <form> <input> field of type hidden to
9590: preserve the value
9591: - a url - in which case the return value is the url with
9592: the neccesary cgi args added to preserve the
9593: inhibitmenu state
9594: - a ref to a url - no return value, but the string is
9595: updated to include the neccessary cgi
9596: args to preserve the inhibitmenu state
9597:
9598: =cut
9599:
9600: sub inhibit_menu_check {
9601: my ($arg) = @_;
9602: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9603: if ($arg eq 'input') {
9604: if ($env{'form.inhibitmenu'}) {
9605: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9606: } else {
9607: return
9608: }
9609: }
9610: if ($env{'form.inhibitmenu'}) {
9611: if (ref($arg)) {
9612: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9613: } elsif ($arg eq '') {
9614: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9615: } else {
9616: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9617: }
9618: }
9619: if (!ref($arg)) {
9620: return $arg;
9621: }
9622: }
9623:
1.251 albertel 9624: ###############################################
1.182 matthew 9625:
9626: =pod
9627:
1.549 albertel 9628: =back
9629:
9630: =head1 User Information Routines
9631:
9632: =over 4
9633:
1.405 albertel 9634: =item * &get_users_function()
1.182 matthew 9635:
9636: Used by &bodytag to determine the current users primary role.
9637: Returns either 'student','coordinator','admin', or 'author'.
9638:
9639: =cut
9640:
9641: ###############################################
9642: sub get_users_function {
1.815 tempelho 9643: my $function = 'norole';
1.818 tempelho 9644: if ($env{'request.role'}=~/^(st)/) {
9645: $function='student';
9646: }
1.907 raeburn 9647: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9648: $function='coordinator';
9649: }
1.258 albertel 9650: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9651: $function='admin';
9652: }
1.826 bisitz 9653: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9654: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9655: $function='author';
9656: }
9657: return $function;
1.54 www 9658: }
1.99 www 9659:
9660: ###############################################
9661:
1.233 raeburn 9662: =pod
9663:
1.821 raeburn 9664: =item * &show_course()
9665:
9666: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9667: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9668:
9669: Inputs:
9670: None
9671:
9672: Outputs:
9673: Scalar: 1 if 'Course' to be used, 0 otherwise.
9674:
9675: =cut
9676:
9677: ###############################################
9678: sub show_course {
9679: my $course = !$env{'user.adv'};
9680: if (!$env{'user.adv'}) {
9681: foreach my $env (keys(%env)) {
9682: next if ($env !~ m/^user\.priv\./);
9683: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9684: $course = 0;
9685: last;
9686: }
9687: }
9688: }
9689: return $course;
9690: }
9691:
9692: ###############################################
9693:
9694: =pod
9695:
1.542 raeburn 9696: =item * &check_user_status()
1.274 raeburn 9697:
9698: Determines current status of supplied role for a
9699: specific user. Roles can be active, previous or future.
9700:
9701: Inputs:
9702: user's domain, user's username, course's domain,
1.375 raeburn 9703: course's number, optional section ID.
1.274 raeburn 9704:
9705: Outputs:
9706: role status: active, previous or future.
9707:
9708: =cut
9709:
9710: sub check_user_status {
1.412 raeburn 9711: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9712: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 9713: my @uroles = keys(%userinfo);
1.274 raeburn 9714: my $srchstr;
9715: my $active_chk = 'none';
1.412 raeburn 9716: my $now = time;
1.274 raeburn 9717: if (@uroles > 0) {
1.908 raeburn 9718: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9719: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9720: } else {
1.412 raeburn 9721: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9722: }
9723: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9724: my $role_end = 0;
9725: my $role_start = 0;
9726: $active_chk = 'active';
1.412 raeburn 9727: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9728: $role_end = $1;
9729: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9730: $role_start = $1;
1.274 raeburn 9731: }
9732: }
9733: if ($role_start > 0) {
1.412 raeburn 9734: if ($now < $role_start) {
1.274 raeburn 9735: $active_chk = 'future';
9736: }
9737: }
9738: if ($role_end > 0) {
1.412 raeburn 9739: if ($now > $role_end) {
1.274 raeburn 9740: $active_chk = 'previous';
9741: }
9742: }
9743: }
9744: }
9745: return $active_chk;
9746: }
9747:
9748: ###############################################
9749:
9750: =pod
9751:
1.405 albertel 9752: =item * &get_sections()
1.233 raeburn 9753:
9754: Determines all the sections for a course including
9755: sections with students and sections containing other roles.
1.419 raeburn 9756: Incoming parameters:
9757:
9758: 1. domain
9759: 2. course number
9760: 3. reference to array containing roles for which sections should
9761: be gathered (optional).
9762: 4. reference to array containing status types for which sections
9763: should be gathered (optional).
9764:
9765: If the third argument is undefined, sections are gathered for any role.
9766: If the fourth argument is undefined, sections are gathered for any status.
9767: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9768:
1.374 raeburn 9769: Returns section hash (keys are section IDs, values are
9770: number of users in each section), subject to the
1.419 raeburn 9771: optional roles filter, optional status filter
1.233 raeburn 9772:
9773: =cut
9774:
9775: ###############################################
9776: sub get_sections {
1.419 raeburn 9777: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9778: if (!defined($cdom) || !defined($cnum)) {
9779: my $cid = $env{'request.course.id'};
9780:
9781: return if (!defined($cid));
9782:
9783: $cdom = $env{'course.'.$cid.'.domain'};
9784: $cnum = $env{'course.'.$cid.'.num'};
9785: }
9786:
9787: my %sectioncount;
1.419 raeburn 9788: my $now = time;
1.240 albertel 9789:
1.1075.2.33 raeburn 9790: my $check_students = 1;
9791: my $only_students = 0;
9792: if (ref($possible_roles) eq 'ARRAY') {
9793: if (grep(/^st$/,@{$possible_roles})) {
9794: if (@{$possible_roles} == 1) {
9795: $only_students = 1;
9796: }
9797: } else {
9798: $check_students = 0;
9799: }
9800: }
9801:
9802: if ($check_students) {
1.276 albertel 9803: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9804: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9805: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9806: my $start_index = &Apache::loncoursedata::CL_START();
9807: my $end_index = &Apache::loncoursedata::CL_END();
9808: my $status;
1.366 albertel 9809: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9810: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9811: $data->[$status_index],
9812: $data->[$start_index],
9813: $data->[$end_index]);
9814: if ($stu_status eq 'Active') {
9815: $status = 'active';
9816: } elsif ($end < $now) {
9817: $status = 'previous';
9818: } elsif ($start > $now) {
9819: $status = 'future';
9820: }
9821: if ($section ne '-1' && $section !~ /^\s*$/) {
9822: if ((!defined($possible_status)) || (($status ne '') &&
9823: (grep/^\Q$status\E$/,@{$possible_status}))) {
9824: $sectioncount{$section}++;
9825: }
1.240 albertel 9826: }
9827: }
9828: }
1.1075.2.33 raeburn 9829: if ($only_students) {
9830: return %sectioncount;
9831: }
1.240 albertel 9832: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9833: foreach my $user (sort(keys(%courseroles))) {
9834: if ($user !~ /^(\w{2})/) { next; }
9835: my ($role) = ($user =~ /^(\w{2})/);
9836: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9837: my ($section,$status);
1.240 albertel 9838: if ($role eq 'cr' &&
9839: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9840: $section=$1;
9841: }
9842: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9843: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9844: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9845: if ($end == -1 && $start == -1) {
9846: next; #deleted role
9847: }
9848: if (!defined($possible_status)) {
9849: $sectioncount{$section}++;
9850: } else {
9851: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9852: $status = 'active';
9853: } elsif ($end < $now) {
9854: $status = 'future';
9855: } elsif ($start > $now) {
9856: $status = 'previous';
9857: }
9858: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9859: $sectioncount{$section}++;
9860: }
9861: }
1.233 raeburn 9862: }
1.366 albertel 9863: return %sectioncount;
1.233 raeburn 9864: }
9865:
1.274 raeburn 9866: ###############################################
1.294 raeburn 9867:
9868: =pod
1.405 albertel 9869:
9870: =item * &get_course_users()
9871:
1.275 raeburn 9872: Retrieves usernames:domains for users in the specified course
9873: with specific role(s), and access status.
9874:
9875: Incoming parameters:
1.277 albertel 9876: 1. course domain
9877: 2. course number
9878: 3. access status: users must have - either active,
1.275 raeburn 9879: previous, future, or all.
1.277 albertel 9880: 4. reference to array of permissible roles
1.288 raeburn 9881: 5. reference to array of section restrictions (optional)
9882: 6. reference to results object (hash of hashes).
9883: 7. reference to optional userdata hash
1.609 raeburn 9884: 8. reference to optional statushash
1.630 raeburn 9885: 9. flag if privileged users (except those set to unhide in
9886: course settings) should be excluded
1.609 raeburn 9887: Keys of top level results hash are roles.
1.275 raeburn 9888: Keys of inner hashes are username:domain, with
9889: values set to access type.
1.288 raeburn 9890: Optional userdata hash returns an array with arguments in the
9891: same order as loncoursedata::get_classlist() for student data.
9892:
1.609 raeburn 9893: Optional statushash returns
9894:
1.288 raeburn 9895: Entries for end, start, section and status are blank because
9896: of the possibility of multiple values for non-student roles.
9897:
1.275 raeburn 9898: =cut
1.405 albertel 9899:
1.275 raeburn 9900: ###############################################
1.405 albertel 9901:
1.275 raeburn 9902: sub get_course_users {
1.630 raeburn 9903: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9904: my %idx = ();
1.419 raeburn 9905: my %seclists;
1.288 raeburn 9906:
9907: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9908: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9909: $idx{end} = &Apache::loncoursedata::CL_END();
9910: $idx{start} = &Apache::loncoursedata::CL_START();
9911: $idx{id} = &Apache::loncoursedata::CL_ID();
9912: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9913: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9914: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9915:
1.290 albertel 9916: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9917: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9918: my $now = time;
1.277 albertel 9919: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9920: my $match = 0;
1.412 raeburn 9921: my $secmatch = 0;
1.419 raeburn 9922: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9923: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9924: if ($section eq '') {
9925: $section = 'none';
9926: }
1.291 albertel 9927: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9928: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9929: $secmatch = 1;
9930: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9931: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9932: $secmatch = 1;
9933: }
9934: } else {
1.419 raeburn 9935: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9936: $secmatch = 1;
9937: }
1.290 albertel 9938: }
1.412 raeburn 9939: if (!$secmatch) {
9940: next;
9941: }
1.419 raeburn 9942: }
1.275 raeburn 9943: if (defined($$types{'active'})) {
1.288 raeburn 9944: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9945: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9946: $match = 1;
1.275 raeburn 9947: }
9948: }
9949: if (defined($$types{'previous'})) {
1.609 raeburn 9950: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9951: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9952: $match = 1;
1.275 raeburn 9953: }
9954: }
9955: if (defined($$types{'future'})) {
1.609 raeburn 9956: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9957: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9958: $match = 1;
1.275 raeburn 9959: }
9960: }
1.609 raeburn 9961: if ($match) {
9962: push(@{$seclists{$student}},$section);
9963: if (ref($userdata) eq 'HASH') {
9964: $$userdata{$student} = $$classlist{$student};
9965: }
9966: if (ref($statushash) eq 'HASH') {
9967: $statushash->{$student}{'st'}{$section} = $status;
9968: }
1.288 raeburn 9969: }
1.275 raeburn 9970: }
9971: }
1.412 raeburn 9972: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9973: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9974: my $now = time;
1.609 raeburn 9975: my %displaystatus = ( previous => 'Expired',
9976: active => 'Active',
9977: future => 'Future',
9978: );
1.1075.2.36 raeburn 9979: my (%nothide,@possdoms);
1.630 raeburn 9980: if ($hidepriv) {
9981: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9982: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9983: if ($user !~ /:/) {
9984: $nothide{join(':',split(/[\@]/,$user))}=1;
9985: } else {
9986: $nothide{$user} = 1;
9987: }
9988: }
1.1075.2.36 raeburn 9989: my @possdoms = ($cdom);
9990: if ($coursehash{'checkforpriv'}) {
9991: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9992: }
1.630 raeburn 9993: }
1.439 raeburn 9994: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9995: my $match = 0;
1.412 raeburn 9996: my $secmatch = 0;
1.439 raeburn 9997: my $status;
1.412 raeburn 9998: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9999: $user =~ s/:$//;
1.439 raeburn 10000: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10001: if ($end == -1 || $start == -1) {
10002: next;
10003: }
10004: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10005: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10006: my ($uname,$udom) = split(/:/,$user);
10007: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10008: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10009: $secmatch = 1;
10010: } elsif ($usec eq '') {
1.420 albertel 10011: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10012: $secmatch = 1;
10013: }
10014: } else {
10015: if (grep(/^\Q$usec\E$/,@{$sections})) {
10016: $secmatch = 1;
10017: }
10018: }
10019: if (!$secmatch) {
10020: next;
10021: }
1.288 raeburn 10022: }
1.419 raeburn 10023: if ($usec eq '') {
10024: $usec = 'none';
10025: }
1.275 raeburn 10026: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10027: if ($hidepriv) {
1.1075.2.36 raeburn 10028: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10029: (!$nothide{$uname.':'.$udom})) {
10030: next;
10031: }
10032: }
1.503 raeburn 10033: if ($end > 0 && $end < $now) {
1.439 raeburn 10034: $status = 'previous';
10035: } elsif ($start > $now) {
10036: $status = 'future';
10037: } else {
10038: $status = 'active';
10039: }
1.277 albertel 10040: foreach my $type (keys(%{$types})) {
1.275 raeburn 10041: if ($status eq $type) {
1.420 albertel 10042: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10043: push(@{$$users{$role}{$user}},$type);
10044: }
1.288 raeburn 10045: $match = 1;
10046: }
10047: }
1.419 raeburn 10048: if (($match) && (ref($userdata) eq 'HASH')) {
10049: if (!exists($$userdata{$uname.':'.$udom})) {
10050: &get_user_info($udom,$uname,\%idx,$userdata);
10051: }
1.420 albertel 10052: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10053: push(@{$seclists{$uname.':'.$udom}},$usec);
10054: }
1.609 raeburn 10055: if (ref($statushash) eq 'HASH') {
10056: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10057: }
1.275 raeburn 10058: }
10059: }
10060: }
10061: }
1.290 albertel 10062: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10063: if ((defined($cdom)) && (defined($cnum))) {
10064: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10065: if ( defined($csettings{'internal.courseowner'}) ) {
10066: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10067: next if ($owner eq '');
10068: my ($ownername,$ownerdom);
10069: if ($owner =~ /^([^:]+):([^:]+)$/) {
10070: $ownername = $1;
10071: $ownerdom = $2;
10072: } else {
10073: $ownername = $owner;
10074: $ownerdom = $cdom;
10075: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10076: }
10077: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10078: if (defined($userdata) &&
1.609 raeburn 10079: !exists($$userdata{$owner})) {
10080: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10081: if (!grep(/^none$/,@{$seclists{$owner}})) {
10082: push(@{$seclists{$owner}},'none');
10083: }
10084: if (ref($statushash) eq 'HASH') {
10085: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10086: }
1.290 albertel 10087: }
1.279 raeburn 10088: }
10089: }
10090: }
1.419 raeburn 10091: foreach my $user (keys(%seclists)) {
10092: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10093: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10094: }
1.275 raeburn 10095: }
10096: return;
10097: }
10098:
1.288 raeburn 10099: sub get_user_info {
10100: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10101: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10102: &plainname($uname,$udom,'lastname');
1.291 albertel 10103: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10104: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10105: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10106: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10107: return;
10108: }
1.275 raeburn 10109:
1.472 raeburn 10110: ###############################################
10111:
10112: =pod
10113:
10114: =item * &get_user_quota()
10115:
1.1075.2.41 raeburn 10116: Retrieves quota assigned for storage of user files.
10117: Default is to report quota for portfolio files.
1.472 raeburn 10118:
10119: Incoming parameters:
10120: 1. user's username
10121: 2. user's domain
1.1075.2.41 raeburn 10122: 3. quota name - portfolio, author, or course
10123: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 10124: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 10125: course
1.472 raeburn 10126:
10127: Returns:
1.1075.2.58 raeburn 10128: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10129: 2. (Optional) Type of setting: custom or default
10130: (individually assigned or default for user's
10131: institutional status).
10132: 3. (Optional) - User's institutional status (e.g., faculty, staff
10133: or student - types as defined in localenroll::inst_usertypes
10134: for user's domain, which determines default quota for user.
10135: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10136:
10137: If a value has been stored in the user's environment,
1.536 raeburn 10138: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 10139: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10140:
10141: =cut
10142:
10143: ###############################################
10144:
10145:
10146: sub get_user_quota {
1.1075.2.42 raeburn 10147: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10148: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10149: if (!defined($udom)) {
10150: $udom = $env{'user.domain'};
10151: }
10152: if (!defined($uname)) {
10153: $uname = $env{'user.name'};
10154: }
10155: if (($udom eq '' || $uname eq '') ||
10156: ($udom eq 'public') && ($uname eq 'public')) {
10157: $quota = 0;
1.536 raeburn 10158: $quotatype = 'default';
10159: $defquota = 0;
1.472 raeburn 10160: } else {
1.536 raeburn 10161: my $inststatus;
1.1075.2.41 raeburn 10162: if ($quotaname eq 'course') {
10163: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10164: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10165: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10166: } else {
10167: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10168: $quota = $cenv{'internal.uploadquota'};
10169: }
1.536 raeburn 10170: } else {
1.1075.2.41 raeburn 10171: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10172: if ($quotaname eq 'author') {
10173: $quota = $env{'environment.authorquota'};
10174: } else {
10175: $quota = $env{'environment.portfolioquota'};
10176: }
10177: $inststatus = $env{'environment.inststatus'};
10178: } else {
10179: my %userenv =
10180: &Apache::lonnet::get('environment',['portfolioquota',
10181: 'authorquota','inststatus'],$udom,$uname);
10182: my ($tmp) = keys(%userenv);
10183: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10184: if ($quotaname eq 'author') {
10185: $quota = $userenv{'authorquota'};
10186: } else {
10187: $quota = $userenv{'portfolioquota'};
10188: }
10189: $inststatus = $userenv{'inststatus'};
10190: } else {
10191: undef(%userenv);
10192: }
10193: }
10194: }
10195: if ($quota eq '' || wantarray) {
10196: if ($quotaname eq 'course') {
10197: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 10198: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
10199: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 10200: $defquota = $domdefs{$crstype.'quota'};
10201: }
10202: if ($defquota eq '') {
10203: $defquota = 500;
10204: }
1.1075.2.41 raeburn 10205: } else {
10206: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10207: }
10208: if ($quota eq '') {
10209: $quota = $defquota;
10210: $quotatype = 'default';
10211: } else {
10212: $quotatype = 'custom';
10213: }
1.472 raeburn 10214: }
10215: }
1.536 raeburn 10216: if (wantarray) {
10217: return ($quota,$quotatype,$settingstatus,$defquota);
10218: } else {
10219: return $quota;
10220: }
1.472 raeburn 10221: }
10222:
10223: ###############################################
10224:
10225: =pod
10226:
10227: =item * &default_quota()
10228:
1.536 raeburn 10229: Retrieves default quota assigned for storage of user portfolio files,
10230: given an (optional) user's institutional status.
1.472 raeburn 10231:
10232: Incoming parameters:
1.1075.2.42 raeburn 10233:
1.472 raeburn 10234: 1. domain
1.536 raeburn 10235: 2. (Optional) institutional status(es). This is a : separated list of
10236: status types (e.g., faculty, staff, student etc.)
10237: which apply to the user for whom the default is being retrieved.
10238: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 10239: default quota will be returned.
10240: 3. quota name - portfolio, author, or course
10241: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10242:
10243: Returns:
1.1075.2.42 raeburn 10244:
1.1075.2.58 raeburn 10245: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10246: 2. (Optional) institutional type which determined the value of the
10247: default quota.
1.472 raeburn 10248:
10249: If a value has been stored in the domain's configuration db,
10250: it will return that, otherwise it returns 20 (for backwards
10251: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 10252: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10253:
1.536 raeburn 10254: If the user's status includes multiple types (e.g., staff and student),
10255: the largest default quota which applies to the user determines the
10256: default quota returned.
10257:
1.472 raeburn 10258: =cut
10259:
10260: ###############################################
10261:
10262:
10263: sub default_quota {
1.1075.2.41 raeburn 10264: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10265: my ($defquota,$settingstatus);
10266: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10267: ['quotas'],$udom);
1.1075.2.41 raeburn 10268: my $key = 'defaultquota';
10269: if ($quotaname eq 'author') {
10270: $key = 'authorquota';
10271: }
1.622 raeburn 10272: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10273: if ($inststatus ne '') {
1.765 raeburn 10274: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10275: foreach my $item (@statuses) {
1.1075.2.41 raeburn 10276: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10277: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10278: if ($defquota eq '') {
1.1075.2.41 raeburn 10279: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10280: $settingstatus = $item;
1.1075.2.41 raeburn 10281: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10282: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10283: $settingstatus = $item;
10284: }
10285: }
1.1075.2.41 raeburn 10286: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10287: if ($quotahash{'quotas'}{$item} ne '') {
10288: if ($defquota eq '') {
10289: $defquota = $quotahash{'quotas'}{$item};
10290: $settingstatus = $item;
10291: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10292: $defquota = $quotahash{'quotas'}{$item};
10293: $settingstatus = $item;
10294: }
1.536 raeburn 10295: }
10296: }
10297: }
10298: }
10299: if ($defquota eq '') {
1.1075.2.41 raeburn 10300: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10301: $defquota = $quotahash{'quotas'}{$key}{'default'};
10302: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10303: $defquota = $quotahash{'quotas'}{'default'};
10304: }
1.536 raeburn 10305: $settingstatus = 'default';
1.1075.2.42 raeburn 10306: if ($defquota eq '') {
10307: if ($quotaname eq 'author') {
10308: $defquota = 500;
10309: }
10310: }
1.536 raeburn 10311: }
10312: } else {
10313: $settingstatus = 'default';
1.1075.2.41 raeburn 10314: if ($quotaname eq 'author') {
10315: $defquota = 500;
10316: } else {
10317: $defquota = 20;
10318: }
1.536 raeburn 10319: }
10320: if (wantarray) {
10321: return ($defquota,$settingstatus);
1.472 raeburn 10322: } else {
1.536 raeburn 10323: return $defquota;
1.472 raeburn 10324: }
10325: }
10326:
1.1075.2.41 raeburn 10327: ###############################################
10328:
10329: =pod
10330:
1.1075.2.42 raeburn 10331: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 10332:
10333: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 10334: of existing file within authoring space will cause quota for the authoring
10335: space to be exceeded.
10336:
10337: Same, if upload of a file directly to a course/community via Course Editor
10338: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 10339:
1.1075.2.61 raeburn 10340: Inputs: 7
1.1075.2.42 raeburn 10341: 1. username or coursenum
1.1075.2.41 raeburn 10342: 2. domain
1.1075.2.42 raeburn 10343: 3. context ('author' or 'course')
1.1075.2.41 raeburn 10344: 4. filename of file for which action is being requested
10345: 5. filesize (kB) of file
10346: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 10347: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 10348:
10349: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
10350: otherwise return null.
10351:
1.1075.2.42 raeburn 10352: =back
10353:
1.1075.2.41 raeburn 10354: =cut
10355:
1.1075.2.42 raeburn 10356: sub excess_filesize_warning {
1.1075.2.59 raeburn 10357: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 10358: my $current_disk_usage = 0;
1.1075.2.59 raeburn 10359: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 10360: if ($context eq 'author') {
10361: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10362: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10363: } else {
10364: foreach my $subdir ('docs','supplemental') {
10365: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10366: }
10367: }
1.1075.2.41 raeburn 10368: $disk_quota = int($disk_quota * 1000);
10369: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 10370: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 10371: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 10372: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10373: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 10374: $disk_quota,$current_disk_usage).
10375: '</p>';
10376: }
10377: return;
10378: }
10379:
10380: ###############################################
10381:
10382:
1.384 raeburn 10383: sub get_secgrprole_info {
10384: my ($cdom,$cnum,$needroles,$type) = @_;
10385: my %sections_count = &get_sections($cdom,$cnum);
10386: my @sections = (sort {$a <=> $b} keys(%sections_count));
10387: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10388: my @groups = sort(keys(%curr_groups));
10389: my $allroles = [];
10390: my $rolehash;
10391: my $accesshash = {
10392: active => 'Currently has access',
10393: future => 'Will have future access',
10394: previous => 'Previously had access',
10395: };
10396: if ($needroles) {
10397: $rolehash = {'all' => 'all'};
1.385 albertel 10398: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10399: if (&Apache::lonnet::error(%user_roles)) {
10400: undef(%user_roles);
10401: }
10402: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10403: my ($role)=split(/\:/,$item,2);
10404: if ($role eq 'cr') { next; }
10405: if ($role =~ /^cr/) {
10406: $$rolehash{$role} = (split('/',$role))[3];
10407: } else {
10408: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10409: }
10410: }
10411: foreach my $key (sort(keys(%{$rolehash}))) {
10412: push(@{$allroles},$key);
10413: }
10414: push (@{$allroles},'st');
10415: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10416: }
10417: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10418: }
10419:
1.555 raeburn 10420: sub user_picker {
1.1075.2.127 raeburn 10421: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10422: my $currdom = $dom;
1.1075.2.114 raeburn 10423: my @alldoms = &Apache::lonnet::all_domains();
10424: if (@alldoms == 1) {
10425: my %domsrch = &Apache::lonnet::get_dom('configuration',
10426: ['directorysrch'],$alldoms[0]);
10427: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10428: my $showdom = $domdesc;
10429: if ($showdom eq '') {
10430: $showdom = $dom;
10431: }
10432: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10433: if ((!$domsrch{'directorysrch'}{'available'}) &&
10434: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10435: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10436: }
10437: }
10438: }
1.555 raeburn 10439: my %curr_selected = (
10440: srchin => 'dom',
1.580 raeburn 10441: srchby => 'lastname',
1.555 raeburn 10442: );
10443: my $srchterm;
1.625 raeburn 10444: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10445: if ($srch->{'srchby'} ne '') {
10446: $curr_selected{'srchby'} = $srch->{'srchby'};
10447: }
10448: if ($srch->{'srchin'} ne '') {
10449: $curr_selected{'srchin'} = $srch->{'srchin'};
10450: }
10451: if ($srch->{'srchtype'} ne '') {
10452: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10453: }
10454: if ($srch->{'srchdomain'} ne '') {
10455: $currdom = $srch->{'srchdomain'};
10456: }
10457: $srchterm = $srch->{'srchterm'};
10458: }
1.1075.2.98 raeburn 10459: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10460: 'usr' => 'Search criteria',
1.563 raeburn 10461: 'doma' => 'Domain/institution to search',
1.558 albertel 10462: 'uname' => 'username',
10463: 'lastname' => 'last name',
1.555 raeburn 10464: 'lastfirst' => 'last name, first name',
1.558 albertel 10465: 'crs' => 'in this course',
1.576 raeburn 10466: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10467: 'alc' => 'all LON-CAPA',
1.573 raeburn 10468: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10469: 'exact' => 'is',
10470: 'contains' => 'contains',
1.569 raeburn 10471: 'begins' => 'begins with',
1.1075.2.98 raeburn 10472: );
10473: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10474: 'youm' => "You must include some text to search for.",
10475: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10476: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10477: 'yomc' => "You must choose a domain when using an institutional directory search.",
10478: 'ymcd' => "You must choose a domain when using a domain search.",
10479: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10480: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10481: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10482: );
1.1075.2.98 raeburn 10483: &html_escape(\%html_lt);
10484: &js_escape(\%js_lt);
1.1075.2.115 raeburn 10485: my $domform;
1.1075.2.126 raeburn 10486: my $allow_blank = 1;
1.1075.2.115 raeburn 10487: if ($fixeddom) {
1.1075.2.126 raeburn 10488: $allow_blank = 0;
10489: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115 raeburn 10490: } else {
1.1075.2.126 raeburn 10491: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115 raeburn 10492: }
1.563 raeburn 10493: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10494:
10495: my @srchins = ('crs','dom','alc','instd');
10496:
10497: foreach my $option (@srchins) {
10498: # FIXME 'alc' option unavailable until
10499: # loncreateuser::print_user_query_page()
10500: # has been completed.
10501: next if ($option eq 'alc');
1.880 raeburn 10502: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10503: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127 raeburn 10504: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10505: if ($curr_selected{'srchin'} eq $option) {
10506: $srchinsel .= '
1.1075.2.98 raeburn 10507: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10508: } else {
10509: $srchinsel .= '
1.1075.2.98 raeburn 10510: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10511: }
1.555 raeburn 10512: }
1.563 raeburn 10513: $srchinsel .= "\n </select>\n";
1.555 raeburn 10514:
10515: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10516: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10517: if ($curr_selected{'srchby'} eq $option) {
10518: $srchbysel .= '
1.1075.2.98 raeburn 10519: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10520: } else {
10521: $srchbysel .= '
1.1075.2.98 raeburn 10522: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10523: }
10524: }
10525: $srchbysel .= "\n </select>\n";
10526:
10527: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10528: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10529: if ($curr_selected{'srchtype'} eq $option) {
10530: $srchtypesel .= '
1.1075.2.98 raeburn 10531: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10532: } else {
10533: $srchtypesel .= '
1.1075.2.98 raeburn 10534: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10535: }
10536: }
10537: $srchtypesel .= "\n </select>\n";
10538:
1.558 albertel 10539: my ($newuserscript,$new_user_create);
1.994 raeburn 10540: my $context_dom = $env{'request.role.domain'};
10541: if ($context eq 'requestcrs') {
10542: if ($env{'form.coursedom'} ne '') {
10543: $context_dom = $env{'form.coursedom'};
10544: }
10545: }
1.556 raeburn 10546: if ($forcenewuser) {
1.576 raeburn 10547: if (ref($srch) eq 'HASH') {
1.994 raeburn 10548: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10549: if ($cancreate) {
10550: $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>';
10551: } else {
1.799 bisitz 10552: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10553: my %usertypetext = (
10554: official => 'institutional',
10555: unofficial => 'non-institutional',
10556: );
1.799 bisitz 10557: $new_user_create = '<p class="LC_warning">'
10558: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10559: .' '
10560: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10561: ,'<a href="'.$helplink.'">','</a>')
10562: .'</p><br />';
1.627 raeburn 10563: }
1.576 raeburn 10564: }
10565: }
10566:
1.556 raeburn 10567: $newuserscript = <<"ENDSCRIPT";
10568:
1.570 raeburn 10569: function setSearch(createnew,callingForm) {
1.556 raeburn 10570: if (createnew == 1) {
1.570 raeburn 10571: for (var i=0; i<callingForm.srchby.length; i++) {
10572: if (callingForm.srchby.options[i].value == 'uname') {
10573: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10574: }
10575: }
1.570 raeburn 10576: for (var i=0; i<callingForm.srchin.length; i++) {
10577: if ( callingForm.srchin.options[i].value == 'dom') {
10578: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10579: }
10580: }
1.570 raeburn 10581: for (var i=0; i<callingForm.srchtype.length; i++) {
10582: if (callingForm.srchtype.options[i].value == 'exact') {
10583: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10584: }
10585: }
1.570 raeburn 10586: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10587: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10588: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10589: }
10590: }
10591: }
10592: }
10593: ENDSCRIPT
1.558 albertel 10594:
1.556 raeburn 10595: }
10596:
1.555 raeburn 10597: my $output = <<"END_BLOCK";
1.556 raeburn 10598: <script type="text/javascript">
1.824 bisitz 10599: // <![CDATA[
1.570 raeburn 10600: function validateEntry(callingForm) {
1.558 albertel 10601:
1.556 raeburn 10602: var checkok = 1;
1.558 albertel 10603: var srchin;
1.570 raeburn 10604: for (var i=0; i<callingForm.srchin.length; i++) {
10605: if ( callingForm.srchin[i].checked ) {
10606: srchin = callingForm.srchin[i].value;
1.558 albertel 10607: }
10608: }
10609:
1.570 raeburn 10610: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10611: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10612: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10613: var srchterm = callingForm.srchterm.value;
10614: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10615: var msg = "";
10616:
10617: if (srchterm == "") {
10618: checkok = 0;
1.1075.2.98 raeburn 10619: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10620: }
10621:
1.569 raeburn 10622: if (srchtype== 'begins') {
10623: if (srchterm.length < 2) {
10624: checkok = 0;
1.1075.2.98 raeburn 10625: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10626: }
10627: }
10628:
1.556 raeburn 10629: if (srchtype== 'contains') {
10630: if (srchterm.length < 3) {
10631: checkok = 0;
1.1075.2.98 raeburn 10632: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10633: }
10634: }
10635: if (srchin == 'instd') {
10636: if (srchdomain == '') {
10637: checkok = 0;
1.1075.2.98 raeburn 10638: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10639: }
10640: }
10641: if (srchin == 'dom') {
10642: if (srchdomain == '') {
10643: checkok = 0;
1.1075.2.98 raeburn 10644: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10645: }
10646: }
10647: if (srchby == 'lastfirst') {
10648: if (srchterm.indexOf(",") == -1) {
10649: checkok = 0;
1.1075.2.98 raeburn 10650: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10651: }
10652: if (srchterm.indexOf(",") == srchterm.length -1) {
10653: checkok = 0;
1.1075.2.98 raeburn 10654: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10655: }
10656: }
10657: if (checkok == 0) {
1.1075.2.98 raeburn 10658: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10659: return;
10660: }
10661: if (checkok == 1) {
1.570 raeburn 10662: callingForm.submit();
1.556 raeburn 10663: }
10664: }
10665:
10666: $newuserscript
10667:
1.824 bisitz 10668: // ]]>
1.556 raeburn 10669: </script>
1.558 albertel 10670:
10671: $new_user_create
10672:
1.555 raeburn 10673: END_BLOCK
1.558 albertel 10674:
1.876 raeburn 10675: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 10676: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10677: $domform.
10678: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 10679: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10680: $srchbysel.
10681: $srchtypesel.
10682: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10683: $srchinsel.
10684: &Apache::lonhtmlcommon::row_closure(1).
10685: &Apache::lonhtmlcommon::end_pick_box().
10686: '<br />';
1.1075.2.114 raeburn 10687: return ($output,1);
1.555 raeburn 10688: }
10689:
1.612 raeburn 10690: sub user_rule_check {
1.615 raeburn 10691: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 10692: my ($response,%inst_response);
1.612 raeburn 10693: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 10694: if (keys(%{$usershash}) > 1) {
10695: my (%by_username,%by_id,%userdoms);
10696: my $checkid;
1.612 raeburn 10697: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 10698: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10699: $checkid = 1;
10700: }
10701: }
10702: foreach my $user (keys(%{$usershash})) {
10703: my ($uname,$udom) = split(/:/,$user);
10704: if ($checkid) {
10705: if (ref($usershash->{$user}) eq 'HASH') {
10706: if ($usershash->{$user}->{'id'} ne '') {
10707: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
10708: $userdoms{$udom} = 1;
10709: if (ref($inst_results) eq 'HASH') {
10710: $inst_results->{$uname.':'.$udom} = {};
10711: }
10712: }
10713: }
10714: } else {
10715: $by_username{$udom}{$uname} = 1;
10716: $userdoms{$udom} = 1;
10717: if (ref($inst_results) eq 'HASH') {
10718: $inst_results->{$uname.':'.$udom} = {};
10719: }
10720: }
10721: }
10722: foreach my $udom (keys(%userdoms)) {
10723: if (!$got_rules->{$udom}) {
10724: my %domconfig = &Apache::lonnet::get_dom('configuration',
10725: ['usercreation'],$udom);
10726: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10727: foreach my $item ('username','id') {
10728: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10729: $$curr_rules{$udom}{$item} =
10730: $domconfig{'usercreation'}{$item.'_rule'};
10731: }
10732: }
10733: }
10734: $got_rules->{$udom} = 1;
10735: }
10736: }
10737: if ($checkid) {
10738: foreach my $udom (keys(%by_id)) {
10739: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10740: if ($outcome eq 'ok') {
10741: foreach my $id (keys(%{$by_id{$udom}})) {
10742: my $uname = $by_id{$udom}{$id};
10743: $inst_response{$uname.':'.$udom} = $outcome;
10744: }
10745: if (ref($results) eq 'HASH') {
10746: foreach my $uname (keys(%{$results})) {
10747: if (exists($inst_response{$uname.':'.$udom})) {
10748: $inst_response{$uname.':'.$udom} = $outcome;
10749: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10750: }
10751: }
10752: }
10753: }
1.612 raeburn 10754: }
1.615 raeburn 10755: } else {
1.1075.2.99 raeburn 10756: foreach my $udom (keys(%by_username)) {
10757: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10758: if ($outcome eq 'ok') {
10759: foreach my $uname (keys(%{$by_username{$udom}})) {
10760: $inst_response{$uname.':'.$udom} = $outcome;
10761: }
10762: if (ref($results) eq 'HASH') {
10763: foreach my $uname (keys(%{$results})) {
10764: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10765: }
10766: }
10767: }
10768: }
1.612 raeburn 10769: }
1.1075.2.99 raeburn 10770: } elsif (keys(%{$usershash}) == 1) {
10771: my $user = (keys(%{$usershash}))[0];
10772: my ($uname,$udom) = split(/:/,$user);
10773: if (($udom ne '') && ($uname ne '')) {
10774: if (ref($usershash->{$user}) eq 'HASH') {
10775: if (ref($checks) eq 'HASH') {
10776: if (defined($checks->{'username'})) {
10777: ($inst_response{$user},%{$inst_results->{$user}}) =
10778: &Apache::lonnet::get_instuser($udom,$uname);
10779: } elsif (defined($checks->{'id'})) {
10780: if ($usershash->{$user}->{'id'} ne '') {
10781: ($inst_response{$user},%{$inst_results->{$user}}) =
10782: &Apache::lonnet::get_instuser($udom,undef,
10783: $usershash->{$user}->{'id'});
10784: } else {
10785: ($inst_response{$user},%{$inst_results->{$user}}) =
10786: &Apache::lonnet::get_instuser($udom,$uname);
10787: }
10788: }
10789: } else {
10790: ($inst_response{$user},%{$inst_results->{$user}}) =
10791: &Apache::lonnet::get_instuser($udom,$uname);
10792: return;
10793: }
10794: if (!$got_rules->{$udom}) {
10795: my %domconfig = &Apache::lonnet::get_dom('configuration',
10796: ['usercreation'],$udom);
10797: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10798: foreach my $item ('username','id') {
10799: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10800: $$curr_rules{$udom}{$item} =
10801: $domconfig{'usercreation'}{$item.'_rule'};
10802: }
10803: }
1.585 raeburn 10804: }
1.1075.2.99 raeburn 10805: $got_rules->{$udom} = 1;
1.585 raeburn 10806: }
10807: }
1.1075.2.99 raeburn 10808: } else {
10809: return;
10810: }
10811: } else {
10812: return;
10813: }
10814: foreach my $user (keys(%{$usershash})) {
10815: my ($uname,$udom) = split(/:/,$user);
10816: next if (($udom eq '') || ($uname eq ''));
10817: my $id;
10818: if (ref($inst_results) eq 'HASH') {
10819: if (ref($inst_results->{$user}) eq 'HASH') {
10820: $id = $inst_results->{$user}->{'id'};
10821: }
10822: }
10823: if ($id eq '') {
10824: if (ref($usershash->{$user})) {
10825: $id = $usershash->{$user}->{'id'};
10826: }
1.585 raeburn 10827: }
1.612 raeburn 10828: foreach my $item (keys(%{$checks})) {
10829: if (ref($$curr_rules{$udom}) eq 'HASH') {
10830: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10831: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 10832: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10833: $$curr_rules{$udom}{$item});
1.612 raeburn 10834: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10835: if ($rule_check{$rule}) {
10836: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 10837: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10838: if (ref($inst_results) eq 'HASH') {
10839: if (ref($inst_results->{$user}) eq 'HASH') {
10840: if (keys(%{$inst_results->{$user}}) == 0) {
10841: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 10842: } elsif ($item eq 'id') {
10843: if ($inst_results->{$user}->{'id'} eq '') {
10844: $$alerts{$item}{$udom}{$uname} = 1;
10845: }
1.615 raeburn 10846: }
1.612 raeburn 10847: }
10848: }
1.615 raeburn 10849: }
10850: last;
1.585 raeburn 10851: }
10852: }
10853: }
10854: }
10855: }
10856: }
10857: }
10858: }
1.612 raeburn 10859: return;
10860: }
10861:
10862: sub user_rule_formats {
10863: my ($domain,$domdesc,$curr_rules,$check) = @_;
10864: my %text = (
10865: 'username' => 'Usernames',
10866: 'id' => 'IDs',
10867: );
10868: my $output;
10869: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10870: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10871: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 10872: $output = '<br />'.
10873: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10874: '<span class="LC_cusr_emph">','</span>',$domdesc).
10875: ' <ul>';
1.612 raeburn 10876: foreach my $rule (@{$ruleorder}) {
10877: if (ref($curr_rules) eq 'ARRAY') {
10878: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10879: if (ref($rules->{$rule}) eq 'HASH') {
10880: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10881: $rules->{$rule}{'desc'}.'</li>';
10882: }
10883: }
10884: }
10885: }
10886: $output .= '</ul>';
10887: }
10888: }
10889: return $output;
10890: }
10891:
10892: sub instrule_disallow_msg {
1.615 raeburn 10893: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10894: my $response;
10895: my %text = (
10896: item => 'username',
10897: items => 'usernames',
10898: match => 'matches',
10899: do => 'does',
10900: action => 'a username',
10901: one => 'one',
10902: );
10903: if ($count > 1) {
10904: $text{'item'} = 'usernames';
10905: $text{'match'} ='match';
10906: $text{'do'} = 'do';
10907: $text{'action'} = 'usernames',
10908: $text{'one'} = 'ones';
10909: }
10910: if ($checkitem eq 'id') {
10911: $text{'items'} = 'IDs';
10912: $text{'item'} = 'ID';
10913: $text{'action'} = 'an ID';
1.615 raeburn 10914: if ($count > 1) {
10915: $text{'item'} = 'IDs';
10916: $text{'action'} = 'IDs';
10917: }
1.612 raeburn 10918: }
1.674 bisitz 10919: $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 10920: if ($mode eq 'upload') {
10921: if ($checkitem eq 'username') {
10922: $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'}.");
10923: } elsif ($checkitem eq 'id') {
1.674 bisitz 10924: $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 10925: }
1.669 raeburn 10926: } elsif ($mode eq 'selfcreate') {
10927: if ($checkitem eq 'id') {
10928: $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.");
10929: }
1.615 raeburn 10930: } else {
10931: if ($checkitem eq 'username') {
10932: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10933: } elsif ($checkitem eq 'id') {
10934: $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.");
10935: }
1.612 raeburn 10936: }
10937: return $response;
1.585 raeburn 10938: }
10939:
1.624 raeburn 10940: sub personal_data_fieldtitles {
10941: my %fieldtitles = &Apache::lonlocal::texthash (
10942: id => 'Student/Employee ID',
10943: permanentemail => 'E-mail address',
10944: lastname => 'Last Name',
10945: firstname => 'First Name',
10946: middlename => 'Middle Name',
10947: generation => 'Generation',
10948: gen => 'Generation',
1.765 raeburn 10949: inststatus => 'Affiliation',
1.624 raeburn 10950: );
10951: return %fieldtitles;
10952: }
10953:
1.642 raeburn 10954: sub sorted_inst_types {
10955: my ($dom) = @_;
1.1075.2.70 raeburn 10956: my ($usertypes,$order);
10957: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10958: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10959: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10960: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10961: } else {
10962: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10963: }
1.642 raeburn 10964: my $othertitle = &mt('All users');
10965: if ($env{'request.course.id'}) {
1.668 raeburn 10966: $othertitle = &mt('Any users');
1.642 raeburn 10967: }
10968: my @types;
10969: if (ref($order) eq 'ARRAY') {
10970: @types = @{$order};
10971: }
10972: if (@types == 0) {
10973: if (ref($usertypes) eq 'HASH') {
10974: @types = sort(keys(%{$usertypes}));
10975: }
10976: }
10977: if (keys(%{$usertypes}) > 0) {
10978: $othertitle = &mt('Other users');
10979: }
10980: return ($othertitle,$usertypes,\@types);
10981: }
10982:
1.645 raeburn 10983: sub get_institutional_codes {
1.1075.2.157 raeburn 10984: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 10985: # Get complete list of course sections to update
10986: my @currsections = ();
10987: my @currxlists = ();
1.1075.2.157 raeburn 10988: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 10989: my $coursecode = $$settings{'internal.coursecode'};
1.1075.2.157 raeburn 10990: my $crskey = $crs.':'.$coursecode;
10991: @{$unclutteredsec{$crskey}} = ();
10992: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 10993:
10994: if ($$settings{'internal.sectionnums'} ne '') {
10995: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10996: }
10997:
10998: if ($$settings{'internal.crosslistings'} ne '') {
10999: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11000: }
11001:
11002: if (@currxlists > 0) {
1.1075.2.157 raeburn 11003: foreach my $xl (@currxlists) {
11004: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11005: unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119 raeburn 11006: push(@{$allcourses},$1);
1.645 raeburn 11007: $$LC_code{$1} = $2;
11008: }
11009: }
11010: }
11011: }
1.1075.2.157 raeburn 11012:
1.645 raeburn 11013: if (@currsections > 0) {
1.1075.2.157 raeburn 11014: foreach my $sec (@currsections) {
11015: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11016: my $instsec = $1;
1.645 raeburn 11017: my $lc_sec = $2;
1.1075.2.157 raeburn 11018: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11019: push(@{$unclutteredsec{$crskey}},$instsec);
11020: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11021: }
11022: }
11023: }
11024: }
11025:
11026: if (@{$unclutteredsec{$crskey}} > 0) {
11027: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11028: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11029: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11030: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11031: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1075.2.119 raeburn 11032: push(@{$allcourses},$sec);
1.1075.2.157 raeburn 11033: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11034: }
11035: }
11036: }
11037: }
11038: return;
11039: }
11040:
1.971 raeburn 11041: sub get_standard_codeitems {
11042: return ('Year','Semester','Department','Number','Section');
11043: }
11044:
1.112 bowersj2 11045: =pod
11046:
1.780 raeburn 11047: =head1 Slot Helpers
11048:
11049: =over 4
11050:
11051: =item * sorted_slots()
11052:
1.1040 raeburn 11053: Sorts an array of slot names in order of an optional sort key,
11054: default sort is by slot start time (earliest first).
1.780 raeburn 11055:
11056: Inputs:
11057:
11058: =over 4
11059:
11060: slotsarr - Reference to array of unsorted slot names.
11061:
11062: slots - Reference to hash of hash, where outer hash keys are slot names.
11063:
1.1040 raeburn 11064: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11065:
1.549 albertel 11066: =back
11067:
1.780 raeburn 11068: Returns:
11069:
11070: =over 4
11071:
1.1040 raeburn 11072: sorted - An array of slot names sorted by a specified sort key
11073: (default sort key is start time of the slot).
1.780 raeburn 11074:
11075: =back
11076:
11077: =cut
11078:
11079:
11080: sub sorted_slots {
1.1040 raeburn 11081: my ($slotsarr,$slots,$sortkey) = @_;
11082: if ($sortkey eq '') {
11083: $sortkey = 'starttime';
11084: }
1.780 raeburn 11085: my @sorted;
11086: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11087: @sorted =
11088: sort {
11089: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11090: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11091: }
11092: if (ref($slots->{$a})) { return -1;}
11093: if (ref($slots->{$b})) { return 1;}
11094: return 0;
11095: } @{$slotsarr};
11096: }
11097: return @sorted;
11098: }
11099:
1.1040 raeburn 11100: =pod
11101:
11102: =item * get_future_slots()
11103:
11104: Inputs:
11105:
11106: =over 4
11107:
11108: cnum - course number
11109:
11110: cdom - course domain
11111:
11112: now - current UNIX time
11113:
11114: symb - optional symb
11115:
11116: =back
11117:
11118: Returns:
11119:
11120: =over 4
11121:
11122: sorted_reservable - ref to array of student_schedulable slots currently
11123: reservable, ordered by end date of reservation period.
11124:
11125: reservable_now - ref to hash of student_schedulable slots currently
11126: reservable.
11127:
11128: Keys in inner hash are:
11129: (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104 raeburn 11130: (b) endreserve: end date of reservation period.
11131: (c) uniqueperiod: start,end dates when slot is to be uniquely
11132: selected.
1.1040 raeburn 11133:
11134: sorted_future - ref to array of student_schedulable slots reservable in
11135: the future, ordered by start date of reservation period.
11136:
11137: future_reservable - ref to hash of student_schedulable slots reservable
11138: in the future.
11139:
11140: Keys in inner hash are:
11141: (a) symb: either blank or symb to which slot use is restricted.
11142: (b) startreserve: start date of reservation period.
1.1075.2.104 raeburn 11143: (c) uniqueperiod: start,end dates when slot is to be uniquely
11144: selected.
1.1040 raeburn 11145:
11146: =back
11147:
11148: =cut
11149:
11150: sub get_future_slots {
11151: my ($cnum,$cdom,$now,$symb) = @_;
11152: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11153: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11154: foreach my $slot (keys(%slots)) {
11155: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11156: if ($symb) {
11157: next if (($slots{$slot}->{'symb'} ne '') &&
11158: ($slots{$slot}->{'symb'} ne $symb));
11159: }
11160: if (($slots{$slot}->{'starttime'} > $now) &&
11161: ($slots{$slot}->{'endtime'} > $now)) {
11162: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11163: my $userallowed = 0;
11164: if ($slots{$slot}->{'allowedsections'}) {
11165: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11166: if (!defined($env{'request.role.sec'})
11167: && grep(/^No section assigned$/,@allowed_sec)) {
11168: $userallowed=1;
11169: } else {
11170: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11171: $userallowed=1;
11172: }
11173: }
11174: unless ($userallowed) {
11175: if (defined($env{'request.course.groups'})) {
11176: my @groups = split(/:/,$env{'request.course.groups'});
11177: foreach my $group (@groups) {
11178: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11179: $userallowed=1;
11180: last;
11181: }
11182: }
11183: }
11184: }
11185: }
11186: if ($slots{$slot}->{'allowedusers'}) {
11187: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11188: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11189: if (grep(/^\Q$user\E$/,@allowed_users)) {
11190: $userallowed = 1;
11191: }
11192: }
11193: next unless($userallowed);
11194: }
11195: my $startreserve = $slots{$slot}->{'startreserve'};
11196: my $endreserve = $slots{$slot}->{'endreserve'};
11197: my $symb = $slots{$slot}->{'symb'};
1.1075.2.104 raeburn 11198: my $uniqueperiod;
11199: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11200: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11201: }
1.1040 raeburn 11202: if (($startreserve < $now) &&
11203: (!$endreserve || $endreserve > $now)) {
11204: my $lastres = $endreserve;
11205: if (!$lastres) {
11206: $lastres = $slots{$slot}->{'starttime'};
11207: }
11208: $reservable_now{$slot} = {
11209: symb => $symb,
1.1075.2.104 raeburn 11210: endreserve => $lastres,
11211: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11212: };
11213: } elsif (($startreserve > $now) &&
11214: (!$endreserve || $endreserve > $startreserve)) {
11215: $future_reservable{$slot} = {
11216: symb => $symb,
1.1075.2.104 raeburn 11217: startreserve => $startreserve,
11218: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11219: };
11220: }
11221: }
11222: }
11223: my @unsorted_reservable = keys(%reservable_now);
11224: if (@unsorted_reservable > 0) {
11225: @sorted_reservable =
11226: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11227: }
11228: my @unsorted_future = keys(%future_reservable);
11229: if (@unsorted_future > 0) {
11230: @sorted_future =
11231: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11232: }
11233: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11234: }
1.780 raeburn 11235:
11236: =pod
11237:
1.1057 foxr 11238: =back
11239:
1.549 albertel 11240: =head1 HTTP Helpers
11241:
11242: =over 4
11243:
1.648 raeburn 11244: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11245:
1.258 albertel 11246: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11247: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11248: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11249:
11250: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11251: $possible_names is an ref to an array of form element names. As an example:
11252: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11253: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11254:
11255: =cut
1.1 albertel 11256:
1.6 albertel 11257: sub get_unprocessed_cgi {
1.25 albertel 11258: my ($query,$possible_names)= @_;
1.26 matthew 11259: # $Apache::lonxml::debug=1;
1.356 albertel 11260: foreach my $pair (split(/&/,$query)) {
11261: my ($name, $value) = split(/=/,$pair);
1.369 www 11262: $name = &unescape($name);
1.25 albertel 11263: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11264: $value =~ tr/+/ /;
11265: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11266: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11267: }
1.16 harris41 11268: }
1.6 albertel 11269: }
11270:
1.112 bowersj2 11271: =pod
11272:
1.648 raeburn 11273: =item * &cacheheader()
1.112 bowersj2 11274:
11275: returns cache-controlling header code
11276:
11277: =cut
11278:
1.7 albertel 11279: sub cacheheader {
1.258 albertel 11280: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11281: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11282: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11283: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11284: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11285: return $output;
1.7 albertel 11286: }
11287:
1.112 bowersj2 11288: =pod
11289:
1.648 raeburn 11290: =item * &no_cache($r)
1.112 bowersj2 11291:
11292: specifies header code to not have cache
11293:
11294: =cut
11295:
1.9 albertel 11296: sub no_cache {
1.216 albertel 11297: my ($r) = @_;
11298: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11299: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11300: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11301: $r->no_cache(1);
11302: $r->header_out("Expires" => $date);
11303: $r->header_out("Pragma" => "no-cache");
1.123 www 11304: }
11305:
11306: sub content_type {
1.181 albertel 11307: my ($r,$type,$charset) = @_;
1.299 foxr 11308: if ($r) {
11309: # Note that printout.pl calls this with undef for $r.
11310: &no_cache($r);
11311: }
1.258 albertel 11312: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11313: unless ($charset) {
11314: $charset=&Apache::lonlocal::current_encoding;
11315: }
11316: if ($charset) { $type.='; charset='.$charset; }
11317: if ($r) {
11318: $r->content_type($type);
11319: } else {
11320: print("Content-type: $type\n\n");
11321: }
1.9 albertel 11322: }
1.25 albertel 11323:
1.112 bowersj2 11324: =pod
11325:
1.648 raeburn 11326: =item * &add_to_env($name,$value)
1.112 bowersj2 11327:
1.258 albertel 11328: adds $name to the %env hash with value
1.112 bowersj2 11329: $value, if $name already exists, the entry is converted to an array
11330: reference and $value is added to the array.
11331:
11332: =cut
11333:
1.25 albertel 11334: sub add_to_env {
11335: my ($name,$value)=@_;
1.258 albertel 11336: if (defined($env{$name})) {
11337: if (ref($env{$name})) {
1.25 albertel 11338: #already have multiple values
1.258 albertel 11339: push(@{ $env{$name} },$value);
1.25 albertel 11340: } else {
11341: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11342: my $first=$env{$name};
11343: undef($env{$name});
11344: push(@{ $env{$name} },$first,$value);
1.25 albertel 11345: }
11346: } else {
1.258 albertel 11347: $env{$name}=$value;
1.25 albertel 11348: }
1.31 albertel 11349: }
1.149 albertel 11350:
11351: =pod
11352:
1.648 raeburn 11353: =item * &get_env_multiple($name)
1.149 albertel 11354:
1.258 albertel 11355: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11356: values may be defined and end up as an array ref.
11357:
11358: returns an array of values
11359:
11360: =cut
11361:
11362: sub get_env_multiple {
11363: my ($name) = @_;
11364: my @values;
1.258 albertel 11365: if (defined($env{$name})) {
1.149 albertel 11366: # exists is it an array
1.258 albertel 11367: if (ref($env{$name})) {
11368: @values=@{ $env{$name} };
1.149 albertel 11369: } else {
1.258 albertel 11370: $values[0]=$env{$name};
1.149 albertel 11371: }
11372: }
11373: return(@values);
11374: }
11375:
1.660 raeburn 11376: sub ask_for_embedded_content {
11377: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11378: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 11379: %currsubfile,%unused,$rem);
1.1071 raeburn 11380: my $counter = 0;
11381: my $numnew = 0;
1.987 raeburn 11382: my $numremref = 0;
11383: my $numinvalid = 0;
11384: my $numpathchg = 0;
11385: my $numexisting = 0;
1.1071 raeburn 11386: my $numunused = 0;
11387: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 11388: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11389: my $heading = &mt('Upload embedded files');
11390: my $buttontext = &mt('Upload');
11391:
1.1075.2.11 raeburn 11392: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 11393: if ($actionurl eq '/adm/dependencies') {
11394: $navmap = Apache::lonnavmaps::navmap->new();
11395: }
11396: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11397: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 11398: }
1.1075.2.35 raeburn 11399: if (($actionurl eq '/adm/portfolio') ||
11400: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11401: my $current_path='/';
11402: if ($env{'form.currentpath'}) {
11403: $current_path = $env{'form.currentpath'};
11404: }
11405: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 11406: $udom = $cdom;
11407: $uname = $cnum;
1.984 raeburn 11408: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11409: } else {
11410: $udom = $env{'user.domain'};
11411: $uname = $env{'user.name'};
11412: $url = '/userfiles/portfolio';
11413: }
1.987 raeburn 11414: $toplevel = $url.'/';
1.984 raeburn 11415: $url .= $current_path;
11416: $getpropath = 1;
1.987 raeburn 11417: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11418: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11419: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11420: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11421: $toplevel = $url;
1.984 raeburn 11422: if ($rest ne '') {
1.987 raeburn 11423: $url .= $rest;
11424: }
11425: } elsif ($actionurl eq '/adm/coursedocs') {
11426: if (ref($args) eq 'HASH') {
1.1071 raeburn 11427: $url = $args->{'docs_url'};
11428: $toplevel = $url;
1.1075.2.11 raeburn 11429: if ($args->{'context'} eq 'paste') {
11430: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11431: ($path) =
11432: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11433: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11434: $fileloc =~ s{^/}{};
11435: }
1.1071 raeburn 11436: }
11437: } elsif ($actionurl eq '/adm/dependencies') {
11438: if ($env{'request.course.id'} ne '') {
11439: if (ref($args) eq 'HASH') {
11440: $url = $args->{'docs_url'};
11441: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 11442: $toplevel = $url;
11443: unless ($toplevel =~ m{^/}) {
11444: $toplevel = "/$url";
11445: }
1.1075.2.11 raeburn 11446: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 11447: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11448: $path = $1;
11449: } else {
11450: ($path) =
11451: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11452: }
1.1075.2.79 raeburn 11453: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11454: $fileloc = $toplevel;
11455: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11456: my ($udom,$uname,$fname) =
11457: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11458: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11459: } else {
11460: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11461: }
1.1071 raeburn 11462: $fileloc =~ s{^/}{};
11463: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11464: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11465: }
1.987 raeburn 11466: }
1.1075.2.35 raeburn 11467: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11468: $udom = $cdom;
11469: $uname = $cnum;
11470: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11471: $toplevel = $url;
11472: $path = $url;
11473: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11474: $fileloc =~ s{^/}{};
11475: }
11476: foreach my $file (keys(%{$allfiles})) {
11477: my $embed_file;
11478: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11479: $embed_file = $1;
11480: } else {
11481: $embed_file = $file;
11482: }
1.1075.2.55 raeburn 11483: my ($absolutepath,$cleaned_file);
11484: if ($embed_file =~ m{^\w+://}) {
11485: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 11486: $newfiles{$cleaned_file} = 1;
11487: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11488: } else {
1.1075.2.55 raeburn 11489: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11490: if ($embed_file =~ m{^/}) {
11491: $absolutepath = $embed_file;
11492: }
1.1075.2.47 raeburn 11493: if ($cleaned_file =~ m{/}) {
11494: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11495: $path = &check_for_traversal($path,$url,$toplevel);
11496: my $item = $fname;
11497: if ($path ne '') {
11498: $item = $path.'/'.$fname;
11499: $subdependencies{$path}{$fname} = 1;
11500: } else {
11501: $dependencies{$item} = 1;
11502: }
11503: if ($absolutepath) {
11504: $mapping{$item} = $absolutepath;
11505: } else {
11506: $mapping{$item} = $embed_file;
11507: }
11508: } else {
11509: $dependencies{$embed_file} = 1;
11510: if ($absolutepath) {
1.1075.2.47 raeburn 11511: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11512: } else {
1.1075.2.47 raeburn 11513: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11514: }
11515: }
1.984 raeburn 11516: }
11517: }
1.1071 raeburn 11518: my $dirptr = 16384;
1.984 raeburn 11519: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11520: $currsubfile{$path} = {};
1.1075.2.35 raeburn 11521: if (($actionurl eq '/adm/portfolio') ||
11522: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11523: my ($sublistref,$listerror) =
11524: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11525: if (ref($sublistref) eq 'ARRAY') {
11526: foreach my $line (@{$sublistref}) {
11527: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11528: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11529: }
1.984 raeburn 11530: }
1.987 raeburn 11531: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11532: if (opendir(my $dir,$url.'/'.$path)) {
11533: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11534: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11535: }
1.1075.2.11 raeburn 11536: } elsif (($actionurl eq '/adm/dependencies') ||
11537: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 11538: ($args->{'context'} eq 'paste')) ||
11539: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11540: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 11541: my $dir;
11542: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11543: $dir = $fileloc;
11544: } else {
11545: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11546: }
1.1071 raeburn 11547: if ($dir ne '') {
11548: my ($sublistref,$listerror) =
11549: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11550: if (ref($sublistref) eq 'ARRAY') {
11551: foreach my $line (@{$sublistref}) {
11552: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11553: undef,$mtime)=split(/\&/,$line,12);
11554: unless (($testdir&$dirptr) ||
11555: ($file_name =~ /^\.\.?$/)) {
11556: $currsubfile{$path}{$file_name} = [$size,$mtime];
11557: }
11558: }
11559: }
11560: }
1.984 raeburn 11561: }
11562: }
11563: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11564: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11565: my $item = $path.'/'.$file;
11566: unless ($mapping{$item} eq $item) {
11567: $pathchanges{$item} = 1;
11568: }
11569: $existing{$item} = 1;
11570: $numexisting ++;
11571: } else {
11572: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11573: }
11574: }
1.1071 raeburn 11575: if ($actionurl eq '/adm/dependencies') {
11576: foreach my $path (keys(%currsubfile)) {
11577: if (ref($currsubfile{$path}) eq 'HASH') {
11578: foreach my $file (keys(%{$currsubfile{$path}})) {
11579: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 11580: next if (($rem ne '') &&
11581: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11582: (ref($navmap) &&
11583: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11584: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11585: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11586: $unused{$path.'/'.$file} = 1;
11587: }
11588: }
11589: }
11590: }
11591: }
1.984 raeburn 11592: }
1.987 raeburn 11593: my %currfile;
1.1075.2.35 raeburn 11594: if (($actionurl eq '/adm/portfolio') ||
11595: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11596: my ($dirlistref,$listerror) =
11597: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11598: if (ref($dirlistref) eq 'ARRAY') {
11599: foreach my $line (@{$dirlistref}) {
11600: my ($file_name,$rest) = split(/\&/,$line,2);
11601: $currfile{$file_name} = 1;
11602: }
1.984 raeburn 11603: }
1.987 raeburn 11604: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11605: if (opendir(my $dir,$url)) {
1.987 raeburn 11606: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11607: map {$currfile{$_} = 1;} @dir_list;
11608: }
1.1075.2.11 raeburn 11609: } elsif (($actionurl eq '/adm/dependencies') ||
11610: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 11611: ($args->{'context'} eq 'paste')) ||
11612: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11613: if ($env{'request.course.id'} ne '') {
11614: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11615: if ($dir ne '') {
11616: my ($dirlistref,$listerror) =
11617: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11618: if (ref($dirlistref) eq 'ARRAY') {
11619: foreach my $line (@{$dirlistref}) {
11620: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11621: $size,undef,$mtime)=split(/\&/,$line,12);
11622: unless (($testdir&$dirptr) ||
11623: ($file_name =~ /^\.\.?$/)) {
11624: $currfile{$file_name} = [$size,$mtime];
11625: }
11626: }
11627: }
11628: }
11629: }
1.984 raeburn 11630: }
11631: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11632: if (exists($currfile{$file})) {
1.987 raeburn 11633: unless ($mapping{$file} eq $file) {
11634: $pathchanges{$file} = 1;
11635: }
11636: $existing{$file} = 1;
11637: $numexisting ++;
11638: } else {
1.984 raeburn 11639: $newfiles{$file} = 1;
11640: }
11641: }
1.1071 raeburn 11642: foreach my $file (keys(%currfile)) {
11643: unless (($file eq $filename) ||
11644: ($file eq $filename.'.bak') ||
11645: ($dependencies{$file})) {
1.1075.2.11 raeburn 11646: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 11647: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11648: next if (($rem ne '') &&
11649: (($env{"httpref.$rem".$file} ne '') ||
11650: (ref($navmap) &&
11651: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11652: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11653: ($navmap->getResourceByUrl($rem.$1)))))));
11654: }
1.1075.2.11 raeburn 11655: }
1.1071 raeburn 11656: $unused{$file} = 1;
11657: }
11658: }
1.1075.2.11 raeburn 11659: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11660: ($args->{'context'} eq 'paste')) {
11661: $counter = scalar(keys(%existing));
11662: $numpathchg = scalar(keys(%pathchanges));
11663: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 11664: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11665: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11666: $counter = scalar(keys(%existing));
11667: $numpathchg = scalar(keys(%pathchanges));
11668: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 11669: }
1.984 raeburn 11670: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11671: if ($actionurl eq '/adm/dependencies') {
11672: next if ($embed_file =~ m{^\w+://});
11673: }
1.660 raeburn 11674: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 11675: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11676: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11677: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 11678: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11679: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11680: }
1.1075.2.35 raeburn 11681: $upload_output .= '</td>';
1.1071 raeburn 11682: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 11683: $upload_output.='<td align="right">'.
11684: '<span class="LC_info LC_fontsize_medium">'.
11685: &mt("URL points to web address").'</span>';
1.987 raeburn 11686: $numremref++;
1.660 raeburn 11687: } elsif ($args->{'error_on_invalid_names'}
11688: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 11689: $upload_output.='<td align="right"><span class="LC_warning">'.
11690: &mt('Invalid characters').'</span>';
1.987 raeburn 11691: $numinvalid++;
1.660 raeburn 11692: } else {
1.1075.2.35 raeburn 11693: $upload_output .= '<td>'.
11694: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11695: $embed_file,\%mapping,
1.1071 raeburn 11696: $allfiles,$codebase,'upload');
11697: $counter ++;
11698: $numnew ++;
1.987 raeburn 11699: }
11700: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11701: }
11702: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11703: if ($actionurl eq '/adm/dependencies') {
11704: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11705: $modify_output .= &start_data_table_row().
11706: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11707: '<img src="'.&icon($embed_file).'" border="0" />'.
11708: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11709: '<td>'.$size.'</td>'.
11710: '<td>'.$mtime.'</td>'.
11711: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11712: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11713: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11714: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11715: &embedded_file_element('upload_embedded',$counter,
11716: $embed_file,\%mapping,
11717: $allfiles,$codebase,'modify').
11718: '</div></td>'.
11719: &end_data_table_row()."\n";
11720: $counter ++;
11721: } else {
11722: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 11723: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11724: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11725: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11726: &Apache::loncommon::end_data_table_row()."\n";
11727: }
11728: }
11729: my $delidx = $counter;
11730: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11731: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11732: $delete_output .= &start_data_table_row().
11733: '<td><img src="'.&icon($oldfile).'" />'.
11734: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11735: '<td>'.$size.'</td>'.
11736: '<td>'.$mtime.'</td>'.
11737: '<td><label><input type="checkbox" name="del_upload_dep" '.
11738: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11739: &embedded_file_element('upload_embedded',$delidx,
11740: $oldfile,\%mapping,$allfiles,
11741: $codebase,'delete').'</td>'.
11742: &end_data_table_row()."\n";
11743: $numunused ++;
11744: $delidx ++;
1.987 raeburn 11745: }
11746: if ($upload_output) {
11747: $upload_output = &start_data_table().
11748: $upload_output.
11749: &end_data_table()."\n";
11750: }
1.1071 raeburn 11751: if ($modify_output) {
11752: $modify_output = &start_data_table().
11753: &start_data_table_header_row().
11754: '<th>'.&mt('File').'</th>'.
11755: '<th>'.&mt('Size (KB)').'</th>'.
11756: '<th>'.&mt('Modified').'</th>'.
11757: '<th>'.&mt('Upload replacement?').'</th>'.
11758: &end_data_table_header_row().
11759: $modify_output.
11760: &end_data_table()."\n";
11761: }
11762: if ($delete_output) {
11763: $delete_output = &start_data_table().
11764: &start_data_table_header_row().
11765: '<th>'.&mt('File').'</th>'.
11766: '<th>'.&mt('Size (KB)').'</th>'.
11767: '<th>'.&mt('Modified').'</th>'.
11768: '<th>'.&mt('Delete?').'</th>'.
11769: &end_data_table_header_row().
11770: $delete_output.
11771: &end_data_table()."\n";
11772: }
1.987 raeburn 11773: my $applies = 0;
11774: if ($numremref) {
11775: $applies ++;
11776: }
11777: if ($numinvalid) {
11778: $applies ++;
11779: }
11780: if ($numexisting) {
11781: $applies ++;
11782: }
1.1071 raeburn 11783: if ($counter || $numunused) {
1.987 raeburn 11784: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11785: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11786: $state.'<h3>'.$heading.'</h3>';
11787: if ($actionurl eq '/adm/dependencies') {
11788: if ($numnew) {
11789: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11790: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11791: $upload_output.'<br />'."\n";
11792: }
11793: if ($numexisting) {
11794: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11795: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11796: $modify_output.'<br />'."\n";
11797: $buttontext = &mt('Save changes');
11798: }
11799: if ($numunused) {
11800: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11801: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11802: $delete_output.'<br />'."\n";
11803: $buttontext = &mt('Save changes');
11804: }
11805: } else {
11806: $output .= $upload_output.'<br />'."\n";
11807: }
11808: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11809: $counter.'" />'."\n";
11810: if ($actionurl eq '/adm/dependencies') {
11811: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11812: $numnew.'" />'."\n";
11813: } elsif ($actionurl eq '') {
1.987 raeburn 11814: $output .= '<input type="hidden" name="phase" value="three" />';
11815: }
11816: } elsif ($applies) {
11817: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11818: if ($applies > 1) {
11819: $output .=
1.1075.2.35 raeburn 11820: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11821: if ($numremref) {
11822: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11823: }
11824: if ($numinvalid) {
11825: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11826: }
11827: if ($numexisting) {
11828: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11829: }
11830: $output .= '</ul><br />';
11831: } elsif ($numremref) {
11832: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11833: } elsif ($numinvalid) {
11834: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11835: } elsif ($numexisting) {
11836: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11837: }
11838: $output .= $upload_output.'<br />';
11839: }
11840: my ($pathchange_output,$chgcount);
1.1071 raeburn 11841: $chgcount = $counter;
1.987 raeburn 11842: if (keys(%pathchanges) > 0) {
11843: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11844: if ($counter) {
1.987 raeburn 11845: $output .= &embedded_file_element('pathchange',$chgcount,
11846: $embed_file,\%mapping,
1.1071 raeburn 11847: $allfiles,$codebase,'change');
1.987 raeburn 11848: } else {
11849: $pathchange_output .=
11850: &start_data_table_row().
11851: '<td><input type ="checkbox" name="namechange" value="'.
11852: $chgcount.'" checked="checked" /></td>'.
11853: '<td>'.$mapping{$embed_file}.'</td>'.
11854: '<td>'.$embed_file.
11855: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11856: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11857: '</td>'.&end_data_table_row();
1.660 raeburn 11858: }
1.987 raeburn 11859: $numpathchg ++;
11860: $chgcount ++;
1.660 raeburn 11861: }
11862: }
1.1075.2.35 raeburn 11863: if (($counter) || ($numunused)) {
1.987 raeburn 11864: if ($numpathchg) {
11865: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11866: $numpathchg.'" />'."\n";
11867: }
11868: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11869: ($actionurl eq '/adm/imsimport')) {
11870: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11871: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11872: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11873: } elsif ($actionurl eq '/adm/dependencies') {
11874: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11875: }
1.1075.2.35 raeburn 11876: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11877: } elsif ($numpathchg) {
11878: my %pathchange = ();
11879: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11880: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11881: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 11882: }
1.987 raeburn 11883: }
1.1071 raeburn 11884: return ($output,$counter,$numpathchg);
1.987 raeburn 11885: }
11886:
1.1075.2.47 raeburn 11887: =pod
11888:
11889: =item * clean_path($name)
11890:
11891: Performs clean-up of directories, subdirectories and filename in an
11892: embedded object, referenced in an HTML file which is being uploaded
11893: to a course or portfolio, where
11894: "Upload embedded images/multimedia files if HTML file" checkbox was
11895: checked.
11896:
11897: Clean-up is similar to replacements in lonnet::clean_filename()
11898: except each / between sub-directory and next level is preserved.
11899:
11900: =cut
11901:
11902: sub clean_path {
11903: my ($embed_file) = @_;
11904: $embed_file =~s{^/+}{};
11905: my @contents;
11906: if ($embed_file =~ m{/}) {
11907: @contents = split(/\//,$embed_file);
11908: } else {
11909: @contents = ($embed_file);
11910: }
11911: my $lastidx = scalar(@contents)-1;
11912: for (my $i=0; $i<=$lastidx; $i++) {
11913: $contents[$i]=~s{\\}{/}g;
11914: $contents[$i]=~s/\s+/\_/g;
11915: $contents[$i]=~s{[^/\w\.\-]}{}g;
11916: if ($i == $lastidx) {
11917: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11918: }
11919: }
11920: if ($lastidx > 0) {
11921: return join('/',@contents);
11922: } else {
11923: return $contents[0];
11924: }
11925: }
11926:
1.987 raeburn 11927: sub embedded_file_element {
1.1071 raeburn 11928: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11929: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11930: (ref($codebase) eq 'HASH'));
11931: my $output;
1.1071 raeburn 11932: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11933: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11934: }
11935: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11936: &escape($embed_file).'" />';
11937: unless (($context eq 'upload_embedded') &&
11938: ($mapping->{$embed_file} eq $embed_file)) {
11939: $output .='
11940: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11941: }
11942: my $attrib;
11943: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11944: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11945: }
11946: $output .=
11947: "\n\t\t".
11948: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11949: $attrib.'" />';
11950: if (exists($codebase->{$mapping->{$embed_file}})) {
11951: $output .=
11952: "\n\t\t".
11953: '<input name="codebase_'.$num.'" type="hidden" value="'.
11954: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11955: }
1.987 raeburn 11956: return $output;
1.660 raeburn 11957: }
11958:
1.1071 raeburn 11959: sub get_dependency_details {
11960: my ($currfile,$currsubfile,$embed_file) = @_;
11961: my ($size,$mtime,$showsize,$showmtime);
11962: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11963: if ($embed_file =~ m{/}) {
11964: my ($path,$fname) = split(/\//,$embed_file);
11965: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11966: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11967: }
11968: } else {
11969: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11970: ($size,$mtime) = @{$currfile->{$embed_file}};
11971: }
11972: }
11973: $showsize = $size/1024.0;
11974: $showsize = sprintf("%.1f",$showsize);
11975: if ($mtime > 0) {
11976: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11977: }
11978: }
11979: return ($showsize,$showmtime);
11980: }
11981:
11982: sub ask_embedded_js {
11983: return <<"END";
11984: <script type="text/javascript"">
11985: // <![CDATA[
11986: function toggleBrowse(counter) {
11987: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11988: var fileid = document.getElementById('embedded_item_'+counter);
11989: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11990: if (chkboxid.checked == true) {
11991: uploaddivid.style.display='block';
11992: } else {
11993: uploaddivid.style.display='none';
11994: fileid.value = '';
11995: }
11996: }
11997: // ]]>
11998: </script>
11999:
12000: END
12001: }
12002:
1.661 raeburn 12003: sub upload_embedded {
12004: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12005: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12006: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12007: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12008: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12009: my $orig_uploaded_filename =
12010: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12011: foreach my $type ('orig','ref','attrib','codebase') {
12012: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12013: $env{'form.embedded_'.$type.'_'.$i} =
12014: &unescape($env{'form.embedded_'.$type.'_'.$i});
12015: }
12016: }
1.661 raeburn 12017: my ($path,$fname) =
12018: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12019: # no path, whole string is fname
12020: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12021: $fname = &Apache::lonnet::clean_filename($fname);
12022: # See if there is anything left
12023: next if ($fname eq '');
12024:
12025: # Check if file already exists as a file or directory.
12026: my ($state,$msg);
12027: if ($context eq 'portfolio') {
12028: my $port_path = $dirpath;
12029: if ($group ne '') {
12030: $port_path = "groups/$group/$port_path";
12031: }
1.987 raeburn 12032: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12033: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12034: $dir_root,$port_path,$disk_quota,
12035: $current_disk_usage,$uname,$udom);
12036: if ($state eq 'will_exceed_quota'
1.984 raeburn 12037: || $state eq 'file_locked') {
1.661 raeburn 12038: $output .= $msg;
12039: next;
12040: }
12041: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12042: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12043: if ($state eq 'exists') {
12044: $output .= $msg;
12045: next;
12046: }
12047: }
12048: # Check if extension is valid
12049: if (($fname =~ /\.(\w+)$/) &&
12050: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 12051: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12052: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12053: next;
12054: } elsif (($fname =~ /\.(\w+)$/) &&
12055: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12056: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12057: next;
12058: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 12059: $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 12060: next;
12061: }
12062: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 12063: my $subdir = $path;
12064: $subdir =~ s{/+$}{};
1.661 raeburn 12065: if ($context eq 'portfolio') {
1.984 raeburn 12066: my $result;
12067: if ($state eq 'existingfile') {
12068: $result=
12069: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 12070: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12071: } else {
1.984 raeburn 12072: $result=
12073: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12074: $dirpath.
1.1075.2.35 raeburn 12075: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12076: if ($result !~ m|^/uploaded/|) {
12077: $output .= '<span class="LC_error">'
12078: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12079: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12080: .'</span><br />';
12081: next;
12082: } else {
1.987 raeburn 12083: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12084: $path.$fname.'</span>').'<br />';
1.984 raeburn 12085: }
1.661 raeburn 12086: }
1.1075.2.35 raeburn 12087: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
12088: my $extendedsubdir = $dirpath.'/'.$subdir;
12089: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12090: my $result =
1.1075.2.35 raeburn 12091: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12092: if ($result !~ m|^/uploaded/|) {
12093: $output .= '<span class="LC_error">'
12094: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12095: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12096: .'</span><br />';
12097: next;
12098: } else {
12099: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12100: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 12101: if ($context eq 'syllabus') {
12102: &Apache::lonnet::make_public_indefinitely($result);
12103: }
1.987 raeburn 12104: }
1.661 raeburn 12105: } else {
12106: # Save the file
12107: my $target = $env{'form.embedded_item_'.$i};
12108: my $fullpath = $dir_root.$dirpath.'/'.$path;
12109: my $dest = $fullpath.$fname;
12110: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12111: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12112: my $count;
12113: my $filepath = $dir_root;
1.1027 raeburn 12114: foreach my $subdir (@parts) {
12115: $filepath .= "/$subdir";
12116: if (!-e $filepath) {
1.661 raeburn 12117: mkdir($filepath,0770);
12118: }
12119: }
12120: my $fh;
12121: if (!open($fh,'>'.$dest)) {
12122: &Apache::lonnet::logthis('Failed to create '.$dest);
12123: $output .= '<span class="LC_error">'.
1.1071 raeburn 12124: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12125: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12126: '</span><br />';
12127: } else {
12128: if (!print $fh $env{'form.embedded_item_'.$i}) {
12129: &Apache::lonnet::logthis('Failed to write to '.$dest);
12130: $output .= '<span class="LC_error">'.
1.1071 raeburn 12131: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12132: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12133: '</span><br />';
12134: } else {
1.987 raeburn 12135: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12136: $url.'</span>').'<br />';
12137: unless ($context eq 'testbank') {
12138: $footer .= &mt('View embedded file: [_1]',
12139: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12140: }
12141: }
12142: close($fh);
12143: }
12144: }
12145: if ($env{'form.embedded_ref_'.$i}) {
12146: $pathchange{$i} = 1;
12147: }
12148: }
12149: if ($output) {
12150: $output = '<p>'.$output.'</p>';
12151: }
12152: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12153: $returnflag = 'ok';
1.1071 raeburn 12154: my $numpathchgs = scalar(keys(%pathchange));
12155: if ($numpathchgs > 0) {
1.987 raeburn 12156: if ($context eq 'portfolio') {
12157: $output .= '<p>'.&mt('or').'</p>';
12158: } elsif ($context eq 'testbank') {
1.1071 raeburn 12159: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12160: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12161: $returnflag = 'modify_orightml';
12162: }
12163: }
1.1071 raeburn 12164: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12165: }
12166:
12167: sub modify_html_form {
12168: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12169: my $end = 0;
12170: my $modifyform;
12171: if ($context eq 'upload_embedded') {
12172: return unless (ref($pathchange) eq 'HASH');
12173: if ($env{'form.number_embedded_items'}) {
12174: $end += $env{'form.number_embedded_items'};
12175: }
12176: if ($env{'form.number_pathchange_items'}) {
12177: $end += $env{'form.number_pathchange_items'};
12178: }
12179: if ($end) {
12180: for (my $i=0; $i<$end; $i++) {
12181: if ($i < $env{'form.number_embedded_items'}) {
12182: next unless($pathchange->{$i});
12183: }
12184: $modifyform .=
12185: &start_data_table_row().
12186: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12187: 'checked="checked" /></td>'.
12188: '<td>'.$env{'form.embedded_ref_'.$i}.
12189: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12190: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12191: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12192: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12193: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12194: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12195: '<td>'.$env{'form.embedded_orig_'.$i}.
12196: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12197: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12198: &end_data_table_row();
1.1071 raeburn 12199: }
1.987 raeburn 12200: }
12201: } else {
12202: $modifyform = $pathchgtable;
12203: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12204: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12205: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12206: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12207: }
12208: }
12209: if ($modifyform) {
1.1071 raeburn 12210: if ($actionurl eq '/adm/dependencies') {
12211: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12212: }
1.987 raeburn 12213: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12214: '<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".
12215: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12216: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12217: '</ol></p>'."\n".'<p>'.
12218: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12219: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12220: &start_data_table()."\n".
12221: &start_data_table_header_row().
12222: '<th>'.&mt('Change?').'</th>'.
12223: '<th>'.&mt('Current reference').'</th>'.
12224: '<th>'.&mt('Required reference').'</th>'.
12225: &end_data_table_header_row()."\n".
12226: $modifyform.
12227: &end_data_table().'<br />'."\n".$hiddenstate.
12228: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12229: '</form>'."\n";
12230: }
12231: return;
12232: }
12233:
12234: sub modify_html_refs {
1.1075.2.35 raeburn 12235: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12236: my $container;
12237: if ($context eq 'portfolio') {
12238: $container = $env{'form.container'};
12239: } elsif ($context eq 'coursedoc') {
12240: $container = $env{'form.primaryurl'};
1.1071 raeburn 12241: } elsif ($context eq 'manage_dependencies') {
12242: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12243: $container = "/$container";
1.1075.2.35 raeburn 12244: } elsif ($context eq 'syllabus') {
12245: $container = $url;
1.987 raeburn 12246: } else {
1.1027 raeburn 12247: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12248: }
12249: my (%allfiles,%codebase,$output,$content);
12250: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 12251: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12252: if (wantarray) {
12253: return ('',0,0);
12254: } else {
12255: return;
12256: }
12257: }
12258: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 12259: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12260: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12261: if (wantarray) {
12262: return ('',0,0);
12263: } else {
12264: return;
12265: }
12266: }
1.987 raeburn 12267: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12268: if ($content eq '-1') {
12269: if (wantarray) {
12270: return ('',0,0);
12271: } else {
12272: return;
12273: }
12274: }
1.987 raeburn 12275: } else {
1.1071 raeburn 12276: unless ($container =~ /^\Q$dir_root\E/) {
12277: if (wantarray) {
12278: return ('',0,0);
12279: } else {
12280: return;
12281: }
12282: }
1.1075.2.128 raeburn 12283: if (open(my $fh,'<',$container)) {
1.987 raeburn 12284: $content = join('', <$fh>);
12285: close($fh);
12286: } else {
1.1071 raeburn 12287: if (wantarray) {
12288: return ('',0,0);
12289: } else {
12290: return;
12291: }
1.987 raeburn 12292: }
12293: }
12294: my ($count,$codebasecount) = (0,0);
12295: my $mm = new File::MMagic;
12296: my $mime_type = $mm->checktype_contents($content);
12297: if ($mime_type eq 'text/html') {
12298: my $parse_result =
12299: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12300: \%codebase,\$content);
12301: if ($parse_result eq 'ok') {
12302: foreach my $i (@changes) {
12303: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12304: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12305: if ($allfiles{$ref}) {
12306: my $newname = $orig;
12307: my ($attrib_regexp,$codebase);
1.1006 raeburn 12308: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12309: if ($attrib_regexp =~ /:/) {
12310: $attrib_regexp =~ s/\:/|/g;
12311: }
12312: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12313: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12314: $count += $numchg;
1.1075.2.35 raeburn 12315: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 12316: delete($allfiles{$ref});
1.987 raeburn 12317: }
12318: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12319: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12320: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12321: $codebasecount ++;
12322: }
12323: }
12324: }
1.1075.2.35 raeburn 12325: my $skiprewrites;
1.987 raeburn 12326: if ($count || $codebasecount) {
12327: my $saveresult;
1.1071 raeburn 12328: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 12329: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12330: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12331: if ($url eq $container) {
12332: my ($fname) = ($container =~ m{/([^/]+)$});
12333: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12334: $count,'<span class="LC_filename">'.
1.1071 raeburn 12335: $fname.'</span>').'</p>';
1.987 raeburn 12336: } else {
12337: $output = '<p class="LC_error">'.
12338: &mt('Error: update failed for: [_1].',
12339: '<span class="LC_filename">'.
12340: $container.'</span>').'</p>';
12341: }
1.1075.2.35 raeburn 12342: if ($context eq 'syllabus') {
12343: unless ($saveresult eq 'ok') {
12344: $skiprewrites = 1;
12345: }
12346: }
1.987 raeburn 12347: } else {
1.1075.2.128 raeburn 12348: if (open(my $fh,'>',$container)) {
1.987 raeburn 12349: print $fh $content;
12350: close($fh);
12351: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12352: $count,'<span class="LC_filename">'.
12353: $container.'</span>').'</p>';
1.661 raeburn 12354: } else {
1.987 raeburn 12355: $output = '<p class="LC_error">'.
12356: &mt('Error: could not update [_1].',
12357: '<span class="LC_filename">'.
12358: $container.'</span>').'</p>';
1.661 raeburn 12359: }
12360: }
12361: }
1.1075.2.35 raeburn 12362: if (($context eq 'syllabus') && (!$skiprewrites)) {
12363: my ($actionurl,$state);
12364: $actionurl = "/public/$udom/$uname/syllabus";
12365: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12366: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12367: \%codebase,
12368: {'context' => 'rewrites',
12369: 'ignore_remote_references' => 1,});
12370: if (ref($mapping) eq 'HASH') {
12371: my $rewrites = 0;
12372: foreach my $key (keys(%{$mapping})) {
12373: next if ($key =~ m{^https?://});
12374: my $ref = $mapping->{$key};
12375: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12376: my $attrib;
12377: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12378: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12379: }
12380: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12381: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12382: $rewrites += $numchg;
12383: }
12384: }
12385: if ($rewrites) {
12386: my $saveresult;
12387: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12388: if ($url eq $container) {
12389: my ($fname) = ($container =~ m{/([^/]+)$});
12390: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12391: $count,'<span class="LC_filename">'.
12392: $fname.'</span>').'</p>';
12393: } else {
12394: $output .= '<p class="LC_error">'.
12395: &mt('Error: could not update links in [_1].',
12396: '<span class="LC_filename">'.
12397: $container.'</span>').'</p>';
12398:
12399: }
12400: }
12401: }
12402: }
1.987 raeburn 12403: } else {
12404: &logthis('Failed to parse '.$container.
12405: ' to modify references: '.$parse_result);
1.661 raeburn 12406: }
12407: }
1.1071 raeburn 12408: if (wantarray) {
12409: return ($output,$count,$codebasecount);
12410: } else {
12411: return $output;
12412: }
1.661 raeburn 12413: }
12414:
12415: sub check_for_existing {
12416: my ($path,$fname,$element) = @_;
12417: my ($state,$msg);
12418: if (-d $path.'/'.$fname) {
12419: $state = 'exists';
12420: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12421: } elsif (-e $path.'/'.$fname) {
12422: $state = 'exists';
12423: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12424: }
12425: if ($state eq 'exists') {
12426: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12427: }
12428: return ($state,$msg);
12429: }
12430:
12431: sub check_for_upload {
12432: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12433: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12434: my $filesize = length($env{'form.'.$element});
12435: if (!$filesize) {
12436: my $msg = '<span class="LC_error">'.
12437: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12438: '<span class="LC_filename">'.$fname.'</span>',
12439: $filesize).'<br />'.
1.1007 raeburn 12440: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12441: '</span>';
12442: return ('zero_bytes',$msg);
12443: }
12444: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12445: my $getpropath = 1;
1.1021 raeburn 12446: my ($dirlistref,$listerror) =
12447: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12448: my $found_file = 0;
12449: my $locked_file = 0;
1.991 raeburn 12450: my @lockers;
12451: my $navmap;
12452: if ($env{'request.course.id'}) {
12453: $navmap = Apache::lonnavmaps::navmap->new();
12454: }
1.1021 raeburn 12455: if (ref($dirlistref) eq 'ARRAY') {
12456: foreach my $line (@{$dirlistref}) {
12457: my ($file_name,$rest)=split(/\&/,$line,2);
12458: if ($file_name eq $fname){
12459: $file_name = $path.$file_name;
12460: if ($group ne '') {
12461: $file_name = $group.$file_name;
12462: }
12463: $found_file = 1;
12464: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12465: foreach my $lock (@lockers) {
12466: if (ref($lock) eq 'ARRAY') {
12467: my ($symb,$crsid) = @{$lock};
12468: if ($crsid eq $env{'request.course.id'}) {
12469: if (ref($navmap)) {
12470: my $res = $navmap->getBySymb($symb);
12471: foreach my $part (@{$res->parts()}) {
12472: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12473: unless (($slot_status == $res->RESERVED) ||
12474: ($slot_status == $res->RESERVED_LOCATION)) {
12475: $locked_file = 1;
12476: }
1.991 raeburn 12477: }
1.1021 raeburn 12478: } else {
12479: $locked_file = 1;
1.991 raeburn 12480: }
12481: } else {
12482: $locked_file = 1;
12483: }
12484: }
1.1021 raeburn 12485: }
12486: } else {
12487: my @info = split(/\&/,$rest);
12488: my $currsize = $info[6]/1000;
12489: if ($currsize < $filesize) {
12490: my $extra = $filesize - $currsize;
12491: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 12492: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12493: &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.1075.2.69 raeburn 12494: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12495: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12496: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12497: return ('will_exceed_quota',$msg);
12498: }
1.984 raeburn 12499: }
12500: }
1.661 raeburn 12501: }
12502: }
12503: }
12504: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 12505: my $msg = '<p class="LC_warning">'.
12506: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
12507: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12508: return ('will_exceed_quota',$msg);
12509: } elsif ($found_file) {
12510: if ($locked_file) {
1.1075.2.69 raeburn 12511: my $msg = '<p class="LC_warning">';
1.661 raeburn 12512: $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.1075.2.69 raeburn 12513: $msg .= '</p>';
1.661 raeburn 12514: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12515: return ('file_locked',$msg);
12516: } else {
1.1075.2.69 raeburn 12517: my $msg = '<p class="LC_error">';
1.984 raeburn 12518: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69 raeburn 12519: $msg .= '</p>';
1.984 raeburn 12520: return ('existingfile',$msg);
1.661 raeburn 12521: }
12522: }
12523: }
12524:
1.987 raeburn 12525: sub check_for_traversal {
12526: my ($path,$url,$toplevel) = @_;
12527: my @parts=split(/\//,$path);
12528: my $cleanpath;
12529: my $fullpath = $url;
12530: for (my $i=0;$i<@parts;$i++) {
12531: next if ($parts[$i] eq '.');
12532: if ($parts[$i] eq '..') {
12533: $fullpath =~ s{([^/]+/)$}{};
12534: } else {
12535: $fullpath .= $parts[$i].'/';
12536: }
12537: }
12538: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12539: $cleanpath = $1;
12540: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12541: my $curr_toprel = $1;
12542: my @parts = split(/\//,$curr_toprel);
12543: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12544: my @urlparts = split(/\//,$url_toprel);
12545: my $doubledots;
12546: my $startdiff = -1;
12547: for (my $i=0; $i<@urlparts; $i++) {
12548: if ($startdiff == -1) {
12549: unless ($urlparts[$i] eq $parts[$i]) {
12550: $startdiff = $i;
12551: $doubledots .= '../';
12552: }
12553: } else {
12554: $doubledots .= '../';
12555: }
12556: }
12557: if ($startdiff > -1) {
12558: $cleanpath = $doubledots;
12559: for (my $i=$startdiff; $i<@parts; $i++) {
12560: $cleanpath .= $parts[$i].'/';
12561: }
12562: }
12563: }
12564: $cleanpath =~ s{(/)$}{};
12565: return $cleanpath;
12566: }
1.31 albertel 12567:
1.1053 raeburn 12568: sub is_archive_file {
12569: my ($mimetype) = @_;
12570: if (($mimetype eq 'application/octet-stream') ||
12571: ($mimetype eq 'application/x-stuffit') ||
12572: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12573: return 1;
12574: }
12575: return;
12576: }
12577:
12578: sub decompress_form {
1.1065 raeburn 12579: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12580: my %lt = &Apache::lonlocal::texthash (
12581: this => 'This file is an archive file.',
1.1067 raeburn 12582: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12583: itsc => 'Its contents are as follows:',
1.1053 raeburn 12584: youm => 'You may wish to extract its contents.',
12585: extr => 'Extract contents',
1.1067 raeburn 12586: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12587: proa => 'Process automatically?',
1.1053 raeburn 12588: yes => 'Yes',
12589: no => 'No',
1.1067 raeburn 12590: fold => 'Title for folder containing movie',
12591: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12592: );
1.1065 raeburn 12593: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12594: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12595: my $info = &list_archive_contents($fileloc,\@paths);
12596: if (@paths) {
12597: foreach my $path (@paths) {
12598: $path =~ s{^/}{};
1.1067 raeburn 12599: if ($path =~ m{^([^/]+)/$}) {
12600: $topdir = $1;
12601: }
1.1065 raeburn 12602: if ($path =~ m{^([^/]+)/}) {
12603: $toplevel{$1} = $path;
12604: } else {
12605: $toplevel{$path} = $path;
12606: }
12607: }
12608: }
1.1067 raeburn 12609: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 12610: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12611: "$topdir/media/",
12612: "$topdir/media/$topdir.mp4",
12613: "$topdir/media/FirstFrame.png",
12614: "$topdir/media/player.swf",
12615: "$topdir/media/swfobject.js",
12616: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 12617: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 12618: "$topdir/$topdir.mp4",
12619: "$topdir/$topdir\_config.xml",
12620: "$topdir/$topdir\_controller.swf",
12621: "$topdir/$topdir\_embed.css",
12622: "$topdir/$topdir\_First_Frame.png",
12623: "$topdir/$topdir\_player.html",
12624: "$topdir/$topdir\_Thumbnails.png",
12625: "$topdir/playerProductInstall.swf",
12626: "$topdir/scripts/",
12627: "$topdir/scripts/config_xml.js",
12628: "$topdir/scripts/handlebars.js",
12629: "$topdir/scripts/jquery-1.7.1.min.js",
12630: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12631: "$topdir/scripts/modernizr.js",
12632: "$topdir/scripts/player-min.js",
12633: "$topdir/scripts/swfobject.js",
12634: "$topdir/skins/",
12635: "$topdir/skins/configuration_express.xml",
12636: "$topdir/skins/express_show/",
12637: "$topdir/skins/express_show/player-min.css",
12638: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 12639: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12640: "$topdir/$topdir.mp4",
12641: "$topdir/$topdir\_config.xml",
12642: "$topdir/$topdir\_controller.swf",
12643: "$topdir/$topdir\_embed.css",
12644: "$topdir/$topdir\_First_Frame.png",
12645: "$topdir/$topdir\_player.html",
12646: "$topdir/$topdir\_Thumbnails.png",
12647: "$topdir/playerProductInstall.swf",
12648: "$topdir/scripts/",
12649: "$topdir/scripts/config_xml.js",
12650: "$topdir/scripts/techsmith-smart-player.min.js",
12651: "$topdir/skins/",
12652: "$topdir/skins/configuration_express.xml",
12653: "$topdir/skins/express_show/",
12654: "$topdir/skins/express_show/spritesheet.min.css",
12655: "$topdir/skins/express_show/spritesheet.png",
12656: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 12657: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12658: if (@diffs == 0) {
1.1075.2.59 raeburn 12659: $is_camtasia = 6;
12660: } else {
1.1075.2.81 raeburn 12661: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 12662: if (@diffs == 0) {
12663: $is_camtasia = 8;
1.1075.2.81 raeburn 12664: } else {
12665: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12666: if (@diffs == 0) {
12667: $is_camtasia = 8;
12668: }
1.1075.2.59 raeburn 12669: }
1.1067 raeburn 12670: }
12671: }
12672: my $output;
12673: if ($is_camtasia) {
12674: $output = <<"ENDCAM";
12675: <script type="text/javascript" language="Javascript">
12676: // <![CDATA[
12677:
12678: function camtasiaToggle() {
12679: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12680: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 12681: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12682: document.getElementById('camtasia_titles').style.display='block';
12683: } else {
12684: document.getElementById('camtasia_titles').style.display='none';
12685: }
12686: }
12687: }
12688: return;
12689: }
12690:
12691: // ]]>
12692: </script>
12693: <p>$lt{'camt'}</p>
12694: ENDCAM
1.1065 raeburn 12695: } else {
1.1067 raeburn 12696: $output = '<p>'.$lt{'this'};
12697: if ($info eq '') {
12698: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12699: } else {
12700: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12701: '<div><pre>'.$info.'</pre></div>';
12702: }
1.1065 raeburn 12703: }
1.1067 raeburn 12704: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12705: my $duplicates;
12706: my $num = 0;
12707: if (ref($dirlist) eq 'ARRAY') {
12708: foreach my $item (@{$dirlist}) {
12709: if (ref($item) eq 'ARRAY') {
12710: if (exists($toplevel{$item->[0]})) {
12711: $duplicates .=
12712: &start_data_table_row().
12713: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12714: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12715: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12716: 'value="1" />'.&mt('Yes').'</label>'.
12717: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12718: '<td>'.$item->[0].'</td>';
12719: if ($item->[2]) {
12720: $duplicates .= '<td>'.&mt('Directory').'</td>';
12721: } else {
12722: $duplicates .= '<td>'.&mt('File').'</td>';
12723: }
12724: $duplicates .= '<td>'.$item->[3].'</td>'.
12725: '<td>'.
12726: &Apache::lonlocal::locallocaltime($item->[4]).
12727: '</td>'.
12728: &end_data_table_row();
12729: $num ++;
12730: }
12731: }
12732: }
12733: }
12734: my $itemcount;
12735: if (@paths > 0) {
12736: $itemcount = scalar(@paths);
12737: } else {
12738: $itemcount = 1;
12739: }
1.1067 raeburn 12740: if ($is_camtasia) {
12741: $output .= $lt{'auto'}.'<br />'.
12742: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 12743: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12744: $lt{'yes'}.'</label> <label>'.
12745: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12746: $lt{'no'}.'</label></span><br />'.
12747: '<div id="camtasia_titles" style="display:block">'.
12748: &Apache::lonhtmlcommon::start_pick_box().
12749: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12750: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12751: &Apache::lonhtmlcommon::row_closure().
12752: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12753: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12754: &Apache::lonhtmlcommon::row_closure(1).
12755: &Apache::lonhtmlcommon::end_pick_box().
12756: '</div>';
12757: }
1.1065 raeburn 12758: $output .=
12759: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12760: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12761: "\n";
1.1065 raeburn 12762: if ($duplicates ne '') {
12763: $output .= '<p><span class="LC_warning">'.
12764: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12765: &start_data_table().
12766: &start_data_table_header_row().
12767: '<th>'.&mt('Overwrite?').'</th>'.
12768: '<th>'.&mt('Name').'</th>'.
12769: '<th>'.&mt('Type').'</th>'.
12770: '<th>'.&mt('Size').'</th>'.
12771: '<th>'.&mt('Last modified').'</th>'.
12772: &end_data_table_header_row().
12773: $duplicates.
12774: &end_data_table().
12775: '</p>';
12776: }
1.1067 raeburn 12777: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12778: if (ref($hiddenelements) eq 'HASH') {
12779: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12780: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12781: }
12782: }
12783: $output .= <<"END";
1.1067 raeburn 12784: <br />
1.1053 raeburn 12785: <input type="submit" name="decompress" value="$lt{'extr'}" />
12786: </form>
12787: $noextract
12788: END
12789: return $output;
12790: }
12791:
1.1065 raeburn 12792: sub decompression_utility {
12793: my ($program) = @_;
12794: my @utilities = ('tar','gunzip','bunzip2','unzip');
12795: my $location;
12796: if (grep(/^\Q$program\E$/,@utilities)) {
12797: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12798: '/usr/sbin/') {
12799: if (-x $dir.$program) {
12800: $location = $dir.$program;
12801: last;
12802: }
12803: }
12804: }
12805: return $location;
12806: }
12807:
12808: sub list_archive_contents {
12809: my ($file,$pathsref) = @_;
12810: my (@cmd,$output);
12811: my $needsregexp;
12812: if ($file =~ /\.zip$/) {
12813: @cmd = (&decompression_utility('unzip'),"-l");
12814: $needsregexp = 1;
12815: } elsif (($file =~ m/\.tar\.gz$/) ||
12816: ($file =~ /\.tgz$/)) {
12817: @cmd = (&decompression_utility('tar'),"-ztf");
12818: } elsif ($file =~ /\.tar\.bz2$/) {
12819: @cmd = (&decompression_utility('tar'),"-jtf");
12820: } elsif ($file =~ m|\.tar$|) {
12821: @cmd = (&decompression_utility('tar'),"-tf");
12822: }
12823: if (@cmd) {
12824: undef($!);
12825: undef($@);
12826: if (open(my $fh,"-|", @cmd, $file)) {
12827: while (my $line = <$fh>) {
12828: $output .= $line;
12829: chomp($line);
12830: my $item;
12831: if ($needsregexp) {
12832: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12833: } else {
12834: $item = $line;
12835: }
12836: if ($item ne '') {
12837: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12838: push(@{$pathsref},$item);
12839: }
12840: }
12841: }
12842: close($fh);
12843: }
12844: }
12845: return $output;
12846: }
12847:
1.1053 raeburn 12848: sub decompress_uploaded_file {
12849: my ($file,$dir) = @_;
12850: &Apache::lonnet::appenv({'cgi.file' => $file});
12851: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12852: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12853: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12854: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12855: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12856: my $decompressed = $env{'cgi.decompressed'};
12857: &Apache::lonnet::delenv('cgi.file');
12858: &Apache::lonnet::delenv('cgi.dir');
12859: &Apache::lonnet::delenv('cgi.decompressed');
12860: return ($decompressed,$result);
12861: }
12862:
1.1055 raeburn 12863: sub process_decompression {
12864: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128 raeburn 12865: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12866: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12867: &mt('Unexpected file path.').'</p>'."\n";
12868: }
12869: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12870: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12871: &mt('Unexpected course context.').'</p>'."\n";
12872: }
12873: unless ($file eq &Apache::lonnet::clean_filename($file)) {
12874: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12875: &mt('Filename contained unexpected characters.').'</p>'."\n";
12876: }
1.1055 raeburn 12877: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 12878: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 12879: $error = &mt('Filename not a supported archive file type.').
12880: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12881: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12882: } else {
12883: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12884: if ($docuhome eq 'no_host') {
12885: $error = &mt('Could not determine home server for course.');
12886: } else {
12887: my @ids=&Apache::lonnet::current_machine_ids();
12888: my $currdir = "$dir_root/$destination";
12889: if (grep(/^\Q$docuhome\E$/,@ids)) {
12890: $dir = &LONCAPA::propath($docudom,$docuname).
12891: "$dir_root/$destination";
12892: } else {
12893: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12894: "$dir_root/$docudom/$docuname/$destination";
12895: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12896: $error = &mt('Archive file not found.');
12897: }
12898: }
1.1065 raeburn 12899: my (@to_overwrite,@to_skip);
12900: if ($env{'form.archive_overwrite_total'} > 0) {
12901: my $total = $env{'form.archive_overwrite_total'};
12902: for (my $i=0; $i<$total; $i++) {
12903: if ($env{'form.archive_overwrite_'.$i} == 1) {
12904: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12905: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12906: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12907: }
12908: }
12909: }
12910: my $numskip = scalar(@to_skip);
1.1075.2.128 raeburn 12911: my $numoverwrite = scalar(@to_overwrite);
12912: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12913: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12914: } elsif ($dir eq '') {
1.1055 raeburn 12915: $error = &mt('Directory containing archive file unavailable.');
12916: } elsif (!$error) {
1.1065 raeburn 12917: my ($decompressed,$display);
1.1075.2.128 raeburn 12918: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12919: my $tempdir = time.'_'.$$.int(rand(10000));
12920: mkdir("$dir/$tempdir",0755);
1.1075.2.128 raeburn 12921: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12922: ($decompressed,$display) =
12923: &decompress_uploaded_file($file,"$dir/$tempdir");
12924: foreach my $item (@to_skip) {
12925: if (($item ne '') && ($item !~ /\.\./)) {
12926: if (-f "$dir/$tempdir/$item") {
12927: unlink("$dir/$tempdir/$item");
12928: } elsif (-d "$dir/$tempdir/$item") {
12929: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
12930: }
12931: }
12932: }
12933: foreach my $item (@to_overwrite) {
12934: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
12935: if (($item ne '') && ($item !~ /\.\./)) {
12936: if (-f "$dir/$item") {
12937: unlink("$dir/$item");
12938: } elsif (-d "$dir/$item") {
12939: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
12940: }
12941: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
12942: }
1.1065 raeburn 12943: }
12944: }
1.1075.2.128 raeburn 12945: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
12946: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
12947: }
1.1065 raeburn 12948: }
12949: } else {
12950: ($decompressed,$display) =
12951: &decompress_uploaded_file($file,$dir);
12952: }
1.1055 raeburn 12953: if ($decompressed eq 'ok') {
1.1065 raeburn 12954: $output = '<p class="LC_info">'.
12955: &mt('Files extracted successfully from archive.').
12956: '</p>'."\n";
1.1055 raeburn 12957: my ($warning,$result,@contents);
12958: my ($newdirlistref,$newlisterror) =
12959: &Apache::lonnet::dirlist($currdir,$docudom,
12960: $docuname,1);
12961: my (%is_dir,%changes,@newitems);
12962: my $dirptr = 16384;
1.1065 raeburn 12963: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12964: foreach my $dir_line (@{$newdirlistref}) {
12965: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128 raeburn 12966: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 12967: push(@newitems,$item);
12968: if ($dirptr&$testdir) {
12969: $is_dir{$item} = 1;
12970: }
12971: $changes{$item} = 1;
12972: }
12973: }
12974: }
12975: if (keys(%changes) > 0) {
12976: foreach my $item (sort(@newitems)) {
12977: if ($changes{$item}) {
12978: push(@contents,$item);
12979: }
12980: }
12981: }
12982: if (@contents > 0) {
1.1067 raeburn 12983: my $wantform;
12984: unless ($env{'form.autoextract_camtasia'}) {
12985: $wantform = 1;
12986: }
1.1056 raeburn 12987: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12988: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12989: $currdir,\%is_dir,
12990: \%children,\%parent,
1.1056 raeburn 12991: \@contents,\%dirorder,
12992: \%titles,$wantform);
1.1055 raeburn 12993: if ($datatable ne '') {
12994: $output .= &archive_options_form('decompressed',$datatable,
12995: $count,$hiddenelem);
1.1065 raeburn 12996: my $startcount = 6;
1.1055 raeburn 12997: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12998: \%titles,\%children);
1.1055 raeburn 12999: }
1.1067 raeburn 13000: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 13001: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13002: my %displayed;
13003: my $total = 1;
13004: $env{'form.archive_directory'} = [];
13005: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13006: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13007: $path =~ s{/$}{};
13008: my $item;
13009: if ($path ne '') {
13010: $item = "$path/$titles{$i}";
13011: } else {
13012: $item = $titles{$i};
13013: }
13014: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13015: if ($item eq $contents[0]) {
13016: push(@{$env{'form.archive_directory'}},$i);
13017: $env{'form.archive_'.$i} = 'display';
13018: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13019: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 13020: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13021: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13022: $env{'form.archive_'.$i} = 'display';
13023: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13024: $displayed{'web'} = $i;
13025: } else {
1.1075.2.59 raeburn 13026: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13027: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13028: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13029: push(@{$env{'form.archive_directory'}},$i);
13030: }
13031: $env{'form.archive_'.$i} = 'dependency';
13032: }
13033: $total ++;
13034: }
13035: for (my $i=1; $i<$total; $i++) {
13036: next if ($i == $displayed{'web'});
13037: next if ($i == $displayed{'folder'});
13038: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13039: }
13040: $env{'form.phase'} = 'decompress_cleanup';
13041: $env{'form.archivedelete'} = 1;
13042: $env{'form.archive_count'} = $total-1;
13043: $output .=
13044: &process_extracted_files('coursedocs',$docudom,
13045: $docuname,$destination,
13046: $dir_root,$hiddenelem);
13047: }
1.1055 raeburn 13048: } else {
13049: $warning = &mt('No new items extracted from archive file.');
13050: }
13051: } else {
13052: $output = $display;
13053: $error = &mt('An error occurred during extraction from the archive file.');
13054: }
13055: }
13056: }
13057: }
13058: if ($error) {
13059: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13060: $error.'</p>'."\n";
13061: }
13062: if ($warning) {
13063: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13064: }
13065: return $output;
13066: }
13067:
13068: sub get_extracted {
1.1056 raeburn 13069: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13070: $titles,$wantform) = @_;
1.1055 raeburn 13071: my $count = 0;
13072: my $depth = 0;
13073: my $datatable;
1.1056 raeburn 13074: my @hierarchy;
1.1055 raeburn 13075: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13076: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13077: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13078: foreach my $item (@{$contents}) {
13079: $count ++;
1.1056 raeburn 13080: @{$dirorder->{$count}} = @hierarchy;
13081: $titles->{$count} = $item;
1.1055 raeburn 13082: &archive_hierarchy($depth,$count,$parent,$children);
13083: if ($wantform) {
13084: $datatable .= &archive_row($is_dir->{$item},$item,
13085: $currdir,$depth,$count);
13086: }
13087: if ($is_dir->{$item}) {
13088: $depth ++;
1.1056 raeburn 13089: push(@hierarchy,$count);
13090: $parent->{$depth} = $count;
1.1055 raeburn 13091: $datatable .=
13092: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13093: \$depth,\$count,\@hierarchy,$dirorder,
13094: $children,$parent,$titles,$wantform);
1.1055 raeburn 13095: $depth --;
1.1056 raeburn 13096: pop(@hierarchy);
1.1055 raeburn 13097: }
13098: }
13099: return ($count,$datatable);
13100: }
13101:
13102: sub recurse_extracted_archive {
1.1056 raeburn 13103: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13104: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13105: my $result='';
1.1056 raeburn 13106: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13107: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13108: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13109: return $result;
13110: }
13111: my $dirptr = 16384;
13112: my ($newdirlistref,$newlisterror) =
13113: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13114: if (ref($newdirlistref) eq 'ARRAY') {
13115: foreach my $dir_line (@{$newdirlistref}) {
13116: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13117: unless ($item =~ /^\.+$/) {
13118: $$count ++;
1.1056 raeburn 13119: @{$dirorder->{$$count}} = @{$hierarchy};
13120: $titles->{$$count} = $item;
1.1055 raeburn 13121: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13122:
1.1055 raeburn 13123: my $is_dir;
13124: if ($dirptr&$testdir) {
13125: $is_dir = 1;
13126: }
13127: if ($wantform) {
13128: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13129: }
13130: if ($is_dir) {
13131: $$depth ++;
1.1056 raeburn 13132: push(@{$hierarchy},$$count);
13133: $parent->{$$depth} = $$count;
1.1055 raeburn 13134: $result .=
13135: &recurse_extracted_archive("$currdir/$item",$docudom,
13136: $docuname,$depth,$count,
1.1056 raeburn 13137: $hierarchy,$dirorder,$children,
13138: $parent,$titles,$wantform);
1.1055 raeburn 13139: $$depth --;
1.1056 raeburn 13140: pop(@{$hierarchy});
1.1055 raeburn 13141: }
13142: }
13143: }
13144: }
13145: return $result;
13146: }
13147:
13148: sub archive_hierarchy {
13149: my ($depth,$count,$parent,$children) =@_;
13150: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13151: if (exists($parent->{$depth})) {
13152: $children->{$parent->{$depth}} .= $count.':';
13153: }
13154: }
13155: return;
13156: }
13157:
13158: sub archive_row {
13159: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13160: my ($name) = ($item =~ m{([^/]+)$});
13161: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13162: 'display' => 'Add as file',
1.1055 raeburn 13163: 'dependency' => 'Include as dependency',
13164: 'discard' => 'Discard',
13165: );
13166: if ($is_dir) {
1.1059 raeburn 13167: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13168: }
1.1056 raeburn 13169: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13170: my $offset = 0;
1.1055 raeburn 13171: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13172: $offset ++;
1.1065 raeburn 13173: if ($action ne 'display') {
13174: $offset ++;
13175: }
1.1055 raeburn 13176: $output .= '<td><span class="LC_nobreak">'.
13177: '<label><input type="radio" name="archive_'.$count.
13178: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13179: my $text = $choices{$action};
13180: if ($is_dir) {
13181: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13182: if ($action eq 'display') {
1.1059 raeburn 13183: $text = &mt('Add as folder');
1.1055 raeburn 13184: }
1.1056 raeburn 13185: } else {
13186: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13187:
13188: }
13189: $output .= ' /> '.$choices{$action}.'</label></span>';
13190: if ($action eq 'dependency') {
13191: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13192: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13193: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13194: '<option value=""></option>'."\n".
13195: '</select>'."\n".
13196: '</div>';
1.1059 raeburn 13197: } elsif ($action eq 'display') {
13198: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13199: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13200: '</div>';
1.1055 raeburn 13201: }
1.1056 raeburn 13202: $output .= '</td>';
1.1055 raeburn 13203: }
13204: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13205: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13206: for (my $i=0; $i<$depth; $i++) {
13207: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13208: }
13209: if ($is_dir) {
13210: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13211: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13212: } else {
13213: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13214: }
13215: $output .= ' '.$name.'</td>'."\n".
13216: &end_data_table_row();
13217: return $output;
13218: }
13219:
13220: sub archive_options_form {
1.1065 raeburn 13221: my ($form,$display,$count,$hiddenelem) = @_;
13222: my %lt = &Apache::lonlocal::texthash(
13223: perm => 'Permanently remove archive file?',
13224: hows => 'How should each extracted item be incorporated in the course?',
13225: cont => 'Content actions for all',
13226: addf => 'Add as folder/file',
13227: incd => 'Include as dependency for a displayed file',
13228: disc => 'Discard',
13229: no => 'No',
13230: yes => 'Yes',
13231: save => 'Save',
13232: );
13233: my $output = <<"END";
13234: <form name="$form" method="post" action="">
13235: <p><span class="LC_nobreak">$lt{'perm'}
13236: <label>
13237: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13238: </label>
13239:
13240: <label>
13241: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13242: </span>
13243: </p>
13244: <input type="hidden" name="phase" value="decompress_cleanup" />
13245: <br />$lt{'hows'}
13246: <div class="LC_columnSection">
13247: <fieldset>
13248: <legend>$lt{'cont'}</legend>
13249: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13250: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13251: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13252: </fieldset>
13253: </div>
13254: END
13255: return $output.
1.1055 raeburn 13256: &start_data_table()."\n".
1.1065 raeburn 13257: $display."\n".
1.1055 raeburn 13258: &end_data_table()."\n".
13259: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13260: $hiddenelem.
1.1065 raeburn 13261: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13262: '</form>';
13263: }
13264:
13265: sub archive_javascript {
1.1056 raeburn 13266: my ($startcount,$numitems,$titles,$children) = @_;
13267: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13268: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13269: my $scripttag = <<START;
13270: <script type="text/javascript">
13271: // <![CDATA[
13272:
13273: function checkAll(form,prefix) {
13274: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13275: for (var i=0; i < form.elements.length; i++) {
13276: var id = form.elements[i].id;
13277: if ((id != '') && (id != undefined)) {
13278: if (idstr.test(id)) {
13279: if (form.elements[i].type == 'radio') {
13280: form.elements[i].checked = true;
1.1056 raeburn 13281: var nostart = i-$startcount;
1.1059 raeburn 13282: var offset = nostart%7;
13283: var count = (nostart-offset)/7;
1.1056 raeburn 13284: dependencyCheck(form,count,offset);
1.1055 raeburn 13285: }
13286: }
13287: }
13288: }
13289: }
13290:
13291: function propagateCheck(form,count) {
13292: if (count > 0) {
1.1059 raeburn 13293: var startelement = $startcount + ((count-1) * 7);
13294: for (var j=1; j<6; j++) {
13295: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13296: var item = startelement + j;
13297: if (form.elements[item].type == 'radio') {
13298: if (form.elements[item].checked) {
13299: containerCheck(form,count,j);
13300: break;
13301: }
1.1055 raeburn 13302: }
13303: }
13304: }
13305: }
13306: }
13307:
13308: numitems = $numitems
1.1056 raeburn 13309: var titles = new Array(numitems);
13310: var parents = new Array(numitems);
1.1055 raeburn 13311: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13312: parents[i] = new Array;
1.1055 raeburn 13313: }
1.1059 raeburn 13314: var maintitle = '$maintitle';
1.1055 raeburn 13315:
13316: START
13317:
1.1056 raeburn 13318: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13319: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13320: for (my $i=0; $i<@contents; $i ++) {
13321: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13322: }
13323: }
13324:
1.1056 raeburn 13325: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13326: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13327: }
13328:
1.1055 raeburn 13329: $scripttag .= <<END;
13330:
13331: function containerCheck(form,count,offset) {
13332: if (count > 0) {
1.1056 raeburn 13333: dependencyCheck(form,count,offset);
1.1059 raeburn 13334: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13335: form.elements[item].checked = true;
13336: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13337: if (parents[count].length > 0) {
13338: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13339: containerCheck(form,parents[count][j],offset);
13340: }
13341: }
13342: }
13343: }
13344: }
13345:
13346: function dependencyCheck(form,count,offset) {
13347: if (count > 0) {
1.1059 raeburn 13348: var chosen = (offset+$startcount)+7*(count-1);
13349: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13350: var currtype = form.elements[depitem].type;
13351: if (form.elements[chosen].value == 'dependency') {
13352: document.getElementById('arc_depon_'+count).style.display='block';
13353: form.elements[depitem].options.length = 0;
13354: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 13355: for (var i=1; i<=numitems; i++) {
13356: if (i == count) {
13357: continue;
13358: }
1.1059 raeburn 13359: var startelement = $startcount + (i-1) * 7;
13360: for (var j=1; j<6; j++) {
13361: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13362: var item = startelement + j;
13363: if (form.elements[item].type == 'radio') {
13364: if (form.elements[item].checked) {
13365: if (form.elements[item].value == 'display') {
13366: var n = form.elements[depitem].options.length;
13367: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13368: }
13369: }
13370: }
13371: }
13372: }
13373: }
13374: } else {
13375: document.getElementById('arc_depon_'+count).style.display='none';
13376: form.elements[depitem].options.length = 0;
13377: form.elements[depitem].options[0] = new Option('Select','',true,true);
13378: }
1.1059 raeburn 13379: titleCheck(form,count,offset);
1.1056 raeburn 13380: }
13381: }
13382:
13383: function propagateSelect(form,count,offset) {
13384: if (count > 0) {
1.1065 raeburn 13385: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13386: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13387: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13388: if (parents[count].length > 0) {
13389: for (var j=0; j<parents[count].length; j++) {
13390: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13391: }
13392: }
13393: }
13394: }
13395: }
1.1056 raeburn 13396:
13397: function containerSelect(form,count,offset,picked) {
13398: if (count > 0) {
1.1065 raeburn 13399: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13400: if (form.elements[item].type == 'radio') {
13401: if (form.elements[item].value == 'dependency') {
13402: if (form.elements[item+1].type == 'select-one') {
13403: for (var i=0; i<form.elements[item+1].options.length; i++) {
13404: if (form.elements[item+1].options[i].value == picked) {
13405: form.elements[item+1].selectedIndex = i;
13406: break;
13407: }
13408: }
13409: }
13410: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13411: if (parents[count].length > 0) {
13412: for (var j=0; j<parents[count].length; j++) {
13413: containerSelect(form,parents[count][j],offset,picked);
13414: }
13415: }
13416: }
13417: }
13418: }
13419: }
13420: }
13421:
1.1059 raeburn 13422: function titleCheck(form,count,offset) {
13423: if (count > 0) {
13424: var chosen = (offset+$startcount)+7*(count-1);
13425: var depitem = $startcount + ((count-1) * 7) + 2;
13426: var currtype = form.elements[depitem].type;
13427: if (form.elements[chosen].value == 'display') {
13428: document.getElementById('arc_title_'+count).style.display='block';
13429: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13430: document.getElementById('archive_title_'+count).value=maintitle;
13431: }
13432: } else {
13433: document.getElementById('arc_title_'+count).style.display='none';
13434: if (currtype == 'text') {
13435: document.getElementById('archive_title_'+count).value='';
13436: }
13437: }
13438: }
13439: return;
13440: }
13441:
1.1055 raeburn 13442: // ]]>
13443: </script>
13444: END
13445: return $scripttag;
13446: }
13447:
13448: sub process_extracted_files {
1.1067 raeburn 13449: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13450: my $numitems = $env{'form.archive_count'};
1.1075.2.128 raeburn 13451: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 13452: my @ids=&Apache::lonnet::current_machine_ids();
13453: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13454: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13455: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13456: if (grep(/^\Q$docuhome\E$/,@ids)) {
13457: $prefix = &LONCAPA::propath($docudom,$docuname);
13458: $pathtocheck = "$dir_root/$destination";
13459: $dir = $dir_root;
13460: $ishome = 1;
13461: } else {
13462: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13463: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128 raeburn 13464: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 13465: }
13466: my $currdir = "$dir_root/$destination";
13467: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13468: if ($env{'form.folderpath'}) {
13469: my @items = split('&',$env{'form.folderpath'});
13470: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 13471: if ($env{'form.folderpath'} =~ /\:1$/) {
13472: $containers{'0'}='page';
13473: } else {
13474: $containers{'0'}='sequence';
13475: }
1.1055 raeburn 13476: }
13477: my @archdirs = &get_env_multiple('form.archive_directory');
13478: if ($numitems) {
13479: for (my $i=1; $i<=$numitems; $i++) {
13480: my $path = $env{'form.archive_content_'.$i};
13481: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13482: my $item = $1;
13483: $toplevelitems{$item} = $i;
13484: if (grep(/^\Q$i\E$/,@archdirs)) {
13485: $is_dir{$item} = 1;
13486: }
13487: }
13488: }
13489: }
1.1067 raeburn 13490: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13491: if (keys(%toplevelitems) > 0) {
13492: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13493: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13494: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13495: }
1.1066 raeburn 13496: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13497: if ($numitems) {
13498: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 13499: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13500: my $path = $env{'form.archive_content_'.$i};
13501: if ($path =~ /^\Q$pathtocheck\E/) {
13502: if ($env{'form.archive_'.$i} eq 'discard') {
13503: if ($prefix ne '' && $path ne '') {
13504: if (-e $prefix.$path) {
1.1066 raeburn 13505: if ((@archdirs > 0) &&
13506: (grep(/^\Q$i\E$/,@archdirs))) {
13507: $todeletedir{$prefix.$path} = 1;
13508: } else {
13509: $todelete{$prefix.$path} = 1;
13510: }
1.1055 raeburn 13511: }
13512: }
13513: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13514: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13515: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13516: $docstitle = $env{'form.archive_title_'.$i};
13517: if ($docstitle eq '') {
13518: $docstitle = $title;
13519: }
1.1055 raeburn 13520: $outer = 0;
1.1056 raeburn 13521: if (ref($dirorder{$i}) eq 'ARRAY') {
13522: if (@{$dirorder{$i}} > 0) {
13523: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13524: if ($env{'form.archive_'.$item} eq 'display') {
13525: $outer = $item;
13526: last;
13527: }
13528: }
13529: }
13530: }
13531: my ($errtext,$fatal) =
13532: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13533: '/'.$folders{$outer}.'.'.
13534: $containers{$outer});
13535: next if ($fatal);
13536: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13537: if ($context eq 'coursedocs') {
1.1056 raeburn 13538: $mapinner{$i} = time;
1.1055 raeburn 13539: $folders{$i} = 'default_'.$mapinner{$i};
13540: $containers{$i} = 'sequence';
13541: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13542: $folders{$i}.'.'.$containers{$i};
13543: my $newidx = &LONCAPA::map::getresidx();
13544: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13545: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13546: push(@LONCAPA::map::order,$newidx);
13547: my ($outtext,$errtext) =
13548: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13549: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 13550: '.'.$containers{$outer},1,1);
1.1056 raeburn 13551: $newseqid{$i} = $newidx;
1.1067 raeburn 13552: unless ($errtext) {
1.1075.2.128 raeburn 13553: $result .= '<li>'.&mt('Folder: [_1] added to course',
13554: &HTML::Entities::encode($docstitle,'<>&"'))..
13555: '</li>'."\n";
1.1067 raeburn 13556: }
1.1055 raeburn 13557: }
13558: } else {
13559: if ($context eq 'coursedocs') {
13560: my $newidx=&LONCAPA::map::getresidx();
13561: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13562: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13563: $title;
1.1075.2.128 raeburn 13564: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
13565: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13566: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067 raeburn 13567: }
1.1075.2.128 raeburn 13568: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13569: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13570: }
13571: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13572: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
13573: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
13574: unless ($ishome) {
13575: my $fetch = "$newdest{$i}/$title";
13576: $fetch =~ s/^\Q$prefix$dir\E//;
13577: $prompttofetch{$fetch} = 1;
13578: }
13579: }
13580: }
13581: $LONCAPA::map::resources[$newidx]=
13582: $docstitle.':'.$url.':false:normal:res';
13583: push(@LONCAPA::map::order, $newidx);
13584: my ($outtext,$errtext)=
13585: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13586: $docuname.'/'.$folders{$outer}.
13587: '.'.$containers{$outer},1,1);
13588: unless ($errtext) {
13589: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13590: $result .= '<li>'.&mt('File: [_1] added to course',
13591: &HTML::Entities::encode($docstitle,'<>&"')).
13592: '</li>'."\n";
13593: }
1.1067 raeburn 13594: }
1.1075.2.128 raeburn 13595: } else {
13596: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13597: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067 raeburn 13598: }
1.1055 raeburn 13599: }
13600: }
1.1075.2.11 raeburn 13601: }
13602: } else {
1.1075.2.128 raeburn 13603: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13604: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11 raeburn 13605: }
13606: }
13607: for (my $i=1; $i<=$numitems; $i++) {
13608: next unless ($env{'form.archive_'.$i} eq 'dependency');
13609: my $path = $env{'form.archive_content_'.$i};
13610: if ($path =~ /^\Q$pathtocheck\E/) {
13611: my ($title) = ($path =~ m{/([^/]+)$});
13612: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13613: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13614: if (ref($dirorder{$i}) eq 'ARRAY') {
13615: my ($itemidx,$fullpath,$relpath);
13616: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13617: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13618: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 13619: if ($dirorder{$i}->[$j] eq $container) {
13620: $itemidx = $j;
1.1056 raeburn 13621: }
13622: }
1.1075.2.11 raeburn 13623: }
13624: if ($itemidx eq '') {
13625: $itemidx = 0;
13626: }
13627: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13628: if ($mapinner{$referrer{$i}}) {
13629: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13630: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13631: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13632: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13633: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13634: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13635: if (!-e $fullpath) {
13636: mkdir($fullpath,0755);
1.1056 raeburn 13637: }
13638: }
1.1075.2.11 raeburn 13639: } else {
13640: last;
1.1056 raeburn 13641: }
1.1075.2.11 raeburn 13642: }
13643: }
13644: } elsif ($newdest{$referrer{$i}}) {
13645: $fullpath = $newdest{$referrer{$i}};
13646: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13647: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13648: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13649: last;
13650: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13651: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13652: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13653: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13654: if (!-e $fullpath) {
13655: mkdir($fullpath,0755);
1.1056 raeburn 13656: }
13657: }
1.1075.2.11 raeburn 13658: } else {
13659: last;
1.1056 raeburn 13660: }
1.1075.2.11 raeburn 13661: }
13662: }
13663: if ($fullpath ne '') {
13664: if (-e "$prefix$path") {
1.1075.2.128 raeburn 13665: unless (rename("$prefix$path","$fullpath/$title")) {
13666: $warning .= &mt('Failed to rename dependency').'<br />';
13667: }
1.1075.2.11 raeburn 13668: }
13669: if (-e "$fullpath/$title") {
13670: my $showpath;
13671: if ($relpath ne '') {
13672: $showpath = "$relpath/$title";
13673: } else {
13674: $showpath = "/$title";
1.1056 raeburn 13675: }
1.1075.2.128 raeburn 13676: $result .= '<li>'.&mt('[_1] included as a dependency',
13677: &HTML::Entities::encode($showpath,'<>&"')).
13678: '</li>'."\n";
13679: unless ($ishome) {
13680: my $fetch = "$fullpath/$title";
13681: $fetch =~ s/^\Q$prefix$dir\E//;
13682: $prompttofetch{$fetch} = 1;
13683: }
1.1055 raeburn 13684: }
13685: }
13686: }
1.1075.2.11 raeburn 13687: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13688: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128 raeburn 13689: &HTML::Entities::encode($path,'<>&"'),
13690: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13691: '<br />';
1.1055 raeburn 13692: }
13693: } else {
1.1075.2.128 raeburn 13694: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13695: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13696: }
13697: }
13698: if (keys(%todelete)) {
13699: foreach my $key (keys(%todelete)) {
13700: unlink($key);
1.1066 raeburn 13701: }
13702: }
13703: if (keys(%todeletedir)) {
13704: foreach my $key (keys(%todeletedir)) {
13705: rmdir($key);
13706: }
13707: }
13708: foreach my $dir (sort(keys(%is_dir))) {
13709: if (($pathtocheck ne '') && ($dir ne '')) {
13710: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13711: }
13712: }
1.1067 raeburn 13713: if ($result ne '') {
13714: $output .= '<ul>'."\n".
13715: $result."\n".
13716: '</ul>';
13717: }
13718: unless ($ishome) {
13719: my $replicationfail;
13720: foreach my $item (keys(%prompttofetch)) {
13721: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13722: unless ($fetchresult eq 'ok') {
13723: $replicationfail .= '<li>'.$item.'</li>'."\n";
13724: }
13725: }
13726: if ($replicationfail) {
13727: $output .= '<p class="LC_error">'.
13728: &mt('Course home server failed to retrieve:').'<ul>'.
13729: $replicationfail.
13730: '</ul></p>';
13731: }
13732: }
1.1055 raeburn 13733: } else {
13734: $warning = &mt('No items found in archive.');
13735: }
13736: if ($error) {
13737: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13738: $error.'</p>'."\n";
13739: }
13740: if ($warning) {
13741: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13742: }
13743: return $output;
13744: }
13745:
1.1066 raeburn 13746: sub cleanup_empty_dirs {
13747: my ($path) = @_;
13748: if (($path ne '') && (-d $path)) {
13749: if (opendir(my $dirh,$path)) {
13750: my @dircontents = grep(!/^\./,readdir($dirh));
13751: my $numitems = 0;
13752: foreach my $item (@dircontents) {
13753: if (-d "$path/$item") {
1.1075.2.28 raeburn 13754: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13755: if (-e "$path/$item") {
13756: $numitems ++;
13757: }
13758: } else {
13759: $numitems ++;
13760: }
13761: }
13762: if ($numitems == 0) {
13763: rmdir($path);
13764: }
13765: closedir($dirh);
13766: }
13767: }
13768: return;
13769: }
13770:
1.41 ng 13771: =pod
1.45 matthew 13772:
1.1075.2.56 raeburn 13773: =item * &get_folder_hierarchy()
1.1068 raeburn 13774:
13775: Provides hierarchy of names of folders/sub-folders containing the current
13776: item,
13777:
13778: Inputs: 3
13779: - $navmap - navmaps object
13780:
13781: - $map - url for map (either the trigger itself, or map containing
13782: the resource, which is the trigger).
13783:
13784: - $showitem - 1 => show title for map itself; 0 => do not show.
13785:
13786: Outputs: 1 @pathitems - array of folder/subfolder names.
13787:
13788: =cut
13789:
13790: sub get_folder_hierarchy {
13791: my ($navmap,$map,$showitem) = @_;
13792: my @pathitems;
13793: if (ref($navmap)) {
13794: my $mapres = $navmap->getResourceByUrl($map);
13795: if (ref($mapres)) {
13796: my $pcslist = $mapres->map_hierarchy();
13797: if ($pcslist ne '') {
13798: my @pcs = split(/,/,$pcslist);
13799: foreach my $pc (@pcs) {
13800: if ($pc == 1) {
1.1075.2.38 raeburn 13801: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13802: } else {
13803: my $res = $navmap->getByMapPc($pc);
13804: if (ref($res)) {
13805: my $title = $res->compTitle();
13806: $title =~ s/\W+/_/g;
13807: if ($title ne '') {
13808: push(@pathitems,$title);
13809: }
13810: }
13811: }
13812: }
13813: }
1.1071 raeburn 13814: if ($showitem) {
13815: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 13816: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13817: } else {
13818: my $maptitle = $mapres->compTitle();
13819: $maptitle =~ s/\W+/_/g;
13820: if ($maptitle ne '') {
13821: push(@pathitems,$maptitle);
13822: }
1.1068 raeburn 13823: }
13824: }
13825: }
13826: }
13827: return @pathitems;
13828: }
13829:
13830: =pod
13831:
1.1015 raeburn 13832: =item * &get_turnedin_filepath()
13833:
13834: Determines path in a user's portfolio file for storage of files uploaded
13835: to a specific essayresponse or dropbox item.
13836:
13837: Inputs: 3 required + 1 optional.
13838: $symb is symb for resource, $uname and $udom are for current user (required).
13839: $caller is optional (can be "submission", if routine is called when storing
13840: an upoaded file when "Submit Answer" button was pressed).
13841:
13842: Returns array containing $path and $multiresp.
13843: $path is path in portfolio. $multiresp is 1 if this resource contains more
13844: than one file upload item. Callers of routine should append partid as a
13845: subdirectory to $path in cases where $multiresp is 1.
13846:
13847: Called by: homework/essayresponse.pm and homework/structuretags.pm
13848:
13849: =cut
13850:
13851: sub get_turnedin_filepath {
13852: my ($symb,$uname,$udom,$caller) = @_;
13853: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13854: my $turnindir;
13855: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13856: $turnindir = $userhash{'turnindir'};
13857: my ($path,$multiresp);
13858: if ($turnindir eq '') {
13859: if ($caller eq 'submission') {
13860: $turnindir = &mt('turned in');
13861: $turnindir =~ s/\W+/_/g;
13862: my %newhash = (
13863: 'turnindir' => $turnindir,
13864: );
13865: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13866: }
13867: }
13868: if ($turnindir ne '') {
13869: $path = '/'.$turnindir.'/';
13870: my ($multipart,$turnin,@pathitems);
13871: my $navmap = Apache::lonnavmaps::navmap->new();
13872: if (defined($navmap)) {
13873: my $mapres = $navmap->getResourceByUrl($map);
13874: if (ref($mapres)) {
13875: my $pcslist = $mapres->map_hierarchy();
13876: if ($pcslist ne '') {
13877: foreach my $pc (split(/,/,$pcslist)) {
13878: my $res = $navmap->getByMapPc($pc);
13879: if (ref($res)) {
13880: my $title = $res->compTitle();
13881: $title =~ s/\W+/_/g;
13882: if ($title ne '') {
1.1075.2.48 raeburn 13883: if (($pc > 1) && (length($title) > 12)) {
13884: $title = substr($title,0,12);
13885: }
1.1015 raeburn 13886: push(@pathitems,$title);
13887: }
13888: }
13889: }
13890: }
13891: my $maptitle = $mapres->compTitle();
13892: $maptitle =~ s/\W+/_/g;
13893: if ($maptitle ne '') {
1.1075.2.48 raeburn 13894: if (length($maptitle) > 12) {
13895: $maptitle = substr($maptitle,0,12);
13896: }
1.1015 raeburn 13897: push(@pathitems,$maptitle);
13898: }
13899: unless ($env{'request.state'} eq 'construct') {
13900: my $res = $navmap->getBySymb($symb);
13901: if (ref($res)) {
13902: my $partlist = $res->parts();
13903: my $totaluploads = 0;
13904: if (ref($partlist) eq 'ARRAY') {
13905: foreach my $part (@{$partlist}) {
13906: my @types = $res->responseType($part);
13907: my @ids = $res->responseIds($part);
13908: for (my $i=0; $i < scalar(@ids); $i++) {
13909: if ($types[$i] eq 'essay') {
13910: my $partid = $part.'_'.$ids[$i];
13911: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13912: $totaluploads ++;
13913: }
13914: }
13915: }
13916: }
13917: if ($totaluploads > 1) {
13918: $multiresp = 1;
13919: }
13920: }
13921: }
13922: }
13923: } else {
13924: return;
13925: }
13926: } else {
13927: return;
13928: }
13929: my $restitle=&Apache::lonnet::gettitle($symb);
13930: $restitle =~ s/\W+/_/g;
13931: if ($restitle eq '') {
13932: $restitle = ($resurl =~ m{/[^/]+$});
13933: if ($restitle eq '') {
13934: $restitle = time;
13935: }
13936: }
1.1075.2.48 raeburn 13937: if (length($restitle) > 12) {
13938: $restitle = substr($restitle,0,12);
13939: }
1.1015 raeburn 13940: push(@pathitems,$restitle);
13941: $path .= join('/',@pathitems);
13942: }
13943: return ($path,$multiresp);
13944: }
13945:
13946: =pod
13947:
1.464 albertel 13948: =back
1.41 ng 13949:
1.112 bowersj2 13950: =head1 CSV Upload/Handling functions
1.38 albertel 13951:
1.41 ng 13952: =over 4
13953:
1.648 raeburn 13954: =item * &upfile_store($r)
1.41 ng 13955:
13956: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13957: needs $env{'form.upfile'}
1.41 ng 13958: returns $datatoken to be put into hidden field
13959:
13960: =cut
1.31 albertel 13961:
13962: sub upfile_store {
13963: my $r=shift;
1.258 albertel 13964: $env{'form.upfile'}=~s/\r/\n/gs;
13965: $env{'form.upfile'}=~s/\f/\n/gs;
13966: $env{'form.upfile'}=~s/\n+/\n/gs;
13967: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13968:
1.1075.2.128 raeburn 13969: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
13970: '_enroll_'.$env{'request.course.id'}.'_'.
13971: time.'_'.$$);
13972: return if ($datatoken eq '');
13973:
1.31 albertel 13974: {
1.158 raeburn 13975: my $datafile = $r->dir_config('lonDaemons').
13976: '/tmp/'.$datatoken.'.tmp';
1.1075.2.128 raeburn 13977: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 13978: print $fh $env{'form.upfile'};
1.158 raeburn 13979: close($fh);
13980: }
1.31 albertel 13981: }
13982: return $datatoken;
13983: }
13984:
1.56 matthew 13985: =pod
13986:
1.1075.2.128 raeburn 13987: =item * &load_tmp_file($r,$datatoken)
1.41 ng 13988:
13989: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128 raeburn 13990: $datatoken is the name to assign to the temporary file.
1.258 albertel 13991: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13992:
13993: =cut
1.31 albertel 13994:
13995: sub load_tmp_file {
1.1075.2.128 raeburn 13996: my ($r,$datatoken) = @_;
13997: return if ($datatoken eq '');
1.31 albertel 13998: my @studentdata=();
13999: {
1.158 raeburn 14000: my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128 raeburn 14001: '/tmp/'.$datatoken.'.tmp';
14002: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14003: @studentdata=<$fh>;
14004: close($fh);
14005: }
1.31 albertel 14006: }
1.258 albertel 14007: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14008: }
14009:
1.1075.2.128 raeburn 14010: sub valid_datatoken {
14011: my ($datatoken) = @_;
1.1075.2.131 raeburn 14012: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128 raeburn 14013: return $datatoken;
14014: }
14015: return;
14016: }
14017:
1.56 matthew 14018: =pod
14019:
1.648 raeburn 14020: =item * &upfile_record_sep()
1.41 ng 14021:
14022: Separate uploaded file into records
14023: returns array of records,
1.258 albertel 14024: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14025:
14026: =cut
1.31 albertel 14027:
14028: sub upfile_record_sep {
1.258 albertel 14029: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14030: } else {
1.248 albertel 14031: my @records;
1.258 albertel 14032: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14033: if ($line=~/^\s*$/) { next; }
14034: push(@records,$line);
14035: }
14036: return @records;
1.31 albertel 14037: }
14038: }
14039:
1.56 matthew 14040: =pod
14041:
1.648 raeburn 14042: =item * &record_sep($record)
1.41 ng 14043:
1.258 albertel 14044: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14045:
14046: =cut
14047:
1.263 www 14048: sub takeleft {
14049: my $index=shift;
14050: return substr('0000'.$index,-4,4);
14051: }
14052:
1.31 albertel 14053: sub record_sep {
14054: my $record=shift;
14055: my %components=();
1.258 albertel 14056: if ($env{'form.upfiletype'} eq 'xml') {
14057: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14058: my $i=0;
1.356 albertel 14059: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14060: $field=~s/^(\"|\')//;
14061: $field=~s/(\"|\')$//;
1.263 www 14062: $components{&takeleft($i)}=$field;
1.31 albertel 14063: $i++;
14064: }
1.258 albertel 14065: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14066: my $i=0;
1.356 albertel 14067: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14068: $field=~s/^(\"|\')//;
14069: $field=~s/(\"|\')$//;
1.263 www 14070: $components{&takeleft($i)}=$field;
1.31 albertel 14071: $i++;
14072: }
14073: } else {
1.561 www 14074: my $separator=',';
1.480 banghart 14075: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14076: $separator=';';
1.480 banghart 14077: }
1.31 albertel 14078: my $i=0;
1.561 www 14079: # the character we are looking for to indicate the end of a quote or a record
14080: my $looking_for=$separator;
14081: # do not add the characters to the fields
14082: my $ignore=0;
14083: # we just encountered a separator (or the beginning of the record)
14084: my $just_found_separator=1;
14085: # store the field we are working on here
14086: my $field='';
14087: # work our way through all characters in record
14088: foreach my $character ($record=~/(.)/g) {
14089: if ($character eq $looking_for) {
14090: if ($character ne $separator) {
14091: # Found the end of a quote, again looking for separator
14092: $looking_for=$separator;
14093: $ignore=1;
14094: } else {
14095: # Found a separator, store away what we got
14096: $components{&takeleft($i)}=$field;
14097: $i++;
14098: $just_found_separator=1;
14099: $ignore=0;
14100: $field='';
14101: }
14102: next;
14103: }
14104: # single or double quotation marks after a separator indicate beginning of a quote
14105: # we are now looking for the end of the quote and need to ignore separators
14106: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14107: $looking_for=$character;
14108: next;
14109: }
14110: # ignore would be true after we reached the end of a quote
14111: if ($ignore) { next; }
14112: if (($just_found_separator) && ($character=~/\s/)) { next; }
14113: $field.=$character;
14114: $just_found_separator=0;
1.31 albertel 14115: }
1.561 www 14116: # catch the very last entry, since we never encountered the separator
14117: $components{&takeleft($i)}=$field;
1.31 albertel 14118: }
14119: return %components;
14120: }
14121:
1.144 matthew 14122: ######################################################
14123: ######################################################
14124:
1.56 matthew 14125: =pod
14126:
1.648 raeburn 14127: =item * &upfile_select_html()
1.41 ng 14128:
1.144 matthew 14129: Return HTML code to select a file from the users machine and specify
14130: the file type.
1.41 ng 14131:
14132: =cut
14133:
1.144 matthew 14134: ######################################################
14135: ######################################################
1.31 albertel 14136: sub upfile_select_html {
1.144 matthew 14137: my %Types = (
14138: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14139: semisv => &mt('Semicolon separated values'),
1.144 matthew 14140: space => &mt('Space separated'),
14141: tab => &mt('Tabulator separated'),
14142: # xml => &mt('HTML/XML'),
14143: );
14144: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14145: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14146: foreach my $type (sort(keys(%Types))) {
14147: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14148: }
14149: $Str .= "</select>\n";
14150: return $Str;
1.31 albertel 14151: }
14152:
1.301 albertel 14153: sub get_samples {
14154: my ($records,$toget) = @_;
14155: my @samples=({});
14156: my $got=0;
14157: foreach my $rec (@$records) {
14158: my %temp = &record_sep($rec);
14159: if (! grep(/\S/, values(%temp))) { next; }
14160: if (%temp) {
14161: $samples[$got]=\%temp;
14162: $got++;
14163: if ($got == $toget) { last; }
14164: }
14165: }
14166: return \@samples;
14167: }
14168:
1.144 matthew 14169: ######################################################
14170: ######################################################
14171:
1.56 matthew 14172: =pod
14173:
1.648 raeburn 14174: =item * &csv_print_samples($r,$records)
1.41 ng 14175:
14176: Prints a table of sample values from each column uploaded $r is an
14177: Apache Request ref, $records is an arrayref from
14178: &Apache::loncommon::upfile_record_sep
14179:
14180: =cut
14181:
1.144 matthew 14182: ######################################################
14183: ######################################################
1.31 albertel 14184: sub csv_print_samples {
14185: my ($r,$records) = @_;
1.662 bisitz 14186: my $samples = &get_samples($records,5);
1.301 albertel 14187:
1.594 raeburn 14188: $r->print(&mt('Samples').'<br />'.&start_data_table().
14189: &start_data_table_header_row());
1.356 albertel 14190: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14191: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14192: $r->print(&end_data_table_header_row());
1.301 albertel 14193: foreach my $hash (@$samples) {
1.594 raeburn 14194: $r->print(&start_data_table_row());
1.356 albertel 14195: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14196: $r->print('<td>');
1.356 albertel 14197: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14198: $r->print('</td>');
14199: }
1.594 raeburn 14200: $r->print(&end_data_table_row());
1.31 albertel 14201: }
1.594 raeburn 14202: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14203: }
14204:
1.144 matthew 14205: ######################################################
14206: ######################################################
14207:
1.56 matthew 14208: =pod
14209:
1.648 raeburn 14210: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14211:
14212: Prints a table to create associations between values and table columns.
1.144 matthew 14213:
1.41 ng 14214: $r is an Apache Request ref,
14215: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14216: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14217:
14218: =cut
14219:
1.144 matthew 14220: ######################################################
14221: ######################################################
1.31 albertel 14222: sub csv_print_select_table {
14223: my ($r,$records,$d) = @_;
1.301 albertel 14224: my $i=0;
14225: my $samples = &get_samples($records,1);
1.144 matthew 14226: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14227: &start_data_table().&start_data_table_header_row().
1.144 matthew 14228: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14229: '<th>'.&mt('Column').'</th>'.
14230: &end_data_table_header_row()."\n");
1.356 albertel 14231: foreach my $array_ref (@$d) {
14232: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14233: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14234:
1.875 bisitz 14235: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14236: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14237: $r->print('<option value="none"></option>');
1.356 albertel 14238: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14239: $r->print('<option value="'.$sample.'"'.
14240: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14241: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14242: }
1.594 raeburn 14243: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14244: $i++;
14245: }
1.594 raeburn 14246: $r->print(&end_data_table());
1.31 albertel 14247: $i--;
14248: return $i;
14249: }
1.56 matthew 14250:
1.144 matthew 14251: ######################################################
14252: ######################################################
14253:
1.56 matthew 14254: =pod
1.31 albertel 14255:
1.648 raeburn 14256: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14257:
14258: Prints a table of sample values from the upload and can make associate samples to internal names.
14259:
14260: $r is an Apache Request ref,
14261: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14262: $d is an array of 2 element arrays (internal name, displayed name)
14263:
14264: =cut
14265:
1.144 matthew 14266: ######################################################
14267: ######################################################
1.31 albertel 14268: sub csv_samples_select_table {
14269: my ($r,$records,$d) = @_;
14270: my $i=0;
1.144 matthew 14271: #
1.662 bisitz 14272: my $max_samples = 5;
14273: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14274: $r->print(&start_data_table().
14275: &start_data_table_header_row().'<th>'.
14276: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14277: &end_data_table_header_row());
1.301 albertel 14278:
14279: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14280: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14281: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14282: foreach my $option (@$d) {
14283: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14284: $r->print('<option value="'.$value.'"'.
1.253 albertel 14285: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14286: $display.'</option>');
1.31 albertel 14287: }
14288: $r->print('</select></td><td>');
1.662 bisitz 14289: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14290: if (defined($samples->[$line]{$key})) {
14291: $r->print($samples->[$line]{$key}."<br />\n");
14292: }
14293: }
1.594 raeburn 14294: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14295: $i++;
14296: }
1.594 raeburn 14297: $r->print(&end_data_table());
1.31 albertel 14298: $i--;
14299: return($i);
1.115 matthew 14300: }
14301:
1.144 matthew 14302: ######################################################
14303: ######################################################
14304:
1.115 matthew 14305: =pod
14306:
1.648 raeburn 14307: =item * &clean_excel_name($name)
1.115 matthew 14308:
14309: Returns a replacement for $name which does not contain any illegal characters.
14310:
14311: =cut
14312:
1.144 matthew 14313: ######################################################
14314: ######################################################
1.115 matthew 14315: sub clean_excel_name {
14316: my ($name) = @_;
14317: $name =~ s/[:\*\?\/\\]//g;
14318: if (length($name) > 31) {
14319: $name = substr($name,0,31);
14320: }
14321: return $name;
1.25 albertel 14322: }
1.84 albertel 14323:
1.85 albertel 14324: =pod
14325:
1.648 raeburn 14326: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14327:
14328: Returns either 1 or undef
14329:
14330: 1 if the part is to be hidden, undef if it is to be shown
14331:
14332: Arguments are:
14333:
14334: $id the id of the part to be checked
14335: $symb, optional the symb of the resource to check
14336: $udom, optional the domain of the user to check for
14337: $uname, optional the username of the user to check for
14338:
14339: =cut
1.84 albertel 14340:
14341: sub check_if_partid_hidden {
14342: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14343: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14344: $symb,$udom,$uname);
1.141 albertel 14345: my $truth=1;
14346: #if the string starts with !, then the list is the list to show not hide
14347: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14348: my @hiddenlist=split(/,/,$hiddenparts);
14349: foreach my $checkid (@hiddenlist) {
1.141 albertel 14350: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14351: }
1.141 albertel 14352: return !$truth;
1.84 albertel 14353: }
1.127 matthew 14354:
1.138 matthew 14355:
14356: ############################################################
14357: ############################################################
14358:
14359: =pod
14360:
1.157 matthew 14361: =back
14362:
1.138 matthew 14363: =head1 cgi-bin script and graphing routines
14364:
1.157 matthew 14365: =over 4
14366:
1.648 raeburn 14367: =item * &get_cgi_id()
1.138 matthew 14368:
14369: Inputs: none
14370:
14371: Returns an id which can be used to pass environment variables
14372: to various cgi-bin scripts. These environment variables will
14373: be removed from the users environment after a given time by
14374: the routine &Apache::lonnet::transfer_profile_to_env.
14375:
14376: =cut
14377:
14378: ############################################################
14379: ############################################################
1.152 albertel 14380: my $uniq=0;
1.136 matthew 14381: sub get_cgi_id {
1.154 albertel 14382: $uniq=($uniq+1)%100000;
1.280 albertel 14383: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14384: }
14385:
1.127 matthew 14386: ############################################################
14387: ############################################################
14388:
14389: =pod
14390:
1.648 raeburn 14391: =item * &DrawBarGraph()
1.127 matthew 14392:
1.138 matthew 14393: Facilitates the plotting of data in a (stacked) bar graph.
14394: Puts plot definition data into the users environment in order for
14395: graph.png to plot it. Returns an <img> tag for the plot.
14396: The bars on the plot are labeled '1','2',...,'n'.
14397:
14398: Inputs:
14399:
14400: =over 4
14401:
14402: =item $Title: string, the title of the plot
14403:
14404: =item $xlabel: string, text describing the X-axis of the plot
14405:
14406: =item $ylabel: string, text describing the Y-axis of the plot
14407:
14408: =item $Max: scalar, the maximum Y value to use in the plot
14409: If $Max is < any data point, the graph will not be rendered.
14410:
1.140 matthew 14411: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14412: they are plotted. If undefined, default values will be used.
14413:
1.178 matthew 14414: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14415:
1.138 matthew 14416: =item @Values: An array of array references. Each array reference holds data
14417: to be plotted in a stacked bar chart.
14418:
1.239 matthew 14419: =item If the final element of @Values is a hash reference the key/value
14420: pairs will be added to the graph definition.
14421:
1.138 matthew 14422: =back
14423:
14424: Returns:
14425:
14426: An <img> tag which references graph.png and the appropriate identifying
14427: information for the plot.
14428:
1.127 matthew 14429: =cut
14430:
14431: ############################################################
14432: ############################################################
1.134 matthew 14433: sub DrawBarGraph {
1.178 matthew 14434: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14435: #
14436: if (! defined($colors)) {
14437: $colors = ['#33ff00',
14438: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14439: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14440: ];
14441: }
1.228 matthew 14442: my $extra_settings = {};
14443: if (ref($Values[-1]) eq 'HASH') {
14444: $extra_settings = pop(@Values);
14445: }
1.127 matthew 14446: #
1.136 matthew 14447: my $identifier = &get_cgi_id();
14448: my $id = 'cgi.'.$identifier;
1.129 matthew 14449: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14450: return '';
14451: }
1.225 matthew 14452: #
14453: my @Labels;
14454: if (defined($labels)) {
14455: @Labels = @$labels;
14456: } else {
14457: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119 raeburn 14458: push(@Labels,$i+1);
1.225 matthew 14459: }
14460: }
14461: #
1.129 matthew 14462: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14463: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14464: my %ValuesHash;
14465: my $NumSets=1;
14466: foreach my $array (@Values) {
14467: next if (! ref($array));
1.136 matthew 14468: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14469: join(',',@$array);
1.129 matthew 14470: }
1.127 matthew 14471: #
1.136 matthew 14472: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14473: if ($NumBars < 3) {
14474: $width = 120+$NumBars*32;
1.220 matthew 14475: $xskip = 1;
1.225 matthew 14476: $bar_width = 30;
14477: } elsif ($NumBars < 5) {
14478: $width = 120+$NumBars*20;
14479: $xskip = 1;
14480: $bar_width = 20;
1.220 matthew 14481: } elsif ($NumBars < 10) {
1.136 matthew 14482: $width = 120+$NumBars*15;
14483: $xskip = 1;
14484: $bar_width = 15;
14485: } elsif ($NumBars <= 25) {
14486: $width = 120+$NumBars*11;
14487: $xskip = 5;
14488: $bar_width = 8;
14489: } elsif ($NumBars <= 50) {
14490: $width = 120+$NumBars*8;
14491: $xskip = 5;
14492: $bar_width = 4;
14493: } else {
14494: $width = 120+$NumBars*8;
14495: $xskip = 5;
14496: $bar_width = 4;
14497: }
14498: #
1.137 matthew 14499: $Max = 1 if ($Max < 1);
14500: if ( int($Max) < $Max ) {
14501: $Max++;
14502: $Max = int($Max);
14503: }
1.127 matthew 14504: $Title = '' if (! defined($Title));
14505: $xlabel = '' if (! defined($xlabel));
14506: $ylabel = '' if (! defined($ylabel));
1.369 www 14507: $ValuesHash{$id.'.title'} = &escape($Title);
14508: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14509: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14510: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14511: $ValuesHash{$id.'.NumBars'} = $NumBars;
14512: $ValuesHash{$id.'.NumSets'} = $NumSets;
14513: $ValuesHash{$id.'.PlotType'} = 'bar';
14514: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14515: $ValuesHash{$id.'.height'} = $height;
14516: $ValuesHash{$id.'.width'} = $width;
14517: $ValuesHash{$id.'.xskip'} = $xskip;
14518: $ValuesHash{$id.'.bar_width'} = $bar_width;
14519: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14520: #
1.228 matthew 14521: # Deal with other parameters
14522: while (my ($key,$value) = each(%$extra_settings)) {
14523: $ValuesHash{$id.'.'.$key} = $value;
14524: }
14525: #
1.646 raeburn 14526: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14527: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14528: }
14529:
14530: ############################################################
14531: ############################################################
14532:
14533: =pod
14534:
1.648 raeburn 14535: =item * &DrawXYGraph()
1.137 matthew 14536:
1.138 matthew 14537: Facilitates the plotting of data in an XY graph.
14538: Puts plot definition data into the users environment in order for
14539: graph.png to plot it. Returns an <img> tag for the plot.
14540:
14541: Inputs:
14542:
14543: =over 4
14544:
14545: =item $Title: string, the title of the plot
14546:
14547: =item $xlabel: string, text describing the X-axis of the plot
14548:
14549: =item $ylabel: string, text describing the Y-axis of the plot
14550:
14551: =item $Max: scalar, the maximum Y value to use in the plot
14552: If $Max is < any data point, the graph will not be rendered.
14553:
14554: =item $colors: Array ref containing the hex color codes for the data to be
14555: plotted in. If undefined, default values will be used.
14556:
14557: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14558:
14559: =item $Ydata: Array ref containing Array refs.
1.185 www 14560: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14561:
14562: =item %Values: hash indicating or overriding any default values which are
14563: passed to graph.png.
14564: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14565:
14566: =back
14567:
14568: Returns:
14569:
14570: An <img> tag which references graph.png and the appropriate identifying
14571: information for the plot.
14572:
1.137 matthew 14573: =cut
14574:
14575: ############################################################
14576: ############################################################
14577: sub DrawXYGraph {
14578: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14579: #
14580: # Create the identifier for the graph
14581: my $identifier = &get_cgi_id();
14582: my $id = 'cgi.'.$identifier;
14583: #
14584: $Title = '' if (! defined($Title));
14585: $xlabel = '' if (! defined($xlabel));
14586: $ylabel = '' if (! defined($ylabel));
14587: my %ValuesHash =
14588: (
1.369 www 14589: $id.'.title' => &escape($Title),
14590: $id.'.xlabel' => &escape($xlabel),
14591: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14592: $id.'.y_max_value'=> $Max,
14593: $id.'.labels' => join(',',@$Xlabels),
14594: $id.'.PlotType' => 'XY',
14595: );
14596: #
14597: if (defined($colors) && ref($colors) eq 'ARRAY') {
14598: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14599: }
14600: #
14601: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14602: return '';
14603: }
14604: my $NumSets=1;
1.138 matthew 14605: foreach my $array (@{$Ydata}){
1.137 matthew 14606: next if (! ref($array));
14607: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14608: }
1.138 matthew 14609: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14610: #
14611: # Deal with other parameters
14612: while (my ($key,$value) = each(%Values)) {
14613: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14614: }
14615: #
1.646 raeburn 14616: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14617: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14618: }
14619:
14620: ############################################################
14621: ############################################################
14622:
14623: =pod
14624:
1.648 raeburn 14625: =item * &DrawXYYGraph()
1.138 matthew 14626:
14627: Facilitates the plotting of data in an XY graph with two Y axes.
14628: Puts plot definition data into the users environment in order for
14629: graph.png to plot it. Returns an <img> tag for the plot.
14630:
14631: Inputs:
14632:
14633: =over 4
14634:
14635: =item $Title: string, the title of the plot
14636:
14637: =item $xlabel: string, text describing the X-axis of the plot
14638:
14639: =item $ylabel: string, text describing the Y-axis of the plot
14640:
14641: =item $colors: Array ref containing the hex color codes for the data to be
14642: plotted in. If undefined, default values will be used.
14643:
14644: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14645:
14646: =item $Ydata1: The first data set
14647:
14648: =item $Min1: The minimum value of the left Y-axis
14649:
14650: =item $Max1: The maximum value of the left Y-axis
14651:
14652: =item $Ydata2: The second data set
14653:
14654: =item $Min2: The minimum value of the right Y-axis
14655:
14656: =item $Max2: The maximum value of the left Y-axis
14657:
14658: =item %Values: hash indicating or overriding any default values which are
14659: passed to graph.png.
14660: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14661:
14662: =back
14663:
14664: Returns:
14665:
14666: An <img> tag which references graph.png and the appropriate identifying
14667: information for the plot.
1.136 matthew 14668:
14669: =cut
14670:
14671: ############################################################
14672: ############################################################
1.137 matthew 14673: sub DrawXYYGraph {
14674: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14675: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14676: #
14677: # Create the identifier for the graph
14678: my $identifier = &get_cgi_id();
14679: my $id = 'cgi.'.$identifier;
14680: #
14681: $Title = '' if (! defined($Title));
14682: $xlabel = '' if (! defined($xlabel));
14683: $ylabel = '' if (! defined($ylabel));
14684: my %ValuesHash =
14685: (
1.369 www 14686: $id.'.title' => &escape($Title),
14687: $id.'.xlabel' => &escape($xlabel),
14688: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14689: $id.'.labels' => join(',',@$Xlabels),
14690: $id.'.PlotType' => 'XY',
14691: $id.'.NumSets' => 2,
1.137 matthew 14692: $id.'.two_axes' => 1,
14693: $id.'.y1_max_value' => $Max1,
14694: $id.'.y1_min_value' => $Min1,
14695: $id.'.y2_max_value' => $Max2,
14696: $id.'.y2_min_value' => $Min2,
1.136 matthew 14697: );
14698: #
1.137 matthew 14699: if (defined($colors) && ref($colors) eq 'ARRAY') {
14700: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14701: }
14702: #
14703: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14704: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14705: return '';
14706: }
14707: my $NumSets=1;
1.137 matthew 14708: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14709: next if (! ref($array));
14710: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14711: }
14712: #
14713: # Deal with other parameters
14714: while (my ($key,$value) = each(%Values)) {
14715: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14716: }
14717: #
1.646 raeburn 14718: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14719: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14720: }
14721:
14722: ############################################################
14723: ############################################################
14724:
14725: =pod
14726:
1.157 matthew 14727: =back
14728:
1.139 matthew 14729: =head1 Statistics helper routines?
14730:
14731: Bad place for them but what the hell.
14732:
1.157 matthew 14733: =over 4
14734:
1.648 raeburn 14735: =item * &chartlink()
1.139 matthew 14736:
14737: Returns a link to the chart for a specific student.
14738:
14739: Inputs:
14740:
14741: =over 4
14742:
14743: =item $linktext: The text of the link
14744:
14745: =item $sname: The students username
14746:
14747: =item $sdomain: The students domain
14748:
14749: =back
14750:
1.157 matthew 14751: =back
14752:
1.139 matthew 14753: =cut
14754:
14755: ############################################################
14756: ############################################################
14757: sub chartlink {
14758: my ($linktext, $sname, $sdomain) = @_;
14759: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14760: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14761: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14762: '">'.$linktext.'</a>';
1.153 matthew 14763: }
14764:
14765: #######################################################
14766: #######################################################
14767:
14768: =pod
14769:
14770: =head1 Course Environment Routines
1.157 matthew 14771:
14772: =over 4
1.153 matthew 14773:
1.648 raeburn 14774: =item * &restore_course_settings()
1.153 matthew 14775:
1.648 raeburn 14776: =item * &store_course_settings()
1.153 matthew 14777:
14778: Restores/Store indicated form parameters from the course environment.
14779: Will not overwrite existing values of the form parameters.
14780:
14781: Inputs:
14782: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14783:
14784: a hash ref describing the data to be stored. For example:
14785:
14786: %Save_Parameters = ('Status' => 'scalar',
14787: 'chartoutputmode' => 'scalar',
14788: 'chartoutputdata' => 'scalar',
14789: 'Section' => 'array',
1.373 raeburn 14790: 'Group' => 'array',
1.153 matthew 14791: 'StudentData' => 'array',
14792: 'Maps' => 'array');
14793:
14794: Returns: both routines return nothing
14795:
1.631 raeburn 14796: =back
14797:
1.153 matthew 14798: =cut
14799:
14800: #######################################################
14801: #######################################################
14802: sub store_course_settings {
1.496 albertel 14803: return &store_settings($env{'request.course.id'},@_);
14804: }
14805:
14806: sub store_settings {
1.153 matthew 14807: # save to the environment
14808: # appenv the same items, just to be safe
1.300 albertel 14809: my $udom = $env{'user.domain'};
14810: my $uname = $env{'user.name'};
1.496 albertel 14811: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14812: my %SaveHash;
14813: my %AppHash;
14814: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14815: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14816: my $envname = 'environment.'.$basename;
1.258 albertel 14817: if (exists($env{'form.'.$setting})) {
1.153 matthew 14818: # Save this value away
14819: if ($type eq 'scalar' &&
1.258 albertel 14820: (! exists($env{$envname}) ||
14821: $env{$envname} ne $env{'form.'.$setting})) {
14822: $SaveHash{$basename} = $env{'form.'.$setting};
14823: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14824: } elsif ($type eq 'array') {
14825: my $stored_form;
1.258 albertel 14826: if (ref($env{'form.'.$setting})) {
1.153 matthew 14827: $stored_form = join(',',
14828: map {
1.369 www 14829: &escape($_);
1.258 albertel 14830: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14831: } else {
14832: $stored_form =
1.369 www 14833: &escape($env{'form.'.$setting});
1.153 matthew 14834: }
14835: # Determine if the array contents are the same.
1.258 albertel 14836: if ($stored_form ne $env{$envname}) {
1.153 matthew 14837: $SaveHash{$basename} = $stored_form;
14838: $AppHash{$envname} = $stored_form;
14839: }
14840: }
14841: }
14842: }
14843: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14844: $udom,$uname);
1.153 matthew 14845: if ($put_result !~ /^(ok|delayed)/) {
14846: &Apache::lonnet::logthis('unable to save form parameters, '.
14847: 'got error:'.$put_result);
14848: }
14849: # Make sure these settings stick around in this session, too
1.646 raeburn 14850: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14851: return;
14852: }
14853:
14854: sub restore_course_settings {
1.499 albertel 14855: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14856: }
14857:
14858: sub restore_settings {
14859: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14860: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14861: next if (exists($env{'form.'.$setting}));
1.496 albertel 14862: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14863: '.'.$setting;
1.258 albertel 14864: if (exists($env{$envname})) {
1.153 matthew 14865: if ($type eq 'scalar') {
1.258 albertel 14866: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14867: } elsif ($type eq 'array') {
1.258 albertel 14868: $env{'form.'.$setting} = [
1.153 matthew 14869: map {
1.369 www 14870: &unescape($_);
1.258 albertel 14871: } split(',',$env{$envname})
1.153 matthew 14872: ];
14873: }
14874: }
14875: }
1.127 matthew 14876: }
14877:
1.618 raeburn 14878: #######################################################
14879: #######################################################
14880:
14881: =pod
14882:
14883: =head1 Domain E-mail Routines
14884:
14885: =over 4
14886:
1.648 raeburn 14887: =item * &build_recipient_list()
1.618 raeburn 14888:
1.1075.2.44 raeburn 14889: Build recipient lists for following types of e-mail:
1.766 raeburn 14890: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 14891: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14892: module change checking, student/employee ID conflict checks, as
14893: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14894: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14895:
14896: Inputs:
1.1075.2.44 raeburn 14897: defmail (scalar - email address of default recipient),
14898: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14899: requestsmail, updatesmail, or idconflictsmail).
14900:
1.619 raeburn 14901: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 14902:
14903: origmail (scalar - email address of recipient from loncapa.conf,
14904: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14905:
1.1075.2.139 raeburn 14906: $requname username of requester (if mailing type is helpdeskmail)
14907:
14908: $requdom domain of requester (if mailing type is helpdeskmail)
14909:
14910: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14911:
1.655 raeburn 14912: Returns: comma separated list of addresses to which to send e-mail.
14913:
14914: =back
1.618 raeburn 14915:
14916: =cut
14917:
14918: ############################################################
14919: ############################################################
14920: sub build_recipient_list {
1.1075.2.139 raeburn 14921: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14922: my @recipients;
1.1075.2.122 raeburn 14923: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14924: my %domconfig =
1.1075.2.122 raeburn 14925: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14926: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14927: if (exists($domconfig{'contacts'}{$mailing})) {
14928: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14929: my @contacts = ('adminemail','supportemail');
14930: foreach my $item (@contacts) {
14931: if ($domconfig{'contacts'}{$mailing}{$item}) {
14932: my $addr = $domconfig{'contacts'}{$item};
14933: if (!grep(/^\Q$addr\E$/,@recipients)) {
14934: push(@recipients,$addr);
14935: }
1.619 raeburn 14936: }
1.1075.2.122 raeburn 14937: }
14938: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14939: if ($mailing eq 'helpdeskmail') {
14940: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14941: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14942: my @ok_bccs;
14943: foreach my $bcc (@bccs) {
14944: $bcc =~ s/^\s+//g;
14945: $bcc =~ s/\s+$//g;
14946: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14947: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14948: push(@ok_bccs,$bcc);
14949: }
14950: }
14951: }
14952: if (@ok_bccs > 0) {
14953: $allbcc = join(', ',@ok_bccs);
14954: }
14955: }
14956: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14957: }
14958: }
1.766 raeburn 14959: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 14960: $lastresort = $origmail;
1.618 raeburn 14961: }
1.1075.2.139 raeburn 14962: if ($mailing eq 'helpdeskmail') {
14963: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
14964: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
14965: my ($inststatus,$inststatus_checked);
14966: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
14967: ($env{'user.domain'} ne 'public')) {
14968: $inststatus_checked = 1;
14969: $inststatus = $env{'environment.inststatus'};
14970: }
14971: unless ($inststatus_checked) {
14972: if (($requname ne '') && ($requdom ne '')) {
14973: if (($requname =~ /^$match_username$/) &&
14974: ($requdom =~ /^$match_domain$/) &&
14975: (&Apache::lonnet::domain($requdom))) {
14976: my $requhome = &Apache::lonnet::homeserver($requname,
14977: $requdom);
14978: unless ($requhome eq 'no_host') {
14979: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
14980: $inststatus = $userenv{'inststatus'};
14981: $inststatus_checked = 1;
14982: }
14983: }
14984: }
14985: }
14986: unless ($inststatus_checked) {
14987: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
14988: my %srch = (srchby => 'email',
14989: srchdomain => $defdom,
14990: srchterm => $reqemail,
14991: srchtype => 'exact');
14992: my %srch_results = &Apache::lonnet::usersearch(\%srch);
14993: foreach my $uname (keys(%srch_results)) {
14994: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14995: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14996: $inststatus_checked = 1;
14997: last;
14998: }
14999: }
15000: unless ($inststatus_checked) {
15001: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15002: if ($dirsrchres eq 'ok') {
15003: foreach my $uname (keys(%srch_results)) {
15004: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15005: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15006: $inststatus_checked = 1;
15007: last;
15008: }
15009: }
15010: }
15011: }
15012: }
15013: }
15014: if ($inststatus ne '') {
15015: foreach my $status (split(/\:/,$inststatus)) {
15016: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15017: my @contacts = ('adminemail','supportemail');
15018: foreach my $item (@contacts) {
15019: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15020: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15021: if (!grep(/^\Q$addr\E$/,@recipients)) {
15022: push(@recipients,$addr);
15023: }
15024: }
15025: }
15026: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15027: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15028: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15029: my @ok_bccs;
15030: foreach my $bcc (@bccs) {
15031: $bcc =~ s/^\s+//g;
15032: $bcc =~ s/\s+$//g;
15033: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15034: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15035: push(@ok_bccs,$bcc);
15036: }
15037: }
15038: }
15039: if (@ok_bccs > 0) {
15040: $allbcc = join(', ',@ok_bccs);
15041: }
15042: }
15043: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15044: last;
15045: }
15046: }
15047: }
15048: }
15049: }
1.619 raeburn 15050: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 15051: $lastresort = $origmail;
15052: }
1.1075.2.128 raeburn 15053: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122 raeburn 15054: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15055: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15056: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15057: my %what = (
15058: perlvar => 1,
15059: );
15060: my $primary = &Apache::lonnet::domain($defdom,'primary');
15061: if ($primary) {
15062: my $gotaddr;
15063: my ($result,$returnhash) =
15064: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15065: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15066: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15067: $lastresort = $returnhash->{'lonSupportEMail'};
15068: $gotaddr = 1;
15069: }
15070: }
15071: unless ($gotaddr) {
15072: my $uintdom = &Apache::lonnet::internet_dom($primary);
15073: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15074: unless ($uintdom eq $intdom) {
15075: my %domconfig =
15076: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15077: if (ref($domconfig{'contacts'}) eq 'HASH') {
15078: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15079: my @contacts = ('adminemail','supportemail');
15080: foreach my $item (@contacts) {
15081: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15082: my $addr = $domconfig{'contacts'}{$item};
15083: if (!grep(/^\Q$addr\E$/,@recipients)) {
15084: push(@recipients,$addr);
15085: }
15086: }
15087: }
15088: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15089: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15090: }
15091: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15092: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15093: my @ok_bccs;
15094: foreach my $bcc (@bccs) {
15095: $bcc =~ s/^\s+//g;
15096: $bcc =~ s/\s+$//g;
15097: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15098: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15099: push(@ok_bccs,$bcc);
15100: }
15101: }
15102: }
15103: if (@ok_bccs > 0) {
15104: $allbcc = join(', ',@ok_bccs);
15105: }
15106: }
15107: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15108: }
15109: }
15110: }
15111: }
15112: }
15113: }
1.618 raeburn 15114: }
1.688 raeburn 15115: if (defined($defmail)) {
15116: if ($defmail ne '') {
15117: push(@recipients,$defmail);
15118: }
1.618 raeburn 15119: }
15120: if ($otheremails) {
1.619 raeburn 15121: my @others;
15122: if ($otheremails =~ /,/) {
15123: @others = split(/,/,$otheremails);
1.618 raeburn 15124: } else {
1.619 raeburn 15125: push(@others,$otheremails);
15126: }
15127: foreach my $addr (@others) {
15128: if (!grep(/^\Q$addr\E$/,@recipients)) {
15129: push(@recipients,$addr);
15130: }
1.618 raeburn 15131: }
15132: }
1.1075.2.128 raeburn 15133: if ($mailing eq 'helpdeskmail') {
1.1075.2.122 raeburn 15134: if ((!@recipients) && ($lastresort ne '')) {
15135: push(@recipients,$lastresort);
15136: }
15137: } elsif ($lastresort ne '') {
15138: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15139: push(@recipients,$lastresort);
15140: }
15141: }
15142: my $recipientlist = join(',',@recipients);
15143: if (wantarray) {
15144: return ($recipientlist,$allbcc,$addtext);
15145: } else {
15146: return $recipientlist;
15147: }
1.618 raeburn 15148: }
15149:
1.127 matthew 15150: ############################################################
15151: ############################################################
1.154 albertel 15152:
1.655 raeburn 15153: =pod
15154:
15155: =head1 Course Catalog Routines
15156:
15157: =over 4
15158:
15159: =item * &gather_categories()
15160:
15161: Converts category definitions - keys of categories hash stored in
15162: coursecategories in configuration.db on the primary library server in a
15163: domain - to an array. Also generates javascript and idx hash used to
15164: generate Domain Coordinator interface for editing Course Categories.
15165:
15166: Inputs:
1.663 raeburn 15167:
1.655 raeburn 15168: categories (reference to hash of category definitions).
1.663 raeburn 15169:
1.655 raeburn 15170: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15171: categories and subcategories).
1.663 raeburn 15172:
1.655 raeburn 15173: idx (reference to hash of counters used in Domain Coordinator interface for
15174: editing Course Categories).
1.663 raeburn 15175:
1.655 raeburn 15176: jsarray (reference to array of categories used to create Javascript arrays for
15177: Domain Coordinator interface for editing Course Categories).
15178:
15179: Returns: nothing
15180:
15181: Side effects: populates cats, idx and jsarray.
15182:
15183: =cut
15184:
15185: sub gather_categories {
15186: my ($categories,$cats,$idx,$jsarray) = @_;
15187: my %counters;
15188: my $num = 0;
15189: foreach my $item (keys(%{$categories})) {
15190: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15191: if ($container eq '' && $depth == 0) {
15192: $cats->[$depth][$categories->{$item}] = $cat;
15193: } else {
15194: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15195: }
15196: my ($escitem,$tail) = split(/:/,$item,2);
15197: if ($counters{$tail} eq '') {
15198: $counters{$tail} = $num;
15199: $num ++;
15200: }
15201: if (ref($idx) eq 'HASH') {
15202: $idx->{$item} = $counters{$tail};
15203: }
15204: if (ref($jsarray) eq 'ARRAY') {
15205: push(@{$jsarray->[$counters{$tail}]},$item);
15206: }
15207: }
15208: return;
15209: }
15210:
15211: =pod
15212:
15213: =item * &extract_categories()
15214:
15215: Used to generate breadcrumb trails for course categories.
15216:
15217: Inputs:
1.663 raeburn 15218:
1.655 raeburn 15219: categories (reference to hash of category definitions).
1.663 raeburn 15220:
1.655 raeburn 15221: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15222: categories and subcategories).
1.663 raeburn 15223:
1.655 raeburn 15224: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15225:
1.655 raeburn 15226: allitems (reference to hash - key is category key
15227: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15228:
1.655 raeburn 15229: idx (reference to hash of counters used in Domain Coordinator interface for
15230: editing Course Categories).
1.663 raeburn 15231:
1.655 raeburn 15232: jsarray (reference to array of categories used to create Javascript arrays for
15233: Domain Coordinator interface for editing Course Categories).
15234:
1.665 raeburn 15235: subcats (reference to hash of arrays containing all subcategories within each
15236: category, -recursive)
15237:
1.1075.2.132 raeburn 15238: maxd (reference to hash used to hold max depth for all top-level categories).
15239:
1.655 raeburn 15240: Returns: nothing
15241:
15242: Side effects: populates trails and allitems hash references.
15243:
15244: =cut
15245:
15246: sub extract_categories {
1.1075.2.132 raeburn 15247: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 15248: if (ref($categories) eq 'HASH') {
15249: &gather_categories($categories,$cats,$idx,$jsarray);
15250: if (ref($cats->[0]) eq 'ARRAY') {
15251: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15252: my $name = $cats->[0][$i];
15253: my $item = &escape($name).'::0';
15254: my $trailstr;
15255: if ($name eq 'instcode') {
15256: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15257: } elsif ($name eq 'communities') {
15258: $trailstr = &mt('Communities');
1.655 raeburn 15259: } else {
15260: $trailstr = $name;
15261: }
15262: if ($allitems->{$item} eq '') {
15263: push(@{$trails},$trailstr);
15264: $allitems->{$item} = scalar(@{$trails})-1;
15265: }
15266: my @parents = ($name);
15267: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15268: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15269: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15270: if (ref($subcats) eq 'HASH') {
15271: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15272: }
1.1075.2.132 raeburn 15273: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 15274: }
15275: } else {
15276: if (ref($subcats) eq 'HASH') {
15277: $subcats->{$item} = [];
1.655 raeburn 15278: }
1.1075.2.132 raeburn 15279: if (ref($maxd) eq 'HASH') {
15280: $maxd->{$name} = 1;
15281: }
1.655 raeburn 15282: }
15283: }
15284: }
15285: }
15286: return;
15287: }
15288:
15289: =pod
15290:
1.1075.2.56 raeburn 15291: =item * &recurse_categories()
1.655 raeburn 15292:
15293: Recursively used to generate breadcrumb trails for course categories.
15294:
15295: Inputs:
1.663 raeburn 15296:
1.655 raeburn 15297: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15298: categories and subcategories).
1.663 raeburn 15299:
1.655 raeburn 15300: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 15301:
15302: category (current course category, for which breadcrumb trail is being generated).
15303:
15304: trails (reference to array of breadcrumb trails for each category).
15305:
1.655 raeburn 15306: allitems (reference to hash - key is category key
15307: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15308:
1.655 raeburn 15309: parents (array containing containers directories for current category,
15310: back to top level).
15311:
15312: Returns: nothing
15313:
15314: Side effects: populates trails and allitems hash references
15315:
15316: =cut
15317:
15318: sub recurse_categories {
1.1075.2.132 raeburn 15319: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 15320: my $shallower = $depth - 1;
15321: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
15322: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
15323: my $name = $cats->[$depth]{$category}[$k];
15324: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.161. .4(raebu 15325:22): my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15326: if ($allitems->{$item} eq '') {
15327: push(@{$trails},$trailstr);
15328: $allitems->{$item} = scalar(@{$trails})-1;
15329: }
15330: my $deeper = $depth+1;
15331: push(@{$parents},$category);
1.665 raeburn 15332: if (ref($subcats) eq 'HASH') {
15333: my $subcat = &escape($name).':'.$category.':'.$depth;
15334: for (my $j=@{$parents}; $j>=0; $j--) {
15335: my $higher;
15336: if ($j > 0) {
15337: $higher = &escape($parents->[$j]).':'.
15338: &escape($parents->[$j-1]).':'.$j;
15339: } else {
15340: $higher = &escape($parents->[$j]).'::'.$j;
15341: }
15342: push(@{$subcats->{$higher}},$subcat);
15343: }
15344: }
15345: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132 raeburn 15346: $subcats,$maxd);
1.655 raeburn 15347: pop(@{$parents});
15348: }
15349: } else {
15350: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132 raeburn 15351: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15352: if ($allitems->{$item} eq '') {
15353: push(@{$trails},$trailstr);
15354: $allitems->{$item} = scalar(@{$trails})-1;
15355: }
1.1075.2.132 raeburn 15356: if (ref($maxd) eq 'HASH') {
15357: if ($depth > $maxd->{$parents->[0]}) {
15358: $maxd->{$parents->[0]} = $depth;
15359: }
15360: }
1.655 raeburn 15361: }
15362: return;
15363: }
15364:
1.663 raeburn 15365: =pod
15366:
1.1075.2.56 raeburn 15367: =item * &assign_categories_table()
1.663 raeburn 15368:
15369: Create a datatable for display of hierarchical categories in a domain,
15370: with checkboxes to allow a course to be categorized.
15371:
15372: Inputs:
15373:
15374: cathash - reference to hash of categories defined for the domain (from
15375: configuration.db)
15376:
15377: currcat - scalar with an & separated list of categories assigned to a course.
15378:
1.919 raeburn 15379: type - scalar contains course type (Course or Community).
15380:
1.1075.2.117 raeburn 15381: disabled - scalar (optional) contains disabled="disabled" if input elements are
15382: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15383:
1.663 raeburn 15384: Returns: $output (markup to be displayed)
15385:
15386: =cut
15387:
15388: sub assign_categories_table {
1.1075.2.117 raeburn 15389: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15390: my $output;
15391: if (ref($cathash) eq 'HASH') {
1.1075.2.132 raeburn 15392: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
15393: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 15394: $maxdepth = scalar(@cats);
15395: if (@cats > 0) {
15396: my $itemcount = 0;
15397: if (ref($cats[0]) eq 'ARRAY') {
15398: my @currcategories;
15399: if ($currcat ne '') {
15400: @currcategories = split('&',$currcat);
15401: }
1.919 raeburn 15402: my $table;
1.663 raeburn 15403: for (my $i=0; $i<@{$cats[0]}; $i++) {
15404: my $parent = $cats[0][$i];
1.919 raeburn 15405: next if ($parent eq 'instcode');
15406: if ($type eq 'Community') {
15407: next unless ($parent eq 'communities');
15408: } else {
15409: next if ($parent eq 'communities');
15410: }
1.663 raeburn 15411: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15412: my $item = &escape($parent).'::0';
15413: my $checked = '';
15414: if (@currcategories > 0) {
15415: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15416: $checked = ' checked="checked"';
1.663 raeburn 15417: }
15418: }
1.919 raeburn 15419: my $parent_title = $parent;
15420: if ($parent eq 'communities') {
15421: $parent_title = &mt('Communities');
15422: }
15423: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15424: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 15425: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15426: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15427: my $depth = 1;
15428: push(@path,$parent);
1.1075.2.117 raeburn 15429: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15430: pop(@path);
1.919 raeburn 15431: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15432: $itemcount ++;
15433: }
1.919 raeburn 15434: if ($itemcount) {
15435: $output = &Apache::loncommon::start_data_table().
15436: $table.
15437: &Apache::loncommon::end_data_table();
15438: }
1.663 raeburn 15439: }
15440: }
15441: }
15442: return $output;
15443: }
15444:
15445: =pod
15446:
1.1075.2.56 raeburn 15447: =item * &assign_category_rows()
1.663 raeburn 15448:
15449: Create a datatable row for display of nested categories in a domain,
15450: with checkboxes to allow a course to be categorized,called recursively.
15451:
15452: Inputs:
15453:
15454: itemcount - track row number for alternating colors
15455:
15456: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15457: categories and subcategories.
15458:
15459: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15460:
15461: parent - parent of current category item
15462:
15463: path - Array containing all categories back up through the hierarchy from the
15464: current category to the top level.
15465:
15466: currcategories - reference to array of current categories assigned to the course
15467:
1.1075.2.117 raeburn 15468: disabled - scalar (optional) contains disabled="disabled" if input elements are
15469: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15470:
1.663 raeburn 15471: Returns: $output (markup to be displayed).
15472:
15473: =cut
15474:
15475: sub assign_category_rows {
1.1075.2.117 raeburn 15476: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15477: my ($text,$name,$item,$chgstr);
15478: if (ref($cats) eq 'ARRAY') {
15479: my $maxdepth = scalar(@{$cats});
15480: if (ref($cats->[$depth]) eq 'HASH') {
15481: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15482: my $numchildren = @{$cats->[$depth]{$parent}};
15483: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 15484: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15485: for (my $j=0; $j<$numchildren; $j++) {
15486: $name = $cats->[$depth]{$parent}[$j];
15487: $item = &escape($name).':'.&escape($parent).':'.$depth;
15488: my $deeper = $depth+1;
15489: my $checked = '';
15490: if (ref($currcategories) eq 'ARRAY') {
15491: if (@{$currcategories} > 0) {
15492: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15493: $checked = ' checked="checked"';
1.663 raeburn 15494: }
15495: }
15496: }
1.664 raeburn 15497: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15498: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 15499: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15500: '<input type="hidden" name="catname" value="'.$name.'" />'.
15501: '</td><td>';
1.663 raeburn 15502: if (ref($path) eq 'ARRAY') {
15503: push(@{$path},$name);
1.1075.2.117 raeburn 15504: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15505: pop(@{$path});
15506: }
15507: $text .= '</td></tr>';
15508: }
15509: $text .= '</table></td>';
15510: }
15511: }
15512: }
15513: return $text;
15514: }
15515:
1.1075.2.69 raeburn 15516: =pod
15517:
15518: =back
15519:
15520: =cut
15521:
1.655 raeburn 15522: ############################################################
15523: ############################################################
15524:
15525:
1.443 albertel 15526: sub commit_customrole {
1.664 raeburn 15527: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15528: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15529: ($start?', '.&mt('starting').' '.localtime($start):'').
15530: ($end?', ending '.localtime($end):'').': <b>'.
15531: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15532: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15533: '</b><br />';
15534: return $output;
15535: }
15536:
15537: sub commit_standardrole {
1.1075.2.31 raeburn 15538: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15539: my ($output,$logmsg,$linefeed);
15540: if ($context eq 'auto') {
15541: $linefeed = "\n";
15542: } else {
15543: $linefeed = "<br />\n";
15544: }
1.443 albertel 15545: if ($three eq 'st') {
1.541 raeburn 15546: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 15547: $one,$two,$sec,$context,$credits);
1.541 raeburn 15548: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15549: ($result eq 'unknown_course') || ($result eq 'refused')) {
15550: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15551: } else {
1.541 raeburn 15552: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15553: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15554: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15555: if ($context eq 'auto') {
15556: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15557: } else {
15558: $output .= '<b>'.$result.'</b>'.$linefeed.
15559: &mt('Add to classlist').': <b>ok</b>';
15560: }
15561: $output .= $linefeed;
1.443 albertel 15562: }
15563: } else {
15564: $output = &mt('Assigning').' '.$three.' in '.$url.
15565: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15566: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15567: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15568: if ($context eq 'auto') {
15569: $output .= $result.$linefeed;
15570: } else {
15571: $output .= '<b>'.$result.'</b>'.$linefeed;
15572: }
1.443 albertel 15573: }
15574: return $output;
15575: }
15576:
15577: sub commit_studentrole {
1.1075.2.31 raeburn 15578: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15579: $credits) = @_;
1.626 raeburn 15580: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15581: if ($context eq 'auto') {
15582: $linefeed = "\n";
15583: } else {
15584: $linefeed = '<br />'."\n";
15585: }
1.443 albertel 15586: if (defined($one) && defined($two)) {
15587: my $cid=$one.'_'.$two;
15588: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15589: my $secchange = 0;
15590: my $expire_role_result;
15591: my $modify_section_result;
1.628 raeburn 15592: if ($oldsec ne '-1') {
15593: if ($oldsec ne $sec) {
1.443 albertel 15594: $secchange = 1;
1.628 raeburn 15595: my $now = time;
1.443 albertel 15596: my $uurl='/'.$cid;
15597: $uurl=~s/\_/\//g;
15598: if ($oldsec) {
15599: $uurl.='/'.$oldsec;
15600: }
1.626 raeburn 15601: $oldsecurl = $uurl;
1.628 raeburn 15602: $expire_role_result =
1.652 raeburn 15603: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15604: if ($env{'request.course.sec'} ne '') {
15605: if ($expire_role_result eq 'refused') {
15606: my @roles = ('st');
15607: my @statuses = ('previous');
15608: my @roledoms = ($one);
15609: my $withsec = 1;
15610: my %roleshash =
15611: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15612: \@statuses,\@roles,\@roledoms,$withsec);
15613: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15614: my ($oldstart,$oldend) =
15615: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15616: if ($oldend > 0 && $oldend <= $now) {
15617: $expire_role_result = 'ok';
15618: }
15619: }
15620: }
15621: }
1.443 albertel 15622: $result = $expire_role_result;
15623: }
15624: }
15625: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 15626: $modify_section_result =
15627: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15628: undef,undef,undef,$sec,
15629: $end,$start,'','',$cid,
15630: '',$context,$credits);
1.443 albertel 15631: if ($modify_section_result =~ /^ok/) {
15632: if ($secchange == 1) {
1.628 raeburn 15633: if ($sec eq '') {
15634: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15635: } else {
15636: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15637: }
1.443 albertel 15638: } elsif ($oldsec eq '-1') {
1.628 raeburn 15639: if ($sec eq '') {
15640: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15641: } else {
15642: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15643: }
1.443 albertel 15644: } else {
1.628 raeburn 15645: if ($sec eq '') {
15646: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15647: } else {
15648: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15649: }
1.443 albertel 15650: }
15651: } else {
1.628 raeburn 15652: if ($secchange) {
15653: $$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;
15654: } else {
15655: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15656: }
1.443 albertel 15657: }
15658: $result = $modify_section_result;
15659: } elsif ($secchange == 1) {
1.628 raeburn 15660: if ($oldsec eq '') {
1.1075.2.20 raeburn 15661: $$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 15662: } else {
15663: $$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;
15664: }
1.626 raeburn 15665: if ($expire_role_result eq 'refused') {
15666: my $newsecurl = '/'.$cid;
15667: $newsecurl =~ s/\_/\//g;
15668: if ($sec ne '') {
15669: $newsecurl.='/'.$sec;
15670: }
15671: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15672: if ($sec eq '') {
15673: $$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;
15674: } else {
15675: $$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;
15676: }
15677: }
15678: }
1.443 albertel 15679: }
15680: } else {
1.626 raeburn 15681: $$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 15682: $result = "error: incomplete course id\n";
15683: }
15684: return $result;
15685: }
15686:
1.1075.2.25 raeburn 15687: sub show_role_extent {
15688: my ($scope,$context,$role) = @_;
15689: $scope =~ s{^/}{};
15690: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15691: push(@courseroles,'co');
15692: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15693: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15694: $scope =~ s{/}{_};
15695: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15696: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15697: my ($audom,$auname) = split(/\//,$scope);
15698: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15699: &Apache::loncommon::plainname($auname,$audom).'</span>');
15700: } else {
15701: $scope =~ s{/$}{};
15702: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15703: &Apache::lonnet::domain($scope,'description').'</span>');
15704: }
15705: }
15706:
1.443 albertel 15707: ############################################################
15708: ############################################################
15709:
1.566 albertel 15710: sub check_clone {
1.578 raeburn 15711: my ($args,$linefeed) = @_;
1.566 albertel 15712: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15713: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15714: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1075.2.161. .1(raebu 15715:21): my $clonetitle;
15716:21): my @clonemsg;
1.566 albertel 15717: my $can_clone = 0;
1.944 raeburn 15718: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15719: if ($lctype ne 'community') {
15720: $lctype = 'course';
15721: }
1.566 albertel 15722: if ($clonehome eq 'no_host') {
1.944 raeburn 15723: if ($args->{'crstype'} eq 'Community') {
1.1075.2.161. .1(raebu 15724:21): push(@clonemsg,({
15725:21): mt => 'No new community created.',
15726:21): args => [],
15727:21): },
15728:21): {
15729:21): mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
15730:21): args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
15731:21): }));
1.908 raeburn 15732: } else {
1.1075.2.161. .1(raebu 15733:21): push(@clonemsg,({
15734:21): mt => 'No new course created.',
15735:21): args => [],
15736:21): },
15737:21): {
15738:21): mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
15739:21): args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
15740:21): }));
15741:21): }
1.566 albertel 15742: } else {
15743: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1075.2.161. .1(raebu 15744:21): $clonetitle = $clonedesc{'description'};
1.944 raeburn 15745: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15746: if ($clonedesc{'type'} ne 'Community') {
1.1075.2.161. .1(raebu 15747:21): push(@clonemsg,({
15748:21): mt => 'No new community created.',
15749:21): args => [],
15750:21): },
15751:21): {
15752:21): mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
15753:21): args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
15754:21): }));
15755:21): return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 15756: }
15757: }
1.1075.2.119 raeburn 15758: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15759: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15760: $can_clone = 1;
15761: } else {
1.1075.2.95 raeburn 15762: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15763: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 15764: if ($clonehash{'cloners'} eq '') {
15765: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15766: if ($domdefs{'canclone'}) {
15767: unless ($domdefs{'canclone'} eq 'none') {
15768: if ($domdefs{'canclone'} eq 'domain') {
15769: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15770: $can_clone = 1;
15771: }
15772: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15773: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15774: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15775: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15776: $can_clone = 1;
15777: }
15778: }
15779: }
1.908 raeburn 15780: }
1.1075.2.95 raeburn 15781: } else {
15782: my @cloners = split(/,/,$clonehash{'cloners'});
15783: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15784: $can_clone = 1;
1.1075.2.95 raeburn 15785: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15786: $can_clone = 1;
1.1075.2.96 raeburn 15787: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15788: $can_clone = 1;
1.1075.2.95 raeburn 15789: }
15790: unless ($can_clone) {
1.1075.2.96 raeburn 15791: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15792: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 15793: my (%gotdomdefaults,%gotcodedefaults);
15794: foreach my $cloner (@cloners) {
15795: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15796: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15797: my (%codedefaults,@code_order);
15798: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15799: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15800: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15801: }
15802: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15803: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15804: }
15805: } else {
15806: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15807: \%codedefaults,
15808: \@code_order);
15809: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15810: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15811: }
15812: if (@code_order > 0) {
15813: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15814: $cloner,$clonehash{'internal.coursecode'},
15815: $args->{'crscode'})) {
15816: $can_clone = 1;
15817: last;
15818: }
15819: }
15820: }
15821: }
15822: }
1.1075.2.96 raeburn 15823: }
15824: }
15825: unless ($can_clone) {
15826: my $ccrole = 'cc';
15827: if ($args->{'crstype'} eq 'Community') {
15828: $ccrole = 'co';
15829: }
15830: my %roleshash =
15831: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15832: $args->{'ccdomain'},
15833: 'userroles',['active'],[$ccrole],
15834: [$args->{'clonedomain'}]);
15835: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15836: $can_clone = 1;
15837: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15838: $args->{'ccuname'},$args->{'ccdomain'})) {
15839: $can_clone = 1;
1.1075.2.95 raeburn 15840: }
15841: }
15842: unless ($can_clone) {
15843: if ($args->{'crstype'} eq 'Community') {
1.1075.2.161. .1(raebu 15844:21): push(@clonemsg,({
15845:21): mt => 'No new community created.',
15846:21): args => [],
15847:21): },
15848:21): {
15849:21): 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]).',
15850:21): args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
15851:21): }));
1.1075.2.95 raeburn 15852: } else {
1.1075.2.161. .1(raebu 15853:21): push(@clonemsg,({
15854:21): mt => 'No new course created.',
15855:21): args => [],
15856:21): },
15857:21): {
15858:21): 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]).',
15859:21): args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
15860:21): }));
1.578 raeburn 15861: }
1.566 albertel 15862: }
1.578 raeburn 15863: }
1.566 albertel 15864: }
1.1075.2.161. .1(raebu 15865:21): return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 15866: }
15867:
1.444 albertel 15868: sub construct_course {
1.1075.2.119 raeburn 15869: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1075.2.161. .1(raebu 15870:21): $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
15871:21): my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 15872: my $linefeed = '<br />'."\n";
15873: if ($context eq 'auto') {
15874: $linefeed = "\n";
15875: }
1.566 albertel 15876:
15877: #
15878: # Are we cloning?
15879: #
1.1075.2.161. .1(raebu 15880:21): my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 15881: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1075.2.161. .1(raebu 15882:21): ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 15883: if (!$can_clone) {
1.1075.2.161. .1(raebu 15884:21): return (0,$outcome,$clonemsgref);
1.566 albertel 15885: }
15886: }
15887:
1.444 albertel 15888: #
15889: # Open course
15890: #
15891: my $crstype = lc($args->{'crstype'});
15892: my %cenv=();
15893: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15894: $args->{'cdescr'},
15895: $args->{'curl'},
15896: $args->{'course_home'},
15897: $args->{'nonstandard'},
15898: $args->{'crscode'},
15899: $args->{'ccuname'}.':'.
15900: $args->{'ccdomain'},
1.882 raeburn 15901: $args->{'crstype'},
1.1075.2.161. .1(raebu 15902:21): $cnum,$context,$category,
15903:21): $callercontext);
1.444 albertel 15904:
15905: # Note: The testing routines depend on this being output; see
15906: # Utils::Course. This needs to at least be output as a comment
15907: # if anyone ever decides to not show this, and Utils::Course::new
15908: # will need to be suitably modified.
1.1075.2.161. .1(raebu 15909:21): if (($callercontext eq 'auto') && ($user_lh ne '')) {
15910:21): $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
15911:21): } else {
15912:21): $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
15913:21): }
1.943 raeburn 15914: if ($$courseid =~ /^error:/) {
1.1075.2.161. .1(raebu 15915:21): return (0,$outcome,$clonemsgref);
1.943 raeburn 15916: }
15917:
1.444 albertel 15918: #
15919: # Check if created correctly
15920: #
1.479 albertel 15921: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15922: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15923: if ($crsuhome eq 'no_host') {
1.1075.2.161. .1(raebu 15924:21): if (($callercontext eq 'auto') && ($user_lh ne '')) {
15925:21): $outcome .= &mt_user($user_lh,
15926:21): 'Course creation failed, unrecognized course home server.');
15927:21): } else {
15928:21): $outcome .= &mt('Course creation failed, unrecognized course home server.');
15929:21): }
15930:21): $outcome .= $linefeed;
15931:21): return (0,$outcome,$clonemsgref);
1.943 raeburn 15932: }
1.541 raeburn 15933: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15934:
1.444 albertel 15935: #
1.566 albertel 15936: # Do the cloning
1.1075.2.161. .1(raebu 15937:21): #
15938:21): my @clonemsg;
1.566 albertel 15939: if ($can_clone && $cloneid) {
1.1075.2.161. .1(raebu 15940:21): push(@clonemsg,
15941:21): {
15942:21): mt => 'Created [_1] by cloning from [_2]',
15943:21): args => [$crstype,$clonetitle],
15944:21): });
1.566 albertel 15945: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15946: # Copy all files
1.1075.2.161. .1(raebu 15947:21): my @info =
15948:21): &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
15949:21): $args->{'dateshift'},$args->{'crscode'},
15950:21): $args->{'ccuname'}.':'.$args->{'ccdomain'},
15951:21): $args->{'tinyurls'});
15952:21): if (@info) {
15953:21): push(@clonemsg,@info);
15954:21): }
1.444 albertel 15955: # Restore URL
1.566 albertel 15956: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15957: # Restore title
1.566 albertel 15958: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15959: # Restore creation date, creator and creation context.
15960: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15961: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15962: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15963: # Mark as cloned
1.566 albertel 15964: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15965: # Need to clone grading mode
15966: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15967: $cenv{'grading'}=$newenv{'grading'};
15968: # Do not clone these environment entries
15969: &Apache::lonnet::del('environment',
15970: ['default_enrollment_start_date',
15971: 'default_enrollment_end_date',
15972: 'question.email',
15973: 'policy.email',
15974: 'comment.email',
15975: 'pch.users.denied',
1.725 raeburn 15976: 'plc.users.denied',
15977: 'hidefromcat',
1.1075.2.36 raeburn 15978: 'checkforpriv',
1.1075.2.158 raeburn 15979: 'categories'],
1.638 www 15980: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 15981: if ($args->{'textbook'}) {
15982: $cenv{'internal.textbook'} = $args->{'textbook'};
15983: }
1.444 albertel 15984: }
1.566 albertel 15985:
1.444 albertel 15986: #
15987: # Set environment (will override cloned, if existing)
15988: #
15989: my @sections = ();
15990: my @xlists = ();
15991: if ($args->{'crstype'}) {
15992: $cenv{'type'}=$args->{'crstype'};
15993: }
15994: if ($args->{'crsid'}) {
15995: $cenv{'courseid'}=$args->{'crsid'};
15996: }
15997: if ($args->{'crscode'}) {
15998: $cenv{'internal.coursecode'}=$args->{'crscode'};
15999: }
16000: if ($args->{'crsquota'} ne '') {
16001: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16002: } else {
16003: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16004: }
16005: if ($args->{'ccuname'}) {
16006: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16007: ':'.$args->{'ccdomain'};
16008: } else {
16009: $cenv{'internal.courseowner'} = $args->{'curruser'};
16010: }
1.1075.2.31 raeburn 16011: if ($args->{'defaultcredits'}) {
16012: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16013: }
1.444 albertel 16014: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
16015: if ($args->{'crssections'}) {
16016: $cenv{'internal.sectionnums'} = '';
16017: if ($args->{'crssections'} =~ m/,/) {
16018: @sections = split/,/,$args->{'crssections'};
16019: } else {
16020: $sections[0] = $args->{'crssections'};
16021: }
16022: if (@sections > 0) {
16023: foreach my $item (@sections) {
16024: my ($sec,$gp) = split/:/,$item;
16025: my $class = $args->{'crscode'}.$sec;
16026: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16027: $cenv{'internal.sectionnums'} .= $item.',';
16028: unless ($addcheck eq 'ok') {
1.1075.2.119 raeburn 16029: push(@badclasses,$class);
1.444 albertel 16030: }
16031: }
16032: $cenv{'internal.sectionnums'} =~ s/,$//;
16033: }
16034: }
16035: # do not hide course coordinator from staff listing,
16036: # even if privileged
16037: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 16038: # add course coordinator's domain to domains to check for privileged users
16039: # if different to course domain
16040: if ($$crsudom ne $args->{'ccdomain'}) {
16041: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16042: }
1.444 albertel 16043: # add crosslistings
16044: if ($args->{'crsxlist'}) {
16045: $cenv{'internal.crosslistings'}='';
16046: if ($args->{'crsxlist'} =~ m/,/) {
16047: @xlists = split/,/,$args->{'crsxlist'};
16048: } else {
16049: $xlists[0] = $args->{'crsxlist'};
16050: }
16051: if (@xlists > 0) {
16052: foreach my $item (@xlists) {
16053: my ($xl,$gp) = split/:/,$item;
16054: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16055: $cenv{'internal.crosslistings'} .= $item.',';
16056: unless ($addcheck eq 'ok') {
1.1075.2.119 raeburn 16057: push(@badclasses,$xl);
1.444 albertel 16058: }
16059: }
16060: $cenv{'internal.crosslistings'} =~ s/,$//;
16061: }
16062: }
16063: if ($args->{'autoadds'}) {
16064: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16065: }
16066: if ($args->{'autodrops'}) {
16067: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16068: }
16069: # check for notification of enrollment changes
16070: my @notified = ();
16071: if ($args->{'notify_owner'}) {
16072: if ($args->{'ccuname'} ne '') {
16073: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16074: }
16075: }
16076: if ($args->{'notify_dc'}) {
16077: if ($uname ne '') {
1.630 raeburn 16078: push(@notified,$uname.':'.$udom);
1.444 albertel 16079: }
16080: }
16081: if (@notified > 0) {
16082: my $notifylist;
16083: if (@notified > 1) {
16084: $notifylist = join(',',@notified);
16085: } else {
16086: $notifylist = $notified[0];
16087: }
16088: $cenv{'internal.notifylist'} = $notifylist;
16089: }
16090: if (@badclasses > 0) {
16091: my %lt=&Apache::lonlocal::texthash(
1.1075.2.119 raeburn 16092: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16093: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16094: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16095: );
1.1075.2.119 raeburn 16096: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16097: &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
1.541 raeburn 16098: if ($context eq 'auto') {
16099: $outcome .= $badclass_msg.$linefeed;
1.1075.2.119 raeburn 16100: } else {
1.566 albertel 16101: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119 raeburn 16102: }
16103: foreach my $item (@badclasses) {
1.541 raeburn 16104: if ($context eq 'auto') {
1.1075.2.119 raeburn 16105: $outcome .= " - $item\n";
1.541 raeburn 16106: } else {
1.1075.2.119 raeburn 16107: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16108: }
1.1075.2.119 raeburn 16109: }
16110: if ($context eq 'auto') {
16111: $outcome .= $linefeed;
16112: } else {
16113: $outcome .= "</ul><br /><br /></div>\n";
16114: }
1.444 albertel 16115: }
16116: if ($args->{'no_end_date'}) {
16117: $args->{'endaccess'} = 0;
16118: }
16119: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16120: $cenv{'internal.autoend'}=$args->{'enrollend'};
16121: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16122: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16123: if ($args->{'showphotos'}) {
16124: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16125: }
16126: $cenv{'internal.authtype'} = $args->{'authtype'};
16127: $cenv{'internal.autharg'} = $args->{'autharg'};
16128: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16129: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16130: 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');
16131: if ($context eq 'auto') {
16132: $outcome .= $krb_msg;
16133: } else {
1.566 albertel 16134: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16135: }
16136: $outcome .= $linefeed;
1.444 albertel 16137: }
16138: }
16139: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16140: if ($args->{'setpolicy'}) {
16141: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16142: }
16143: if ($args->{'setcontent'}) {
16144: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16145: }
1.1075.2.110 raeburn 16146: if ($args->{'setcomment'}) {
16147: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16148: }
1.444 albertel 16149: }
16150: if ($args->{'reshome'}) {
16151: $cenv{'reshome'}=$args->{'reshome'}.'/';
16152: $cenv{'reshome'}=~s/\/+$/\//;
16153: }
16154: #
16155: # course has keyed access
16156: #
16157: if ($args->{'setkeys'}) {
16158: $cenv{'keyaccess'}='yes';
16159: }
16160: # if specified, key authority is not course, but user
16161: # only active if keyaccess is yes
16162: if ($args->{'keyauth'}) {
1.487 albertel 16163: my ($user,$domain) = split(':',$args->{'keyauth'});
16164: $user = &LONCAPA::clean_username($user);
16165: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16166: if ($user ne '' && $domain ne '') {
1.487 albertel 16167: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16168: }
16169: }
16170:
1.1075.2.59 raeburn 16171: #
16172: # generate and store uniquecode (available to course requester), if course should have one.
16173: #
16174: if ($args->{'uniquecode'}) {
16175: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16176: if ($code) {
16177: $cenv{'internal.uniquecode'} = $code;
16178: my %crsinfo =
16179: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16180: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16181: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16182: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16183: }
16184: if (ref($coderef)) {
16185: $$coderef = $code;
16186: }
16187: }
16188: }
16189:
1.444 albertel 16190: if ($args->{'disresdis'}) {
16191: $cenv{'pch.roles.denied'}='st';
16192: }
16193: if ($args->{'disablechat'}) {
16194: $cenv{'plc.roles.denied'}='st';
16195: }
16196:
16197: # Record we've not yet viewed the Course Initialization Helper for this
16198: # course
16199: $cenv{'course.helper.not.run'} = 1;
16200: #
16201: # Use new Randomseed
16202: #
16203: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16204: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16205: #
16206: # The encryption code and receipt prefix for this course
16207: #
16208: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16209: $cenv{'internal.encpref'}=100+int(9*rand(99));
16210: #
16211: # By default, use standard grading
16212: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16213:
1.541 raeburn 16214: $outcome .= $linefeed.&mt('Setting environment').': '.
16215: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16216: #
16217: # Open all assignments
16218: #
16219: if ($args->{'openall'}) {
1.1075.2.146 raeburn 16220: my $opendate = time;
16221: if ($args->{'openallfrom'} =~ /^\d+$/) {
16222: $opendate = $args->{'openallfrom'};
16223: }
1.444 albertel 16224: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1075.2.146 raeburn 16225: my %storecontent = ($storeunder => $opendate,
1.444 albertel 16226: $storeunder.'.type' => 'date_start');
1.1075.2.146 raeburn 16227: $outcome .= &mt('All assignments open starting [_1]',
16228: &Apache::lonlocal::locallocaltime($opendate)).': '.
16229: &Apache::lonnet::cput
16230: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16231: }
16232: #
16233: # Set first page
16234: #
16235: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16236: || ($cloneid)) {
1.445 albertel 16237: use LONCAPA::map;
1.444 albertel 16238: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16239:
16240: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16241: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16242:
1.444 albertel 16243: $outcome .= ($fatal?$errtext:'read ok').' - ';
16244: my $title; my $url;
16245: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16246: $title=&mt('Syllabus');
1.444 albertel 16247: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16248: } else {
1.963 raeburn 16249: $title=&mt('Table of Contents');
1.444 albertel 16250: $url='/adm/navmaps';
16251: }
1.445 albertel 16252:
16253: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16254: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16255:
16256: if ($errtext) { $fatal=2; }
1.541 raeburn 16257: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16258: }
1.566 albertel 16259:
1.1075.2.161. .1(raebu 16260:21): return (1,$outcome,\@clonemsg);
1.444 albertel 16261: }
16262:
1.1075.2.59 raeburn 16263: sub make_unique_code {
16264: my ($cdom,$cnum) = @_;
16265: # get lock on uniquecodes db
16266: my $lockhash = {
16267: $cnum."\0".'uniquecodes' => $env{'user.name'}.
16268: ':'.$env{'user.domain'},
16269: };
16270: my $tries = 0;
16271: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16272: my ($code,$error);
16273:
16274: while (($gotlock ne 'ok') && ($tries<3)) {
16275: $tries ++;
16276: sleep 1;
16277: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16278: }
16279: if ($gotlock eq 'ok') {
16280: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
16281: my $gotcode;
16282: my $attempts = 0;
16283: while ((!$gotcode) && ($attempts < 100)) {
16284: $code = &generate_code();
16285: if (!exists($currcodes{$code})) {
16286: $gotcode = 1;
16287: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
16288: $error = 'nostore';
16289: }
16290: }
16291: $attempts ++;
16292: }
16293: my @del_lock = ($cnum."\0".'uniquecodes');
16294: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
16295: } else {
16296: $error = 'nolock';
16297: }
16298: return ($code,$error);
16299: }
16300:
16301: sub generate_code {
16302: my $code;
16303: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
16304: for (my $i=0; $i<6; $i++) {
16305: my $lettnum = int (rand 2);
16306: my $item = '';
16307: if ($lettnum) {
16308: $item = $letts[int( rand(18) )];
16309: } else {
16310: $item = 1+int( rand(8) );
16311: }
16312: $code .= $item;
16313: }
16314: return $code;
16315: }
16316:
1.444 albertel 16317: ############################################################
16318: ############################################################
16319:
1.953 droeschl 16320: #SD
16321: # only Community and Course, or anything else?
1.378 raeburn 16322: sub course_type {
16323: my ($cid) = @_;
16324: if (!defined($cid)) {
16325: $cid = $env{'request.course.id'};
16326: }
1.404 albertel 16327: if (defined($env{'course.'.$cid.'.type'})) {
16328: return $env{'course.'.$cid.'.type'};
1.378 raeburn 16329: } else {
16330: return 'Course';
1.377 raeburn 16331: }
16332: }
1.156 albertel 16333:
1.406 raeburn 16334: sub group_term {
16335: my $crstype = &course_type();
16336: my %names = (
16337: 'Course' => 'group',
1.865 raeburn 16338: 'Community' => 'group',
1.406 raeburn 16339: );
16340: return $names{$crstype};
16341: }
16342:
1.902 raeburn 16343: sub course_types {
1.1075.2.59 raeburn 16344: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 16345: my %typename = (
16346: official => 'Official course',
16347: unofficial => 'Unofficial course',
16348: community => 'Community',
1.1075.2.59 raeburn 16349: textbook => 'Textbook course',
1.902 raeburn 16350: );
16351: return (\@types,\%typename);
16352: }
16353:
1.156 albertel 16354: sub icon {
16355: my ($file)=@_;
1.505 albertel 16356: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 16357: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 16358: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 16359: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
16360: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
16361: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16362: $curfext.".gif") {
16363: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16364: $curfext.".gif";
16365: }
16366: }
1.249 albertel 16367: return &lonhttpdurl($iconname);
1.154 albertel 16368: }
1.84 albertel 16369:
1.575 albertel 16370: sub lonhttpdurl {
1.692 www 16371: #
16372: # Had been used for "small fry" static images on separate port 8080.
16373: # Modify here if lightweight http functionality desired again.
16374: # Currently eliminated due to increasing firewall issues.
16375: #
1.575 albertel 16376: my ($url)=@_;
1.692 www 16377: return $url;
1.215 albertel 16378: }
16379:
1.213 albertel 16380: sub connection_aborted {
16381: my ($r)=@_;
16382: $r->print(" ");$r->rflush();
16383: my $c = $r->connection;
16384: return $c->aborted();
16385: }
16386:
1.221 foxr 16387: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16388: # strings as 'strings'.
16389: sub escape_single {
1.221 foxr 16390: my ($input) = @_;
1.223 albertel 16391: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16392: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16393: return $input;
16394: }
1.223 albertel 16395:
1.222 foxr 16396: # Same as escape_single, but escape's "'s This
16397: # can be used for "strings"
16398: sub escape_double {
16399: my ($input) = @_;
16400: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16401: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16402: return $input;
16403: }
1.223 albertel 16404:
1.222 foxr 16405: # Escapes the last element of a full URL.
16406: sub escape_url {
16407: my ($url) = @_;
1.238 raeburn 16408: my @urlslices = split(/\//, $url,-1);
1.369 www 16409: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 16410: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16411: }
1.462 albertel 16412:
1.820 raeburn 16413: sub compare_arrays {
16414: my ($arrayref1,$arrayref2) = @_;
16415: my (@difference,%count);
16416: @difference = ();
16417: %count = ();
16418: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16419: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16420: foreach my $element (keys(%count)) {
16421: if ($count{$element} == 1) {
16422: push(@difference,$element);
16423: }
16424: }
16425: }
16426: return @difference;
16427: }
16428:
1.1075.2.152 raeburn 16429: sub lon_status_items {
16430: my %defaults = (
16431: E => 100,
16432: W => 4,
16433: N => 1,
16434: U => 5,
16435: threshold => 200,
16436: sysmail => 2500,
16437: );
16438: my %names = (
16439: E => 'Errors',
16440: W => 'Warnings',
16441: N => 'Notices',
16442: U => 'Unsent',
16443: );
16444: return (\%defaults,\%names);
16445: }
16446:
1.817 bisitz 16447: # -------------------------------------------------------- Initialize user login
1.462 albertel 16448: sub init_user_environment {
1.463 albertel 16449: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16450: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16451:
16452: my $public=($username eq 'public' && $domain eq 'public');
16453:
16454: # See if old ID present, if so, remove
16455:
1.1062 raeburn 16456: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16457: my $now=time;
16458:
16459: if ($public) {
16460: my $max_public=100;
16461: my $oldest;
16462: my $oldest_time=0;
16463: for(my $next=1;$next<=$max_public;$next++) {
16464: if (-e $lonids."/publicuser_$next.id") {
16465: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16466: if ($mtime<$oldest_time || !$oldest_time) {
16467: $oldest_time=$mtime;
16468: $oldest=$next;
16469: }
16470: } else {
16471: $cookie="publicuser_$next";
16472: last;
16473: }
16474: }
16475: if (!$cookie) { $cookie="publicuser_$oldest"; }
16476: } else {
1.463 albertel 16477: # if this isn't a robot, kill any existing non-robot sessions
16478: if (!$args->{'robot'}) {
16479: opendir(DIR,$lonids);
16480: while ($filename=readdir(DIR)) {
16481: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136 raeburn 16482: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
16483: &GDBM_READER(),0640)) {
16484: my $linkedfile;
16485: if (exists($oldenv{'user.linkedenv'})) {
16486: $linkedfile = $oldenv{'user.linkedenv'};
16487: }
16488: untie(%oldenv);
16489: if (unlink("$lonids/$filename")) {
16490: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
16491: if (-l "$lonids/$linkedfile.id") {
16492: unlink("$lonids/$linkedfile.id");
16493: }
16494: }
16495: }
16496: } else {
16497: unlink($lonids.'/'.$filename);
16498: }
1.463 albertel 16499: }
1.462 albertel 16500: }
1.463 albertel 16501: closedir(DIR);
1.1075.2.84 raeburn 16502: # If there is a undeleted lockfile for the user's paste buffer remove it.
16503: my $namespace = 'nohist_courseeditor';
16504: my $lockingkey = 'paste'."\0".'locked_num';
16505: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16506: $domain,$username);
16507: if (exists($lockhash{$lockingkey})) {
16508: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16509: unless ($delresult eq 'ok') {
16510: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16511: }
16512: }
1.462 albertel 16513: }
16514: # Give them a new cookie
1.463 albertel 16515: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16516: : $now.$$.int(rand(10000)));
1.463 albertel 16517: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16518:
16519: # Initialize roles
16520:
1.1062 raeburn 16521: ($userroles,$firstaccenv,$timerintenv) =
16522: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16523: }
16524: # ------------------------------------ Check browser type and MathML capability
16525:
1.1075.2.77 raeburn 16526: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16527: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16528:
16529: # ------------------------------------------------------------- Get environment
16530:
16531: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16532: my ($tmp) = keys(%userenv);
16533: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
16534: } else {
16535: undef(%userenv);
16536: }
16537: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16538: $form->{'interface'}=$userenv{'interface'};
16539: }
16540: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16541:
16542: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16543: foreach my $option ('interface','localpath','localres') {
16544: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16545: }
16546: # --------------------------------------------------------- Write first profile
16547:
16548: {
1.1075.2.150 raeburn 16549: my $ip = &Apache::lonnet::get_requestor_ip();
1.462 albertel 16550: my %initial_env =
16551: ("user.name" => $username,
16552: "user.domain" => $domain,
16553: "user.home" => $authhost,
16554: "browser.type" => $clientbrowser,
16555: "browser.version" => $clientversion,
16556: "browser.mathml" => $clientmathml,
16557: "browser.unicode" => $clientunicode,
16558: "browser.os" => $clientos,
1.1075.2.42 raeburn 16559: "browser.mobile" => $clientmobile,
16560: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 16561: "browser.osversion" => $clientosversion,
1.462 albertel 16562: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16563: "request.course.fn" => '',
16564: "request.course.uri" => '',
16565: "request.course.sec" => '',
16566: "request.role" => 'cm',
16567: "request.role.adv" => $env{'user.adv'},
1.1075.2.150 raeburn 16568: "request.host" => $ip,);
1.462 albertel 16569:
16570: if ($form->{'localpath'}) {
16571: $initial_env{"browser.localpath"} = $form->{'localpath'};
16572: $initial_env{"browser.localres"} = $form->{'localres'};
16573: }
16574:
16575: if ($form->{'interface'}) {
16576: $form->{'interface'}=~s/\W//gs;
16577: $initial_env{"browser.interface"} = $form->{'interface'};
16578: $env{'browser.interface'}=$form->{'interface'};
16579: }
16580:
1.1075.2.54 raeburn 16581: if ($form->{'iptoken'}) {
16582: my $lonhost = $r->dir_config('lonHostID');
16583: $initial_env{"user.noloadbalance"} = $lonhost;
16584: $env{'user.noloadbalance'} = $lonhost;
16585: }
16586:
1.1075.2.120 raeburn 16587: if ($form->{'noloadbalance'}) {
16588: my @hosts = &Apache::lonnet::current_machine_ids();
16589: my $hosthere = $form->{'noloadbalance'};
16590: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16591: $initial_env{"user.noloadbalance"} = $hosthere;
16592: $env{'user.noloadbalance'} = $hosthere;
16593: }
16594: }
16595:
1.1016 raeburn 16596: unless ($domain eq 'public') {
1.1075.2.125 raeburn 16597: my %is_adv = ( is_adv => $env{'user.adv'} );
16598: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980 raeburn 16599:
1.1075.2.125 raeburn 16600: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16601: $userenv{'availabletools.'.$tool} =
16602: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16603: undef,\%userenv,\%domdef,\%is_adv);
16604: }
1.724 raeburn 16605:
1.1075.2.125 raeburn 16606: foreach my $crstype ('official','unofficial','community','textbook') {
16607: $userenv{'canrequest.'.$crstype} =
16608: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16609: 'reload','requestcourses',
16610: \%userenv,\%domdef,\%is_adv);
16611: }
1.765 raeburn 16612:
1.1075.2.125 raeburn 16613: $userenv{'canrequest.author'} =
16614: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16615: 'reload','requestauthor',
16616: \%userenv,\%domdef,\%is_adv);
16617: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16618: $domain,$username);
16619: my $reqstatus = $reqauthor{'author_status'};
16620: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16621: if (ref($reqauthor{'author'}) eq 'HASH') {
16622: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16623: $reqauthor{'author'}{'timestamp'};
16624: }
1.1075.2.14 raeburn 16625: }
16626: }
16627:
1.462 albertel 16628: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16629:
1.462 albertel 16630: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16631: &GDBM_WRCREAT(),0640)) {
16632: &_add_to_env(\%disk_env,\%initial_env);
16633: &_add_to_env(\%disk_env,\%userenv,'environment.');
16634: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16635: if (ref($firstaccenv) eq 'HASH') {
16636: &_add_to_env(\%disk_env,$firstaccenv);
16637: }
16638: if (ref($timerintenv) eq 'HASH') {
16639: &_add_to_env(\%disk_env,$timerintenv);
16640: }
1.463 albertel 16641: if (ref($args->{'extra_env'})) {
16642: &_add_to_env(\%disk_env,$args->{'extra_env'});
16643: }
1.462 albertel 16644: untie(%disk_env);
16645: } else {
1.705 tempelho 16646: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16647: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16648: return 'error: '.$!;
16649: }
16650: }
16651: $env{'request.role'}='cm';
16652: $env{'request.role.adv'}=$env{'user.adv'};
16653: $env{'browser.type'}=$clientbrowser;
16654:
16655: return $cookie;
16656:
16657: }
16658:
16659: sub _add_to_env {
16660: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16661: if (ref($env_data) eq 'HASH') {
16662: while (my ($key,$value) = each(%$env_data)) {
16663: $idf->{$prefix.$key} = $value;
16664: $env{$prefix.$key} = $value;
16665: }
1.462 albertel 16666: }
16667: }
16668:
1.685 tempelho 16669: # --- Get the symbolic name of a problem and the url
16670: sub get_symb {
16671: my ($request,$silent) = @_;
1.726 raeburn 16672: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16673: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16674: if ($symb eq '') {
16675: if (!$silent) {
1.1071 raeburn 16676: if (ref($request)) {
16677: $request->print("Unable to handle ambiguous references:$url:.");
16678: }
1.685 tempelho 16679: return ();
16680: }
16681: }
16682: &Apache::lonenc::check_decrypt(\$symb);
16683: return ($symb);
16684: }
16685:
16686: # --------------------------------------------------------------Get annotation
16687:
16688: sub get_annotation {
16689: my ($symb,$enc) = @_;
16690:
16691: my $key = $symb;
16692: if (!$enc) {
16693: $key =
16694: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16695: }
16696: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16697: return $annotation{$key};
16698: }
16699:
16700: sub clean_symb {
1.731 raeburn 16701: my ($symb,$delete_enc) = @_;
1.685 tempelho 16702:
16703: &Apache::lonenc::check_decrypt(\$symb);
16704: my $enc = $env{'request.enc'};
1.731 raeburn 16705: if ($delete_enc) {
1.730 raeburn 16706: delete($env{'request.enc'});
16707: }
1.685 tempelho 16708:
16709: return ($symb,$enc);
16710: }
1.462 albertel 16711:
1.1075.2.69 raeburn 16712: ############################################################
16713: ############################################################
16714:
16715: =pod
16716:
16717: =head1 Routines for building display used to search for courses
16718:
16719:
16720: =over 4
16721:
16722: =item * &build_filters()
16723:
16724: Create markup for a table used to set filters to use when selecting
16725: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16726: and quotacheck.pl
16727:
16728:
16729: Inputs:
16730:
16731: filterlist - anonymous array of fields to include as potential filters
16732:
16733: crstype - course type
16734:
16735: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16736: to pop-open a course selector (will contain "extra element").
16737:
16738: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16739:
16740: filter - anonymous hash of criteria and their values
16741:
16742: action - form action
16743:
16744: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16745:
16746: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
16747:
16748: cloneruname - username of owner of new course who wants to clone
16749:
16750: clonerudom - domain of owner of new course who wants to clone
16751:
16752: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16753:
16754: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16755:
16756: codedom - domain
16757:
16758: formname - value of form element named "form".
16759:
16760: fixeddom - domain, if fixed.
16761:
16762: prevphase - value to assign to form element named "phase" when going back to the previous screen
16763:
16764: cnameelement - name of form element in form on opener page which will receive title of selected course
16765:
16766: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16767:
16768: cdomelement - name of form element in form on opener page which will receive domain of selected course
16769:
16770: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16771:
16772: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16773:
16774: clonewarning - warning message about missing information for intended course owner when DC creates a course
16775:
16776:
16777: Returns: $output - HTML for display of search criteria, and hidden form elements.
16778:
16779:
16780: Side Effects: None
16781:
16782: =cut
16783:
16784: # ---------------------------------------------- search for courses based on last activity etc.
16785:
16786: sub build_filters {
16787: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16788: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16789: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16790: $cnameelement,$cnumelement,$cdomelement,$setroles,
16791: $clonetext,$clonewarning) = @_;
16792: my ($list,$jscript);
16793: my $onchange = 'javascript:updateFilters(this)';
16794: my ($domainselectform,$sincefilterform,$createdfilterform,
16795: $ownerdomselectform,$persondomselectform,$instcodeform,
16796: $typeselectform,$instcodetitle);
16797: if ($formname eq '') {
16798: $formname = $caller;
16799: }
16800: foreach my $item (@{$filterlist}) {
16801: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16802: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16803: if ($item eq 'domainfilter') {
16804: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16805: } elsif ($item eq 'coursefilter') {
16806: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16807: } elsif ($item eq 'ownerfilter') {
16808: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16809: } elsif ($item eq 'ownerdomfilter') {
16810: $filter->{'ownerdomfilter'} =
16811: &LONCAPA::clean_domain($filter->{$item});
16812: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16813: 'ownerdomfilter',1);
16814: } elsif ($item eq 'personfilter') {
16815: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16816: } elsif ($item eq 'persondomfilter') {
16817: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16818: 'persondomfilter',1);
16819: } else {
16820: $filter->{$item} =~ s/\W//g;
16821: }
16822: if (!$filter->{$item}) {
16823: $filter->{$item} = '';
16824: }
16825: }
16826: if ($item eq 'domainfilter') {
16827: my $allow_blank = 1;
16828: if ($formname eq 'portform') {
16829: $allow_blank=0;
16830: } elsif ($formname eq 'studentform') {
16831: $allow_blank=0;
16832: }
16833: if ($fixeddom) {
16834: $domainselectform = '<input type="hidden" name="domainfilter"'.
16835: ' value="'.$codedom.'" />'.
16836: &Apache::lonnet::domain($codedom,'description');
16837: } else {
16838: $domainselectform = &select_dom_form($filter->{$item},
16839: 'domainfilter',
16840: $allow_blank,'',$onchange);
16841: }
16842: } else {
16843: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16844: }
16845: }
16846:
16847: # last course activity filter and selection
16848: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16849:
16850: # course created filter and selection
16851: if (exists($filter->{'createdfilter'})) {
16852: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16853: }
16854:
16855: my %lt = &Apache::lonlocal::texthash(
16856: 'cac' => "$crstype Activity",
16857: 'ccr' => "$crstype Created",
16858: 'cde' => "$crstype Title",
16859: 'cdo' => "$crstype Domain",
16860: 'ins' => 'Institutional Code',
16861: 'inc' => 'Institutional Categorization',
16862: 'cow' => "$crstype Owner/Co-owner",
16863: 'cop' => "$crstype Personnel Includes",
16864: 'cog' => 'Type',
16865: );
16866:
16867: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16868: my $typeval = 'Course';
16869: if ($crstype eq 'Community') {
16870: $typeval = 'Community';
16871: }
16872: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16873: } else {
16874: $typeselectform = '<select name="type" size="1"';
16875: if ($onchange) {
16876: $typeselectform .= ' onchange="'.$onchange.'"';
16877: }
16878: $typeselectform .= '>'."\n";
16879: foreach my $posstype ('Course','Community') {
16880: $typeselectform.='<option value="'.$posstype.'"'.
16881: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
16882: }
16883: $typeselectform.="</select>";
16884: }
16885:
16886: my ($cloneableonlyform,$cloneabletitle);
16887: if (exists($filter->{'cloneableonly'})) {
16888: my $cloneableon = '';
16889: my $cloneableoff = ' checked="checked"';
16890: if ($filter->{'cloneableonly'}) {
16891: $cloneableon = $cloneableoff;
16892: $cloneableoff = '';
16893: }
16894: $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>';
16895: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 16896: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 16897: } else {
16898: $cloneabletitle = &mt('Cloneable by you');
16899: }
16900: }
16901: my $officialjs;
16902: if ($crstype eq 'Course') {
16903: if (exists($filter->{'instcodefilter'})) {
16904: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16905: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16906: if ($codedom) {
16907: $officialjs = 1;
16908: ($instcodeform,$jscript,$$numtitlesref) =
16909: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16910: $officialjs,$codetitlesref);
16911: if ($jscript) {
16912: $jscript = '<script type="text/javascript">'."\n".
16913: '// <![CDATA['."\n".
16914: $jscript."\n".
16915: '// ]]>'."\n".
16916: '</script>'."\n";
16917: }
16918: }
16919: if ($instcodeform eq '') {
16920: $instcodeform =
16921: '<input type="text" name="instcodefilter" size="10" value="'.
16922: $list->{'instcodefilter'}.'" />';
16923: $instcodetitle = $lt{'ins'};
16924: } else {
16925: $instcodetitle = $lt{'inc'};
16926: }
16927: if ($fixeddom) {
16928: $instcodetitle .= '<br />('.$codedom.')';
16929: }
16930: }
16931: }
16932: my $output = qq|
16933: <form method="post" name="filterpicker" action="$action">
16934: <input type="hidden" name="form" value="$formname" />
16935: |;
16936: if ($formname eq 'modifycourse') {
16937: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16938: '<input type="hidden" name="prevphase" value="'.
16939: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 16940: } elsif ($formname eq 'quotacheck') {
16941: $output .= qq|
16942: <input type="hidden" name="sortby" value="" />
16943: <input type="hidden" name="sortorder" value="" />
16944: |;
16945: } else {
1.1075.2.69 raeburn 16946: my $name_input;
16947: if ($cnameelement ne '') {
16948: $name_input = '<input type="hidden" name="cnameelement" value="'.
16949: $cnameelement.'" />';
16950: }
16951: $output .= qq|
16952: <input type="hidden" name="cnumelement" value="$cnumelement" />
16953: <input type="hidden" name="cdomelement" value="$cdomelement" />
16954: $name_input
16955: $roleelement
16956: $multelement
16957: $typeelement
16958: |;
16959: if ($formname eq 'portform') {
16960: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16961: }
16962: }
16963: if ($fixeddom) {
16964: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16965: }
16966: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16967: if ($sincefilterform) {
16968: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16969: .$sincefilterform
16970: .&Apache::lonhtmlcommon::row_closure();
16971: }
16972: if ($createdfilterform) {
16973: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16974: .$createdfilterform
16975: .&Apache::lonhtmlcommon::row_closure();
16976: }
16977: if ($domainselectform) {
16978: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16979: .$domainselectform
16980: .&Apache::lonhtmlcommon::row_closure();
16981: }
16982: if ($typeselectform) {
16983: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16984: $output .= $typeselectform;
16985: } else {
16986: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16987: .$typeselectform
16988: .&Apache::lonhtmlcommon::row_closure();
16989: }
16990: }
16991: if ($instcodeform) {
16992: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16993: .$instcodeform
16994: .&Apache::lonhtmlcommon::row_closure();
16995: }
16996: if (exists($filter->{'ownerfilter'})) {
16997: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16998: '<table><tr><td>'.&mt('Username').'<br />'.
16999: '<input type="text" name="ownerfilter" size="20" value="'.
17000: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17001: $ownerdomselectform.'</td></tr></table>'.
17002: &Apache::lonhtmlcommon::row_closure();
17003: }
17004: if (exists($filter->{'personfilter'})) {
17005: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17006: '<table><tr><td>'.&mt('Username').'<br />'.
17007: '<input type="text" name="personfilter" size="20" value="'.
17008: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17009: $persondomselectform.'</td></tr></table>'.
17010: &Apache::lonhtmlcommon::row_closure();
17011: }
17012: if (exists($filter->{'coursefilter'})) {
17013: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17014: .'<input type="text" name="coursefilter" size="25" value="'
17015: .$list->{'coursefilter'}.'" />'
17016: .&Apache::lonhtmlcommon::row_closure();
17017: }
17018: if ($cloneableonlyform) {
17019: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17020: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17021: }
17022: if (exists($filter->{'descriptfilter'})) {
17023: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17024: .'<input type="text" name="descriptfilter" size="40" value="'
17025: .$list->{'descriptfilter'}.'" />'
17026: .&Apache::lonhtmlcommon::row_closure(1);
17027: }
17028: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17029: '<input type="hidden" name="updater" value="" />'."\n".
17030: '<input type="submit" name="gosearch" value="'.
17031: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17032: return $jscript.$clonewarning.$output;
17033: }
17034:
17035: =pod
17036:
17037: =item * &timebased_select_form()
17038:
17039: Create markup for a dropdown list used to select a time-based
17040: filter e.g., Course Activity, Course Created, when searching for courses
17041: or communities
17042:
17043: Inputs:
17044:
17045: item - name of form element (sincefilter or createdfilter)
17046:
17047: filter - anonymous hash of criteria and their values
17048:
17049: Returns: HTML for a select box contained a blank, then six time selections,
17050: with value set in incoming form variables currently selected.
17051:
17052: Side Effects: None
17053:
17054: =cut
17055:
17056: sub timebased_select_form {
17057: my ($item,$filter) = @_;
17058: if (ref($filter) eq 'HASH') {
17059: $filter->{$item} =~ s/[^\d-]//g;
17060: if (!$filter->{$item}) { $filter->{$item}=-1; }
17061: return &select_form(
17062: $filter->{$item},
17063: $item,
17064: { '-1' => '',
17065: '86400' => &mt('today'),
17066: '604800' => &mt('last week'),
17067: '2592000' => &mt('last month'),
17068: '7776000' => &mt('last three months'),
17069: '15552000' => &mt('last six months'),
17070: '31104000' => &mt('last year'),
17071: 'select_form_order' =>
17072: ['-1','86400','604800','2592000','7776000',
17073: '15552000','31104000']});
17074: }
17075: }
17076:
17077: =pod
17078:
17079: =item * &js_changer()
17080:
17081: Create script tag containing Javascript used to submit course search form
17082: when course type or domain is changed, and also to hide 'Searching ...' on
17083: page load completion for page showing search result.
17084:
17085: Inputs: None
17086:
17087: Returns: markup containing updateFilters() and hideSearching() javascript functions.
17088:
17089: Side Effects: None
17090:
17091: =cut
17092:
17093: sub js_changer {
17094: return <<ENDJS;
17095: <script type="text/javascript">
17096: // <![CDATA[
17097: function updateFilters(caller) {
17098: if (typeof(caller) != "undefined") {
17099: document.filterpicker.updater.value = caller.name;
17100: }
17101: document.filterpicker.submit();
17102: }
17103:
17104: function hideSearching() {
17105: if (document.getElementById('searching')) {
17106: document.getElementById('searching').style.display = 'none';
17107: }
17108: return;
17109: }
17110:
17111: // ]]>
17112: </script>
17113:
17114: ENDJS
17115: }
17116:
17117: =pod
17118:
17119: =item * &search_courses()
17120:
17121: Process selected filters form course search form and pass to lonnet::courseiddump
17122: to retrieve a hash for which keys are courseIDs which match the selected filters.
17123:
17124: Inputs:
17125:
17126: dom - domain being searched
17127:
17128: type - course type ('Course' or 'Community' or '.' if any).
17129:
17130: filter - anonymous hash of criteria and their values
17131:
17132: numtitles - for institutional codes - number of categories
17133:
17134: cloneruname - optional username of new course owner
17135:
17136: clonerudom - optional domain of new course owner
17137:
1.1075.2.95 raeburn 17138: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 17139: (used when DC is using course creation form)
17140:
17141: codetitles - reference to array of titles of components in institutional codes (official courses).
17142:
1.1075.2.95 raeburn 17143: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17144: (and so can clone automatically)
17145:
17146: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17147:
17148: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17149: courses to clone
1.1075.2.69 raeburn 17150:
17151: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17152:
17153:
17154: Side Effects: None
17155:
17156: =cut
17157:
17158:
17159: sub search_courses {
1.1075.2.95 raeburn 17160: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17161: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 17162: my (%courses,%showcourses,$cloner);
17163: if (($filter->{'ownerfilter'} ne '') ||
17164: ($filter->{'ownerdomfilter'} ne '')) {
17165: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17166: $filter->{'ownerdomfilter'};
17167: }
17168: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17169: if (!$filter->{$item}) {
17170: $filter->{$item}='.';
17171: }
17172: }
17173: my $now = time;
17174: my $timefilter =
17175: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17176: my ($createdbefore,$createdafter);
17177: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17178: $createdbefore = $now;
17179: $createdafter = $now-$filter->{'createdfilter'};
17180: }
17181: my ($instcodefilter,$regexpok);
17182: if ($numtitles) {
17183: if ($env{'form.official'} eq 'on') {
17184: $instcodefilter =
17185: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17186: $regexpok = 1;
17187: } elsif ($env{'form.official'} eq 'off') {
17188: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17189: unless ($instcodefilter eq '') {
17190: $regexpok = -1;
17191: }
17192: }
17193: } else {
17194: $instcodefilter = $filter->{'instcodefilter'};
17195: }
17196: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17197: if ($type eq '') { $type = '.'; }
17198:
17199: if (($clonerudom ne '') && ($cloneruname ne '')) {
17200: $cloner = $cloneruname.':'.$clonerudom;
17201: }
17202: %courses = &Apache::lonnet::courseiddump($dom,
17203: $filter->{'descriptfilter'},
17204: $timefilter,
17205: $instcodefilter,
17206: $filter->{'combownerfilter'},
17207: $filter->{'coursefilter'},
17208: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 17209: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 17210: $filter->{'cloneableonly'},
17211: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 17212: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 17213: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
17214: my $ccrole;
17215: if ($type eq 'Community') {
17216: $ccrole = 'co';
17217: } else {
17218: $ccrole = 'cc';
17219: }
17220: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
17221: $filter->{'persondomfilter'},
17222: 'userroles',undef,
17223: [$ccrole,'in','ad','ep','ta','cr'],
17224: $dom);
17225: foreach my $role (keys(%rolehash)) {
17226: my ($cnum,$cdom,$courserole) = split(':',$role);
17227: my $cid = $cdom.'_'.$cnum;
17228: if (exists($courses{$cid})) {
17229: if (ref($courses{$cid}) eq 'HASH') {
17230: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
17231: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119 raeburn 17232: push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69 raeburn 17233: }
17234: } else {
17235: $courses{$cid}{roles} = [$courserole];
17236: }
17237: $showcourses{$cid} = $courses{$cid};
17238: }
17239: }
17240: }
17241: %courses = %showcourses;
17242: }
17243: return %courses;
17244: }
17245:
17246: =pod
17247:
17248: =back
17249:
1.1075.2.88 raeburn 17250: =head1 Routines for version requirements for current course.
17251:
17252: =over 4
17253:
17254: =item * &check_release_required()
17255:
17256: Compares required LON-CAPA version with version on server, and
17257: if required version is newer looks for a server with the required version.
17258:
17259: Looks first at servers in user's owen domain; if none suitable, looks at
17260: servers in course's domain are permitted to host sessions for user's domain.
17261:
17262: Inputs:
17263:
17264: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17265:
17266: $courseid - Course ID of current course
17267:
17268: $rolecode - User's current role in course (for switchserver query string).
17269:
17270: $required - LON-CAPA version needed by course (format: Major.Minor).
17271:
17272:
17273: Returns:
17274:
17275: $switchserver - query string tp append to /adm/switchserver call (if
17276: current server's LON-CAPA version is too old.
17277:
17278: $warning - Message is displayed if no suitable server could be found.
17279:
17280: =cut
17281:
17282: sub check_release_required {
17283: my ($loncaparev,$courseid,$rolecode,$required) = @_;
17284: my ($switchserver,$warning);
17285: if ($required ne '') {
17286: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
17287: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17288: if ($reqdmajor ne '' && $reqdminor ne '') {
17289: my $otherserver;
17290: if (($major eq '' && $minor eq '') ||
17291: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
17292: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
17293: my $switchlcrev =
17294: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
17295: $userdomserver);
17296: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17297: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
17298: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
17299: my $cdom = $env{'course.'.$courseid.'.domain'};
17300: if ($cdom ne $env{'user.domain'}) {
17301: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
17302: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
17303: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17304: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
17305: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
17306: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
17307: my $canhost =
17308: &Apache::lonnet::can_host_session($env{'user.domain'},
17309: $coursedomserver,
17310: $remoterev,
17311: $udomdefaults{'remotesessions'},
17312: $defdomdefaults{'hostedsessions'});
17313:
17314: if ($canhost) {
17315: $otherserver = $coursedomserver;
17316: } else {
17317: $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.");
17318: }
17319: } else {
17320: $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).");
17321: }
17322: } else {
17323: $otherserver = $userdomserver;
17324: }
17325: }
17326: if ($otherserver ne '') {
17327: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
17328: }
17329: }
17330: }
17331: return ($switchserver,$warning);
17332: }
17333:
17334: =pod
17335:
17336: =item * &check_release_result()
17337:
17338: Inputs:
17339:
17340: $switchwarning - Warning message if no suitable server found to host session.
17341:
17342: $switchserver - query string to append to /adm/switchserver containing lonHostID
17343: and current role.
17344:
17345: Returns: HTML to display with information about requirement to switch server.
17346: Either displaying warning with link to Roles/Courses screen or
17347: display link to switchserver.
17348:
1.1075.2.69 raeburn 17349: =cut
17350:
1.1075.2.88 raeburn 17351: sub check_release_result {
17352: my ($switchwarning,$switchserver) = @_;
17353: my $output = &start_page('Selected course unavailable on this server').
17354: '<p class="LC_warning">';
17355: if ($switchwarning) {
17356: $output .= $switchwarning.'<br /><a href="/adm/roles">';
17357: if (&show_course()) {
17358: $output .= &mt('Display courses');
17359: } else {
17360: $output .= &mt('Display roles');
17361: }
17362: $output .= '</a>';
17363: } elsif ($switchserver) {
17364: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17365: '<br />'.
17366: '<a href="/adm/switchserver?'.$switchserver.'">'.
17367: &mt('Switch Server').
17368: '</a>';
17369: }
17370: $output .= '</p>'.&end_page();
17371: return $output;
17372: }
17373:
17374: =pod
17375:
17376: =item * &needs_coursereinit()
17377:
17378: Determine if course contents stored for user's session needs to be
17379: refreshed, because content has changed since "Big Hash" last tied.
17380:
17381: Check for change is made if time last checked is more than 10 minutes ago
17382: (by default).
17383:
17384: Inputs:
17385:
17386: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17387:
17388: $interval (optional) - Time which may elapse (in s) between last check for content
17389: change in current course. (default: 600 s).
17390:
17391: Returns: an array; first element is:
17392:
17393: =over 4
17394:
17395: 'switch' - if content updates mean user's session
17396: needs to be switched to a server running a newer LON-CAPA version
17397:
17398: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17399: on current server hosting user's session
17400:
17401: '' - if no action required.
17402:
17403: =back
17404:
17405: If first item element is 'switch':
17406:
17407: second item is $switchwarning - Warning message if no suitable server found to host session.
17408:
17409: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17410: and current role.
17411:
17412: otherwise: no other elements returned.
17413:
17414: =back
17415:
17416: =cut
17417:
17418: sub needs_coursereinit {
17419: my ($loncaparev,$interval) = @_;
17420: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17421: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17422: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17423: my $now = time;
17424: if ($interval eq '') {
17425: $interval = 600;
17426: }
17427: if (($now-$env{'request.course.timechecked'})>$interval) {
17428: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1075.2.161. .4(raebu 17429:22): my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
.1(raebu 17430:21): if ($blocked) {
17431:21): return ();
17432:21): }
17433:21): my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
1.1075.2.88 raeburn 17434: if ($lastchange > $env{'request.course.tied'}) {
17435: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17436: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17437: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17438: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17439: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17440: $curr_reqd_hash{'internal.releaserequired'}});
17441: my ($switchserver,$switchwarning) =
17442: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17443: $curr_reqd_hash{'internal.releaserequired'});
17444: if ($switchwarning ne '' || $switchserver ne '') {
17445: return ('switch',$switchwarning,$switchserver);
17446: }
17447: }
17448: }
17449: return ('update');
17450: }
17451: }
17452: return ();
17453: }
1.1075.2.69 raeburn 17454:
1.1075.2.11 raeburn 17455: sub update_content_constraints {
17456: my ($cdom,$cnum,$chome,$cid) = @_;
17457: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17458: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
17459: my %checkresponsetypes;
17460: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
17461: my ($item,$name,$value) = split(/:/,$key);
17462: if ($item eq 'resourcetag') {
17463: if ($name eq 'responsetype') {
17464: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17465: }
17466: }
17467: }
17468: my $navmap = Apache::lonnavmaps::navmap->new();
17469: if (defined($navmap)) {
17470: my %allresponses;
17471: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
17472: my %responses = $res->responseTypes();
17473: foreach my $key (keys(%responses)) {
17474: next unless(exists($checkresponsetypes{$key}));
17475: $allresponses{$key} += $responses{$key};
17476: }
17477: }
17478: foreach my $key (keys(%allresponses)) {
17479: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17480: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17481: ($reqdmajor,$reqdminor) = ($major,$minor);
17482: }
17483: }
17484: undef($navmap);
17485: }
17486: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17487: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17488: }
17489: return;
17490: }
17491:
1.1075.2.27 raeburn 17492: sub allmaps_incourse {
17493: my ($cdom,$cnum,$chome,$cid) = @_;
17494: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17495: $cid = $env{'request.course.id'};
17496: $cdom = $env{'course.'.$cid.'.domain'};
17497: $cnum = $env{'course.'.$cid.'.num'};
17498: $chome = $env{'course.'.$cid.'.home'};
17499: }
17500: my %allmaps = ();
17501: my $lastchange =
17502: &Apache::lonnet::get_coursechange($cdom,$cnum);
17503: if ($lastchange > $env{'request.course.tied'}) {
17504: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17505: unless ($ferr) {
17506: &update_content_constraints($cdom,$cnum,$chome,$cid);
17507: }
17508: }
17509: my $navmap = Apache::lonnavmaps::navmap->new();
17510: if (defined($navmap)) {
17511: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17512: $allmaps{$res->src()} = 1;
17513: }
17514: }
17515: return \%allmaps;
17516: }
17517:
1.1075.2.11 raeburn 17518: sub parse_supplemental_title {
17519: my ($title) = @_;
17520:
17521: my ($foldertitle,$renametitle);
17522: if ($title =~ /&&&/) {
17523: $title = &HTML::Entites::decode($title);
17524: }
17525: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17526: $renametitle=$4;
17527: my ($time,$uname,$udom) = ($1,$2,$3);
17528: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17529: my $name = &plainname($uname,$udom);
17530: $name = &HTML::Entities::encode($name,'"<>&\'');
17531: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17532: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17533: $name.': <br />'.$foldertitle;
17534: }
17535: if (wantarray) {
17536: return ($title,$foldertitle,$renametitle);
17537: }
17538: return $title;
17539: }
17540:
1.1075.2.43 raeburn 17541: sub recurse_supplemental {
17542: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
17543: if ($suppmap) {
17544: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17545: if ($fatal) {
17546: $errors ++;
17547: } else {
17548: if ($#LONCAPA::map::resources > 0) {
17549: foreach my $res (@LONCAPA::map::resources) {
17550: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
17551: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 17552: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
17553: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 17554: } else {
17555: $numfiles ++;
17556: }
17557: }
17558: }
17559: }
17560: }
17561: }
17562: return ($numfiles,$errors);
17563: }
17564:
1.1075.2.18 raeburn 17565: sub symb_to_docspath {
1.1075.2.119 raeburn 17566: my ($symb,$navmapref) = @_;
17567: return unless ($symb && ref($navmapref));
1.1075.2.18 raeburn 17568: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17569: if ($resurl=~/\.(sequence|page)$/) {
17570: $mapurl=$resurl;
17571: } elsif ($resurl eq 'adm/navmaps') {
17572: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17573: }
17574: my $mapresobj;
1.1075.2.119 raeburn 17575: unless (ref($$navmapref)) {
17576: $$navmapref = Apache::lonnavmaps::navmap->new();
17577: }
17578: if (ref($$navmapref)) {
17579: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18 raeburn 17580: }
17581: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17582: my $type=$2;
17583: my $path;
17584: if (ref($mapresobj)) {
17585: my $pcslist = $mapresobj->map_hierarchy();
17586: if ($pcslist ne '') {
17587: foreach my $pc (split(/,/,$pcslist)) {
17588: next if ($pc <= 1);
1.1075.2.119 raeburn 17589: my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18 raeburn 17590: if (ref($res)) {
17591: my $thisurl = $res->src();
17592: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17593: my $thistitle = $res->title();
17594: $path .= '&'.
17595: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 17596: &escape($thistitle).
1.1075.2.18 raeburn 17597: ':'.$res->randompick().
17598: ':'.$res->randomout().
17599: ':'.$res->encrypted().
17600: ':'.$res->randomorder().
17601: ':'.$res->is_page();
17602: }
17603: }
17604: }
17605: $path =~ s/^\&//;
17606: my $maptitle = $mapresobj->title();
17607: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 17608: $maptitle = 'Main Content';
1.1075.2.18 raeburn 17609: }
17610: $path .= (($path ne '')? '&' : '').
17611: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 17612: &escape($maptitle).
1.1075.2.18 raeburn 17613: ':'.$mapresobj->randompick().
17614: ':'.$mapresobj->randomout().
17615: ':'.$mapresobj->encrypted().
17616: ':'.$mapresobj->randomorder().
17617: ':'.$mapresobj->is_page();
17618: } else {
17619: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17620: my $ispage = (($type eq 'page')? 1 : '');
17621: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 17622: $maptitle = 'Main Content';
1.1075.2.18 raeburn 17623: }
17624: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 17625: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 17626: }
17627: unless ($mapurl eq 'default') {
17628: $path = 'default&'.
1.1075.2.46 raeburn 17629: &escape('Main Content').
1.1075.2.18 raeburn 17630: ':::::&'.$path;
17631: }
17632: return $path;
17633: }
17634:
1.1075.2.14 raeburn 17635: sub captcha_display {
1.1075.2.137 raeburn 17636: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 17637: my ($output,$error);
1.1075.2.107 raeburn 17638: my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137 raeburn 17639: &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 17640: if ($captcha eq 'original') {
17641: $output = &create_captcha();
17642: unless ($output) {
17643: $error = 'captcha';
17644: }
17645: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 17646: $output = &create_recaptcha($pubkey,$version);
1.1075.2.14 raeburn 17647: unless ($output) {
17648: $error = 'recaptcha';
17649: }
17650: }
1.1075.2.107 raeburn 17651: return ($output,$error,$captcha,$version);
1.1075.2.14 raeburn 17652: }
17653:
17654: sub captcha_response {
1.1075.2.137 raeburn 17655: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 17656: my ($captcha_chk,$captcha_error);
1.1075.2.137 raeburn 17657: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 17658: if ($captcha eq 'original') {
17659: ($captcha_chk,$captcha_error) = &check_captcha();
17660: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 17661: $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14 raeburn 17662: } else {
17663: $captcha_chk = 1;
17664: }
17665: return ($captcha_chk,$captcha_error);
17666: }
17667:
17668: sub get_captcha_config {
1.1075.2.137 raeburn 17669: my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107 raeburn 17670: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14 raeburn 17671: my $hostname = &Apache::lonnet::hostname($lonhost);
17672: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17673: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17674: if ($context eq 'usercreation') {
17675: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17676: if (ref($domconfig{$context}) eq 'HASH') {
17677: $hashtocheck = $domconfig{$context}{'cancreate'};
17678: if (ref($hashtocheck) eq 'HASH') {
17679: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17680: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17681: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17682: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17683: }
17684: if ($privkey && $pubkey) {
17685: $captcha = 'recaptcha';
1.1075.2.107 raeburn 17686: $version = $hashtocheck->{'recaptchaversion'};
17687: if ($version ne '2') {
17688: $version = 1;
17689: }
1.1075.2.14 raeburn 17690: } else {
17691: $captcha = 'original';
17692: }
17693: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17694: $captcha = 'original';
17695: }
17696: }
17697: } else {
17698: $captcha = 'captcha';
17699: }
17700: } elsif ($context eq 'login') {
17701: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17702: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17703: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17704: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
17705: if ($privkey && $pubkey) {
17706: $captcha = 'recaptcha';
1.1075.2.107 raeburn 17707: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17708: if ($version ne '2') {
17709: $version = 1;
17710: }
1.1075.2.14 raeburn 17711: } else {
17712: $captcha = 'original';
17713: }
17714: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17715: $captcha = 'original';
17716: }
1.1075.2.137 raeburn 17717: } elsif ($context eq 'passwords') {
17718: if ($dom_in_effect) {
17719: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
17720: if ($passwdconf{'captcha'} eq 'recaptcha') {
17721: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
17722: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
17723: $privkey = $passwdconf{'recaptchakeys'}{'private'};
17724: }
17725: if ($privkey && $pubkey) {
17726: $captcha = 'recaptcha';
17727: $version = $passwdconf{'recaptchaversion'};
17728: if ($version ne '2') {
17729: $version = 1;
17730: }
17731: } else {
17732: $captcha = 'original';
17733: }
17734: } elsif ($passwdconf{'captcha'} ne 'notused') {
17735: $captcha = 'original';
17736: }
17737: }
1.1075.2.14 raeburn 17738: }
1.1075.2.107 raeburn 17739: return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14 raeburn 17740: }
17741:
17742: sub create_captcha {
17743: my %captcha_params = &captcha_settings();
17744: my ($output,$maxtries,$tries) = ('',10,0);
17745: while ($tries < $maxtries) {
17746: $tries ++;
17747: my $captcha = Authen::Captcha->new (
17748: output_folder => $captcha_params{'output_dir'},
17749: data_folder => $captcha_params{'db_dir'},
17750: );
17751: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17752:
17753: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17754: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1075.2.158 raeburn 17755: '<span class="LC_nobreak">'.
1.1075.2.14 raeburn 17756: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 17757: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
1.1075.2.158 raeburn 17758: '</span><br />'.
1.1075.2.66 raeburn 17759: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 17760: last;
17761: }
17762: }
1.1075.2.158 raeburn 17763: if ($output eq '') {
17764: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
17765: }
1.1075.2.14 raeburn 17766: return $output;
17767: }
17768:
17769: sub captcha_settings {
17770: my %captcha_params = (
17771: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17772: www_output_dir => "/captchaspool",
17773: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17774: numchars => '5',
17775: );
17776: return %captcha_params;
17777: }
17778:
17779: sub check_captcha {
17780: my ($captcha_chk,$captcha_error);
17781: my $code = $env{'form.code'};
17782: my $md5sum = $env{'form.crypt'};
17783: my %captcha_params = &captcha_settings();
17784: my $captcha = Authen::Captcha->new(
17785: output_folder => $captcha_params{'output_dir'},
17786: data_folder => $captcha_params{'db_dir'},
17787: );
1.1075.2.26 raeburn 17788: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 17789: my %captcha_hash = (
17790: 0 => 'Code not checked (file error)',
17791: -1 => 'Failed: code expired',
17792: -2 => 'Failed: invalid code (not in database)',
17793: -3 => 'Failed: invalid code (code does not match crypt)',
17794: );
17795: if ($captcha_chk != 1) {
17796: $captcha_error = $captcha_hash{$captcha_chk}
17797: }
17798: return ($captcha_chk,$captcha_error);
17799: }
17800:
17801: sub create_recaptcha {
1.1075.2.107 raeburn 17802: my ($pubkey,$version) = @_;
17803: if ($version >= 2) {
1.1075.2.158 raeburn 17804: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
17805: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1075.2.107 raeburn 17806: } else {
17807: my $use_ssl;
17808: if ($ENV{'SERVER_PORT'} == 443) {
17809: $use_ssl = 1;
17810: }
17811: my $captcha = Captcha::reCAPTCHA->new;
17812: return $captcha->get_options_setter({theme => 'white'})."\n".
17813: $captcha->get_html($pubkey,undef,$use_ssl).
17814: &mt('If the text is hard to read, [_1] will replace them.',
17815: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17816: '<br /><br />';
17817: }
1.1075.2.14 raeburn 17818: }
17819:
17820: sub check_recaptcha {
1.1075.2.107 raeburn 17821: my ($privkey,$version) = @_;
1.1075.2.14 raeburn 17822: my $captcha_chk;
1.1075.2.150 raeburn 17823: my $ip = &Apache::lonnet::get_requestor_ip();
1.1075.2.107 raeburn 17824: if ($version >= 2) {
17825: my $ua = LWP::UserAgent->new;
17826: $ua->timeout(10);
17827: my %info = (
17828: secret => $privkey,
17829: response => $env{'form.g-recaptcha-response'},
1.1075.2.150 raeburn 17830: remoteip => $ip,
1.1075.2.107 raeburn 17831: );
17832: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
17833: if ($response->is_success) {
17834: my $data = JSON::DWIW->from_json($response->decoded_content);
17835: if (ref($data) eq 'HASH') {
17836: if ($data->{'success'}) {
17837: $captcha_chk = 1;
17838: }
17839: }
17840: }
17841: } else {
17842: my $captcha = Captcha::reCAPTCHA->new;
17843: my $captcha_result =
17844: $captcha->check_answer(
17845: $privkey,
1.1075.2.150 raeburn 17846: $ip,
1.1075.2.107 raeburn 17847: $env{'form.recaptcha_challenge_field'},
17848: $env{'form.recaptcha_response_field'},
17849: );
17850: if ($captcha_result->{is_valid}) {
17851: $captcha_chk = 1;
17852: }
1.1075.2.14 raeburn 17853: }
17854: return $captcha_chk;
17855: }
17856:
1.1075.2.64 raeburn 17857: sub emailusername_info {
1.1075.2.103 raeburn 17858: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64 raeburn 17859: my %titles = &Apache::lonlocal::texthash (
17860: lastname => 'Last Name',
17861: firstname => 'First Name',
17862: institution => 'School/college/university',
17863: location => "School's city, state/province, country",
17864: web => "School's web address",
17865: officialemail => 'E-mail address at institution (if different)',
1.1075.2.103 raeburn 17866: id => 'Student/Employee ID',
1.1075.2.64 raeburn 17867: );
17868: return (\@fields,\%titles);
17869: }
17870:
1.1075.2.56 raeburn 17871: sub cleanup_html {
17872: my ($incoming) = @_;
17873: my $outgoing;
17874: if ($incoming ne '') {
17875: $outgoing = $incoming;
17876: $outgoing =~ s/;/;/g;
17877: $outgoing =~ s/\#/#/g;
17878: $outgoing =~ s/\&/&/g;
17879: $outgoing =~ s/</</g;
17880: $outgoing =~ s/>/>/g;
17881: $outgoing =~ s/\(/(/g;
17882: $outgoing =~ s/\)/)/g;
17883: $outgoing =~ s/"/"/g;
17884: $outgoing =~ s/'/'/g;
17885: $outgoing =~ s/\$/$/g;
17886: $outgoing =~ s{/}{/}g;
17887: $outgoing =~ s/=/=/g;
17888: $outgoing =~ s/\\/\/g
17889: }
17890: return $outgoing;
17891: }
17892:
1.1075.2.74 raeburn 17893: # Checks for critical messages and returns a redirect url if one exists.
17894: # $interval indicates how often to check for messages.
1.1075.2.161. .1(raebu 17895:21): # $context is the calling context -- roles, grades, contents, menu or flip.
1.1075.2.74 raeburn 17896: sub critical_redirect {
1.1075.2.161. .1(raebu 17897:21): my ($interval,$context) = @_;
1.1075.2.158 raeburn 17898: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
17899: return ();
17900: }
1.1075.2.74 raeburn 17901: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1075.2.161. .1(raebu 17902:21): if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
17903:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17904:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
.4(raebu 17905:22): my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
.1(raebu 17906:21): if ($blocked) {
17907:21): my $checkrole = "cm./$cdom/$cnum";
17908:21): if ($env{'request.course.sec'} ne '') {
17909:21): $checkrole .= "/$env{'request.course.sec'}";
17910:21): }
17911:21): unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
17912:21): ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
17913:21): return;
17914:21): }
17915:21): }
17916:21): }
1.1075.2.74 raeburn 17917: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17918: $env{'user.name'});
17919: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
17920: my $redirecturl;
17921: if ($what[0]) {
1.1075.2.158 raeburn 17922: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1075.2.74 raeburn 17923: $redirecturl='/adm/email?critical=display';
17924: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17925: return (1, $url);
17926: }
17927: }
17928: }
17929: return ();
17930: }
17931:
1.1075.2.64 raeburn 17932: # Use:
17933: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17934: #
17935: ##################################################
17936: # password associated functions #
17937: ##################################################
17938: sub des_keys {
17939: # Make a new key for DES encryption.
17940: # Each key has two parts which are returned separately.
17941: # Please note: Each key must be passed through the &hex function
17942: # before it is output to the web browser. The hex versions cannot
17943: # be used to decrypt.
17944: my @hexstr=('0','1','2','3','4','5','6','7',
17945: '8','9','a','b','c','d','e','f');
17946: my $lkey='';
17947: for (0..7) {
17948: $lkey.=$hexstr[rand(15)];
17949: }
17950: my $ukey='';
17951: for (0..7) {
17952: $ukey.=$hexstr[rand(15)];
17953: }
17954: return ($lkey,$ukey);
17955: }
17956:
17957: sub des_decrypt {
17958: my ($key,$cyphertext) = @_;
17959: my $keybin=pack("H16",$key);
17960: my $cypher;
17961: if ($Crypt::DES::VERSION>=2.03) {
17962: $cypher=new Crypt::DES $keybin;
17963: } else {
17964: $cypher=new DES $keybin;
17965: }
1.1075.2.106 raeburn 17966: my $plaintext='';
17967: my $cypherlength = length($cyphertext);
17968: my $numchunks = int($cypherlength/32);
17969: for (my $j=0; $j<$numchunks; $j++) {
17970: my $start = $j*32;
17971: my $cypherblock = substr($cyphertext,$start,32);
17972: my $chunk =
17973: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17974: $chunk .=
17975: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17976: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17977: $plaintext .= $chunk;
17978: }
1.1075.2.64 raeburn 17979: return $plaintext;
17980: }
17981:
1.1075.2.161. .1(raebu 17982:21): sub get_requested_shorturls {
17983:21): my ($cdom,$cnum,$navmap) = @_;
17984:21): return unless (ref($navmap));
17985:21): my ($numnew,$errors);
17986:21): my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
17987:21): if (@toshorten) {
17988:21): my (%maps,%resources,%titles);
17989:21): &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
17990:21): 'shorturls',$cdom,$cnum);
17991:21): if (keys(%resources)) {
17992:21): my %tocreate;
17993:21): foreach my $item (sort {$a <=> $b} (@toshorten)) {
17994:21): my $symb = $resources{$item};
17995:21): if ($symb) {
17996:21): $tocreate{$cnum.'&'.$symb} = 1;
17997:21): }
17998:21): }
17999:21): if (keys(%tocreate)) {
18000:21): ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
18001:21): \%tocreate);
18002:21): }
18003:21): }
18004:21): }
18005:21): return ($numnew,$errors);
18006:21): }
18007:21):
18008:21): sub make_short_symbs {
18009:21): my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
18010:21): my ($numnew,@errors);
18011:21): if (ref($tocreateref) eq 'HASH') {
18012:21): my %tocreate = %{$tocreateref};
18013:21): if (keys(%tocreate)) {
18014:21): my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
18015:21): my $su = Short::URL->new(no_vowels => 1);
18016:21): my $init = '';
18017:21): my (%newunique,%addcourse,%courseonly,%failed);
18018:21): # get lock on tiny db
18019:21): my $now = time;
18020:21): if ($lockuser eq '') {
18021:21): $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
18022:21): }
18023:21): my $lockhash = {
18024:21): "lock\0$now" => $lockuser,
18025:21): };
18026:21): my $tries = 0;
18027:21): my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
18028:21): my ($code,$error);
18029:21): while (($gotlock ne 'ok') && ($tries<3)) {
18030:21): $tries ++;
18031:21): sleep 1;
18032:21): $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
18033:21): }
18034:21): if ($gotlock eq 'ok') {
18035:21): $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
18036:21): \%addcourse,\%courseonly,\%failed);
18037:21): if (keys(%failed)) {
18038:21): my $numfailed = scalar(keys(%failed));
18039:21): push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
18040:21): }
18041:21): if (keys(%newunique)) {
18042:21): my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
18043:21): if ($putres eq 'ok') {
18044:21): $numnew = scalar(keys(%newunique));
18045:21): my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
18046:21): unless ($newputres eq 'ok') {
18047:21): push(@errors,&mt('error: could not store course look-up of short URLs'));
18048:21): }
18049:21): } else {
18050:21): push(@errors,&mt('error: could not store unique six character URLs'));
18051:21): }
18052:21): }
18053:21): my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
18054:21): unless ($dellockres eq 'ok') {
18055:21): push(@errors,&mt('error: could not release lockfile'));
18056:21): }
18057:21): } else {
18058:21): push(@errors,&mt('error: could not obtain lockfile'));
18059:21): }
18060:21): if (keys(%courseonly)) {
18061:21): my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
18062:21): if ($result ne 'ok') {
18063:21): push(@errors,&mt('error: could not update course look-up of short URLs'));
18064:21): }
18065:21): }
18066:21): }
18067:21): }
18068:21): return ($numnew,\@errors);
18069:21): }
18070:21):
18071:21): sub shorten_symbs {
18072:21): my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
18073:21): return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
18074:21): (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
18075:21): (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
18076:21): my (%possibles,%collisions);
18077:21): foreach my $key (keys(%{$tocreate})) {
18078:21): my $num = String::CRC32::crc32($key);
18079:21): my $tiny = $su->encode($num,$init);
18080:21): if ($tiny) {
18081:21): $possibles{$tiny} = $key;
18082:21): }
18083:21): }
18084:21): if (!$init) {
18085:21): $init = 1;
18086:21): } else {
18087:21): $init ++;
18088:21): }
18089:21): if (keys(%possibles)) {
18090:21): my @posstiny = keys(%possibles);
18091:21): my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
18092:21): my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
18093:21): if (keys(%currtiny)) {
18094:21): foreach my $key (keys(%currtiny)) {
18095:21): next if ($currtiny{$key} eq '');
18096:21): if ($currtiny{$key} eq $possibles{$key}) {
18097:21): my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
18098:21): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18099:21): $courseonly->{$tsymb} = $key;
18100:21): }
18101:21): } else {
18102:21): $collisions{$possibles{$key}} = 1;
18103:21): }
18104:21): delete($possibles{$key});
18105:21): }
18106:21): }
18107:21): foreach my $key (keys(%possibles)) {
18108:21): $newunique->{$key} = $possibles{$key};
18109:21): my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
18110:21): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18111:21): $addcourse->{$tsymb} = $key;
18112:21): }
18113:21): }
18114:21): }
18115:21): if (keys(%collisions)) {
18116:21): if ($init <5) {
18117:21): if (!$init) {
18118:21): $init = 1;
18119:21): } else {
18120:21): $init ++;
18121:21): }
18122:21): $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
18123:21): $newunique,$addcourse,$courseonly,$failed);
18124:21): } else {
18125:21): foreach my $key (keys(%collisions)) {
18126:21): $failed->{$key} = 1;
18127:21): $failed->{$key} = 1;
18128:21): }
18129:21): }
18130:21): }
18131:21): return $init;
18132:21): }
18133:21):
1.1075.2.135 raeburn 18134: sub is_nonframeable {
18135: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
18136: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
18137: return if (($remprotocol eq '') || ($remhost eq ''));
18138:
18139: $remprotocol = lc($remprotocol);
18140: $remhost = lc($remhost);
18141: my $remport = 80;
18142: if ($remprotocol eq 'https') {
18143: $remport = 443;
18144: }
18145: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
18146: if ($cached) {
18147: unless ($nocache) {
18148: if ($result) {
18149: return 1;
18150: } else {
18151: return 0;
18152: }
18153: }
18154: }
18155: my $uselink;
18156: my $request = new HTTP::Request('HEAD',$url);
1.1075.2.142 raeburn 18157: my $ua = LWP::UserAgent->new;
18158: $ua->timeout(5);
18159: my $response=$ua->request($request);
1.1075.2.135 raeburn 18160: if ($response->is_success()) {
18161: my $secpolicy = lc($response->header('content-security-policy'));
18162: my $xframeop = lc($response->header('x-frame-options'));
18163: $secpolicy =~ s/^\s+|\s+$//g;
18164: $xframeop =~ s/^\s+|\s+$//g;
18165: if (($secpolicy ne '') || ($xframeop ne '')) {
18166: my $remotehost = $remprotocol.'://'.$remhost;
18167: my ($origin,$protocol,$port);
18168: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
18169: $port = $ENV{'SERVER_PORT'};
18170: } else {
18171: $port = 80;
18172: }
18173: if ($absolute eq '') {
18174: $protocol = 'http:';
18175: if ($port == 443) {
18176: $protocol = 'https:';
18177: }
18178: $origin = $protocol.'//'.lc($hostname);
18179: } else {
18180: $origin = lc($absolute);
18181: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
18182: }
18183: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
18184: my $framepolicy = $1;
18185: $framepolicy =~ s/^\s+|\s+$//g;
18186: my @policies = split(/\s+/,$framepolicy);
18187: if (@policies) {
18188: if (grep(/^\Q'none'\E$/,@policies)) {
18189: $uselink = 1;
18190: } else {
18191: $uselink = 1;
18192: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
18193: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
18194: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
18195: undef($uselink);
18196: }
18197: if ($uselink) {
18198: if (grep(/^\Q'self'\E$/,@policies)) {
18199: if (($origin ne '') && ($remotehost eq $origin)) {
18200: undef($uselink);
18201: }
18202: }
18203: }
18204: if ($uselink) {
18205: my @possok;
18206: if ($ip ne '') {
18207: push(@possok,$ip);
18208: }
18209: my $hoststr = '';
18210: foreach my $part (reverse(split(/\./,$hostname))) {
18211: if ($hoststr eq '') {
18212: $hoststr = $part;
18213: } else {
18214: $hoststr = "$part.$hoststr";
18215: }
18216: if ($hoststr eq $hostname) {
18217: push(@possok,$hostname);
18218: } else {
18219: push(@possok,"*.$hoststr");
18220: }
18221: }
18222: if (@possok) {
18223: foreach my $poss (@possok) {
18224: last if (!$uselink);
18225: foreach my $policy (@policies) {
18226: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
18227: undef($uselink);
18228: last;
18229: }
18230: }
18231: }
18232: }
18233: }
18234: }
18235: }
18236: } elsif ($xframeop ne '') {
18237: $uselink = 1;
18238: my @policies = split(/\s*,\s*/,$xframeop);
18239: if (@policies) {
18240: unless (grep(/^deny$/,@policies)) {
18241: if ($origin ne '') {
18242: if (grep(/^sameorigin$/,@policies)) {
18243: if ($remotehost eq $origin) {
18244: undef($uselink);
18245: }
18246: }
18247: if ($uselink) {
18248: foreach my $policy (@policies) {
18249: if ($policy =~ /^allow-from\s*(.+)$/) {
18250: my $allowfrom = $1;
18251: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
18252: undef($uselink);
18253: last;
18254: }
18255: }
18256: }
18257: }
18258: }
18259: }
18260: }
18261: }
18262: }
18263: }
18264: if ($nocache) {
18265: if ($cached) {
18266: my $devalidate;
18267: if ($uselink && !$result) {
18268: $devalidate = 1;
18269: } elsif (!$uselink && $result) {
18270: $devalidate = 1;
18271: }
18272: if ($devalidate) {
18273: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
18274: }
18275: }
18276: } else {
18277: if ($uselink) {
18278: $result = 1;
18279: } else {
18280: $result = 0;
18281: }
18282: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
18283: }
18284: return $uselink;
18285: }
18286:
1.1075.2.161. .1(raebu 18287:21): sub page_menu {
18288:21): my ($menucolls,$menunum) = @_;
18289:21): my %menu;
18290:21): foreach my $item (split(/;/,$menucolls)) {
18291:21): my ($num,$value) = split(/\%/,$item);
18292:21): if ($num eq $menunum) {
18293:21): my @entries = split(/\&/,$value);
18294:21): foreach my $entry (@entries) {
18295:21): my ($name,$fields) = split(/=/,$entry);
18296:21): if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
18297:21): $menu{$name} = $fields;
18298:21): } else {
18299:21): my @shown;
18300:21): if ($fields =~ /,/) {
18301:21): @shown = split(/,/,$fields);
18302:21): } else {
18303:21): @shown = ($fields);
18304:21): }
18305:21): if (@shown) {
18306:21): foreach my $field (@shown) {
18307:21): next if ($field eq '');
18308:21): $menu{$field} = 1;
18309:21): }
18310:21): }
18311:21): }
18312:21): }
18313:21): }
18314:21): }
18315:21): return %menu;
18316:21): }
18317:21):
1.112 bowersj2 18318: 1;
18319: __END__;
1.41 ng 18320:
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